[Bast-commits] r7324 - in DBIx-Class-Schema-PopulateMore/truck: . lib/DBIx/Class/Schema t

[jnapiorkowski at dev.catalyst.perl.org]

Author: jnapiorkowski
Date: 2009-08-17 18:29:40 +0000 (Mon, 17 Aug 2009)
New Revision: 7324

Modified:
   DBIx-Class-Schema-PopulateMore/truck/Changes
   DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore.pm
   DBIx-Class-Schema-PopulateMore/truck/t/01-schema.t
Log:
added new argument style to populate_more in increase some flexibility and reduce verbosity

Modified: DBIx-Class-Schema-PopulateMore/truck/Changes
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/Changes	2009-08-17 10:37:14 UTC (rev 7323)
+++ DBIx-Class-Schema-PopulateMore/truck/Changes	2009-08-17 18:29:40 UTC (rev 7324)
@@ -1,5 +1,9 @@
 Revision history for Perl extension DBIx-Class-Schema-PopulateMore.
 
+0.14 Monday, August 17, 2009
+    - Increased the flexibility of allowed incoming arguments and documented
+      this change.  Added test for this format.
+
 0.13 Monday, July 6, 2009
     - Fix an error with the way we parse command inflators so that if a source
       string contains '::' it won't give us the wrong lookup index

Modified: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore.pm	2009-08-17 10:37:14 UTC (rev 7323)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore.pm	2009-08-17 18:29:40 UTC (rev 7324)
@@ -11,11 +11,11 @@
 
 =head1 VERSION
 
-Version 0.13
+Version 0.14
 
 =cut
 
-our $VERSION = '0.13';
+our $VERSION = '0.14';
 
 =head1 SYNOPSIS
 
@@ -135,15 +135,60 @@
 Given an arrayref formatted as in the L</SYNOPSIS> example, populate a rows in
 a database.  Confesses on errors.  
 
+We allow a few different inputs to make it less verbose to use under different
+situations, as well as format nicely using your configuration format of choice.
+
 The $ArrayRef contains one or more elements in the following pattern;
 
-	{Source => {
-		fields => [qw/ column belongs_to has_many/],
-		data => {
-			key_1 => ['value', $row, \@rows ],
-	}}}
+	$schema->populate_more([
+		{Source1 => {
+			fields => [qw/ column belongs_to has_many/],
+			data => {
+				key_1 => ['value', $row, \@rows ],
+		}}},
+		{Source2 => {
+			fields => [qw/ column belongs_to has_many/],
+			data => {
+				key_1 => ['value', $row, \@rows ],
+		}}},
+	]);
 
-'Source' is the name of a DBIC source (as in $schema->resultset($Source)->...)
+The @Array version can be one of the following:
+
+	## Option One
+	$schema->populate_more(
+		{Source1 => {
+			fields => [qw/ column belongs_to has_many/],
+			data => {
+				key_1 => ['value', $row, \@rows ],
+		}}},
+		{Source2 => {
+			fields => [qw/ column belongs_to has_many/],
+			data => {
+				key_1 => ['value', $row, \@rows ],
+		}}},
+	);
+
+	## Option Two
+	$schema->populate_more(
+		Source1 => {
+			fields => [qw/ column belongs_to has_many/],
+			data => {
+				key_1 => ['value', $row, \@rows ],
+			}
+		},
+		Source2 => {
+			fields => [qw/ column belongs_to has_many/],
+			data => {
+				key_1 => ['value', $row, \@rows ],
+			}
+		},
+	);
+
+The last option is probably your choice if you are building a Perl structure
+directly, since it's the least verbose.
+
+'SourceX' is the name of a DBIC source (as in $schema->resultset($Source)->...)
 while fields is an arrayref of either columns or named relationships and data
 is a hashref of rows that you will insert into the Source.
 
@@ -157,12 +202,23 @@
     $self->throw_exception("Argument is required.")
 	  unless $arg;
 
-	$arg = ref $arg eq 'ARRAY' ? $arg : [$arg, @rest];
-	
+	my @args = (ref $arg && ref $arg eq 'ARRAY') ? @$arg : ($arg, @rest);
+
+	my @definitions;
+	while(@args) {
+		my $next = shift(@args);
+		if( (ref $next) && (ref $next eq 'HASH') ) {
+			push @definitions, $next;
+		} else {
+			my $value = shift(@args);
+			push @definitions, {$next => $value};
+		}
+	}
+
 	my $command;
 	eval {
 		$command = DBIx::Class::Schema::PopulateMore::Command->new(
-			definitions=>$arg,
+			definitions=>[@definitions],
 			schema=>$self,
 			exception_cb=>sub {
 				$self->throw_exception(@_);

Modified: DBIx-Class-Schema-PopulateMore/truck/t/01-schema.t
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/t/01-schema.t	2009-08-17 10:37:14 UTC (rev 7323)
+++ DBIx-Class-Schema-PopulateMore/truck/t/01-schema.t	2009-08-17 18:29:40 UTC (rev 7324)
@@ -1,7 +1,7 @@
 use warnings;
 use strict;
 
-use Test::More tests => 35;
+use Test::More tests => 40;
 use DBIx::Class::Schema::PopulateMore::Test::Schema;
 
 ok my $schema = DBIx::Class::Schema::PopulateMore::Test::Schema->connect_and_setup
@@ -184,7 +184,7 @@
 	
 }
 
-## Extra tests
+## Extra tests for alternative ->populate_more argument styles
 
 ok my $extra = [
 	{Person	=> {
@@ -202,5 +202,28 @@
 
 is $joe->age, 19, 'Joe is 19';
 
+ok my %index3 = $schema->populate_more(
+		Gender => {
+			fields => 'label',
+			data => {
+				unknown => 'unknown',
+			}
+		},
+			
+		Person => {
+			fields => ['name', 'age', 'gender'],
+			data => {
+				toad => ['toad', 38, '!Index:Gender.unknown'],
+				bill => ['bill', 40, '!Find:Gender.[label=male]'],
+				york => ['york', 45, '!Find:Gender.[label=female]'],
+			}
+		},
+    ) => 'Successful populated.';
 
+ok my ($bill,$toad,$york) = $schema->resultset('Person')->search({name=>[qw/bill toad york/]},{order_by=>\"name asc"})
+  => 'Found bill, toad and york';
 
+is $bill->age, 40, 'Got correct age for bill';
+is $toad->age, 38, 'Got correct age for toad';
+is $york->age, 45, 'Got correct age for york';
+