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

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

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

            
100

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

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

            
115
1;
116

            
117
=head1 NAME
118

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

            
121
=head1 SYNOPSYS
122

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

            
130
=head1 ATTRIBUTES
131

            
132
=head2 C<param>
133

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

            
137
Parameter.
138

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

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

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

            
146
=head2 C<condition>
147

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

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

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

            
155
=over 4
156

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

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

            
163
=item * C<defined>
164

            
165
    condition => 'defined';
166

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

            
169
=item * C<length>
170

            
171
    condition => 'length';
172

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

            
175
=item * C<code reference>
176

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

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

            
182
=head1 METHODS
183

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

            
187
=head2 C<map>
188

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

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

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

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

            
206
The following hash reference is returned.
207

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

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

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

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

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

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

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

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

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

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

            
242
is mapped to
243

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

            
246
=cut