From: Peter Rabbitson Date: Tue, 19 Jan 2010 17:19:40 +0000 (+0000) Subject: First round of detabification X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d7f20fdf18a715c90597dd65167d4dafaac7c69f;p=dbsrgits%2FDBIx-Class-Historic.git First round of detabification --- diff --git a/maint/svn-log.perl b/maint/svn-log.perl index dad1388..a094bf6 100644 --- a/maint/svn-log.perl +++ b/maint/svn-log.perl @@ -17,8 +17,8 @@ use POSIX qw(strftime); use XML::Parser; my %month = qw( - Jan 01 Feb 02 Mar 03 Apr 04 May 05 Jun 06 - Jul 07 Aug 08 Sep 09 Oct 10 Nov 11 Dec 12 + Jan 01 Feb 02 Mar 03 Apr 04 May 05 Jun 06 + Jul 07 Aug 08 Sep 09 Oct 10 Nov 11 Dec 12 ); $Text::Wrap::huge = "wrap"; @@ -48,28 +48,28 @@ use constant MAX_TIMESTAMP => "9999-99-99 99:99:99"; GetOptions( "age=s" => \$days_back, "repo=s" => \$svn_repo, - "help" => \$send_help, + "help" => \$send_help, ) or exit; # Find the trunk for the current repository if one isn't specified. unless (defined $svn_repo) { - $svn_repo = `svn info . | grep '^URL: '`; - if (length $svn_repo) { - chomp $svn_repo; - $svn_repo =~ s{^URL\:\s+(.+?)/trunk/?.*$}{$1}; - } - else { - $send_help = 1; - } + $svn_repo = `svn info . | grep '^URL: '`; + if (length $svn_repo) { + chomp $svn_repo; + $svn_repo =~ s{^URL\:\s+(.+?)/trunk/?.*$}{$1}; + } + else { + $send_help = 1; + } } die( - "$0 usage:\n", - " --repo REPOSITORY\n", - " [--age DAYS]\n", - "\n", - "REPOSITORY must have a trunk subdirectory and a tags directory where\n", - "release tags are kept.\n", + "$0 usage:\n", + " --repo REPOSITORY\n", + " [--age DAYS]\n", + "\n", + "REPOSITORY must have a trunk subdirectory and a tags directory where\n", + "release tags are kept.\n", ) if $send_help; my $earliest_date = strftime "%F", gmtime(time() - $days_back * 86400); @@ -81,31 +81,31 @@ my %tag; open(TAG, "svn -v list $svn_repo/tags|") or die $!; while () { - # The date is unused, however. - next unless ( - my ($rev, $date, $tag) = m{ - (\d+).*?(\S\S\S\s+\d\d\s+(?:\d\d\d\d|\d\d:\d\d))\s+(v[0-9_.]+) - }x - ); - - my @tag_log = gather_log("$svn_repo/tags/$tag", "--stop-on-copy"); - die "Tag $tag has changes after tagging!\n" if @tag_log > 1; - - my $timestamp = $tag_log[0][LOG_DATE]; - $tag{$timestamp} = [ - $rev, # TAG_REV - $tag, # TAG_TAG - [ ], # TAG_LOG - ]; + # The date is unused, however. + next unless ( + my ($rev, $date, $tag) = m{ + (\d+).*?(\S\S\S\s+\d\d\s+(?:\d\d\d\d|\d\d:\d\d))\s+(v[0-9_.]+) + }x + ); + + my @tag_log = gather_log("$svn_repo/tags/$tag", "--stop-on-copy"); + die "Tag $tag has changes after tagging!\n" if @tag_log > 1; + + my $timestamp = $tag_log[0][LOG_DATE]; + $tag{$timestamp} = [ + $rev, # TAG_REV + $tag, # TAG_TAG + [ ], # TAG_LOG + ]; } close TAG; # Fictitious "HEAD" tag for revisions that came after the last tag. $tag{+MAX_TIMESTAMP} = [ - "HEAD", # TAG_REV - "(untagged)", # TAG_TAG - undef, # TAG_LOG + "HEAD", # TAG_REV + "(untagged)", # TAG_TAG + undef, # TAG_LOG ]; ### 2. Gather the log for the trunk. Place log entries under their @@ -114,184 +114,184 @@ $tag{+MAX_TIMESTAMP} = [ my @tag_dates = sort keys %tag; while (my $date = pop(@tag_dates)) { - # We're done if this date's before our earliest date. - if ($date lt $earliest_date) { - delete $tag{$date}; - next; - } + # We're done if this date's before our earliest date. + if ($date lt $earliest_date) { + delete $tag{$date}; + next; + } - my $tag = $tag{$date}[TAG_TAG]; - #warn "Gathering information for tag $tag...\n"; + my $tag = $tag{$date}[TAG_TAG]; + #warn "Gathering information for tag $tag...\n"; - my $this_rev = $tag{$date}[TAG_REV]; - my $prev_rev; - if (@tag_dates) { - $prev_rev = $tag{$tag_dates[-1]}[TAG_REV]; - } - else { - $prev_rev = 0; - } + my $this_rev = $tag{$date}[TAG_REV]; + my $prev_rev; + if (@tag_dates) { + $prev_rev = $tag{$tag_dates[-1]}[TAG_REV]; + } + else { + $prev_rev = 0; + } - my @log = gather_log("$svn_repo/trunk", "-r", "$this_rev:$prev_rev"); + my @log = gather_log("$svn_repo/trunk", "-r", "$this_rev:$prev_rev"); - $tag{$date}[TAG_LOG] = \@log; + $tag{$date}[TAG_LOG] = \@log; } ### 3. PROFIT! No, wait... generate the nice log file. foreach my $timestamp (sort { $b cmp $a } keys %tag) { - my $tag_rec = $tag{$timestamp}; - - # Skip this tag if there are no log entries. - next unless @{$tag_rec->[TAG_LOG]}; - - my $tag_line = "$timestamp $tag_rec->[TAG_TAG]"; - my $tag_bar = "=" x length($tag_line); - print $tag_bar, "\n", $tag_line, "\n", $tag_bar, "\n\n"; - - foreach my $log_rec (@{$tag_rec->[TAG_LOG]}) { - - my @paths = @{$log_rec->[LOG_PATHS]}; - if (@paths > 1) { - @paths = grep { - $_->[PATH_PATH] ne "/trunk" or $_->[PATH_ACTION] ne "M" - } @paths; - } - - my $time_line = wrap( - " ", " ", - join( - "; ", - "$log_rec->[LOG_DATE] (r$log_rec->[LOG_REV]) by $log_rec->[LOG_WHO]", - map { "$_->[PATH_PATH] $_->[PATH_ACTION]" } @paths - ) - ); - - if ($time_line =~ /\n/) { - $time_line = wrap( - " ", " ", - "$log_rec->[LOG_DATE] (r$log_rec->[LOG_REV]) by $log_rec->[LOG_WHO]\n" - ) . - wrap( - " ", " ", - join( - "; ", - map { "$_->[PATH_PATH] $_->[PATH_ACTION]" } @paths - ) - ); - } - - print $time_line, "\n\n"; - - # Blank lines should have the indent level of whitespace. This - # makes it easier for other utilities to parse them. - - my @paragraphs = split /\n\s*\n/, $log_rec->[LOG_MESSAGE]; - foreach my $paragraph (@paragraphs) { - - # Trim off identical leading space from every line. - my ($whitespace) = $paragraph =~ /^(\s*)/; - if (length $whitespace) { - $paragraph =~ s/^$whitespace//mg; - } - - # Re-flow the paragraph if it isn't indented from the norm. - # This should preserve indented quoted text, wiki-style. - unless ($paragraph =~ /^\s/) { - $paragraph = fill(" ", " ", $paragraph); - } - } - - print join("\n \n", @paragraphs), "\n\n"; - } + my $tag_rec = $tag{$timestamp}; + + # Skip this tag if there are no log entries. + next unless @{$tag_rec->[TAG_LOG]}; + + my $tag_line = "$timestamp $tag_rec->[TAG_TAG]"; + my $tag_bar = "=" x length($tag_line); + print $tag_bar, "\n", $tag_line, "\n", $tag_bar, "\n\n"; + + foreach my $log_rec (@{$tag_rec->[TAG_LOG]}) { + + my @paths = @{$log_rec->[LOG_PATHS]}; + if (@paths > 1) { + @paths = grep { + $_->[PATH_PATH] ne "/trunk" or $_->[PATH_ACTION] ne "M" + } @paths; + } + + my $time_line = wrap( + " ", " ", + join( + "; ", + "$log_rec->[LOG_DATE] (r$log_rec->[LOG_REV]) by $log_rec->[LOG_WHO]", + map { "$_->[PATH_PATH] $_->[PATH_ACTION]" } @paths + ) + ); + + if ($time_line =~ /\n/) { + $time_line = wrap( + " ", " ", + "$log_rec->[LOG_DATE] (r$log_rec->[LOG_REV]) by $log_rec->[LOG_WHO]\n" + ) . + wrap( + " ", " ", + join( + "; ", + map { "$_->[PATH_PATH] $_->[PATH_ACTION]" } @paths + ) + ); + } + + print $time_line, "\n\n"; + + # Blank lines should have the indent level of whitespace. This + # makes it easier for other utilities to parse them. + + my @paragraphs = split /\n\s*\n/, $log_rec->[LOG_MESSAGE]; + foreach my $paragraph (@paragraphs) { + + # Trim off identical leading space from every line. + my ($whitespace) = $paragraph =~ /^(\s*)/; + if (length $whitespace) { + $paragraph =~ s/^$whitespace//mg; + } + + # Re-flow the paragraph if it isn't indented from the norm. + # This should preserve indented quoted text, wiki-style. + unless ($paragraph =~ /^\s/) { + $paragraph = fill(" ", " ", $paragraph); + } + } + + print join("\n \n", @paragraphs), "\n\n"; + } } print( - "==============\n", - "End of Excerpt\n", - "==============\n", + "==============\n", + "End of Excerpt\n", + "==============\n", ); ### Z. Helper functions. sub gather_log { - my ($url, @flags) = @_; - - my (@log, @stack); - - my $parser = XML::Parser->new( - Handlers => { - Start => sub { - my ($self, $tag, %att) = @_; - push @stack, [ $tag, \%att ]; - if ($tag eq "logentry") { - push @log, [ ]; - $log[-1][LOG_WHO] = "(nobody)"; - } - }, - Char => sub { - my ($self, $text) = @_; - $stack[-1][1]{0} .= $text; - }, - End => sub { - my ($self, $tag) = @_; - die "close $tag w/out open" unless @stack; - my ($pop_tag, $att) = @{pop @stack}; - - die "$tag ne $pop_tag" if $tag ne $pop_tag; - - if ($tag eq "date") { - my $timestamp = $att->{0}; - my ($date, $time) = split /[T.]/, $timestamp; - $log[-1][LOG_DATE] = "$date $time"; - return; - } - - if ($tag eq "logentry") { - $log[-1][LOG_REV] = $att->{revision}; - return; - } - - if ($tag eq "msg") { - $log[-1][LOG_MESSAGE] = $att->{0}; - return; - } - - if ($tag eq "author") { - $log[-1][LOG_WHO] = $att->{0}; - return; - } - - if ($tag eq "path") { - my $path = $att->{0}; - $path =~ s{^/trunk/}{}; - push( - @{$log[-1][LOG_PATHS]}, [ - $path, # PATH_PATH - $att->{action}, # PATH_ACTION - ] - ); - - $log[-1][LOG_PATHS][-1][PATH_CPF_PATH] = $att->{"copyfrom-path"} if ( - exists $att->{"copyfrom-path"} - ); - - $log[-1][LOG_PATHS][-1][PATH_CPF_REV] = $att->{"copyfrom-rev"} if ( - exists $att->{"copyfrom-rev"} - ); - return; - } - - } - } - ); - - my $cmd = "svn -v --xml @flags log $url"; - #warn "Command: $cmd\n"; - - open(LOG, "$cmd|") or die $!; - $parser->parse(*LOG); - close LOG; - - return @log; + my ($url, @flags) = @_; + + my (@log, @stack); + + my $parser = XML::Parser->new( + Handlers => { + Start => sub { + my ($self, $tag, %att) = @_; + push @stack, [ $tag, \%att ]; + if ($tag eq "logentry") { + push @log, [ ]; + $log[-1][LOG_WHO] = "(nobody)"; + } + }, + Char => sub { + my ($self, $text) = @_; + $stack[-1][1]{0} .= $text; + }, + End => sub { + my ($self, $tag) = @_; + die "close $tag w/out open" unless @stack; + my ($pop_tag, $att) = @{pop @stack}; + + die "$tag ne $pop_tag" if $tag ne $pop_tag; + + if ($tag eq "date") { + my $timestamp = $att->{0}; + my ($date, $time) = split /[T.]/, $timestamp; + $log[-1][LOG_DATE] = "$date $time"; + return; + } + + if ($tag eq "logentry") { + $log[-1][LOG_REV] = $att->{revision}; + return; + } + + if ($tag eq "msg") { + $log[-1][LOG_MESSAGE] = $att->{0}; + return; + } + + if ($tag eq "author") { + $log[-1][LOG_WHO] = $att->{0}; + return; + } + + if ($tag eq "path") { + my $path = $att->{0}; + $path =~ s{^/trunk/}{}; + push( + @{$log[-1][LOG_PATHS]}, [ + $path, # PATH_PATH + $att->{action}, # PATH_ACTION + ] + ); + + $log[-1][LOG_PATHS][-1][PATH_CPF_PATH] = $att->{"copyfrom-path"} if ( + exists $att->{"copyfrom-path"} + ); + + $log[-1][LOG_PATHS][-1][PATH_CPF_REV] = $att->{"copyfrom-rev"} if ( + exists $att->{"copyfrom-rev"} + ); + return; + } + + } + } + ); + + my $cmd = "svn -v --xml @flags log $url"; + #warn "Command: $cmd\n"; + + open(LOG, "$cmd|") or die $!; + $parser->parse(*LOG); + close LOG; + + return @log; } diff --git a/t/06notabs.t b/t/06notabs.t index 7eba2c6..23b3453 100644 --- a/t/06notabs.t +++ b/t/06notabs.t @@ -23,6 +23,6 @@ foreach my $MODULE ( @MODULES ) { } } -all_perl_files_ok(); +all_perl_files_ok(qw/t lib script maint/); done_testing; diff --git a/t/101populate_rs.t b/t/101populate_rs.t index 5454fa0..942d927 100644 --- a/t/101populate_rs.t +++ b/t/101populate_rs.t @@ -20,11 +20,11 @@ use DBICTest; ## Get a Schema and some ResultSets we can play with. ## ---------------------------------------------------------------------------- -my $schema = DBICTest->init_schema(); -my $art_rs = $schema->resultset('Artist'); -my $cd_rs = $schema->resultset('CD'); +my $schema = DBICTest->init_schema(); +my $art_rs = $schema->resultset('Artist'); +my $cd_rs = $schema->resultset('CD'); -my $restricted_art_rs = $art_rs->search({rank => 42}); +my $restricted_art_rs = $art_rs->search({rank => 42}); ok( $schema, 'Got a Schema object'); ok( $art_rs, 'Got Good Artist Resultset'); @@ -37,87 +37,87 @@ ok( $cd_rs, 'Got Good CD Resultset'); SCHEMA_POPULATE1: { - ## Test to make sure that the old $schema->populate is using the new method - ## for $resultset->populate when in void context and with sub objects. - - $schema->populate('Artist', [ - - [qw/name cds/], - ["001First Artist", [ - {title=>"001Title1", year=>2000}, - {title=>"001Title2", year=>2001}, - {title=>"001Title3", year=>2002}, - ]], - ["002Second Artist", []], - ["003Third Artist", [ - {title=>"003Title1", year=>2005}, - ]], - [undef, [ - {title=>"004Title1", year=>2010} - ]], - ]); - - isa_ok $schema, 'DBIx::Class::Schema'; - - my ($undef, $artist1, $artist2, $artist3 ) = $schema->resultset('Artist')->search({ - name=>["001First Artist","002Second Artist","003Third Artist", undef]}, - {order_by=>'name ASC'})->all; - - isa_ok $artist1, 'DBICTest::Artist'; - isa_ok $artist2, 'DBICTest::Artist'; - isa_ok $artist3, 'DBICTest::Artist'; - isa_ok $undef, 'DBICTest::Artist'; - - ok $artist1->name eq '001First Artist', "Got Expected Artist Name for Artist001"; - ok $artist2->name eq '002Second Artist', "Got Expected Artist Name for Artist002"; - ok $artist3->name eq '003Third Artist', "Got Expected Artist Name for Artist003"; - ok !defined $undef->name, "Got Expected Artist Name for Artist004"; - - ok $artist1->cds->count eq 3, "Got Right number of CDs for Artist1"; - ok $artist2->cds->count eq 0, "Got Right number of CDs for Artist2"; - ok $artist3->cds->count eq 1, "Got Right number of CDs for Artist3"; - ok $undef->cds->count eq 1, "Got Right number of CDs for Artist4"; - - ARTIST1CDS: { - - my ($cd1, $cd2, $cd3) = $artist1->cds->search(undef, {order_by=>'year ASC'}); - - isa_ok $cd1, 'DBICTest::CD'; - isa_ok $cd2, 'DBICTest::CD'; - isa_ok $cd3, 'DBICTest::CD'; - - ok $cd1->year == 2000; - ok $cd2->year == 2001; - ok $cd3->year == 2002; - - ok $cd1->title eq '001Title1'; - ok $cd2->title eq '001Title2'; - ok $cd3->title eq '001Title3'; - } - - ARTIST3CDS: { - - my ($cd1) = $artist3->cds->search(undef, {order_by=>'year ASC'}); - - isa_ok $cd1, 'DBICTest::CD'; - - ok $cd1->year == 2005; - ok $cd1->title eq '003Title1'; - } - - ARTIST4CDS: { - - my ($cd1) = $undef->cds->search(undef, {order_by=>'year ASC'}); - - isa_ok $cd1, 'DBICTest::CD'; - - ok $cd1->year == 2010; - ok $cd1->title eq '004Title1'; - } - - ## Need to do some cleanup so that later tests don't get borked - - $undef->delete; + ## Test to make sure that the old $schema->populate is using the new method + ## for $resultset->populate when in void context and with sub objects. + + $schema->populate('Artist', [ + + [qw/name cds/], + ["001First Artist", [ + {title=>"001Title1", year=>2000}, + {title=>"001Title2", year=>2001}, + {title=>"001Title3", year=>2002}, + ]], + ["002Second Artist", []], + ["003Third Artist", [ + {title=>"003Title1", year=>2005}, + ]], + [undef, [ + {title=>"004Title1", year=>2010} + ]], + ]); + + isa_ok $schema, 'DBIx::Class::Schema'; + + my ($undef, $artist1, $artist2, $artist3 ) = $schema->resultset('Artist')->search({ + name=>["001First Artist","002Second Artist","003Third Artist", undef]}, + {order_by=>'name ASC'})->all; + + isa_ok $artist1, 'DBICTest::Artist'; + isa_ok $artist2, 'DBICTest::Artist'; + isa_ok $artist3, 'DBICTest::Artist'; + isa_ok $undef, 'DBICTest::Artist'; + + ok $artist1->name eq '001First Artist', "Got Expected Artist Name for Artist001"; + ok $artist2->name eq '002Second Artist', "Got Expected Artist Name for Artist002"; + ok $artist3->name eq '003Third Artist', "Got Expected Artist Name for Artist003"; + ok !defined $undef->name, "Got Expected Artist Name for Artist004"; + + ok $artist1->cds->count eq 3, "Got Right number of CDs for Artist1"; + ok $artist2->cds->count eq 0, "Got Right number of CDs for Artist2"; + ok $artist3->cds->count eq 1, "Got Right number of CDs for Artist3"; + ok $undef->cds->count eq 1, "Got Right number of CDs for Artist4"; + + ARTIST1CDS: { + + my ($cd1, $cd2, $cd3) = $artist1->cds->search(undef, {order_by=>'year ASC'}); + + isa_ok $cd1, 'DBICTest::CD'; + isa_ok $cd2, 'DBICTest::CD'; + isa_ok $cd3, 'DBICTest::CD'; + + ok $cd1->year == 2000; + ok $cd2->year == 2001; + ok $cd3->year == 2002; + + ok $cd1->title eq '001Title1'; + ok $cd2->title eq '001Title2'; + ok $cd3->title eq '001Title3'; + } + + ARTIST3CDS: { + + my ($cd1) = $artist3->cds->search(undef, {order_by=>'year ASC'}); + + isa_ok $cd1, 'DBICTest::CD'; + + ok $cd1->year == 2005; + ok $cd1->title eq '003Title1'; + } + + ARTIST4CDS: { + + my ($cd1) = $undef->cds->search(undef, {order_by=>'year ASC'}); + + isa_ok $cd1, 'DBICTest::CD'; + + ok $cd1->year == 2010; + ok $cd1->title eq '004Title1'; + } + + ## Need to do some cleanup so that later tests don't get borked + + $undef->delete; } @@ -127,221 +127,221 @@ SCHEMA_POPULATE1: { ARRAY_CONTEXT: { - ## These first set of tests are cake because array context just delegates - ## all it's processing to $resultset->create - - HAS_MANY_NO_PKS: { - - ## This first group of tests checks to make sure we can call populate - ## with the parent having many children and let the keys be automatic - - my $artists = [ - { - name => 'Angsty-Whiny Girl', - cds => [ - { title => 'My First CD', year => 2006 }, - { title => 'Yet More Tweeny-Pop crap', year => 2007 }, - ], - }, - { - name => 'Manufactured Crap', - }, - { - name => 'Like I Give a Damn', - cds => [ - { title => 'My parents sold me to a record company' ,year => 2005 }, - { title => 'Why Am I So Ugly?', year => 2006 }, - { title => 'I Got Surgery and am now Popular', year => 2007 } - ], - }, - { - name => 'Formerly Named', - cds => [ - { title => 'One Hit Wonder', year => 2006 }, - ], - }, - ]; - - ## Get the result row objects. - - my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists); - - ## Do we have the right object? - - isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'"); - isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'"); - isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); - isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'"); - - ## Find the expected information? - - ok( $crap->name eq 'Manufactured Crap', "Got Correct name for result object"); - ok( $girl->name eq 'Angsty-Whiny Girl', "Got Correct name for result object"); - ok( $damn->name eq 'Like I Give a Damn', "Got Correct name for result object"); - ok( $formerly->name eq 'Formerly Named', "Got Correct name for result object"); - - ## Create the expected children sub objects? - - ok( $crap->cds->count == 0, "got Expected Number of Cds"); - ok( $girl->cds->count == 2, "got Expected Number of Cds"); - ok( $damn->cds->count == 3, "got Expected Number of Cds"); - ok( $formerly->cds->count == 1, "got Expected Number of Cds"); - - ## Did the cds get expected information? - - my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'}); - - ok( $cd1->title eq "My First CD", "Got Expected CD Title"); - ok( $cd2->title eq "Yet More Tweeny-Pop crap", "Got Expected CD Title"); - } - - HAS_MANY_WITH_PKS: { - - ## This group tests the ability to specify the PK in the parent and let - ## DBIC transparently pass the PK down to the Child and also let's the - ## child create any other needed PK's for itself. - - my $aid = $art_rs->get_column('artistid')->max || 0; - - my $first_aid = ++$aid; - - my $artists = [ - { - artistid => $first_aid, - name => 'PK_Angsty-Whiny Girl', - cds => [ - { artist => $first_aid, title => 'PK_My First CD', year => 2006 }, - { artist => $first_aid, title => 'PK_Yet More Tweeny-Pop crap', year => 2007 }, - ], - }, - { - artistid => ++$aid, - name => 'PK_Manufactured Crap', - }, - { - artistid => ++$aid, - name => 'PK_Like I Give a Damn', - cds => [ - { title => 'PK_My parents sold me to a record company' ,year => 2005 }, - { title => 'PK_Why Am I So Ugly?', year => 2006 }, - { title => 'PK_I Got Surgery and am now Popular', year => 2007 } - ], - }, - { - artistid => ++$aid, - name => 'PK_Formerly Named', - cds => [ - { title => 'PK_One Hit Wonder', year => 2006 }, - ], - }, - ]; - - ## Get the result row objects. - - my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists); - - ## Do we have the right object? - - isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'"); - isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'"); - isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); - isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'"); - - ## Find the expected information? - - ok( $crap->name eq 'PK_Manufactured Crap', "Got Correct name for result object"); - ok( $girl->name eq 'PK_Angsty-Whiny Girl', "Got Correct name for result object"); - ok( $girl->artistid == $first_aid, "Got Correct artist PK for result object"); - ok( $damn->name eq 'PK_Like I Give a Damn', "Got Correct name for result object"); - ok( $formerly->name eq 'PK_Formerly Named', "Got Correct name for result object"); - - ## Create the expected children sub objects? - - ok( $crap->cds->count == 0, "got Expected Number of Cds"); - ok( $girl->cds->count == 2, "got Expected Number of Cds"); - ok( $damn->cds->count == 3, "got Expected Number of Cds"); - ok( $formerly->cds->count == 1, "got Expected Number of Cds"); - - ## Did the cds get expected information? - - my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'}); - - ok( $cd1->title eq "PK_My First CD", "Got Expected CD Title"); - ok( $cd2->title eq "PK_Yet More Tweeny-Pop crap", "Got Expected CD Title"); - } - - BELONGS_TO_NO_PKs: { - - ## Test from a belongs_to perspective, should create artist first, - ## then CD with artistid. This test we let the system automatically - ## create the PK's. Chances are good you'll use it this way mostly. - - my $cds = [ - { - title => 'Some CD3', - year => '1997', - artist => { name => 'Fred BloggsC'}, - }, - { - title => 'Some CD4', - year => '1997', - artist => { name => 'Fred BloggsD'}, - }, - ]; - - my ($cdA, $cdB) = $cd_rs->populate($cds); - - - isa_ok($cdA, 'DBICTest::CD', 'Created CD'); - isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist'); - is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC'); - - - isa_ok($cdB, 'DBICTest::CD', 'Created CD'); - isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist'); - is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD'); - } - - BELONGS_TO_WITH_PKs: { - - ## Test from a belongs_to perspective, should create artist first, - ## then CD with artistid. This time we try setting the PK's - - my $aid = $art_rs->get_column('artistid')->max || 0; - - my $cds = [ - { - title => 'Some CD3', - year => '1997', - artist => { artistid=> ++$aid, name => 'Fred BloggsC'}, - }, - { - title => 'Some CD4', - year => '1997', - artist => { artistid=> ++$aid, name => 'Fred BloggsD'}, - }, - ]; - - my ($cdA, $cdB) = $cd_rs->populate($cds); - - isa_ok($cdA, 'DBICTest::CD', 'Created CD'); - isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist'); - is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC'); - - isa_ok($cdB, 'DBICTest::CD', 'Created CD'); - isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist'); - is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD'); - ok($cdB->artist->artistid == $aid, "Got Expected Artist ID"); - } + ## These first set of tests are cake because array context just delegates + ## all it's processing to $resultset->create + + HAS_MANY_NO_PKS: { + + ## This first group of tests checks to make sure we can call populate + ## with the parent having many children and let the keys be automatic + + my $artists = [ + { + name => 'Angsty-Whiny Girl', + cds => [ + { title => 'My First CD', year => 2006 }, + { title => 'Yet More Tweeny-Pop crap', year => 2007 }, + ], + }, + { + name => 'Manufactured Crap', + }, + { + name => 'Like I Give a Damn', + cds => [ + { title => 'My parents sold me to a record company' ,year => 2005 }, + { title => 'Why Am I So Ugly?', year => 2006 }, + { title => 'I Got Surgery and am now Popular', year => 2007 } + ], + }, + { + name => 'Formerly Named', + cds => [ + { title => 'One Hit Wonder', year => 2006 }, + ], + }, + ]; + + ## Get the result row objects. + + my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists); + + ## Do we have the right object? + + isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'"); + isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'"); + isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); + isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'"); + + ## Find the expected information? + + ok( $crap->name eq 'Manufactured Crap', "Got Correct name for result object"); + ok( $girl->name eq 'Angsty-Whiny Girl', "Got Correct name for result object"); + ok( $damn->name eq 'Like I Give a Damn', "Got Correct name for result object"); + ok( $formerly->name eq 'Formerly Named', "Got Correct name for result object"); + + ## Create the expected children sub objects? + + ok( $crap->cds->count == 0, "got Expected Number of Cds"); + ok( $girl->cds->count == 2, "got Expected Number of Cds"); + ok( $damn->cds->count == 3, "got Expected Number of Cds"); + ok( $formerly->cds->count == 1, "got Expected Number of Cds"); + + ## Did the cds get expected information? + + my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year'}); + + ok( $cd1->title eq "My First CD", "Got Expected CD Title"); + ok( $cd2->title eq "Yet More Tweeny-Pop crap", "Got Expected CD Title"); + } + + HAS_MANY_WITH_PKS: { + + ## This group tests the ability to specify the PK in the parent and let + ## DBIC transparently pass the PK down to the Child and also let's the + ## child create any other needed PK's for itself. + + my $aid = $art_rs->get_column('artistid')->max || 0; + + my $first_aid = ++$aid; + + my $artists = [ + { + artistid => $first_aid, + name => 'PK_Angsty-Whiny Girl', + cds => [ + { artist => $first_aid, title => 'PK_My First CD', year => 2006 }, + { artist => $first_aid, title => 'PK_Yet More Tweeny-Pop crap', year => 2007 }, + ], + }, + { + artistid => ++$aid, + name => 'PK_Manufactured Crap', + }, + { + artistid => ++$aid, + name => 'PK_Like I Give a Damn', + cds => [ + { title => 'PK_My parents sold me to a record company' ,year => 2005 }, + { title => 'PK_Why Am I So Ugly?', year => 2006 }, + { title => 'PK_I Got Surgery and am now Popular', year => 2007 } + ], + }, + { + artistid => ++$aid, + name => 'PK_Formerly Named', + cds => [ + { title => 'PK_One Hit Wonder', year => 2006 }, + ], + }, + ]; + + ## Get the result row objects. + + my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists); + + ## Do we have the right object? + + isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'"); + isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'"); + isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); + isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'"); + + ## Find the expected information? + + ok( $crap->name eq 'PK_Manufactured Crap', "Got Correct name for result object"); + ok( $girl->name eq 'PK_Angsty-Whiny Girl', "Got Correct name for result object"); + ok( $girl->artistid == $first_aid, "Got Correct artist PK for result object"); + ok( $damn->name eq 'PK_Like I Give a Damn', "Got Correct name for result object"); + ok( $formerly->name eq 'PK_Formerly Named', "Got Correct name for result object"); + + ## Create the expected children sub objects? + + ok( $crap->cds->count == 0, "got Expected Number of Cds"); + ok( $girl->cds->count == 2, "got Expected Number of Cds"); + ok( $damn->cds->count == 3, "got Expected Number of Cds"); + ok( $formerly->cds->count == 1, "got Expected Number of Cds"); + + ## Did the cds get expected information? + + my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'}); + + ok( $cd1->title eq "PK_My First CD", "Got Expected CD Title"); + ok( $cd2->title eq "PK_Yet More Tweeny-Pop crap", "Got Expected CD Title"); + } + + BELONGS_TO_NO_PKs: { + + ## Test from a belongs_to perspective, should create artist first, + ## then CD with artistid. This test we let the system automatically + ## create the PK's. Chances are good you'll use it this way mostly. + + my $cds = [ + { + title => 'Some CD3', + year => '1997', + artist => { name => 'Fred BloggsC'}, + }, + { + title => 'Some CD4', + year => '1997', + artist => { name => 'Fred BloggsD'}, + }, + ]; + + my ($cdA, $cdB) = $cd_rs->populate($cds); + + + isa_ok($cdA, 'DBICTest::CD', 'Created CD'); + isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist'); + is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC'); + + + isa_ok($cdB, 'DBICTest::CD', 'Created CD'); + isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist'); + is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD'); + } + + BELONGS_TO_WITH_PKs: { + + ## Test from a belongs_to perspective, should create artist first, + ## then CD with artistid. This time we try setting the PK's + + my $aid = $art_rs->get_column('artistid')->max || 0; + + my $cds = [ + { + title => 'Some CD3', + year => '1997', + artist => { artistid=> ++$aid, name => 'Fred BloggsC'}, + }, + { + title => 'Some CD4', + year => '1997', + artist => { artistid=> ++$aid, name => 'Fred BloggsD'}, + }, + ]; + + my ($cdA, $cdB) = $cd_rs->populate($cds); + + isa_ok($cdA, 'DBICTest::CD', 'Created CD'); + isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist'); + is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC'); + + isa_ok($cdB, 'DBICTest::CD', 'Created CD'); + isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist'); + is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD'); + ok($cdB->artist->artistid == $aid, "Got Expected Artist ID"); + } WITH_COND_FROM_RS: { - + my ($more_crap) = $restricted_art_rs->populate([ { name => 'More Manufactured Crap', }, ]); - + ## Did it use the condition in the resultset? cmp_ok( $more_crap->rank, '==', 42, "Got Correct rank for result object"); } @@ -354,267 +354,267 @@ ARRAY_CONTEXT: { VOID_CONTEXT: { - ## All these tests check the ability to use populate without asking for - ## any returned resultsets. This uses bulk_insert as much as possible - ## in order to increase speed. - - HAS_MANY_WITH_PKS: { - - ## This first group of tests checks to make sure we can call populate - ## with the parent having many children and the parent PK is set - - my $aid = $art_rs->get_column('artistid')->max || 0; - - my $first_aid = ++$aid; - - my $artists = [ - { - artistid => $first_aid, - name => 'VOID_PK_Angsty-Whiny Girl', - cds => [ - { artist => $first_aid, title => 'VOID_PK_My First CD', year => 2006 }, - { artist => $first_aid, title => 'VOID_PK_Yet More Tweeny-Pop crap', year => 2007 }, - ], - }, - { - artistid => ++$aid, - name => 'VOID_PK_Manufactured Crap', - }, - { - artistid => ++$aid, - name => 'VOID_PK_Like I Give a Damn', - cds => [ - { title => 'VOID_PK_My parents sold me to a record company' ,year => 2005 }, - { title => 'VOID_PK_Why Am I So Ugly?', year => 2006 }, - { title => 'VOID_PK_I Got Surgery and am now Popular', year => 2007 } - ], - }, - { - artistid => ++$aid, - name => 'VOID_PK_Formerly Named', - cds => [ - { title => 'VOID_PK_One Hit Wonder', year => 2006 }, - ], - }, - { - artistid => ++$aid, - name => undef, - cds => [ - { title => 'VOID_PK_Zundef test', year => 2006 }, - ], - }, - ]; - - ## Get the result row objects. - - $art_rs->populate($artists); - - my ($undef, $girl, $formerly, $damn, $crap) = $art_rs->search( - - {name=>[ map { $_->{name} } @$artists]}, - {order_by=>'name ASC'}, - ); - - ## Do we have the right object? - - isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'"); - isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'"); - isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); - isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'"); - isa_ok( $undef, 'DBICTest::Artist', "Got 'Artist'"); - - ## Find the expected information? - - ok( $crap->name eq 'VOID_PK_Manufactured Crap', "Got Correct name 'VOID_PK_Manufactured Crap' for result object"); - ok( $girl->name eq 'VOID_PK_Angsty-Whiny Girl', "Got Correct name for result object"); - ok( $damn->name eq 'VOID_PK_Like I Give a Damn', "Got Correct name for result object"); - ok( $formerly->name eq 'VOID_PK_Formerly Named', "Got Correct name for result object"); - ok( !defined $undef->name, "Got Correct name 'is undef' for result object"); - - ## Create the expected children sub objects? - ok( $crap->can('cds'), "Has cds relationship"); - ok( $girl->can('cds'), "Has cds relationship"); - ok( $damn->can('cds'), "Has cds relationship"); - ok( $formerly->can('cds'), "Has cds relationship"); - ok( $undef->can('cds'), "Has cds relationship"); - - ok( $crap->cds->count == 0, "got Expected Number of Cds"); - ok( $girl->cds->count == 2, "got Expected Number of Cds"); - ok( $damn->cds->count == 3, "got Expected Number of Cds"); - ok( $formerly->cds->count == 1, "got Expected Number of Cds"); - ok( $undef->cds->count == 1, "got Expected Number of Cds"); - - ## Did the cds get expected information? - - my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'}); - - ok( $cd1->title eq "VOID_PK_My First CD", "Got Expected CD Title"); - ok( $cd2->title eq "VOID_PK_Yet More Tweeny-Pop crap", "Got Expected CD Title"); - } - - - BELONGS_TO_WITH_PKs: { - - ## Test from a belongs_to perspective, should create artist first, - ## then CD with artistid. This time we try setting the PK's - - my $aid = $art_rs->get_column('artistid')->max || 0; - - my $cds = [ - { - title => 'Some CD3B', - year => '1997', - artist => { artistid=> ++$aid, name => 'Fred BloggsCB'}, - }, - { - title => 'Some CD4B', - year => '1997', - artist => { artistid=> ++$aid, name => 'Fred BloggsDB'}, - }, - ]; - - $cd_rs->populate($cds); - - my ($cdA, $cdB) = $cd_rs->search( - {title=>[sort map {$_->{title}} @$cds]}, - {order_by=>'title ASC'}, - ); - - isa_ok($cdA, 'DBICTest::CD', 'Created CD'); - isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist'); - is($cdA->artist->name, 'Fred BloggsCB', 'Set Artist to FredCB'); - - isa_ok($cdB, 'DBICTest::CD', 'Created CD'); - isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist'); - is($cdB->artist->name, 'Fred BloggsDB', 'Set Artist to FredDB'); - ok($cdB->artist->artistid == $aid, "Got Expected Artist ID"); - } - - BELONGS_TO_NO_PKs: { - - ## Test from a belongs_to perspective, should create artist first, - ## then CD with artistid. - - my $cds = [ - { - title => 'Some CD3BB', - year => '1997', - artist => { name => 'Fred BloggsCBB'}, - }, - { - title => 'Some CD4BB', - year => '1997', - artist => { name => 'Fred BloggsDBB'}, - }, - { - title => 'Some CD5BB', - year => '1997', - artist => { name => undef}, - }, - ]; - - $cd_rs->populate($cds); - - my ($cdA, $cdB, $cdC) = $cd_rs->search( - {title=>[sort map {$_->{title}} @$cds]}, - {order_by=>'title ASC'}, - ); - - isa_ok($cdA, 'DBICTest::CD', 'Created CD'); - isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist'); - is($cdA->title, 'Some CD3BB', 'Found Expected title'); - is($cdA->artist->name, 'Fred BloggsCBB', 'Set Artist to FredCBB'); - - isa_ok($cdB, 'DBICTest::CD', 'Created CD'); - isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist'); - is($cdB->title, 'Some CD4BB', 'Found Expected title'); - is($cdB->artist->name, 'Fred BloggsDBB', 'Set Artist to FredDBB'); - - isa_ok($cdC, 'DBICTest::CD', 'Created CD'); - isa_ok($cdC->artist, 'DBICTest::Artist', 'Set Artist'); - is($cdC->title, 'Some CD5BB', 'Found Expected title'); - is( $cdC->artist->name, undef, 'Set Artist to something undefined'); - } - - - HAS_MANY_NO_PKS: { - - ## This first group of tests checks to make sure we can call populate - ## with the parent having many children and let the keys be automatic - - my $artists = [ - { - name => 'VOID_Angsty-Whiny Girl', - cds => [ - { title => 'VOID_My First CD', year => 2006 }, - { title => 'VOID_Yet More Tweeny-Pop crap', year => 2007 }, - ], - }, - { - name => 'VOID_Manufactured Crap', - }, - { - name => 'VOID_Like I Give a Damn', - cds => [ - { title => 'VOID_My parents sold me to a record company' ,year => 2005 }, - { title => 'VOID_Why Am I So Ugly?', year => 2006 }, - { title => 'VOID_I Got Surgery and am now Popular', year => 2007 } - ], - }, - { - name => 'VOID_Formerly Named', - cds => [ - { title => 'VOID_One Hit Wonder', year => 2006 }, - ], - }, - ]; - - ## Get the result row objects. - - $art_rs->populate($artists); - - my ($girl, $formerly, $damn, $crap) = $art_rs->search( - {name=>[sort map {$_->{name}} @$artists]}, - {order_by=>'name ASC'}, - ); - - ## Do we have the right object? - - isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'"); - isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'"); - isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); - isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'"); - - ## Find the expected information? - - ok( $crap->name eq 'VOID_Manufactured Crap', "Got Correct name for result object"); - ok( $girl->name eq 'VOID_Angsty-Whiny Girl', "Got Correct name for result object"); - ok( $damn->name eq 'VOID_Like I Give a Damn', "Got Correct name for result object"); - ok( $formerly->name eq 'VOID_Formerly Named', "Got Correct name for result object"); - - ## Create the expected children sub objects? - ok( $crap->can('cds'), "Has cds relationship"); - ok( $girl->can('cds'), "Has cds relationship"); - ok( $damn->can('cds'), "Has cds relationship"); - ok( $formerly->can('cds'), "Has cds relationship"); - - ok( $crap->cds->count == 0, "got Expected Number of Cds"); - ok( $girl->cds->count == 2, "got Expected Number of Cds"); - ok( $damn->cds->count == 3, "got Expected Number of Cds"); - ok( $formerly->cds->count == 1, "got Expected Number of Cds"); - - ## Did the cds get expected information? - - my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'}); - - ok($cd1, "Got a got CD"); - ok($cd2, "Got a got CD"); - ok( $cd1->title eq "VOID_My First CD", "Got Expected CD Title"); - ok( $cd2->title eq "VOID_Yet More Tweeny-Pop crap", "Got Expected CD Title"); - } + ## All these tests check the ability to use populate without asking for + ## any returned resultsets. This uses bulk_insert as much as possible + ## in order to increase speed. + + HAS_MANY_WITH_PKS: { + + ## This first group of tests checks to make sure we can call populate + ## with the parent having many children and the parent PK is set + + my $aid = $art_rs->get_column('artistid')->max || 0; + + my $first_aid = ++$aid; + + my $artists = [ + { + artistid => $first_aid, + name => 'VOID_PK_Angsty-Whiny Girl', + cds => [ + { artist => $first_aid, title => 'VOID_PK_My First CD', year => 2006 }, + { artist => $first_aid, title => 'VOID_PK_Yet More Tweeny-Pop crap', year => 2007 }, + ], + }, + { + artistid => ++$aid, + name => 'VOID_PK_Manufactured Crap', + }, + { + artistid => ++$aid, + name => 'VOID_PK_Like I Give a Damn', + cds => [ + { title => 'VOID_PK_My parents sold me to a record company' ,year => 2005 }, + { title => 'VOID_PK_Why Am I So Ugly?', year => 2006 }, + { title => 'VOID_PK_I Got Surgery and am now Popular', year => 2007 } + ], + }, + { + artistid => ++$aid, + name => 'VOID_PK_Formerly Named', + cds => [ + { title => 'VOID_PK_One Hit Wonder', year => 2006 }, + ], + }, + { + artistid => ++$aid, + name => undef, + cds => [ + { title => 'VOID_PK_Zundef test', year => 2006 }, + ], + }, + ]; + + ## Get the result row objects. + + $art_rs->populate($artists); + + my ($undef, $girl, $formerly, $damn, $crap) = $art_rs->search( + + {name=>[ map { $_->{name} } @$artists]}, + {order_by=>'name ASC'}, + ); + + ## Do we have the right object? + + isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'"); + isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'"); + isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); + isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'"); + isa_ok( $undef, 'DBICTest::Artist', "Got 'Artist'"); + + ## Find the expected information? + + ok( $crap->name eq 'VOID_PK_Manufactured Crap', "Got Correct name 'VOID_PK_Manufactured Crap' for result object"); + ok( $girl->name eq 'VOID_PK_Angsty-Whiny Girl', "Got Correct name for result object"); + ok( $damn->name eq 'VOID_PK_Like I Give a Damn', "Got Correct name for result object"); + ok( $formerly->name eq 'VOID_PK_Formerly Named', "Got Correct name for result object"); + ok( !defined $undef->name, "Got Correct name 'is undef' for result object"); + + ## Create the expected children sub objects? + ok( $crap->can('cds'), "Has cds relationship"); + ok( $girl->can('cds'), "Has cds relationship"); + ok( $damn->can('cds'), "Has cds relationship"); + ok( $formerly->can('cds'), "Has cds relationship"); + ok( $undef->can('cds'), "Has cds relationship"); + + ok( $crap->cds->count == 0, "got Expected Number of Cds"); + ok( $girl->cds->count == 2, "got Expected Number of Cds"); + ok( $damn->cds->count == 3, "got Expected Number of Cds"); + ok( $formerly->cds->count == 1, "got Expected Number of Cds"); + ok( $undef->cds->count == 1, "got Expected Number of Cds"); + + ## Did the cds get expected information? + + my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'}); + + ok( $cd1->title eq "VOID_PK_My First CD", "Got Expected CD Title"); + ok( $cd2->title eq "VOID_PK_Yet More Tweeny-Pop crap", "Got Expected CD Title"); + } + + + BELONGS_TO_WITH_PKs: { + + ## Test from a belongs_to perspective, should create artist first, + ## then CD with artistid. This time we try setting the PK's + + my $aid = $art_rs->get_column('artistid')->max || 0; + + my $cds = [ + { + title => 'Some CD3B', + year => '1997', + artist => { artistid=> ++$aid, name => 'Fred BloggsCB'}, + }, + { + title => 'Some CD4B', + year => '1997', + artist => { artistid=> ++$aid, name => 'Fred BloggsDB'}, + }, + ]; + + $cd_rs->populate($cds); + + my ($cdA, $cdB) = $cd_rs->search( + {title=>[sort map {$_->{title}} @$cds]}, + {order_by=>'title ASC'}, + ); + + isa_ok($cdA, 'DBICTest::CD', 'Created CD'); + isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist'); + is($cdA->artist->name, 'Fred BloggsCB', 'Set Artist to FredCB'); + + isa_ok($cdB, 'DBICTest::CD', 'Created CD'); + isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist'); + is($cdB->artist->name, 'Fred BloggsDB', 'Set Artist to FredDB'); + ok($cdB->artist->artistid == $aid, "Got Expected Artist ID"); + } + + BELONGS_TO_NO_PKs: { + + ## Test from a belongs_to perspective, should create artist first, + ## then CD with artistid. + + my $cds = [ + { + title => 'Some CD3BB', + year => '1997', + artist => { name => 'Fred BloggsCBB'}, + }, + { + title => 'Some CD4BB', + year => '1997', + artist => { name => 'Fred BloggsDBB'}, + }, + { + title => 'Some CD5BB', + year => '1997', + artist => { name => undef}, + }, + ]; + + $cd_rs->populate($cds); + + my ($cdA, $cdB, $cdC) = $cd_rs->search( + {title=>[sort map {$_->{title}} @$cds]}, + {order_by=>'title ASC'}, + ); + + isa_ok($cdA, 'DBICTest::CD', 'Created CD'); + isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist'); + is($cdA->title, 'Some CD3BB', 'Found Expected title'); + is($cdA->artist->name, 'Fred BloggsCBB', 'Set Artist to FredCBB'); + + isa_ok($cdB, 'DBICTest::CD', 'Created CD'); + isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist'); + is($cdB->title, 'Some CD4BB', 'Found Expected title'); + is($cdB->artist->name, 'Fred BloggsDBB', 'Set Artist to FredDBB'); + + isa_ok($cdC, 'DBICTest::CD', 'Created CD'); + isa_ok($cdC->artist, 'DBICTest::Artist', 'Set Artist'); + is($cdC->title, 'Some CD5BB', 'Found Expected title'); + is( $cdC->artist->name, undef, 'Set Artist to something undefined'); + } + + + HAS_MANY_NO_PKS: { + + ## This first group of tests checks to make sure we can call populate + ## with the parent having many children and let the keys be automatic + + my $artists = [ + { + name => 'VOID_Angsty-Whiny Girl', + cds => [ + { title => 'VOID_My First CD', year => 2006 }, + { title => 'VOID_Yet More Tweeny-Pop crap', year => 2007 }, + ], + }, + { + name => 'VOID_Manufactured Crap', + }, + { + name => 'VOID_Like I Give a Damn', + cds => [ + { title => 'VOID_My parents sold me to a record company' ,year => 2005 }, + { title => 'VOID_Why Am I So Ugly?', year => 2006 }, + { title => 'VOID_I Got Surgery and am now Popular', year => 2007 } + ], + }, + { + name => 'VOID_Formerly Named', + cds => [ + { title => 'VOID_One Hit Wonder', year => 2006 }, + ], + }, + ]; + + ## Get the result row objects. + + $art_rs->populate($artists); + + my ($girl, $formerly, $damn, $crap) = $art_rs->search( + {name=>[sort map {$_->{name}} @$artists]}, + {order_by=>'name ASC'}, + ); + + ## Do we have the right object? + + isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'"); + isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'"); + isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); + isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'"); + + ## Find the expected information? + + ok( $crap->name eq 'VOID_Manufactured Crap', "Got Correct name for result object"); + ok( $girl->name eq 'VOID_Angsty-Whiny Girl', "Got Correct name for result object"); + ok( $damn->name eq 'VOID_Like I Give a Damn', "Got Correct name for result object"); + ok( $formerly->name eq 'VOID_Formerly Named', "Got Correct name for result object"); + + ## Create the expected children sub objects? + ok( $crap->can('cds'), "Has cds relationship"); + ok( $girl->can('cds'), "Has cds relationship"); + ok( $damn->can('cds'), "Has cds relationship"); + ok( $formerly->can('cds'), "Has cds relationship"); + + ok( $crap->cds->count == 0, "got Expected Number of Cds"); + ok( $girl->cds->count == 2, "got Expected Number of Cds"); + ok( $damn->cds->count == 3, "got Expected Number of Cds"); + ok( $formerly->cds->count == 1, "got Expected Number of Cds"); + + ## Did the cds get expected information? + + my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'}); + + ok($cd1, "Got a got CD"); + ok($cd2, "Got a got CD"); + ok( $cd1->title eq "VOID_My First CD", "Got Expected CD Title"); + ok( $cd2->title eq "VOID_Yet More Tweeny-Pop crap", "Got Expected CD Title"); + } WITH_COND_FROM_RS: { - + $restricted_art_rs->populate([ { name => 'VOID More Manufactured Crap', @@ -624,7 +624,7 @@ VOID_CONTEXT: { my $more_crap = $art_rs->search({ name => 'VOID More Manufactured Crap' })->first; - + ## Did it use the condition in the resultset? cmp_ok( $more_crap->rank, '==', 42, "Got Correct rank for result object"); } @@ -637,28 +637,28 @@ ARRAYREF_OF_ARRAYREF_STYLE: { [1001, 'A singer that jumped the shark two albums ago'], [1002, 'An actually cool singer.'], ]); - + ok my $unknown = $art_rs->find(1000), "got Unknown"; ok my $jumped = $art_rs->find(1001), "got Jumped"; ok my $cool = $art_rs->find(1002), "got Cool"; - + is $unknown->name, 'A Formally Unknown Singer', 'Correct Name'; is $jumped->name, 'A singer that jumped the shark two albums ago', 'Correct Name'; is $cool->name, 'An actually cool singer.', 'Correct Name'; - + my ($cooler, $lamer) = $restricted_art_rs->populate([ [qw/artistid name/], [1003, 'Cooler'], - [1004, 'Lamer'], + [1004, 'Lamer'], ]); - + is $cooler->name, 'Cooler', 'Correct Name'; is $lamer->name, 'Lamer', 'Correct Name'; cmp_ok $cooler->rank, '==', 42, 'Correct Rank'; ARRAY_CONTEXT_WITH_COND_FROM_RS: { - + my ($mega_lamer) = $restricted_art_rs->populate([ { name => 'Mega Lamer', @@ -670,7 +670,7 @@ ARRAYREF_OF_ARRAYREF_STYLE: { } VOID_CONTEXT_WITH_COND_FROM_RS: { - + $restricted_art_rs->populate([ { name => 'VOID Mega Lamer', @@ -680,10 +680,10 @@ ARRAYREF_OF_ARRAYREF_STYLE: { my $mega_lamer = $art_rs->search({ name => 'VOID Mega Lamer' })->first; - + ## Did it use the condition in the resultset? cmp_ok( $mega_lamer->rank, '==', 42, "Got Correct rank for result object"); - } + } } done_testing; diff --git a/t/73oracle.t b/t/73oracle.t index 04f1641..4b51e62 100644 --- a/t/73oracle.t +++ b/t/73oracle.t @@ -229,28 +229,29 @@ my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually"); SKIP: { - skip 'buggy BLOB support in DBD::Oracle 1.23', 8 - if $DBD::Oracle::VERSION == 1.23; + skip 'buggy BLOB support in DBD::Oracle 1.23', 8 + if $DBD::Oracle::VERSION == 1.23; - my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); - $binstr{'large'} = $binstr{'small'} x 1024; + my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); + $binstr{'large'} = $binstr{'small'} x 1024; - my $maxloblen = length $binstr{'large'}; - note "Localizing LongReadLen to $maxloblen to avoid truncation of test data"; - local $dbh->{'LongReadLen'} = $maxloblen; + my $maxloblen = length $binstr{'large'}; + note "Localizing LongReadLen to $maxloblen to avoid truncation of test data"; + local $dbh->{'LongReadLen'} = $maxloblen; - my $rs = $schema->resultset('BindType'); - my $id = 0; + my $rs = $schema->resultset('BindType'); + my $id = 0; - foreach my $type (qw( blob clob )) { - foreach my $size (qw( small large )) { - $id++; + foreach my $type (qw( blob clob )) { + foreach my $size (qw( small large )) { + $id++; - lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } - "inserted $size $type without dying"; - ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" ); - } - } + lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } + "inserted $size $type without dying"; + + ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" ); + } + } } done_testing; diff --git a/t/76select.t b/t/76select.t index 7560d2c..c8b6d38 100644 --- a/t/76select.t +++ b/t/76select.t @@ -33,8 +33,8 @@ lives_ok(sub { $rs->first->get_column('addedtitle') }, 'multiple +select/+as col $rs = $schema->resultset('CD')->search(undef, { '+select' => [ \'COUNT(*) AS year_count' ], - order_by => 'year_count' - } + order_by => 'year_count' + } ); my @counts = $rs->get_column('cdid')->all; ok(scalar(@counts), 'got rows from ->all using +select'); diff --git a/t/bind/bindtype_columns.t b/t/bind/bindtype_columns.t index 629185d..72b460c 100644 --- a/t/bind/bindtype_columns.t +++ b/t/bind/bindtype_columns.t @@ -9,7 +9,7 @@ my ($dsn, $dbuser, $dbpass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/} plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test' unless ($dsn && $dbuser); - + plan tests => 6; my $schema = DBICTest::Schema->connection($dsn, $dbuser, $dbpass, { AutoCommit => 1 }); @@ -32,7 +32,7 @@ my $dbh = $schema->storage->dbh; ],{ RaiseError => 1, PrintError => 1 }); } -my $big_long_string = "\x00\x01\x02 abcd" x 125000; +my $big_long_string = "\x00\x01\x02 abcd" x 125000; my $new; # test inserting a row @@ -40,7 +40,7 @@ my $new; $new = $schema->resultset('BindType')->create({ bytea => $big_long_string }); ok($new->id, "Created a bytea row"); - is($new->bytea, $big_long_string, "Set the blob correctly."); + is($new->bytea, $big_long_string, "Set the blob correctly."); } # test retrieval of the bytea column diff --git a/t/multi_create/standard.t b/t/multi_create/standard.t index 57993cf..703f1d6 100644 --- a/t/multi_create/standard.t +++ b/t/multi_create/standard.t @@ -329,60 +329,60 @@ lives_ok ( sub { }, 'Nested find_or_create'); lives_ok ( sub { - my $artist = $schema->resultset('Artist')->first; - - my $cd_result = $artist->create_related('cds', { - - title => 'TestOneCD1', - year => 2007, - tracks => [ - { title => 'TrackOne' }, - { title => 'TrackTwo' }, - ], - - }); - - isa_ok( $cd_result, 'DBICTest::CD', "Got Good CD Class"); - ok( $cd_result->title eq "TestOneCD1", "Got Expected Title"); - - my $tracks = $cd_result->tracks; - - isa_ok( $tracks, 'DBIx::Class::ResultSet', 'Got Expected Tracks ResultSet'); - - foreach my $track ($tracks->all) - { - isa_ok( $track, 'DBICTest::Track', 'Got Expected Track Class'); - } + my $artist = $schema->resultset('Artist')->first; + + my $cd_result = $artist->create_related('cds', { + + title => 'TestOneCD1', + year => 2007, + tracks => [ + { title => 'TrackOne' }, + { title => 'TrackTwo' }, + ], + + }); + + isa_ok( $cd_result, 'DBICTest::CD', "Got Good CD Class"); + ok( $cd_result->title eq "TestOneCD1", "Got Expected Title"); + + my $tracks = $cd_result->tracks; + + isa_ok( $tracks, 'DBIx::Class::ResultSet', 'Got Expected Tracks ResultSet'); + + foreach my $track ($tracks->all) + { + isa_ok( $track, 'DBICTest::Track', 'Got Expected Track Class'); + } }, 'First create_related pass'); lives_ok ( sub { - my $artist = $schema->resultset('Artist')->first; - - my $cd_result = $artist->create_related('cds', { - - title => 'TestOneCD2', - year => 2007, - tracks => [ - { title => 'TrackOne' }, - { title => 'TrackTwo' }, - ], + my $artist = $schema->resultset('Artist')->first; + + my $cd_result = $artist->create_related('cds', { + + title => 'TestOneCD2', + year => 2007, + tracks => [ + { title => 'TrackOne' }, + { title => 'TrackTwo' }, + ], liner_notes => { notes => 'I can haz liner notes?' }, - }); - - isa_ok( $cd_result, 'DBICTest::CD', "Got Good CD Class"); - ok( $cd_result->title eq "TestOneCD2", "Got Expected Title"); + }); + + isa_ok( $cd_result, 'DBICTest::CD', "Got Good CD Class"); + ok( $cd_result->title eq "TestOneCD2", "Got Expected Title"); ok( $cd_result->notes eq 'I can haz liner notes?', 'Liner notes'); - - my $tracks = $cd_result->tracks; - - isa_ok( $tracks, 'DBIx::Class::ResultSet', "Got Expected Tracks ResultSet"); - - foreach my $track ($tracks->all) - { - isa_ok( $track, 'DBICTest::Track', 'Got Expected Track Class'); - } + + my $tracks = $cd_result->tracks; + + isa_ok( $tracks, 'DBIx::Class::ResultSet', "Got Expected Tracks ResultSet"); + + foreach my $track ($tracks->all) + { + isa_ok( $track, 'DBICTest::Track', 'Got Expected Track Class'); + } }, 'second create_related with same arguments'); lives_ok ( sub { @@ -409,7 +409,7 @@ lives_ok ( sub { is($a->name, 'Kurt Cobain', 'Artist insertion ok'); is($a->cds && $a->cds->first && $a->cds->first->title, - 'In Utero', 'CD insertion ok'); + 'In Utero', 'CD insertion ok'); }, 'populate'); ## Create foreign key col obj including PK @@ -431,7 +431,7 @@ lives_ok ( sub { }, 'Create foreign key col obj including PK'); lives_ok ( sub { - $schema->resultset("CD")->create({ + $schema->resultset("CD")->create({ cdid => 28, title => 'Boogie Wiggle', year => '2007',