Newer Older
265 lines | 6.88kb
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1
package DBIx::Custom::Where;
updatedd pod
Yuki Kimoto authored on 2011-06-12
2
use Object::Simple -base;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
3

            
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
4
use Carp 'croak';
5
use DBIx::Custom::Util '_subname';
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
6
use overload 'bool' => sub {1}, fallback => 1;
7
use overload '""' => sub { shift->to_string }, fallback => 1;
8

            
updated document
Yuki Kimoto authored on 2011-01-20
9
# Carp trust relationship
10
push @DBIx::Custom::CARP_NOT, __PACKAGE__;
11

            
sub module use DBIx::Custom ...
Yuki Kimoto authored on 2011-08-02
12
has [qw/dbi param/],
added map method(not complet...
Yuki Kimoto authored on 2011-08-09
13
    clause => sub { [] };
14

            
improved error messages
Yuki Kimoto authored on 2011-04-18
15
sub new {
16
    my $self = shift->SUPER::new(@_);
17
    
18
    # Check attribute names
19
    my @attrs = keys %$self;
cleanup
Yuki Kimoto authored on 2011-10-21
20
    for my $attr (@attrs) {
cleanup
Yuki Kimoto authored on 2011-04-25
21
        croak qq{"$attr" is invalid attribute name (} . _subname . ")"
improved error messages
Yuki Kimoto authored on 2011-04-18
22
          unless $self->can($attr);
23
    }
24
    
25
    return $self;
26
}
27

            
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
28
sub to_string {
added test
Yuki Kimoto authored on 2011-01-19
29
    my $self = shift;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
30
    
many changed
Yuki Kimoto authored on 2011-01-23
31
    # Clause
added test
Yuki Kimoto authored on 2011-01-19
32
    my $clause = $self->clause;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
33
    $clause = ['and', $clause] unless ref $clause eq 'ARRAY';
added test
Yuki Kimoto authored on 2011-01-19
34
    $clause->[0] = 'and' unless @$clause;
added EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-08-09
35
    
many changed
Yuki Kimoto authored on 2011-01-23
36
    # Parse
added test
Yuki Kimoto authored on 2011-01-19
37
    my $where = [];
38
    my $count = {};
micro optimization
Yuki Kimoto authored on 2011-10-24
39
    $self->{_query_builder} = $self->dbi->query_builder;
micro optimization
Yuki Kimoto authored on 2011-11-18
40
    my $c = $self->dbi->safety_character;
41
    $self->{_re} = $c eq 'a-zA-Z0-9_' ?
42
      qr/[^\\]:([$c\.]+)/so : qr/[^\\]:([$c\.]+)/s;
43
    
micro optimization
Yuki Kimoto authored on 2011-10-24
44
    $self->{_quote} = $self->dbi->_quote;
cleanup
Yuki Kimoto authored on 2011-11-16
45
    $self->{_tag_parse} = exists $ENV{DBIX_CUSTOM_TAG_PARSE}
46
      ? $ENV{DBIX_CUSTOM_TAG_PARSE} : $self->dbi->{tag_parse};
many changed
Yuki Kimoto authored on 2011-01-23
47
    $self->_parse($clause, $where, $count, 'and');
micro optimization
Yuki Kimoto authored on 2011-10-24
48

            
many changed
Yuki Kimoto authored on 2011-01-23
49
    # Stringify
50
    unshift @$where, 'where' if @$where;
added test
Yuki Kimoto authored on 2011-01-19
51
    return join(' ', @$where);
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
52
}
- DBIx::Custom::QueryBuilder...
Yuki Kimoto authored on 2011-11-04
53
    
added test
Yuki Kimoto authored on 2011-01-19
54
our %VALID_OPERATIONS = map { $_ => 1 } qw/and or/;
many changed
Yuki Kimoto authored on 2011-01-23
55
sub _parse {
micro optimization
Yuki Kimoto authored on 2011-10-24
56
    my ($self, $clause, $where, $count, $op, $info) = @_;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
57
    
many changed
Yuki Kimoto authored on 2011-01-23
58
    # Array
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
59
    if (ref $clause eq 'ARRAY') {
many changed
Yuki Kimoto authored on 2011-01-23
60
        
61
        # Start
added test
Yuki Kimoto authored on 2011-01-19
62
        push @$where, '(';
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
63
        
many changed
Yuki Kimoto authored on 2011-01-23
64
        # Operation
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
65
        my $op = $clause->[0] || '';
improved error message
Yuki Kimoto authored on 2011-06-13
66
        croak qq{First argument must be "and" or "or" in where clause } .
67
              qq{"$op" is passed} . _subname . ")"
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
68
          unless $VALID_OPERATIONS{$op};
many changed
Yuki Kimoto authored on 2011-01-23
69
        
fixed DBIx::Custom::Where to...
Yuki Kimoto authored on 2011-06-27
70
        my $pushed_array;
many changed
Yuki Kimoto authored on 2011-01-23
71
        # Parse internal clause
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
72
        for (my $i = 1; $i < @$clause; $i++) {
many changed
Yuki Kimoto authored on 2011-01-23
73
            my $pushed = $self->_parse($clause->[$i], $where, $count, $op);
added test
Yuki Kimoto authored on 2011-01-19
74
            push @$where, $op if $pushed;
fixed DBIx::Custom::Where to...
Yuki Kimoto authored on 2011-06-27
75
            $pushed_array = 1 if $pushed;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
76
        }
added test
Yuki Kimoto authored on 2011-01-19
77
        pop @$where if $where->[-1] eq $op;
78
        
many changed
Yuki Kimoto authored on 2011-01-23
79
        # Undo
added test
Yuki Kimoto authored on 2011-01-19
80
        if ($where->[-1] eq '(') {
81
            pop @$where;
fixed DBIx::Custom::Where to...
Yuki Kimoto authored on 2011-06-27
82
            pop @$where if ($where->[-1] || '') eq $op;
added test
Yuki Kimoto authored on 2011-01-19
83
        }
many changed
Yuki Kimoto authored on 2011-01-23
84
        # End
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
85
        else { push @$where, ')' }
fixed DBIx::Custom::Where to...
Yuki Kimoto authored on 2011-06-27
86
        
87
        return $pushed_array;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
88
    }
many changed
Yuki Kimoto authored on 2011-01-23
89
    
90
    # String
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
91
    else {
DBIx::Custom::Where clause a...
Yuki Kimoto authored on 2011-04-18
92
        # Pushed
93
        my $pushed;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
94
        
added test
Yuki Kimoto authored on 2011-01-19
95
        # Column
micro optimization
Yuki Kimoto authored on 2011-11-18
96
        my $re = $self->{_re};
micro optimization
Yuki Kimoto authored on 2011-10-31
97
        
98
        my $column;
cleanup
Yuki Kimoto authored on 2011-11-18
99
        my $sql = " " . $clause || '';
100
        if ($self->{_tag_parse} && ($sql =~ /\s\{/)) {
cleanup
Yuki Kimoto authored on 2011-11-18
101
            my $columns = $self->dbi->query_builder->build_query($sql)->{columns};
micro optimization
Yuki Kimoto authored on 2011-10-31
102
            $column = $columns->[0];
103
        }
fixed where clause parsing b...
Yuki Kimoto authored on 2011-11-01
104
        else {
105
            $sql =~ s/([0-9]):/$1\\:/g;
micro optimization
Yuki Kimoto authored on 2011-11-18
106
            ($column) = $sql =~ /$re/;
fixed where clause parsing b...
Yuki Kimoto authored on 2011-11-01
107
        }
micro optimization
Yuki Kimoto authored on 2011-10-31
108
        unless (defined $column) {
DBIx::Custom::Where clause a...
Yuki Kimoto authored on 2011-04-18
109
            push @$where, $clause;
110
            $pushed = 1;
111
            return $pushed;
112
        }
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
113
        
many changed
Yuki Kimoto authored on 2011-01-23
114
        # Column count up
added test
Yuki Kimoto authored on 2011-01-19
115
        my $count = ++$count->{$column};
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
116
        
many changed
Yuki Kimoto authored on 2011-01-23
117
        # Push
micro optimization
Yuki Kimoto authored on 2011-10-24
118
        my $param = $self->{param};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
119
        if (ref $param eq 'HASH') {
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
120
            if (exists $param->{$column}) {
added map method(not complet...
Yuki Kimoto authored on 2011-08-09
121
                my $if = $self->{_if};
added EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-08-09
122
                
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
123
                if (ref $param->{$column} eq 'ARRAY') {
cleanup
Yuki Kimoto authored on 2011-08-09
124
                    $pushed = 1 if exists $param->{$column}->[$count - 1]
125
                      && ref $param->{$column}->[$count - 1] ne 'DBIx::Custom::NotExists'
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
126
                }
cleanup
Yuki Kimoto authored on 2011-08-09
127
                elsif ($count == 1) { $pushed = 1 }
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
128
            }
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
129
            push @$where, $clause if $pushed;
130
        }
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
131
        elsif (!defined $param) {
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
132
            push @$where, $clause;
133
            $pushed = 1;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
134
        }
improved error messages
Yuki Kimoto authored on 2011-04-18
135
        else {
cleanup
Yuki Kimoto authored on 2011-04-25
136
            croak "Parameter must be hash reference or undfined value ("
137
                . _subname . ")"
improved error messages
Yuki Kimoto authored on 2011-04-18
138
        }
added test
Yuki Kimoto authored on 2011-01-19
139
        return $pushed;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
140
    }
fixed DBIx::Custom::Where to...
Yuki Kimoto authored on 2011-06-27
141
    return;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
142
}
143
1;
144

            
145
=head1 NAME
146

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
147
DBIx::Custom::Where - Where clause
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
148

            
149
=head1 SYNOPSYS
- id option work if id count...
Yuki Kimoto authored on 2011-11-03
150
    
151
    # Create DBIx::Custom::Where object
152
    my $where = $dbi->where;
153
    
154
    # Set clause and parameter
155
    $where->clause(['and', ':title{like}', ':price{=}']);
156
    
157
    # Create where clause by to_string method
158
    my $where_clause = $where->to_string;
159
    
160
    # Create where clause by stringify
161
    my $where_clause = "$where";
162
    
163
    # Created where clause in the above way
164
    where :title{=} and :price{like}
165
    
166
    # Only price condition
167
    $where->clause(['and', ':title{like}', ':price{=}']);
168
    $where->param({price => 1900});
169
    my $where_clause = "$where";
170
    
171
    # Created where clause in the above way
172
    where :price{=}
173
    
174
    # Only title condition
175
    $where->clause(['and', ':title{like}', ':price{=}']);
176
    $where->param({title => 'Perl'});
177
    my $where_clause = "$where";
178
    
179
    # Created where clause in the above way
180
    where :title{like}
181
    
182
    # Nothing
183
    $where->clause(['and', ':title{like}', ':price{=}']);
184
    $where->param({});
185
    my $where_clause = "$where";
186
    
187
    # or condition
188
    $where->clause(['or', ':title{like}', ':price{=}']);
189
    
190
    # More than one parameter
191
    $where->clause(['and', ':price{>}', ':price{<}']);
192
    $where->param({price => [1000, 2000]});
193
    
194
    # Only first condition
195
    $where->clause(['and', ':price{>}', ':price{<}']);
196
    $where->param({price => [1000, $dbi->not_exists]});
197
    
198
    # Only second condition
199
    $where->clause(['and', ':price{>}', ':price{<}']);
200
    $where->param({price => [$dbi->not_exists, 2000]});
201
    
202
    # More complex condition
203
    $where->clause(
204
        [
205
            'and',
206
            ':price{=}',
207
            ['or', ':title{=}', ':title{=}', ':title{=}']
208
        ]
209
    );
210
    my $where_clause = "$where";
211
    
212
    # Created where clause in the above way
213
    where :price{=} and (:title{=} or :title{=} or :title{=})
214
    
215
    # Using Full-qualified column name
216
    $where->clause(['and', ':book.title{like}', ':book.price{=}']);
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
217

            
218
=head1 ATTRIBUTES
219

            
220
=head2 C<clause>
221

            
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
222
    my $clause = $where->clause;
223
    $where = $where->clause(
224
        ['and',
- id option work if id count...
Yuki Kimoto authored on 2011-11-03
225
            ':title{=}', 
226
            ['or', ':date{<}', ':date{>}']
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
227
        ]
added test
Yuki Kimoto authored on 2011-01-19
228
    );
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
229

            
many changed
Yuki Kimoto authored on 2011-01-23
230
Where clause. Above one is expanded to the following SQL by to_string
231
If all parameter names is exists.
232

            
- id option work if id count...
Yuki Kimoto authored on 2011-11-03
233
    where title = :title and ( date < :date or date > :date )
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
234

            
map cleanup
Yuki Kimoto authored on 2011-08-09
235
=head2 C<param>
236

            
237
    my $param = $where->param;
238
    $where = $where->param({
239
        title => 'Perl',
240
        date => ['2010-11-11', '2011-03-05'],
241
    });
242

            
243
=head2 C<dbi>
244

            
245
    my $dbi = $where->dbi;
246
    $where = $where->dbi($dbi);
247

            
248
L<DBIx::Custom> object.
249

            
250
=head1 METHODS
251

            
252
L<DBIx::Custom::Where> inherits all methods from L<Object::Simple>
253
and implements the following new ones.
254

            
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
255
=head2 C<to_string>
256

            
257
    $where->to_string;
added test
Yuki Kimoto authored on 2011-01-19
258

            
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
259
Convert where clause to string.
260

            
261
double quote is override to execute C<to_string> method.
262

            
263
    my $string_where = "$where";
added test
Yuki Kimoto authored on 2011-01-19
264

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
265
=cut