Newer Older
208 lines | 5.205kb
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/],
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
13
    clause => sub { [] };
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
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;
20
    foreach 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') {
34
        foreach my $column (keys %{$self->param}) {
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;
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 = {};
many changed
Yuki Kimoto authored on 2011-01-23
47
    $self->_parse($clause, $where, $count, 'and');
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
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
}
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 {
added test
Yuki Kimoto authored on 2011-01-19
56
    my ($self, $clause, $where, $count, $op) = @_;
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
cleanup
Yuki Kimoto authored on 2011-08-02
96
        my $columns = $self->dbi->query_builder->build_query($clause)->columns;
DBIx::Custom::Where clause a...
Yuki Kimoto authored on 2011-04-18
97
        if (@$columns == 0) {
98
            push @$where, $clause;
99
            $pushed = 1;
100
            return $pushed;
101
        }
102
        elsif (@$columns != 1) {
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
103
            croak qq{Each part contains one column name: "$clause" (}
cleanup
Yuki Kimoto authored on 2011-04-25
104
                  . _subname . ")";
DBIx::Custom::Where clause a...
Yuki Kimoto authored on 2011-04-18
105
        }
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
106
        
107
        # Remove quote
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
108
        my $column = $columns->[0];
sub module use DBIx::Custom ...
Yuki Kimoto authored on 2011-08-02
109
        if (my $q = $self->dbi->_quote) {
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
110
            $q = quotemeta($q);
111
            $column =~ s/[$q]//g;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
112
        }
113
        
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
114
        # Check safety
cleanup
Yuki Kimoto authored on 2011-08-02
115
        my $safety = $self->dbi->safety_character;
cleanup
Yuki Kimoto authored on 2011-04-25
116
        croak qq{"$column" is not safety column name (} . _subname . ")"
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
117
          unless $column =~ /^[$safety\.]+$/;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
118
        
many changed
Yuki Kimoto authored on 2011-01-23
119
        # Column count up
added test
Yuki Kimoto authored on 2011-01-19
120
        my $count = ++$count->{$column};
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
121
        
many changed
Yuki Kimoto authored on 2011-01-23
122
        # Push
123
        my $param = $self->param;
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
124
        if (ref $param eq 'HASH') {
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
125
            if (exists $param->{$column}) {
126
                if (ref $param->{$column} eq 'ARRAY') {
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
127
                    $pushed = 1
128
                      if  exists $param->{$column}->[$count - 1]
129
                       && ref $param->{$column}->[$count - 1] ne 'DBIx::Custom::NotExists';
130
                } 
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
131
                elsif ($count == 1) {
132
                    $pushed = 1;
133
                }
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
134
            }
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
135
            push @$where, $clause if $pushed;
136
        }
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
137
        elsif (!defined $param) {
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
138
            push @$where, $clause;
139
            $pushed = 1;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
140
        }
improved error messages
Yuki Kimoto authored on 2011-04-18
141
        else {
cleanup
Yuki Kimoto authored on 2011-04-25
142
            croak "Parameter must be hash reference or undfined value ("
143
                . _subname . ")"
improved error messages
Yuki Kimoto authored on 2011-04-18
144
        }
added test
Yuki Kimoto authored on 2011-01-19
145
        return $pushed;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
146
    }
fixed DBIx::Custom::Where to...
Yuki Kimoto authored on 2011-06-27
147
    return;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
148
}
149

            
150
1;
151

            
152
=head1 NAME
153

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

            
156
=head1 SYNOPSYS
157

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

            
161
=head1 ATTRIBUTES
162

            
163
=head2 C<clause>
164

            
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
165
    my $clause = $where->clause;
166
    $where = $where->clause(
167
        ['and',
168
            'title = :title', 
169
            ['or', 'date < :date', 'date > :date']
170
        ]
added test
Yuki Kimoto authored on 2011-01-19
171
    );
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
172

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

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

            
update pod
Yuki Kimoto authored on 2011-01-27
178
=head2 C<param>
179

            
180
    my $param = $where->param;
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
181
    $where = $where->param({
182
        title => 'Perl',
183
        date => ['2010-11-11', '2011-03-05'],
184
    });
update pod
Yuki Kimoto authored on 2011-01-27
185

            
cleanup
Yuki Kimoto authored on 2011-08-02
186
=head2 C<dbi>
update pod
Yuki Kimoto authored on 2011-01-27
187

            
cleanup
Yuki Kimoto authored on 2011-08-02
188
    my $dbi = $where->dbi;
189
    $where = $where->dbi($dbi);
190

            
191
L<DBIx::Custom> object.
update pod
Yuki Kimoto authored on 2011-01-27
192

            
193
=head1 METHODS
194

            
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
195
L<DBIx::Custom::Where> inherits all methods from L<Object::Simple>
196
and implements the following new ones.
197

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

            
200
    $where->to_string;
added test
Yuki Kimoto authored on 2011-01-19
201

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

            
204
double quote is override to execute C<to_string> method.
205

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

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