Newer Older
200 lines | 5.059kb
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

            
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
12
has [qw/param query_builder quote safety_character /],
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;
32
    my $safety = $self->safety_character;
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
        
70
        # Parse internal clause
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
71
        for (my $i = 1; $i < @$clause; $i++) {
many changed
Yuki Kimoto authored on 2011-01-23
72
            my $pushed = $self->_parse($clause->[$i], $where, $count, $op);
added test
Yuki Kimoto authored on 2011-01-19
73
            push @$where, $op if $pushed;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
74
        }
added test
Yuki Kimoto authored on 2011-01-19
75
        pop @$where if $where->[-1] eq $op;
76
        
many changed
Yuki Kimoto authored on 2011-01-23
77
        # Undo
added test
Yuki Kimoto authored on 2011-01-19
78
        if ($where->[-1] eq '(') {
79
            pop @$where;
80
            pop @$where;
81
        }
many changed
Yuki Kimoto authored on 2011-01-23
82
        # End
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
83
        else { push @$where, ')' }
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
84
    }
many changed
Yuki Kimoto authored on 2011-01-23
85
    
86
    # String
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
87
    else {
DBIx::Custom::Where clause a...
Yuki Kimoto authored on 2011-04-18
88
        # Pushed
89
        my $pushed;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
90
        
added test
Yuki Kimoto authored on 2011-01-19
91
        # Column
92
        my $columns = $self->query_builder->build_query($clause)->columns;
DBIx::Custom::Where clause a...
Yuki Kimoto authored on 2011-04-18
93
        if (@$columns == 0) {
94
            push @$where, $clause;
95
            $pushed = 1;
96
            return $pushed;
97
        }
98
        elsif (@$columns != 1) {
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
99
            croak qq{Each part contains one column name: "$clause" (}
cleanup
Yuki Kimoto authored on 2011-04-25
100
                  . _subname . ")";
DBIx::Custom::Where clause a...
Yuki Kimoto authored on 2011-04-18
101
        }
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
102
        
103
        # Remove quote
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
104
        my $column = $columns->[0];
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
105
        if (my $q = $self->quote) {
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
106
            $column =~ s/$q//g;
107
        }
108
        
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
109
        # Check safety
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
110
        my $safety = $self->safety_character;
cleanup
Yuki Kimoto authored on 2011-04-25
111
        croak qq{"$column" is not safety column name (} . _subname . ")"
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
112
          unless $column =~ /^[$safety\.]+$/;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
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
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}) {
121
                if (ref $param->{$column} eq 'ARRAY') {
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
122
                    $pushed = 1
123
                      if  exists $param->{$column}->[$count - 1]
124
                       && ref $param->{$column}->[$count - 1] ne 'DBIx::Custom::NotExists';
125
                } 
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
126
                elsif ($count == 1) {
127
                    $pushed = 1;
128
                }
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
129
            }
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
130
            push @$where, $clause if $pushed;
131
        }
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
132
        elsif (!defined $param) {
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
133
            push @$where, $clause;
134
            $pushed = 1;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
135
        }
improved error messages
Yuki Kimoto authored on 2011-04-18
136
        else {
cleanup
Yuki Kimoto authored on 2011-04-25
137
            croak "Parameter must be hash reference or undfined value ("
138
                . _subname . ")"
improved error messages
Yuki Kimoto authored on 2011-04-18
139
        }
added test
Yuki Kimoto authored on 2011-01-19
140
        return $pushed;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
141
    }
142
}
143

            
144
1;
145

            
146
=head1 NAME
147

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

            
150
=head1 SYNOPSYS
151

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

            
155
=head1 ATTRIBUTES
156

            
157
=head2 C<clause>
158

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

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

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

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

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

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

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

            
185
=head1 METHODS
186

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

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

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

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

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

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

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