Newer Older
255 lines | 6.522kb
added Next version
Yuki Kimoto authored on 2011-11-16
1
package DBIx::Custom::Next::Where;
2
use Object::Simple -base;
3

            
4
use Carp 'croak';
5
use DBIx::Custom::Next::Util '_subname';
6
use overload 'bool' => sub {1}, fallback => 1;
7
use overload '""' => sub { shift->to_string }, fallback => 1;
8

            
9
# Carp trust relationship
10
push @DBIx::Custom::Next::CARP_NOT, __PACKAGE__;
11

            
12
has [qw/dbi param/],
13
    clause => sub { [] };
14

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

            
28
sub to_string {
29
    my $self = shift;
30
    
31
    # Clause
32
    my $clause = $self->clause;
33
    $clause = ['and', $clause] unless ref $clause eq 'ARRAY';
34
    $clause->[0] = 'and' unless @$clause;
35
    
36
    # Parse
37
    my $where = [];
38
    my $count = {};
39
    $self->{_safety_character} = $self->dbi->safety_character;
40
    $self->{_quote} = $self->dbi->quote;
41
    $self->_parse($clause, $where, $count, 'and');
42

            
43
    # Stringify
44
    unshift @$where, 'where' if @$where;
45
    return join(' ', @$where);
46
}
47
    
48
our %VALID_OPERATIONS = map { $_ => 1 } qw/and or/;
49
sub _parse {
50
    my ($self, $clause, $where, $count, $op, $info) = @_;
51
    
52
    # Array
53
    if (ref $clause eq 'ARRAY') {
54
        
55
        # Start
56
        push @$where, '(';
57
        
58
        # Operation
59
        my $op = $clause->[0] || '';
60
        croak qq{First argument must be "and" or "or" in where clause } .
61
              qq{"$op" is passed} . _subname . ")"
62
          unless $VALID_OPERATIONS{$op};
63
        
64
        my $pushed_array;
65
        # Parse internal clause
66
        for (my $i = 1; $i < @$clause; $i++) {
67
            my $pushed = $self->_parse($clause->[$i], $where, $count, $op);
68
            push @$where, $op if $pushed;
69
            $pushed_array = 1 if $pushed;
70
        }
71
        pop @$where if $where->[-1] eq $op;
72
        
73
        # Undo
74
        if ($where->[-1] eq '(') {
75
            pop @$where;
76
            pop @$where if ($where->[-1] || '') eq $op;
77
        }
78
        # End
79
        else { push @$where, ')' }
80
        
81
        return $pushed_array;
82
    }
83
    
84
    # String
85
    else {
86
        # Pushed
87
        my $pushed;
88
        
89
        # Column
90
        my $c = $self->{_safety_character};
91
        
92
        my $column;
93
        my $sql = $clause;
94
        $sql =~ s/([0-9]):/$1\\:/g;
95
        if ($sql =~ /[^\\]:([$c\.]+)/s || $sql =~ /^:([$c\.]+)/s) {
96
            $column = $1;
97
        }
98
        unless (defined $column) {
99
            push @$where, $clause;
100
            $pushed = 1;
101
            return $pushed;
102
        }
103
        
104
        # Column count up
105
        my $count = ++$count->{$column};
106
        
107
        # Push
108
        my $param = $self->{param};
109
        if (ref $param eq 'HASH') {
110
            if (exists $param->{$column}) {
111
                my $if = $self->{_if};
112
                
113
                if (ref $param->{$column} eq 'ARRAY') {
114
                    $pushed = 1 if exists $param->{$column}->[$count - 1]
115
                      && ref $param->{$column}->[$count - 1] ne 'DBIx::Custom::Next::NotExists'
116
                }
117
                elsif ($count == 1) { $pushed = 1 }
118
            }
119
            push @$where, $clause if $pushed;
120
        }
121
        elsif (!defined $param) {
122
            push @$where, $clause;
123
            $pushed = 1;
124
        }
125
        else {
126
            croak "Parameter must be hash reference or undfined value ("
127
                . _subname . ")"
128
        }
129
        return $pushed;
130
    }
131
    return;
132
}
133
1;
134

            
135
=head1 NAME
136

            
137
DBIx::Custom::Next::Where - Where clause
138

            
139
=head1 SYNOPSYS
140
    
141
    # Create DBIx::Custom::Next::Where object
142
    my $where = $dbi->where;
143
    
144
    # Set clause and parameter
145
    $where->clause(['and', ':title{like}', ':price{=}']);
146
    
147
    # Create where clause by to_string method
148
    my $where_clause = $where->to_string;
149
    
150
    # Create where clause by stringify
151
    my $where_clause = "$where";
152
    
153
    # Created where clause in the above way
154
    where :title{=} and :price{like}
155
    
156
    # Only price condition
157
    $where->clause(['and', ':title{like}', ':price{=}']);
158
    $where->param({price => 1900});
159
    my $where_clause = "$where";
160
    
161
    # Created where clause in the above way
162
    where :price{=}
163
    
164
    # Only title condition
165
    $where->clause(['and', ':title{like}', ':price{=}']);
166
    $where->param({title => 'Perl'});
167
    my $where_clause = "$where";
168
    
169
    # Created where clause in the above way
170
    where :title{like}
171
    
172
    # Nothing
173
    $where->clause(['and', ':title{like}', ':price{=}']);
174
    $where->param({});
175
    my $where_clause = "$where";
176
    
177
    # or condition
178
    $where->clause(['or', ':title{like}', ':price{=}']);
179
    
180
    # More than one parameter
181
    $where->clause(['and', ':price{>}', ':price{<}']);
182
    $where->param({price => [1000, 2000]});
183
    
184
    # Only first condition
185
    $where->clause(['and', ':price{>}', ':price{<}']);
186
    $where->param({price => [1000, $dbi->not_exists]});
187
    
188
    # Only second condition
189
    $where->clause(['and', ':price{>}', ':price{<}']);
190
    $where->param({price => [$dbi->not_exists, 2000]});
191
    
192
    # More complex condition
193
    $where->clause(
194
        [
195
            'and',
196
            ':price{=}',
197
            ['or', ':title{=}', ':title{=}', ':title{=}']
198
        ]
199
    );
200
    my $where_clause = "$where";
201
    
202
    # Created where clause in the above way
203
    where :price{=} and (:title{=} or :title{=} or :title{=})
204
    
205
    # Using Full-qualified column name
206
    $where->clause(['and', ':book.title{like}', ':book.price{=}']);
207

            
208
=head1 ATTRIBUTES
209

            
210
=head2 C<clause>
211

            
212
    my $clause = $where->clause;
213
    $where = $where->clause(
214
        ['and',
215
            ':title{=}', 
216
            ['or', ':date{<}', ':date{>}']
217
        ]
218
    );
219

            
220
Where clause. Above one is expanded to the following SQL by to_string
221
If all parameter names is exists.
222

            
223
    where title = :title and ( date < :date or date > :date )
224

            
225
=head2 C<param>
226

            
227
    my $param = $where->param;
228
    $where = $where->param({
229
        title => 'Perl',
230
        date => ['2010-11-11', '2011-03-05'],
231
    });
232

            
233
=head2 C<dbi>
234

            
235
    my $dbi = $where->dbi;
236
    $where = $where->dbi($dbi);
237

            
238
L<DBIx::Custom::Next> object.
239

            
240
=head1 METHODS
241

            
242
L<DBIx::Custom::Next::Where> inherits all methods from L<Object::Simple>
243
and implements the following new ones.
244

            
245
=head2 C<to_string>
246

            
247
    $where->to_string;
248

            
249
Convert where clause to string.
250

            
251
double quote is override to execute C<to_string> method.
252

            
253
    my $string_where = "$where";
254

            
255
=cut