- added experimental DBIx::Custom::Model insert

- - added experimental DBIx::Custom::Model insert_at();
  
  - added experimental insert_at()
  
  - improved error message
- Browse files
- Yuki Kimoto commited on 2011-02-28
- 1 parent 063e677
  
  commit 87127e7e567a64aef02d4c576b442ee7237a2550

Showing 4 changed files with 156 additions and 28 deletions

Changes

...	...	@@ -1,3 +1,9 @@
	1	+0.1653
	2	+ - added experimental DBIx::Custom::Model insert_at()
	3	+ - added experimental insert_at()
	4	+ - improved error message
	5	+0.1652
	6	+ - all filter can receive array reference and receiving hash reference is DEPRECATED!
1	7	0.1651
2	8	- add experimental DBIx::Custom::Model filter attribute.
3	9	0.1650

+66 -10

lib/DBIx/Custom.pm

View

@@ -1,6 +1,6 @@
 package DBIx::Custom;
 
-our $VERSION = '0.1651';
+our $VERSION = '0.1653';
 
 use 5.008001;
 use strict;
@@ -322,17 +322,20 @@ sub delete_at {
     if (exists $args{where}) {
         my $where_columns = delete $args{where};
         $where_columns = [$where_columns] unless ref $where_columns;
+
+        croak qq{"where" must be constant value or array reference}
+          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
         
         for(my $i = 0; $i < @$primary_keys; $i ++) {
            $where->{$primary_keys->[$i]} = $where_columns->[$i];
         }
     }
-    elsif (exists $args{param}) {
+    
+    if (exists $args{param}) {
         my $param = delete $args{param};
         
         for(my $i = 0; $i < @$primary_keys; $i ++) {
-           $where->{$primary_keys->[$i]}
-             = delete $param->{$primary_keys->[$i]};
+            delete $param->{$primary_keys->[$i]};
         }
     }
     
@@ -483,6 +486,52 @@ sub insert {
     return $ret_val;
 }
 
+our %VALID_INSERT_AT_ARGS
+  = map { $_ => 1 } qw/table param
+                       where append filter query
+                       primary_key param/;
+
+sub insert_at {
+    my ($self, %args) = @_;
+    
+    # Check arguments
+    foreach my $name (keys %args) {
+        croak qq{"$name" is invalid argument}
+          unless $VALID_INSERT_AT_ARGS{$name};
+    }
+    
+    # Primary key
+    my $primary_keys = delete $args{primary_key};
+    $primary_keys = [$primary_keys] unless ref $primary_keys;
+    
+    # Where clause
+    my $where = {};
+    my $param = {};
+    
+    if (exists $args{where}) {
+        my $where_columns = delete $args{where};
+        $where_columns = [$where_columns] unless ref $where_columns;
+
+        croak qq{"where" must be constant value or array reference}
+          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
+        
+        for(my $i = 0; $i < @$primary_keys; $i ++) {
+           $where->{$primary_keys->[$i]} = $where_columns->[$i];
+        }
+    }
+    
+    if (exists $args{param}) {
+        $param = delete $args{param};
+        for(my $i = 0; $i < @$primary_keys; $i ++) {
+             delete $param->{$primary_keys->[$i]};
+        }
+    }
+    
+    $param = {%$param, %$where};
+    
+    return $self->insert(param => $param, %args);
+}
+
 sub each_column {
     my ($self, $cb) = @_;
     
@@ -691,17 +740,21 @@ sub select_at {
     my $where = {};
     if (exists $args{where}) {
         my $where_columns = delete $args{where};
+        
+        croak qq{"where" must be constant value or array reference}
+          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
+        
         $where_columns = [$where_columns] unless ref $where_columns;
         
         for(my $i = 0; $i < @$primary_keys; $i ++) {
            $where->{$table . '.' . $primary_keys->[$i]} = $where_columns->[$i];
         }
     }
-    elsif (exists $args{param}) {
+    
+    if (exists $args{param}) {
         my $param = delete $args{param};
         for(my $i = 0; $i < @$primary_keys; $i ++) {
-           $where->{$primary_keys->[$i]}
-             = delete $param->{$primary_keys->[$i]};
+             delete $param->{$primary_keys->[$i]};
         }
     }
     
@@ -929,16 +982,19 @@ sub update_at {
     if (exists $args{where}) {
         my $where_columns = delete $args{where};
         $where_columns = [$where_columns] unless ref $where_columns;
+
+        croak qq{"where" must be constant value or array reference}
+          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
         
         for(my $i = 0; $i < @$primary_keys; $i ++) {
            $where->{$primary_keys->[$i]} = $where_columns->[$i];
         }
     }
-    elsif (exists $args{param}) {
+    
+    if (exists $args{param}) {
         $param = delete $args{param};
         for(my $i = 0; $i < @$primary_keys; $i ++) {
-           $where->{$primary_keys->[$i]}
-             = delete $param->{$primary_keys->[$i]};
+            delete $param->{$primary_keys->[$i]};
         }
     }
     

+10

lib/DBIx/Custom/Model.pm

View

@@ -93,6 +93,16 @@ sub insert {
     $self->dbi->insert(table => $self->table, @_);
 }
 
+sub insert_at {
+    my $self = shift;
+    
+    return $self->dbi->insert_at(
+        table => $self->table,
+        primary_key => $self->primary_key,
+        @_
+    );
+}
+
 sub method {
     my $self = shift;
     

+74 -18

t/dbix-custom-core-sqlite.t

View

@@ -1439,14 +1439,41 @@ $dbi->delete_at(
 );
 is_deeply($dbi->select(table => 'table1')->fetch_hash_all, []);
 
+test 'insert_at';
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
+$dbi->execute($CREATE_TABLE->{1});
+$dbi->insert_at(
+    primary_key => ['key1', 'key2'], 
+    table => 'table1',
+    where => [1, 2],
+    param => {key3 => 3}
+);
+is($dbi->select(table => 'table1')->fetch_hash_first->{key1}, 1);
+is($dbi->select(table => 'table1')->fetch_hash_first->{key2}, 2);
+is($dbi->select(table => 'table1')->fetch_hash_first->{key3}, 3);
+
+$dbi->delete_all(table => 'table1');
 $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
-$dbi->delete_at(
+$dbi->insert_at(
+    primary_key => 'key1', 
     table => 'table1',
-    primary_key => ['key1', 'key2'],
-    param => {key1 => 1, key2 => 2},
+    where => 1,
+    param => {key2 => 2, key3 => 3}
 );
-is_deeply($dbi->select(table => 'table1')->fetch_hash_all, []);
 
+is($dbi->select(table => 'table1')->fetch_hash_first->{key1}, 1);
+is($dbi->select(table => 'table1')->fetch_hash_first->{key2}, 2);
+is($dbi->select(table => 'table1')->fetch_hash_first->{key3}, 3);
+
+eval {
+    $dbi->insert_at(
+        table => 'table1',
+        primary_key => ['key1', 'key2'],
+        where => {},
+        param => {key1 => 1, key2 => 2, key3 => 3},
+    );
+};
+like($@, qr/must be/);
 
 test 'update_at';
 $dbi = DBIx::Custom->connect($NEW_ARGS->{0});
@@ -1474,18 +1501,6 @@ is($dbi->select(table => 'table1')->fetch_hash_first->{key1}, 1);
 is($dbi->select(table => 'table1')->fetch_hash_first->{key2}, 2);
 is($dbi->select(table => 'table1')->fetch_hash_first->{key3}, 4);
 
-$dbi->delete_all(table => 'table1');
-$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
-$dbi->update_at(
-    table => 'table1',
-    primary_key => ['key1', 'key2'],
-    param => {key1 => 1, key2 => 2, key3 => 4},
-);
-is($dbi->select(table => 'table1')->fetch_hash_first->{key1}, 1);
-is($dbi->select(table => 'table1')->fetch_hash_first->{key2}, 2);
-is($dbi->select(table => 'table1')->fetch_hash_first->{key3}, 4);
-
-
 test 'select_at';
 $dbi = DBIx::Custom->connect($NEW_ARGS->{0});
 $dbi->execute($CREATE_TABLE->{1});
@@ -1524,6 +1539,35 @@ is($row->{key1}, 1);
 is($row->{key2}, 2);
 is($row->{key3}, 3);
 
+eval {
+    $result = $dbi->select_at(
+        table => 'table1',
+        primary_key => ['key1', 'key2'],
+        where => {},
+        param => {key1 => 1, key2 => 2},
+    );
+};
+like($@, qr/must be/);
+
+eval {
+    $result = $dbi->update_at(
+        table => 'table1',
+        primary_key => ['key1', 'key2'],
+        where => {},
+        param => {key1 => 1, key2 => 2},
+    );
+};
+like($@, qr/must be/);
+
+eval {
+    $result = $dbi->delete_at(
+        table => 'table1',
+        primary_key => ['key1', 'key2'],
+        where => {},
+        param => {key1 => 1, key2 => 2},
+    );
+};
+like($@, qr/must be/);
 
 test 'columns';
 use MyDBI1;
@@ -1559,8 +1603,20 @@ $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
 $dbi->model('table1_3')->delete_at(where => [1, 2]);
 is_deeply($dbi->select(table => 'table1')->fetch_hash_all, []);
 
+test 'model insert_at';
+$dbi = MyDBI6->connect($NEW_ARGS->{0});
+$dbi->execute($CREATE_TABLE->{1});
+$dbi->model('table1')->insert_at(
+    where => [1, 2],
+    param => {key3 => 3}
+);
+$result = $dbi->model('table1')->select;
+$row = $result->fetch_hash_first;
+is($row->{key1}, 1);
+is($row->{key2}, 2);
+is($row->{key3}, 3);
 
-test 'update_at';
+test 'model update_at';
 $dbi = MyDBI6->connect($NEW_ARGS->{0});
 $dbi->execute($CREATE_TABLE->{1});
 $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
@@ -1574,7 +1630,7 @@ is($row->{key1}, 1);
 is($row->{key2}, 2);
 is($row->{key3}, 4);
 
-test 'select_at';
+test 'model select_at';
 $dbi = MyDBI6->connect($NEW_ARGS->{0});
 $dbi->execute($CREATE_TABLE->{1});
 $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});

...	...	@@ -1,6 +1,6 @@
1	1	package DBIx::Custom;
2	2
3		-our $VERSION = '0.1651';
	3	+our $VERSION = '0.1653';
4	4
5	5	use 5.008001;
6	6	use strict;
...	...	@@ -322,17 +322,20 @@ sub delete_at {
322	322	if (exists $args{where}) {
323	323	my $where_columns = delete $args{where};
324	324	$where_columns = [$where_columns] unless ref $where_columns;
	325	+
	326	+ croak qq{"where" must be constant value or array reference}
	327	+ unless !ref $where_columns \|\| ref $where_columns eq 'ARRAY';
325	328
326	329	for(my $i = 0; $i < @$primary_keys; $i ++) {
327	330	$where->{$primary_keys->[$i]} = $where_columns->[$i];
328	331	}
329	332	}
330		- elsif (exists $args{param}) {
	333	+
	334	+ if (exists $args{param}) {
331	335	my $param = delete $args{param};
332	336
333	337	for(my $i = 0; $i < @$primary_keys; $i ++) {
334		- $where->{$primary_keys->[$i]}
335		- = delete $param->{$primary_keys->[$i]};
	338	+ delete $param->{$primary_keys->[$i]};
336	339	}
337	340	}
338	341
...	...	@@ -483,6 +486,52 @@ sub insert {
483	486	return $ret_val;
484	487	}
485	488
	489	+our %VALID_INSERT_AT_ARGS
	490	+ = map { $_ => 1 } qw/table param
	491	+ where append filter query
	492	+ primary_key param/;
	493	+
	494	+sub insert_at {
	495	+ my ($self, %args) = @_;
	496	+
	497	+ # Check arguments
	498	+ foreach my $name (keys %args) {
	499	+ croak qq{"$name" is invalid argument}
	500	+ unless $VALID_INSERT_AT_ARGS{$name};
	501	+ }
	502	+
	503	+ # Primary key
	504	+ my $primary_keys = delete $args{primary_key};
	505	+ $primary_keys = [$primary_keys] unless ref $primary_keys;
	506	+
	507	+ # Where clause
	508	+ my $where = {};
	509	+ my $param = {};
	510	+
	511	+ if (exists $args{where}) {
	512	+ my $where_columns = delete $args{where};
	513	+ $where_columns = [$where_columns] unless ref $where_columns;
	514	+
	515	+ croak qq{"where" must be constant value or array reference}
	516	+ unless !ref $where_columns \|\| ref $where_columns eq 'ARRAY';
	517	+
	518	+ for(my $i = 0; $i < @$primary_keys; $i ++) {
	519	+ $where->{$primary_keys->[$i]} = $where_columns->[$i];
	520	+ }
	521	+ }
	522	+
	523	+ if (exists $args{param}) {
	524	+ $param = delete $args{param};
	525	+ for(my $i = 0; $i < @$primary_keys; $i ++) {
	526	+ delete $param->{$primary_keys->[$i]};
	527	+ }
	528	+ }
	529	+
	530	+ $param = {%$param, %$where};
	531	+
	532	+ return $self->insert(param => $param, %args);
	533	+}
	534	+
486	535	sub each_column {
487	536	my ($self, $cb) = @_;
488	537
...	...	@@ -691,17 +740,21 @@ sub select_at {
691	740	my $where = {};
692	741	if (exists $args{where}) {
693	742	my $where_columns = delete $args{where};
	743	+
	744	+ croak qq{"where" must be constant value or array reference}
	745	+ unless !ref $where_columns \|\| ref $where_columns eq 'ARRAY';
	746	+
694	747	$where_columns = [$where_columns] unless ref $where_columns;
695	748
696	749	for(my $i = 0; $i < @$primary_keys; $i ++) {
697	750	$where->{$table . '.' . $primary_keys->[$i]} = $where_columns->[$i];
698	751	}
699	752	}
700		- elsif (exists $args{param}) {
	753	+
	754	+ if (exists $args{param}) {
701	755	my $param = delete $args{param};
702	756	for(my $i = 0; $i < @$primary_keys; $i ++) {
703		- $where->{$primary_keys->[$i]}
704		- = delete $param->{$primary_keys->[$i]};
	757	+ delete $param->{$primary_keys->[$i]};
705	758	}
706	759	}
707	760
...	...	@@ -929,16 +982,19 @@ sub update_at {
929	982	if (exists $args{where}) {
930	983	my $where_columns = delete $args{where};
931	984	$where_columns = [$where_columns] unless ref $where_columns;
	985	+
	986	+ croak qq{"where" must be constant value or array reference}
	987	+ unless !ref $where_columns \|\| ref $where_columns eq 'ARRAY';
932	988
933	989	for(my $i = 0; $i < @$primary_keys; $i ++) {
934	990	$where->{$primary_keys->[$i]} = $where_columns->[$i];
935	991	}
936	992	}
937		- elsif (exists $args{param}) {
	993	+
	994	+ if (exists $args{param}) {
938	995	$param = delete $args{param};
939	996	for(my $i = 0; $i < @$primary_keys; $i ++) {
940		- $where->{$primary_keys->[$i]}
941		- = delete $param->{$primary_keys->[$i]};
	997	+ delete $param->{$primary_keys->[$i]};
942	998	}
943	999	}
944	1000

...	...	@@ -1439,14 +1439,41 @@ $dbi->delete_at(
1439	1439	);
1440	1440	is_deeply($dbi->select(table => 'table1')->fetch_hash_all, []);
1441	1441
	1442	+test 'insert_at';
	1443	+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
	1444	+$dbi->execute($CREATE_TABLE->{1});
	1445	+$dbi->insert_at(
	1446	+ primary_key => ['key1', 'key2'],
	1447	+ table => 'table1',
	1448	+ where => [1, 2],
	1449	+ param => {key3 => 3}
	1450	+);
	1451	+is($dbi->select(table => 'table1')->fetch_hash_first->{key1}, 1);
	1452	+is($dbi->select(table => 'table1')->fetch_hash_first->{key2}, 2);
	1453	+is($dbi->select(table => 'table1')->fetch_hash_first->{key3}, 3);
	1454	+
	1455	+$dbi->delete_all(table => 'table1');
1442	1456	$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1443		-$dbi->delete_at(
	1457	+$dbi->insert_at(
	1458	+ primary_key => 'key1',
1444	1459	table => 'table1',
1445		- primary_key => ['key1', 'key2'],
1446		- param => {key1 => 1, key2 => 2},
	1460	+ where => 1,
	1461	+ param => {key2 => 2, key3 => 3}
1447	1462	);
1448		-is_deeply($dbi->select(table => 'table1')->fetch_hash_all, []);
1449	1463
	1464	+is($dbi->select(table => 'table1')->fetch_hash_first->{key1}, 1);
	1465	+is($dbi->select(table => 'table1')->fetch_hash_first->{key2}, 2);
	1466	+is($dbi->select(table => 'table1')->fetch_hash_first->{key3}, 3);
	1467	+
	1468	+eval {
	1469	+ $dbi->insert_at(
	1470	+ table => 'table1',
	1471	+ primary_key => ['key1', 'key2'],
	1472	+ where => {},
	1473	+ param => {key1 => 1, key2 => 2, key3 => 3},
	1474	+ );
	1475	+};
	1476	+like($@, qr/must be/);
1450	1477
1451	1478	test 'update_at';
1452	1479	$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
...	...	@@ -1474,18 +1501,6 @@ is($dbi->select(table => 'table1')->fetch_hash_first->{key1}, 1);
1474	1501	is($dbi->select(table => 'table1')->fetch_hash_first->{key2}, 2);
1475	1502	is($dbi->select(table => 'table1')->fetch_hash_first->{key3}, 4);
1476	1503
1477		-$dbi->delete_all(table => 'table1');
1478		-$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1479		-$dbi->update_at(
1480		- table => 'table1',
1481		- primary_key => ['key1', 'key2'],
1482		- param => {key1 => 1, key2 => 2, key3 => 4},
1483		-);
1484		-is($dbi->select(table => 'table1')->fetch_hash_first->{key1}, 1);
1485		-is($dbi->select(table => 'table1')->fetch_hash_first->{key2}, 2);
1486		-is($dbi->select(table => 'table1')->fetch_hash_first->{key3}, 4);
1487		-
1488		-
1489	1504	test 'select_at';
1490	1505	$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
1491	1506	$dbi->execute($CREATE_TABLE->{1});
...	...	@@ -1524,6 +1539,35 @@ is($row->{key1}, 1);
1524	1539	is($row->{key2}, 2);
1525	1540	is($row->{key3}, 3);
1526	1541
	1542	+eval {
	1543	+ $result = $dbi->select_at(
	1544	+ table => 'table1',
	1545	+ primary_key => ['key1', 'key2'],
	1546	+ where => {},
	1547	+ param => {key1 => 1, key2 => 2},
	1548	+ );
	1549	+};
	1550	+like($@, qr/must be/);
	1551	+
	1552	+eval {
	1553	+ $result = $dbi->update_at(
	1554	+ table => 'table1',
	1555	+ primary_key => ['key1', 'key2'],
	1556	+ where => {},
	1557	+ param => {key1 => 1, key2 => 2},
	1558	+ );
	1559	+};
	1560	+like($@, qr/must be/);
	1561	+
	1562	+eval {
	1563	+ $result = $dbi->delete_at(
	1564	+ table => 'table1',
	1565	+ primary_key => ['key1', 'key2'],
	1566	+ where => {},
	1567	+ param => {key1 => 1, key2 => 2},
	1568	+ );
	1569	+};
	1570	+like($@, qr/must be/);
1527	1571
1528	1572	test 'columns';
1529	1573	use MyDBI1;
...	...	@@ -1559,8 +1603,20 @@ $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1559	1603	$dbi->model('table1_3')->delete_at(where => [1, 2]);
1560	1604	is_deeply($dbi->select(table => 'table1')->fetch_hash_all, []);
1561	1605
	1606	+test 'model insert_at';
	1607	+$dbi = MyDBI6->connect($NEW_ARGS->{0});
	1608	+$dbi->execute($CREATE_TABLE->{1});
	1609	+$dbi->model('table1')->insert_at(
	1610	+ where => [1, 2],
	1611	+ param => {key3 => 3}
	1612	+);
	1613	+$result = $dbi->model('table1')->select;
	1614	+$row = $result->fetch_hash_first;
	1615	+is($row->{key1}, 1);
	1616	+is($row->{key2}, 2);
	1617	+is($row->{key3}, 3);
1562	1618
1563		-test 'update_at';
	1619	+test 'model update_at';
1564	1620	$dbi = MyDBI6->connect($NEW_ARGS->{0});
1565	1621	$dbi->execute($CREATE_TABLE->{1});
1566	1622	$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
...	...	@@ -1574,7 +1630,7 @@ is($row->{key1}, 1);
1574	1630	is($row->{key2}, 2);
1575	1631	is($row->{key3}, 4);
1576	1632
1577		-test 'select_at';
	1633	+test 'model select_at';
1578	1634	$dbi = MyDBI6->connect($NEW_ARGS->{0});
1579	1635	$dbi->execute($CREATE_TABLE->{1});
1580	1636	$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});

...	...	@@ -93,6 +93,16 @@ sub insert {
93	93	$self->dbi->insert(table => $self->table, @_);
94	94	}
95	95
	96	+sub insert_at {
	97	+ my $self = shift;
	98	+
	99	+ return $self->dbi->insert_at(
	100	+ table => $self->table,
	101	+ primary_key => $self->primary_key,
	102	+ @_
	103	+ );
	104	+}
	105	+
96	106	sub method {
97	107	my $self = shift;
98	108