Newer Older
201 lines | 5.097kb
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

            
updatedd pod
Yuki Kimoto authored on 2011-06-12
12
has [qw/param query_builder safety_character/],
cleanup
Yuki Kimoto authored on 2011-01-25
13
    clause => sub { [] },
updatedd pod
Yuki Kimoto authored on 2011-06-12
14
    reserved_word_quote => '';
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
15

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

            
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
29
sub to_string {
added test
Yuki Kimoto authored on 2011-01-19
30
    my $self = shift;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
31
    
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
32
    # Check if column name is safety character;
33
    my $safety = $self->safety_character;
34
    if (ref $self->param eq 'HASH') {
35
        foreach my $column (keys %{$self->param}) {
36
            croak qq{"$column" is not safety column name (} . _subname . ")"
37
              unless $column =~ /^[$safety\.]+$/;
38
        }
39
    }
many changed
Yuki Kimoto authored on 2011-01-23
40
    # Clause
added test
Yuki Kimoto authored on 2011-01-19
41
    my $clause = $self->clause;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
42
    $clause = ['and', $clause] unless ref $clause eq 'ARRAY';
added test
Yuki Kimoto authored on 2011-01-19
43
    $clause->[0] = 'and' unless @$clause;
44

            
many changed
Yuki Kimoto authored on 2011-01-23
45
    # Parse
added test
Yuki Kimoto authored on 2011-01-19
46
    my $where = [];
47
    my $count = {};
many changed
Yuki Kimoto authored on 2011-01-23
48
    $self->_parse($clause, $where, $count, 'and');
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
49
    
many changed
Yuki Kimoto authored on 2011-01-23
50
    # Stringify
51
    unshift @$where, 'where' if @$where;
added test
Yuki Kimoto authored on 2011-01-19
52
    return join(' ', @$where);
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
53
}
54

            
added test
Yuki Kimoto authored on 2011-01-19
55
our %VALID_OPERATIONS = map { $_ => 1 } qw/and or/;
many changed
Yuki Kimoto authored on 2011-01-23
56
sub _parse {
added test
Yuki Kimoto authored on 2011-01-19
57
    my ($self, $clause, $where, $count, $op) = @_;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
58
    
many changed
Yuki Kimoto authored on 2011-01-23
59
    # Array
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
60
    if (ref $clause eq 'ARRAY') {
many changed
Yuki Kimoto authored on 2011-01-23
61
        
62
        # Start
added test
Yuki Kimoto authored on 2011-01-19
63
        push @$where, '(';
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
64
        
many changed
Yuki Kimoto authored on 2011-01-23
65
        # Operation
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
66
        my $op = $clause->[0] || '';
improved error message
Yuki Kimoto authored on 2011-06-13
67
        croak qq{First argument must be "and" or "or" in where clause } .
68
              qq{"$op" is passed} . _subname . ")"
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
69
          unless $VALID_OPERATIONS{$op};
many changed
Yuki Kimoto authored on 2011-01-23
70
        
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;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
75
        }
added test
Yuki Kimoto authored on 2011-01-19
76
        pop @$where if $where->[-1] eq $op;
77
        
many changed
Yuki Kimoto authored on 2011-01-23
78
        # Undo
added test
Yuki Kimoto authored on 2011-01-19
79
        if ($where->[-1] eq '(') {
80
            pop @$where;
81
            pop @$where;
82
        }
many changed
Yuki Kimoto authored on 2011-01-23
83
        # End
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
84
        else { push @$where, ')' }
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
85
    }
many changed
Yuki Kimoto authored on 2011-01-23
86
    
87
    # String
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
88
    else {
DBIx::Custom::Where clause a...
Yuki Kimoto authored on 2011-04-18
89
        # Pushed
90
        my $pushed;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
91
        
added test
Yuki Kimoto authored on 2011-01-19
92
        # Column
93
        my $columns = $self->query_builder->build_query($clause)->columns;
DBIx::Custom::Where clause a...
Yuki Kimoto authored on 2011-04-18
94
        if (@$columns == 0) {
95
            push @$where, $clause;
96
            $pushed = 1;
97
            return $pushed;
98
        }
99
        elsif (@$columns != 1) {
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
100
            croak qq{Each part contains one column name: "$clause" (}
cleanup
Yuki Kimoto authored on 2011-04-25
101
                  . _subname . ")";
DBIx::Custom::Where clause a...
Yuki Kimoto authored on 2011-04-18
102
        }
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
103
        
104
        # Remove quote
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
105
        my $column = $columns->[0];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
106
        if (my $q = $self->reserved_word_quote) {
107
            $column =~ s/$q//g;
108
        }
109
        
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
110
        # Check safety
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
111
        my $safety = $self->safety_character;
cleanup
Yuki Kimoto authored on 2011-04-25
112
        croak qq{"$column" is not safety column name (} . _subname . ")"
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
113
          unless $column =~ /^[$safety\.]+$/;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
114
        
many changed
Yuki Kimoto authored on 2011-01-23
115
        # Column count up
added test
Yuki Kimoto authored on 2011-01-19
116
        my $count = ++$count->{$column};
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
117
        
many changed
Yuki Kimoto authored on 2011-01-23
118
        # Push
119
        my $param = $self->param;
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
120
        if (ref $param eq 'HASH') {
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
121
            if (exists $param->{$column}) {
122
                if (ref $param->{$column} eq 'ARRAY') {
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
123
                    $pushed = 1
124
                      if  exists $param->{$column}->[$count - 1]
125
                       && ref $param->{$column}->[$count - 1] ne 'DBIx::Custom::NotExists';
126
                } 
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
127
                elsif ($count == 1) {
128
                    $pushed = 1;
129
                }
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
130
            }
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
131
            push @$where, $clause if $pushed;
132
        }
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
133
        elsif (!defined $param) {
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
134
            push @$where, $clause;
135
            $pushed = 1;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
136
        }
improved error messages
Yuki Kimoto authored on 2011-04-18
137
        else {
cleanup
Yuki Kimoto authored on 2011-04-25
138
            croak "Parameter must be hash reference or undfined value ("
139
                . _subname . ")"
improved error messages
Yuki Kimoto authored on 2011-04-18
140
        }
added test
Yuki Kimoto authored on 2011-01-19
141
        return $pushed;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
142
    }
143
}
144

            
145
1;
146

            
147
=head1 NAME
148

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

            
151
=head1 SYNOPSYS
152

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

            
156
=head1 ATTRIBUTES
157

            
158
=head2 C<clause>
159

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

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

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
181
=head2 C<safety_character>
update pod
Yuki Kimoto authored on 2011-01-27
182

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
183
    my $safety_character = $self->safety_character;
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
184
    $where = $self->safety_character("\w");
update pod
Yuki Kimoto authored on 2011-01-27
185

            
186
=head1 METHODS
187

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

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

            
193
    $where->to_string;
added test
Yuki Kimoto authored on 2011-01-19
194

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

            
197
double quote is override to execute C<to_string> method.
198

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

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