Newer Older
245 lines | 6.188kb
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
32
        if (ref $rule{$key} eq 'ARRAY') {
33
            foreach my $some (@{$rule{$key}}) {
34
                $new_key = $some unless ref $some;
added tests
Yuki Kimoto authored on 2011-08-26
35
                $condition = $some->{condition} if ref $some eq 'HASH';
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
36
                $value_cb = $some if ref $some eq 'CODE';
37
            }
38
        }
39
        elsif (defined $rule{$key}) {
40
            $new_key = $rule{$key};
41
        }
42
        else {
43
            $new_key = $key;
44
        }
45
        
46
        $value_cb ||= sub { $_[0] };
47
        $condition ||= $self->condition;
48
        $condition = $self->_condition_to_sub($condition);
49

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

            
86
sub new {
87
    my $self = shift->SUPER::new(@_);
88
    
89
    # Check attribute names
90
    my @attrs = keys %$self;
91
    foreach my $attr (@attrs) {
92
        croak qq{"$attr" is invalid attribute name (} . _subname . ")"
93
          unless $self->can($attr);
94
    }
95
    
96
    return $self;
97
}
98

            
99

            
100
sub _condition_to_sub {
101
    my ($self, $if) = @_;
102
    $if = $if eq 'exists' ? $if
103
            : $if eq 'defined' ? sub { defined $_[0] }
104
            : $if eq 'length'  ? sub { defined $_[0] && length $_[0] }
105
            : ref $if eq 'CODE' ? $if
106
            : undef;
107

            
108
    croak "You can must specify right value to C<condition> " . _subname
109
      unless $if;
110
    
111
    return $if;
112
}
113

            
114
1;
115

            
116
=head1 NAME
117

            
118
DBIx::Custom::Mapper - Mapper of parameter EXPERIMENTAL
119

            
120
=head1 SYNOPSYS
121

            
122
    my $mapper = $dbi->mapper(param => $param);
123
    my $new_param = $mapper->map(
124
        title => 'book.title', # Key
125
        author => sub { '%' . $_[0] . '%'} # Value
126
        price => ['book.price' => sub { '%' . $_[0] . '%' }], # Key and value
127
    );
128

            
129
=head1 ATTRIBUTES
130

            
131
=head2 C<param>
132

            
133
    my $param = $mapper->param;
134
    $mapper = $mapper->param({title => 'Perl', author => 'Ken'});
135

            
136
Parameter.
137

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

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

            
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
143
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
144

            
145
=head2 C<condition>
146

            
147
    my $condition = $mapper->condition;
148
    $mapper = $mapper->condition('exists');
149

            
150
Mapping condtion, default to C<length>.
151

            
152
You can set the following values to C<condition>.
153

            
154
=over 4
155

            
156
=item * C<exists>
157
   
158
    condition => 'exists'
159

            
160
If key exists, key and value is mapped.
161

            
162
=item * C<defined>
163

            
164
    condition => 'defined';
165

            
166
If value is defined, key and value is mapped.
167

            
168
=item * C<length>
169

            
170
    condition => 'length';
171

            
172
If value is defined and has length, key and value is mapped.
173

            
174
=item * C<code reference>
175

            
176
    condition => sub { defined $_[0] }
177

            
178
You can set code reference to C<condtion>.
179
The subroutine return true, key and value is mapped.
180

            
181
=head1 METHODS
182

            
183
L<DBIx::Custom::Mapper> inherits all methods from L<Object::Simple>
184
and implements the following new ones.
185

            
186
=head2 C<map>
187

            
188
    my $new_param = $mapper->map(
189
        price => 'book.price', # Key
190
        title => sub { '%' . $_[0] . '%'}, # Value
191
        author => ['book.author', sub { '%' . $_[0] . '%'}] # Key and value
192
    );
193

            
194
Map C<param>'s key and value and return new parameter.
195

            
196
For example, if C<param> is set to
197

            
198
    {
199
        price => 1900,
200
        title => 'Perl',
201
        author => 'Ken',
202
        issue_date => '2010-11-11'
203
    }
204

            
205
The following hash reference is returned.
206

            
207
    {
208
        'book.price' => 1900,
209
        title => '%Perl%',
210
        'book.author' => '%Ken%',
211
    }
212

            
213
By default, If the value has length, key and value is mapped.
214

            
215
    title => 'Perl'  # Mapped
216
    {title => '' }   # Not mapped
217
    {title => undef} # Not mapped
218
    {}               # Not mapped
219

            
220
You can set change mapping condition by C<condition> attribute.
221

            
222
    $mapper->condition('defined');
223

            
224
Or you can set C<condtion> option for each key.
225

            
226
    my $new_param = $mapper->map(
227
        price => ['book.price', {condition => 'defined'}]
228
        title => [sub { '%' . $_[0] . '%'}, {condition => 'defined'}] # Value
229
        author => ['book.author', sub { '%' . $_[0] . '%'}, condtion => 'exists']
230
    );
231

            
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
232
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
233

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

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

            
241
is mapped to
242

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

            
245
=cut