Newer Older
187 lines | 4.761kb
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1
package DBIx::Custom::Where;
2

            
updatedd pod
Yuki Kimoto authored on 2011-06-12
3
use Object::Simple -base;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
4

            
5
use overload 'bool' => sub {1}, fallback => 1;
6
use overload '""' => sub { shift->to_string }, fallback => 1;
7

            
cleanup
Yuki Kimoto authored on 2011-04-25
8
use DBIx::Custom::Util '_subname';
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
9
use Carp 'croak';
10

            
updated document
Yuki Kimoto authored on 2011-01-20
11
# Carp trust relationship
12
push @DBIx::Custom::CARP_NOT, __PACKAGE__;
13

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

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

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

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

            
added test
Yuki Kimoto authored on 2011-01-19
57
our %VALID_OPERATIONS = map { $_ => 1 } qw/and or/;
many changed
Yuki Kimoto authored on 2011-01-23
58
sub _parse {
added test
Yuki Kimoto authored on 2011-01-19
59
    my ($self, $clause, $where, $count, $op) = @_;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
60
    
many changed
Yuki Kimoto authored on 2011-01-23
61
    # Array
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
62
    if (ref $clause eq 'ARRAY') {
many changed
Yuki Kimoto authored on 2011-01-23
63
        
64
        # Start
added test
Yuki Kimoto authored on 2011-01-19
65
        push @$where, '(';
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
66
        
many changed
Yuki Kimoto authored on 2011-01-23
67
        # Operation
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
68
        my $op = $clause->[0] || '';
cleanup
Yuki Kimoto authored on 2011-04-25
69
        croak qq{"$op" is invalid operation (} . _subname . ")"
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
70
          unless $VALID_OPERATIONS{$op};
many changed
Yuki Kimoto authored on 2011-01-23
71
        
72
        # Parse internal clause
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
73
        for (my $i = 1; $i < @$clause; $i++) {
many changed
Yuki Kimoto authored on 2011-01-23
74
            my $pushed = $self->_parse($clause->[$i], $where, $count, $op);
added test
Yuki Kimoto authored on 2011-01-19
75
            push @$where, $op 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;
82
            pop @$where;
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, ')' }
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
86
    }
many changed
Yuki Kimoto authored on 2011-01-23
87
    
88
    # String
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
89
    else {
DBIx::Custom::Where clause a...
Yuki Kimoto authored on 2011-04-18
90
        # Pushed
91
        my $pushed;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
92
        
added test
Yuki Kimoto authored on 2011-01-19
93
        # Column
94
        my $columns = $self->query_builder->build_query($clause)->columns;
DBIx::Custom::Where clause a...
Yuki Kimoto authored on 2011-04-18
95
        if (@$columns == 0) {
96
            push @$where, $clause;
97
            $pushed = 1;
98
            return $pushed;
99
        }
100
        elsif (@$columns != 1) {
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
101
            croak qq{Each part contains one column name: "$clause" (}
cleanup
Yuki Kimoto authored on 2011-04-25
102
                  . _subname . ")";
DBIx::Custom::Where clause a...
Yuki Kimoto authored on 2011-04-18
103
        }
104

            
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
        
- 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;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
153

            
154
=head1 ATTRIBUTES
155

            
156
=head2 C<clause>
157

            
added test
Yuki Kimoto authored on 2011-01-19
158
    $where->clause(
159
        ['and', '{= title}', ['or', '{< date}', '{> date}']]
160
    );
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
161

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

            
165
    "where ( {= title} and ( {< date} or {> date} ) )"
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
166

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

            
169
    my $param = $where->param;
170
    $where    = $where->param({title => 'Perl',
171
                               date => ['2010-11-11', '2011-03-05']},
172
                               name => ['Ken', 'Taro']);
173

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
176
    my $safety_character = $self->safety_character;
177
    $dbi                 = $self->safety_character($name);
update pod
Yuki Kimoto authored on 2011-01-27
178

            
179
=head1 METHODS
180

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

            
183
    $where->to_string;
added test
Yuki Kimoto authored on 2011-01-19
184

            
185
Convert where clause to string correspoinding to param name.
186

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