updated pod ・ e025d72 ・ Gitprep

- updated pod;
- Browse files
- Yuki Kimoto commited on 2011-09-02
- 1 parent fc03f45
  
  commit e025d72a3c9a90acc134d6b8328f8564ad4c00d9

Showing 13 changed files with 189 additions and 13 deletions

Changes

...	...	@@ -1,4 +1,6 @@
1	1	0.1722
	2	+ - insert_param, update_param, and assign param can
	3	+ be wrapeed by DB function by C<wrap> option
2	4	- added EXPERIMENTAL pass attribute to DBIx::Custom::Mapper
3	5	- removed EXPERIMENTAL ignore attribute from DBIx::Custom::Mapper
4	6	0.1721

+53 -13

lib/DBIx/Custom.pm

View

@@ -120,7 +120,9 @@ sub AUTOLOAD {
 }
 
 sub assign_param {
-    my ($self, $param) = @_;
+    my ($self, $param, $opts) = @_;
+    
+    my $wrap = $opts->{wrap} || {};
     
     # Create set tag
     my @params;
@@ -130,10 +132,10 @@ sub assign_param {
           unless $column =~ /^[$safety\.]+$/;
         my $column_quote = $self->_q($column);
         $column_quote =~ s/\./$self->_q(".")/e;
-        push @params, ref $param->{$column} eq 'SCALAR'
-          ? "$column_quote = " . ${$param->{$column}}
-          : "$column_quote = :$column";
-
+        my $func = $wrap->{$column} || sub { $_[0] };
+        push @params,
+          ref $param->{$column} eq 'SCALAR' ? "$column_quote = " . ${$param->{$column}}
+        : "$column_quote = " . $func->(":$column");
     }
     my $tag = join(', ', @params);
     
@@ -611,6 +613,7 @@ sub insert {
       if defined $id && !defined $primary_key;
     $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
     my $prefix = delete $args{prefix};
+    my $wrap = delete $args{wrap};
 
     # Merge parameter
     if (defined $id) {
@@ -622,7 +625,8 @@ sub insert {
     my @sql;
     push @sql, "insert";
     push @sql, $prefix if defined $prefix;
-    push @sql, "into " . $self->_q($table) . " " . $self->insert_param($param);
+    push @sql, "into " . $self->_q($table) . " "
+      . $self->insert_param($param, {wrap => $wrap});
     push @sql, $append if defined $append;
     my $sql = join (' ', @sql);
     
@@ -631,7 +635,9 @@ sub insert {
 }
 
 sub insert_param {
-    my ($self, $param) = @_;
+    my ($self, $param, $opts) = @_;
+    
+    my $wrap = $opts->{wrap} || {};
     
     # Create insert parameter tag
     my $safety = $self->safety_character;
@@ -643,8 +649,11 @@ sub insert_param {
         my $column_quote = $self->_q($column);
         $column_quote =~ s/\./$self->_q(".")/e;
         push @columns, $column_quote;
-        push @placeholders, ref $param->{$column} eq 'SCALAR'
-          ? ${$param->{$column}} : ":$column";
+        
+        my $func = $wrap->{$column} || sub { $_[0] };
+        push @placeholders,
+          ref $param->{$column} eq 'SCALAR' ? ${$param->{$column}}
+        : $func->(":$column");
     }
     
     return '(' . join(', ', @columns) . ') ' . 'values ' .
@@ -1148,9 +1157,10 @@ sub update {
       if defined $id && !defined $primary_key;
     $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
     my $prefix = delete $args{prefix};
+    my $wrap = delete $args{wrap};
 
     # Update clause
-    my $update_clause = $self->update_param($param);
+    my $update_clause = $self->update_param($param, {wrap => $wrap});
 
     # Where
     $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
@@ -1192,11 +1202,11 @@ sub update {
 sub update_all { shift->update(allow_update_all => 1, @_) };
 
 sub update_param {
-    my ($self, $param, $opt) = @_;
+    my ($self, $param, $opts) = @_;
     
     # Create update parameter tag
-    my $tag = $self->assign_param($param);
-    $tag = "set $tag" unless $opt->{no_set};
+    my $tag = $self->assign_param($param, $opts);
+    $tag = "set $tag" unless $opts->{no_set};
 
     return $tag;
 }
@@ -2787,6 +2797,21 @@ Same as C<execute> method's C<type_rule1_off> option.
 
 Same as C<execute> method's C<type_rule2_off> option.
 
+=item C<wrap EXPERIMENTAL>
+
+    wrap => {price => sub { "max($_[0])" }}
+
+placeholder wrapped string.
+
+If the following statement
+
+    $dbi->insert({price => 100}, table => 'book',
+      {price => sub { "$_[0] + 5" }});
+
+is executed, the following SQL is executed.
+
+    insert into book price values ( ? + 5 );
+
 =back
 
 =over 4
@@ -3378,6 +3403,21 @@ Same as C<execute> method's C<type_rule2_off> option.
 
 Same as C<select> method's C<where> option.
 
+=item C<wrap EXPERIMENTAL>
+
+    wrap => {price => sub { "max($_[0])" }}
+
+placeholder wrapped string.
+
+If the following statement
+
+    $dbi->update({price => 100}, table => 'book',
+      {price => sub { "$_[0] + 5" }});
+
+is executed, the following SQL is executed.
+
+    update book set price =  ? + 5;
+
 =back
 
 =head2 C<update_all>

t/_run/access.run

View

No changes.

t/_run/access2007-accdb.run

View

No changes.

t/_run/access2010-accdb.run

View

No changes.

t/_run/common-db2.run

View

...	...	@@ -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

t/_run/common-mysql.run

View

...	...	@@ -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

View

...	...	@@ -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

View

...	...	@@ -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

View

...	...	@@ -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

View

No changes.

t/_run/mysql2.run

View

No changes.

+21

t/common.t

View

...	...	@@ -497,6 +497,15 @@ $result = $dbi->execute("select * from $table1");
497	497	$rows = $result->all;
498	498	is_deeply($rows, [{$key1 => 1, $key2 => 2}, {$key1 => 3, $key2 => 4}], "basic");
499	499
	500	+eval { $dbi->execute("drop table $table1") };
	501	+$dbi->execute($create_table1);
	502	+$dbi->insert(table => $table1, param => {$key1 => 1, $key2 => 2},
	503	+ wrap => {$key1 => sub { "$_[0] - 1" }});
	504	+$dbi->insert(table => $table1, param => {$key1 => 3, $key2 => 4});
	505	+$result = $dbi->execute("select * from $table1");
	506	+$rows = $result->all;
	507	+is_deeply($rows, [{$key1 => 0, $key2 => 2}, {$key1 => 3, $key2 => 4}], "basic");
	508	+
500	509	test 'update';
501	510	eval { $dbi->execute("drop table $table1") };
502	511	$dbi->execute($create_table1_2);
...	...	@@ -621,6 +630,18 @@ is_deeply($rows, [{$key1 => 1, $key2 => 11, $key3 => 3, $key4 => 4, $key5 => 5},
621	630	{$key1 => 6, $key2 => 7, $key3 => 8, $key4 => 9, $key5 => 10}],
622	631	"basic");
623	632
	633	+eval { $dbi->execute("drop table $table1") };
	634	+$dbi->execute($create_table1_2);
	635	+$dbi->insert(table => $table1, param => {$key1 => 1, $key2 => 2, $key3 => 3, $key4 => 4, $key5 => 5});
	636	+$dbi->insert(table => $table1, param => {$key1 => 6, $key2 => 7, $key3 => 8, $key4 => 9, $key5 => 10});
	637	+$dbi->update(table => $table1, param => {$key2 => 11}, where => {$key1 => 1},
	638	+wrap => {$key2 => sub { "$_[0] - 1" }});
	639	+$result = $dbi->execute("select * from $table1 order by $key1");
	640	+$rows = $result->all;
	641	+is_deeply($rows, [{$key1 => 1, $key2 => 10, $key3 => 3, $key4 => 4, $key5 => 5},
	642	+ {$key1 => 6, $key2 => 7, $key3 => 8, $key4 => 9, $key5 => 10}],
	643	+ "basic");
	644	+
624	645	eval { $dbi->execute("drop table $table1") };
625	646	$dbi->execute($create_table1_2);
626	647	$dbi->insert(table => $table1, param => {$key1 => 1, $key2 => 2, $key3 => 3, $key4 => 4, $key5 => 5});

...	...	@@ -120,7 +120,9 @@ sub AUTOLOAD {
120	120	}
121	121
122	122	sub assign_param {
123		- my ($self, $param) = @_;
	123	+ my ($self, $param, $opts) = @_;
	124	+
	125	+ my $wrap = $opts->{wrap} \|\| {};
124	126
125	127	# Create set tag
126	128	my @params;
...	...	@@ -130,10 +132,10 @@ sub assign_param {
130	132	unless $column =~ /^[$safety\.]+$/;
131	133	my $column_quote = $self->_q($column);
132	134	$column_quote =~ s/\./$self->_q(".")/e;
133		- push @params, ref $param->{$column} eq 'SCALAR'
134		- ? "$column_quote = " . ${$param->{$column}}
135		- : "$column_quote = :$column";
136		-
	135	+ my $func = $wrap->{$column} \|\| sub { $_[0] };
	136	+ push @params,
	137	+ ref $param->{$column} eq 'SCALAR' ? "$column_quote = " . ${$param->{$column}}
	138	+ : "$column_quote = " . $func->(":$column");
137	139	}
138	140	my $tag = join(', ', @params);
139	141
...	...	@@ -611,6 +613,7 @@ sub insert {
611	613	if defined $id && !defined $primary_key;
612	614	$primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
613	615	my $prefix = delete $args{prefix};
	616	+ my $wrap = delete $args{wrap};
614	617
615	618	# Merge parameter
616	619	if (defined $id) {
...	...	@@ -622,7 +625,8 @@ sub insert {
622	625	my @sql;
623	626	push @sql, "insert";
624	627	push @sql, $prefix if defined $prefix;
625		- push @sql, "into " . $self->_q($table) . " " . $self->insert_param($param);
	628	+ push @sql, "into " . $self->_q($table) . " "
	629	+ . $self->insert_param($param, {wrap => $wrap});
626	630	push @sql, $append if defined $append;
627	631	my $sql = join (' ', @sql);
628	632
...	...	@@ -631,7 +635,9 @@ sub insert {
631	635	}
632	636
633	637	sub insert_param {
634		- my ($self, $param) = @_;
	638	+ my ($self, $param, $opts) = @_;
	639	+
	640	+ my $wrap = $opts->{wrap} \|\| {};
635	641
636	642	# Create insert parameter tag
637	643	my $safety = $self->safety_character;
...	...	@@ -643,8 +649,11 @@ sub insert_param {
643	649	my $column_quote = $self->_q($column);
644	650	$column_quote =~ s/\./$self->_q(".")/e;
645	651	push @columns, $column_quote;
646		- push @placeholders, ref $param->{$column} eq 'SCALAR'
647		- ? ${$param->{$column}} : ":$column";
	652	+
	653	+ my $func = $wrap->{$column} \|\| sub { $_[0] };
	654	+ push @placeholders,
	655	+ ref $param->{$column} eq 'SCALAR' ? ${$param->{$column}}
	656	+ : $func->(":$column");
648	657	}
649	658
650	659	return '(' . join(', ', @columns) . ') ' . 'values ' .
...	...	@@ -1148,9 +1157,10 @@ sub update {
1148	1157	if defined $id && !defined $primary_key;
1149	1158	$primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
1150	1159	my $prefix = delete $args{prefix};
	1160	+ my $wrap = delete $args{wrap};
1151	1161
1152	1162	# Update clause
1153		- my $update_clause = $self->update_param($param);
	1163	+ my $update_clause = $self->update_param($param, {wrap => $wrap});
1154	1164
1155	1165	# Where
1156	1166	$where = $self->_create_param_from_id($id, $primary_key) if defined $id;
...	...	@@ -1192,11 +1202,11 @@ sub update {
1192	1202	sub update_all { shift->update(allow_update_all => 1, @_) };
1193	1203
1194	1204	sub update_param {
1195		- my ($self, $param, $opt) = @_;
	1205	+ my ($self, $param, $opts) = @_;
1196	1206
1197	1207	# Create update parameter tag
1198		- my $tag = $self->assign_param($param);
1199		- $tag = "set $tag" unless $opt->{no_set};
	1208	+ my $tag = $self->assign_param($param, $opts);
	1209	+ $tag = "set $tag" unless $opts->{no_set};
1200	1210
1201	1211	return $tag;
1202	1212	}
...	...	@@ -2787,6 +2797,21 @@ Same as C<execute> method's C<type_rule1_off> option.
2787	2797
2788	2798	Same as C<execute> method's C<type_rule2_off> option.
2789	2799
	2800	+=item C<wrap EXPERIMENTAL>
	2801	+
	2802	+ wrap => {price => sub { "max($_[0])" }}
	2803	+
	2804	+placeholder wrapped string.
	2805	+
	2806	+If the following statement
	2807	+
	2808	+ $dbi->insert({price => 100}, table => 'book',
	2809	+ {price => sub { "$_[0] + 5" }});
	2810	+
	2811	+is executed, the following SQL is executed.
	2812	+
	2813	+ insert into book price values ( ? + 5 );
	2814	+
2790	2815	=back
2791	2816
2792	2817	=over 4
...	...	@@ -3378,6 +3403,21 @@ Same as C<execute> method's C<type_rule2_off> option.
3378	3403
3379	3404	Same as C<select> method's C<where> option.
3380	3405
	3406	+=item C<wrap EXPERIMENTAL>
	3407	+
	3408	+ wrap => {price => sub { "max($_[0])" }}
	3409	+
	3410	+placeholder wrapped string.
	3411	+
	3412	+If the following statement
	3413	+
	3414	+ $dbi->update({price => 100}, table => 'book',
	3415	+ {price => sub { "$_[0] + 5" }});
	3416	+
	3417	+is executed, the following SQL is executed.
	3418	+
	3419	+ update book set price = ? + 5;
	3420	+
3381	3421	=back
3382	3422
3383	3423	=head2 C<update_all>