Newer Older
238 lines | 6.085kb
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
1
package DBIx::Custom::Mapper;
2
use Object::Simple -base;
3

            
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
4
use DBIx::Custom::NotExists;
5

            
added tests
Yuki Kimoto authored on 2011-08-26
6
use Carp 'croak';
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
7
use DBIx::Custom::Util '_subname';
8

            
9
# Carp trust relationship
10
push @DBIx::Custom::CARP_NOT, __PACKAGE__;
11

            
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
12
has [qw/param/],
added tests
Yuki Kimoto authored on 2011-08-26
13
    condition => sub {
14
        sub { defined $_[0] && length $_[0] }
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
15
    },
16
    pass => sub { [] };
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
17

            
18
sub map {
19
    my ($self, %rule) = @_;
20
    my $param = $self->param;
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
21
    $rule{$_} = $rule{$_} for @{$self->pass};
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
22
    
23
    # Mapping
24
    my $new_param = {};
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
25
    foreach my $key (keys %rule) {
26
        
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
27
        my $value_cb;
28
        my $condition;
29
        my $new_key;
30
        
31
        # Get mapping information
- added {KEY => {OPTION_KEY ...
Yuki Kimoto authored on 2011-09-02
32
        $rule{$key} = [$rule{$key}] if ref $rule{$key} ne 'ARRAY';
33
        foreach my $some (@{$rule{$key}}) {
34
            $new_key = $some unless ref $some;
35
            $condition = $some->{condition} if ref $some eq 'HASH';
36
            $value_cb = $some if ref $some eq 'CODE';
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
37
        }
- added {KEY => {OPTION_KEY ...
Yuki Kimoto authored on 2011-09-02
38
        $new_key = $key unless defined $new_key;
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
39
        $value_cb ||= sub { $_[0] };
40
        $condition ||= $self->condition;
41
        $condition = $self->_condition_to_sub($condition);
42

            
43
        # Map parameter
44
        my $value;
45
        if (ref $condition eq 'CODE') {
46
            if (ref $param->{$key} eq 'ARRAY') {
47
                $new_param->{$new_key} = [];
48
                for (my $i = 0; $i < @{$param->{$key}}; $i++) {
49
                    $new_param->{$new_key}->[$i]
50
                      = $condition->($param->{$key}->[$i]) ? $param->{$key}->[$i]
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
51
                      : DBIx::Custom::NotExists->singleton;
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
52
                }
53
            }
54
            else {
55
                $new_param->{$new_key} = $value_cb->($param->{$key})
56
                  if $condition->($param->{$key});
57
            }
58
        }
59
        elsif ($condition eq 'exists') {
60
            if (ref $param->{$key} eq 'ARRAY') {
61
                $new_param->{$new_key} = [];
62
                for (my $i = 0; $i < @{$param->{$key}}; $i++) {
63
                    $new_param->{$new_key}->[$i]
64
                      = exists $param->{$key}->[$i] ? $param->{$key}->[$i]
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
65
                      : DBIx::Custom::NotExists->singleton;
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
66
                }
67
            }
68
            else {
69
                $new_param->{$new_key} = $value_cb->($param->{$key})
70
                  if exists $param->{$key};
71
            }
72
        }
73
        else { croak qq/Condition must be code reference or "exists" / . _subname }
74
    }
75
    
76
    return $new_param;
77
}
78

            
79
sub new {
80
    my $self = shift->SUPER::new(@_);
81
    
82
    # Check attribute names
83
    my @attrs = keys %$self;
84
    foreach my $attr (@attrs) {
85
        croak qq{"$attr" is invalid attribute name (} . _subname . ")"
86
          unless $self->can($attr);
87
    }
88
    
89
    return $self;
90
}
91

            
92

            
93
sub _condition_to_sub {
94
    my ($self, $if) = @_;
95
    $if = $if eq 'exists' ? $if
96
            : $if eq 'defined' ? sub { defined $_[0] }
97
            : $if eq 'length'  ? sub { defined $_[0] && length $_[0] }
98
            : ref $if eq 'CODE' ? $if
99
            : undef;
100

            
101
    croak "You can must specify right value to C<condition> " . _subname
102
      unless $if;
103
    
104
    return $if;
105
}
106

            
107
1;
108

            
109
=head1 NAME
110

            
111
DBIx::Custom::Mapper - Mapper of parameter EXPERIMENTAL
112

            
113
=head1 SYNOPSYS
114

            
115
    my $mapper = $dbi->mapper(param => $param);
116
    my $new_param = $mapper->map(
117
        title => 'book.title', # Key
118
        author => sub { '%' . $_[0] . '%'} # Value
119
        price => ['book.price' => sub { '%' . $_[0] . '%' }], # Key and value
120
    );
121

            
122
=head1 ATTRIBUTES
123

            
124
=head2 C<param>
125

            
126
    my $param = $mapper->param;
127
    $mapper = $mapper->param({title => 'Perl', author => 'Ken'});
128

            
129
Parameter.
130

            
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
131
=head2 C<pass>
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
132

            
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
133
    my $pass = $mapper->pass;
134
    $mapper = $mapper->pass([qw/title author/]);
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
135

            
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
136
the key and value is copied without change when C<map> method is executed.
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
137

            
138
=head2 C<condition>
139

            
140
    my $condition = $mapper->condition;
141
    $mapper = $mapper->condition('exists');
142

            
143
Mapping condtion, default to C<length>.
144

            
145
You can set the following values to C<condition>.
146

            
147
=over 4
148

            
149
=item * C<exists>
150
   
151
    condition => 'exists'
152

            
153
If key exists, key and value is mapped.
154

            
155
=item * C<defined>
156

            
157
    condition => 'defined';
158

            
159
If value is defined, key and value is mapped.
160

            
161
=item * C<length>
162

            
163
    condition => 'length';
164

            
165
If value is defined and has length, key and value is mapped.
166

            
167
=item * C<code reference>
168

            
169
    condition => sub { defined $_[0] }
170

            
171
You can set code reference to C<condtion>.
172
The subroutine return true, key and value is mapped.
173

            
174
=head1 METHODS
175

            
176
L<DBIx::Custom::Mapper> inherits all methods from L<Object::Simple>
177
and implements the following new ones.
178

            
179
=head2 C<map>
180

            
181
    my $new_param = $mapper->map(
182
        price => 'book.price', # Key
183
        title => sub { '%' . $_[0] . '%'}, # Value
184
        author => ['book.author', sub { '%' . $_[0] . '%'}] # Key and value
185
    );
186

            
187
Map C<param>'s key and value and return new parameter.
188

            
189
For example, if C<param> is set to
190

            
191
    {
192
        price => 1900,
193
        title => 'Perl',
194
        author => 'Ken',
195
        issue_date => '2010-11-11'
196
    }
197

            
198
The following hash reference is returned.
199

            
200
    {
201
        'book.price' => 1900,
202
        title => '%Perl%',
203
        'book.author' => '%Ken%',
204
    }
205

            
206
By default, If the value has length, key and value is mapped.
207

            
208
    title => 'Perl'  # Mapped
209
    {title => '' }   # Not mapped
210
    {title => undef} # Not mapped
211
    {}               # Not mapped
212

            
213
You can set change mapping condition by C<condition> attribute.
214

            
215
    $mapper->condition('defined');
216

            
217
Or you can set C<condtion> option for each key.
218

            
219
    my $new_param = $mapper->map(
220
        price => ['book.price', {condition => 'defined'}]
221
        title => [sub { '%' . $_[0] . '%'}, {condition => 'defined'}] # Value
222
        author => ['book.author', sub { '%' . $_[0] . '%'}, condtion => 'exists']
223
    );
224

            
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
225
If C<pass> attrivute is set, the keys and value is copied without change.
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
226

            
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
227
    $mapper->pass([qw/title author/]);
228
    my $new_param = $mapper->map(price => 'book.price');
229

            
230
The following hash reference
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
231
    
232
    {title => 'Perl', author => 'Ken', price => 1900}
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
233

            
234
is mapped to
235

            
236
    {title => 'Perl', author => 'Ken', 'book.price' => 1900}
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
237

            
238
=cut