Showing 13 changed files with 355 additions and 1 deletions
+3
Changes
... ...
@@ -1,3 +1,6 @@
1
+0.1721
2
+    - added EXPERIMENTAL DBIx::Custom::Mapper class
3
+    - added EXPERIMENTAL mapper method to DBIx::Custom
1 4
 0.1720
2 5
     - removed placeholder count check
3 6
     - added EXPERIMENTAL execute method's id and primary key option.
+6 -1
lib/DBIx/Custom.pm
... ...
@@ -1,7 +1,7 @@
1 1
 package DBIx::Custom;
2 2
 use Object::Simple -base;
3 3
 
4
-our $VERSION = '0.1720';
4
+our $VERSION = '0.1721';
5 5
 use 5.008001;
6 6
 
7 7
 use Carp 'croak';
... ...
@@ -714,6 +714,11 @@ sub include_model {
714 714
     return $self;
715 715
 }
716 716
 
717
+sub mapper {
718
+    my $self = shift;
719
+    return DBIx::Custom::Mapper->new(@_);
720
+}
721
+
717 722
 sub map_param {
718 723
     my $self = shift;
719 724
     my $param = shift;
+233
lib/DBIx/Custom/Mapper.pm
... ...
@@ -0,0 +1,233 @@
1
+package DBIx::Custom::Mapper;
2
+use Object::Simple -base;
3
+
4
+use DBIx::Custom::Util '_subname';
5
+
6
+# Carp trust relationship
7
+push @DBIx::Custom::CARP_NOT, __PACKAGE__;
8
+
9
+has [qw/param pass/]
10
+    condition => sub { defined $_[0] && length $_[0] };
11
+
12
+sub map {
13
+    my ($self, %rule) = @_;
14
+    my $param = $self->param;
15
+    
16
+    # Mapping
17
+    my $new_param = {};
18
+    foreach my $key (keys %$param) {
19
+    
20
+        my $value_cb;
21
+        my $condition;
22
+        my $new_key;
23
+        
24
+        # Get mapping information
25
+        if (ref $rule{$key} eq 'ARRAY') {
26
+            foreach my $some (@{$rule{$key}}) {
27
+                $new_key = $some unless ref $some;
28
+                $condition = $some->{if} if ref $some eq 'HASH';
29
+                $value_cb = $some if ref $some eq 'CODE';
30
+            }
31
+        }
32
+        elsif (defined $rule{$key}) {
33
+            $new_key = $rule{$key};
34
+        }
35
+        else {
36
+            $new_key = $key;
37
+        }
38
+        
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]
51
+                      : $self->dbi->not_exists;
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]
65
+                      : $self->dbi->not_exists;
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
+
131
+=head2 C<ignore>
132
+
133
+    my $pass = $mapper->ignore;
134
+    $mapper = $mapper->ignore([qw/title author/]);
135
+
136
+Ignored parameter keys when C<map> method is executed.
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
+        issude_date => '2010-11-11'
205
+    }
206
+
207
+By default, If the value has length, key and value is mapped.
208
+
209
+    title => 'Perl'  # Mapped
210
+    {title => '' }   # Not mapped
211
+    {title => undef} # Not mapped
212
+    {}               # Not mapped
213
+
214
+You can set change mapping condition by C<condition> attribute.
215
+
216
+    $mapper->condition('defined');
217
+
218
+Or you can set C<condtion> option for each key.
219
+
220
+    my $new_param = $mapper->map(
221
+        price => ['book.price', {condition => 'defined'}]
222
+        title => [sub { '%' . $_[0] . '%'}, {condition => 'defined'}] # Value
223
+        author => ['book.author', sub { '%' . $_[0] . '%'}, condtion => 'exists']
224
+    );
225
+
226
+If C<ignore> is set, the keys is ignored.
227
+
228
+    $mapper->ignore([qw/title author/]);
229
+    
230
+    {title => 'Perl', author => 'Ken', price => 1900}
231
+      is mapped to {price => 1900}
232
+
233
+=cut
t/_run/access.run
No changes.
t/_run/access2007-accdb.run
No changes.
t/_run/access2010-accdb.run
No changes.
+5
t/_run/common-db2.run
... ...
@@ -0,0 +1,5 @@
1
+### DB2 Install
2
+
3
+cd /usr/local/src
4
+
5
+curl -L https://www6.software.ibm.com/sdfdl/v2/regs2/db2pmopn/db2_v97/expc/Xa.2/Xb.aA_60_-iVlRRTUNBO90Dq4FHTisv_wdecoCQFeRQbw/Xc.db2exc_974_LNX_x86.tar.gz/Xd./Xf.LPr.D1vk/Xg.6107654/Xi.swg-db2expressc/XY.regsrvs/XZ.2ygJIAbTC5bn3tv2hlm2PnXUcz8/db2exc_974_LNX_x86.tar.gz > db2exc_974_LNX_x86.tar.gz
+5
t/_run/common-mysql.run
... ...
@@ -0,0 +1,5 @@
1
+# Create database
2
+create database dbix_custom;
3
+
4
+# Create User
5
+GRANT ALL PRIVILEGES ON dbix_custom.* TO dbix_custom@"localhost" IDENTIFIED BY 'dbix_custom';
+55
t/_run/common-oracle.run
... ...
@@ -0,0 +1,55 @@
1
+# Download
2
+http://download.oracle.com/otn/linux/oracle10g/xe/10201/oracle-xe-univ-10.2.0.1-1.0.i386.rpm
3
+
4
+# Install
5
+rpm -ivh oracle-xe-univ-10.2.0.1-1.0.i386.rpm
6
+/etc/init.d/oracle-xe configure
7
+
8
+# Note
9
+Port number is set to 8090
10
+
11
+# HTTP access
12
+http://127.0.0.1:8090/apex
13
+
14
+# Create user
15
+id: dbix_custom
16
+password: dbix_custom
17
+
18
+Add all privirage
19
+
20
+# DBD::Oracle
21
+You must be install install client
22
+oracle-instantclient11.2-basic-11.2.0.2.0.i386.rpm
23
+oracle-instantclient11.2-devel-11.2.0.2.0.i386.rpm
24
+oracle-instantclient11.2-sqlplus-11.2.0.2.0.i386.rpm
25
+
26
+rpm -hiv oracle-instantclient11.2-basic-11.2.0.2.0.i386.rpm
27
+rpm -hiv oracle-instantclient11.2-devel-11.2.0.2.0.i386.rpm
28
+rpm -hiv oracle-instantclient11.2-sqlplus-11.2.0.2.0.i386.rpm
29
+
30
+vi /etc/profile.d/oracle.sh
31
+export ORACLE_HOME='/usr/lib/oracle/11.2/client'
32
+export C_INCLUDE_PATH='/usr/include/oracle/11.2/client'
33
+export LD_LIBRARY_PATH='/usr/lib/oracle/11.2/client/lib'
34
+
35
+vi /etc/ld.so.conf.d/oracle.conf
36
+/usr/lib/oracle/11.2/client/lib
37
+
38
+cpan DBD::Oracle
39
+
40
+sqlplus dbix_custom/dbix_custom@localhost:1521/XE
41
+
42
+mkdir -p $ORACLE_HOME/network/admin/
43
+vi $ORACLE_HOME/network/admin/tnsnames.ora
44
+
45
+XE =
46
+  (DESCRIPTION =
47
+    (ADDRESS_LIST =
48
+      (ADDRESS = (PROTOCOL = TCP)(HOST = localhost)(PORT = 1521))
49
+    )
50
+    (CONNECT_DATA =
51
+      (SID = orcl)
52
+    )
53
+  )
54
+
55
+
+35
t/_run/common-postgresql.run
... ...
@@ -0,0 +1,35 @@
1
+### CentOS5
2
+
3
+# Install
4
+yum -y install postgresql-server
5
+yum -y install postgresql
6
+yum -y install postgresql-devel
7
+chkconfig --level 2345 postgresql on
8
+
9
+# Start server
10
+service postgresql start
11
+
12
+# Change config file
13
+vi /var/lib/pgsql/data/pg_hba.conf
14
+  # "local" is for Unix domain socket connections only
15
+  local   all         all                               trust
16
+
17
+# Create user and database
18
+su - postgres
19
+createuser -a -d -U postgres -P dbix_custom
20
+  # Shall the new role be a superuser? (y/n) -> y
21
+  # Shall the new role be allowed to create databases? (y/n) -> y
22
+  # Shall the new role be allowed to create more new roles? (y/n) -> y
23
+
24
+createdb dbix_custom -U dbix_custom
25
+
26
+# Connect to database
27
+psql -U dbix_custom dbix_custom
28
+
29
+# Install DBD::pg
30
+cpanm DBD::Pg
31
+
32
+### Memo
33
+
34
+# Drop user
35
+dropuser dbix_custom
+13
t/_run/common-sqlserver.run
... ...
@@ -0,0 +1,13 @@
1
+# Site
2
+http://awoni.net/fc/sql-server-2008-express/
3
+
4
+
5
+# Install
6
+http://www.microsoft.com/downloads/ja-jp/details.aspx?displaylang=ja&FamilyID=967225eb-207b-4950-91df-eeb5f35a80ee
7
+
8
+
9
+# Note
10
+You enable SQL Server authentication.
11
+You create user "dbix_custom", password "dbix_custom"
12
+You give create_table, insert, update, delete, select authority to user "dbix_custom".
13
+
t/_run/mysql.run
No changes.
t/_run/mysql2.run
No changes.