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

            
3
use strict;
4
use warnings;
5

            
6
use base 'Object::Simple';
7

            
8
use overload 'bool' => sub {1}, fallback => 1;
9
use overload '""' => sub { shift->to_string }, fallback => 1;
10

            
11
use Carp 'croak';
12

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

            
added test
Yuki Kimoto authored on 2011-01-19
16
__PACKAGE__->attr(
17
  'query_builder',
18
  clause => sub { [] },
19
  param => sub { {} }
20
);
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
21

            
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
22
sub to_string {
added test
Yuki Kimoto authored on 2011-01-19
23
    my $self = shift;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
24
    
added test
Yuki Kimoto authored on 2011-01-19
25
    my $clause = $self->clause;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
26
    $clause = ['and', $clause] unless ref $clause eq 'ARRAY';
added test
Yuki Kimoto authored on 2011-01-19
27
    $clause->[0] = 'and' unless @$clause;
28

            
29
    my $where = [];
30
    my $count = {};
31
    $self->_forward($clause, $where, $count, 'and');
32

            
33
    unshift @$where, 'where' if @$where;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
34
    
added test
Yuki Kimoto authored on 2011-01-19
35
    return join(' ', @$where);
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
36
}
37

            
added test
Yuki Kimoto authored on 2011-01-19
38
our %VALID_OPERATIONS = map { $_ => 1 } qw/and or/;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
39

            
40
sub _forward {
added test
Yuki Kimoto authored on 2011-01-19
41
    my ($self, $clause, $where, $count, $op) = @_;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
42
    
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
43
    if (ref $clause eq 'ARRAY') {
added test
Yuki Kimoto authored on 2011-01-19
44
        push @$where, '(';
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
45
        
46
        my $op = $clause->[0] || '';
47
        
48
        croak qq{"$op" is invalid operation}
49
          unless $VALID_OPERATIONS{$op};
50
          
51
        for (my $i = 1; $i < @$clause; $i++) {
added test
Yuki Kimoto authored on 2011-01-19
52
            my $pushed = $self->_forward($clause->[$i], $where, $count, $op);
53
            push @$where, $op if $pushed;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
54
        }
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
55
        
added test
Yuki Kimoto authored on 2011-01-19
56
        pop @$where if $where->[-1] eq $op;
57
        
58
        if ($where->[-1] eq '(') {
59
            pop @$where;
60
            pop @$where;
61
        }
62
        else {
63
            push @$where, ')';
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
64
        }
65
    }
66
    else {
67
        
added test
Yuki Kimoto authored on 2011-01-19
68
        # Column
69
        my $columns = $self->query_builder->build_query($clause)->columns;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
70
        croak qq{each tag contains one column name: tag "$clause"}
71
          unless @$columns == 1;
72
        my $column = $columns->[0];
73
        
added test
Yuki Kimoto authored on 2011-01-19
74
        # Count up
75
        my $count = ++$count->{$column};
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
76
        
added test
Yuki Kimoto authored on 2011-01-19
77
        # Push element
78
        my $param    = $self->param;
79
        my $pushed;
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
80
        if (exists $param->{$column}) {
added test
Yuki Kimoto authored on 2011-01-19
81
            if (ref $param->{$column} eq 'ARRAY') {
82
                $pushed = 1 if exists $param->{$column}->[$count - 1];
changed DBIx::Custom::Where ...
Yuki Kimoto authored on 2011-01-19
83
            }
added test
Yuki Kimoto authored on 2011-01-19
84
            elsif ($count == 1) {
85
                $pushed = 1;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
86
            }
87
        }
added test
Yuki Kimoto authored on 2011-01-19
88
        
89
        push @$where, $clause if $pushed;
90
        
91
        return $pushed;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
92
    }
93
}
94

            
95
1;
96

            
97
=head1 NAME
98

            
99
DBIx::Custom::Where - Where clause
100

            
101
=head1 SYNOPSYS
102

            
103
    $where = DBIx::Custom::Where->new;
104
    
105
    my $sql = "select * from book $where";
106

            
107
=head1 ATTRIBUTES
108

            
109
=head2 C<param>
110

            
111
    my $param = $where->param;
112
    $where    = $where->param({title => 'Perl',
113
                               date => ['2010-11-11', '2011-03-05']},
114
                               name => ['Ken', 'Taro']);
115
=head1 METHODS
116

            
117
=head2 C<clause>
118

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

            
added test
Yuki Kimoto authored on 2011-01-19
123
Where clause.
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
124

            
125
=head2 C<to_string>
126

            
127
    $where->to_string;
added test
Yuki Kimoto authored on 2011-01-19
128

            
129
Convert where clause to string correspoinding to param name.
130