added DBIx::Custom::Mapper ・ b313017 ・ Gitprep

- added DBIx::Custom::Mapper;
- Browse files
- Yuki Kimoto commited on 2011-08-26
- 1 parent b0ff3a6
  
  commit b313017cdda5b3a40b5efadacd60a0fc751a754c

Showing 13 changed files with 355 additions and 1 deletions

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

View

@@ -1,7 +1,7 @@
 package DBIx::Custom;
 use Object::Simple -base;
 
-our $VERSION = '0.1720';
+our $VERSION = '0.1721';
 use 5.008001;
 
 use Carp 'croak';
@@ -714,6 +714,11 @@ sub include_model {
     return $self;
 }
 
+sub mapper {
+    my $self = shift;
+    return DBIx::Custom::Mapper->new(@_);
+}
+
 sub map_param {
     my $self = shift;
     my $param = shift;

+233

lib/DBIx/Custom/Mapper.pm

View

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

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.

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