Newer Older
216 lines | 5.585kb
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
    
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
31
    # Check if column name is safety character;
cleanup
Yuki Kimoto authored on 2011-08-02
32
    my $safety = $self->dbi->safety_character;
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
33
    if (ref $self->param eq 'HASH') {
cleanup
Yuki Kimoto authored on 2011-10-21
34
        for my $column (keys %{$self->param}) {
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
35
            croak qq{"$column" is not safety column name (} . _subname . ")"
36
              unless $column =~ /^[$safety\.]+$/;
37
        }
38
    }
many changed
Yuki Kimoto authored on 2011-01-23
39
    # Clause
added test
Yuki Kimoto authored on 2011-01-19
40
    my $clause = $self->clause;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
41
    $clause = ['and', $clause] unless ref $clause eq 'ARRAY';
added test
Yuki Kimoto authored on 2011-01-19
42
    $clause->[0] = 'and' unless @$clause;
added EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-08-09
43
    
many changed
Yuki Kimoto authored on 2011-01-23
44
    # Parse
added test
Yuki Kimoto authored on 2011-01-19
45
    my $where = [];
46
    my $count = {};
micro optimization
Yuki Kimoto authored on 2011-10-24
47
    $self->{_query_builder} = $self->dbi->query_builder;
48
    $self->{_safety_character} = $self->dbi->safety_character;
49
    $self->{_quote} = $self->dbi->_quote;
micro optimization
Yuki Kimoto authored on 2011-10-31
50
    $self->{_tag_parse} = $self->dbi->tag_parse;
many changed
Yuki Kimoto authored on 2011-01-23
51
    $self->_parse($clause, $where, $count, 'and');
micro optimization
Yuki Kimoto authored on 2011-10-24
52

            
53
        
54
    # Check safety
55
    unless (join('', keys %$count) =~ /^[$self->{_safety_character}\.]+$/) {
56
        for my $column (keys %$count) {
57
            croak qq{"$column" is not safety column name (} . _subname . ")"
58
              unless $column =~ /^[$self->{_safety_character}\.]+$/;
59
        }
60
    }
61

            
many changed
Yuki Kimoto authored on 2011-01-23
62
    # Stringify
63
    unshift @$where, 'where' if @$where;
added test
Yuki Kimoto authored on 2011-01-19
64
    return join(' ', @$where);
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
65
}
66

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

            
160
=head1 NAME
161

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

            
164
=head1 SYNOPSYS
165

            
many changed
Yuki Kimoto authored on 2011-01-23
166
    my $where = DBIx::Custom::Where->new;
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
167
    my $string_where = "$where";
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
168

            
169
=head1 ATTRIBUTES
170

            
171
=head2 C<clause>
172

            
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
173
    my $clause = $where->clause;
174
    $where = $where->clause(
175
        ['and',
176
            'title = :title', 
177
            ['or', 'date < :date', 'date > :date']
178
        ]
added test
Yuki Kimoto authored on 2011-01-19
179
    );
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
180

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

            
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
184
    "where ( title = :title and ( date < :date or date > :date ) )"
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
185

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

            
188
    my $param = $where->param;
189
    $where = $where->param({
190
        title => 'Perl',
191
        date => ['2010-11-11', '2011-03-05'],
192
    });
193

            
194
=head2 C<dbi>
195

            
196
    my $dbi = $where->dbi;
197
    $where = $where->dbi($dbi);
198

            
199
L<DBIx::Custom> object.
200

            
201
=head1 METHODS
202

            
203
L<DBIx::Custom::Where> inherits all methods from L<Object::Simple>
204
and implements the following new ones.
205

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

            
208
    $where->to_string;
added test
Yuki Kimoto authored on 2011-01-19
209

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

            
212
double quote is override to execute C<to_string> method.
213

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

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