Newer Older
131 lines | 3.087kb
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

            
13
__PACKAGE__->attr(param => sub { {} });
14

            
15
sub clause {
16
    my $self = shift;
17
    
18
    if (@_) {
19
        $self->{clause} = ref $_[0] eq 'HASH' ? $_[0] : {@_};
20
        
21
        return $self;
22
    }
23
    return $self->{clause} ||= {};
24
}
25

            
26
sub or_clause {
27
    my $self = shift;
28
    
29
    if (@_) {
30
        $self->{or_clause} = ref $_[0] eq 'HASH' ? $_[0] : {@_};
31
        
32
        return $self;
33
    }
34
    
35
    return $self->{or_clause} ||= {};
36
}
37

            
38
sub to_string {
39
    my $self = shift;
40
    
41
    my $param      = $self->param;
42
    my $clauses    = $self->clause;
43
    my $or_clauses = $self->or_clause;
44
    
45
    # Clause check
46
    my $wexists = keys %$param;
47
    
48
    # Where
49
    my $where = '';
50
    if ($wexists) {
51
        $where .= 'where (';
52
        
53
        foreach my $column (keys %$param) {
54

            
55
            croak qq{"$column" is not found in "clause" or "or_clause"}
56
              if exists $clauses->{$column}
57
                  && exists $or_clauses->{$column};
58
            
59
            if (exists $clauses->{$column}) {
60
                if (ref $clauses->{$column} eq 'ARRAY') {
61
                    foreach my $clause (@{$clauses->{$column}}) {
62
                        $where .= $clause . ' and ';
63
                    }
64
                }
65
                else {
66
                    $where .= $clauses->{$column} . ' and ';
67
                }
68
                            }
69
            elsif (exists $or_clauses->{$column}) {
70
                my $clause = $or_clauses->{$column};
71
                
72
                if (ref $param->{$column} eq 'ARRAY') {
73
                    my $count = @{$param->{$column}};
74
                    if ($count) {
75
                        $where .= '( ';
76
                        $where .= $clause . ' or ' for (1 .. $count);
77
                        $where =~ s/ or $//;
78
                        $where .= ' ) and ';
79
                    }
80
                }
81
                else {
82
                    $where .= $clause . ' and ';
83
                }
84
            }
85
        }
86

            
87
        $where =~ s/ and $//;
88
        $where .= ' )';
89
    }
90
    
91
    return $where;
92
}
93

            
94
1;
95

            
96
=head1 NAME
97

            
98
DBIx::Custom::Where - Where clause
99

            
100
=head1 SYNOPSYS
101

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

            
106
=head1 ATTRIBUTES
107

            
108
=head2 C<param>
109

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

            
116
=head2 C<clause>
117

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

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

            
fix tests
Yuki Kimoto authored on 2011-01-18
123
=head2 C<or_clause>
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
124

            
fix tests
Yuki Kimoto authored on 2011-01-18
125
    $where->or_clause(name => '{= name}');
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
126

            
fix tests
Yuki Kimoto authored on 2011-01-18
127
clause which has these parameter name is joined by ' or '.
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
128

            
129
=head2 C<to_string>
130

            
131
    $where->to_string;