Newer Older
123 lines | 2.83kb
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

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

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

            
26
    my $where = [];
27
    my $count = {};
28
    $self->_forward($clause, $where, $count, 'and');
29

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

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

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

            
92
1;
93

            
94
=head1 NAME
95

            
96
DBIx::Custom::Where - Where clause
97

            
98
=head1 SYNOPSYS
99

            
100
    $where = DBIx::Custom::Where->new;
101
    
102
    my $sql = "select * from book $where";
103

            
104
=head1 ATTRIBUTES
105

            
106
=head2 C<param>
107

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

            
114
=head2 C<clause>
115

            
fix tests
Yuki Kimoto authored on 2011-01-18
116
    $where->clause(title => '{= title}', date => ['{< date}', '{> date}']);
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
117

            
fix tests
Yuki Kimoto authored on 2011-01-18
118
Where clause. These clauses is joined by ' and ' at C<to_string()>
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
119
if corresponding parameter name is exists in C<param>.
120

            
121
=head2 C<to_string>
122

            
123
    $where->to_string;