[Bast-commits] r8385 - in DBIx-Class/0.08/trunk: maint t t/bind
t/multi_create
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Tue Jan 19 17:19:41 GMT 2010
Author: ribasushi
Date: 2010-01-19 17:19:40 +0000 (Tue, 19 Jan 2010)
New Revision: 8385
Modified:
DBIx-Class/0.08/trunk/maint/svn-log.perl
DBIx-Class/0.08/trunk/t/06notabs.t
DBIx-Class/0.08/trunk/t/101populate_rs.t
DBIx-Class/0.08/trunk/t/73oracle.t
DBIx-Class/0.08/trunk/t/76select.t
DBIx-Class/0.08/trunk/t/bind/bindtype_columns.t
DBIx-Class/0.08/trunk/t/multi_create/standard.t
Log:
First round of detabification
Modified: DBIx-Class/0.08/trunk/maint/svn-log.perl
===================================================================
--- DBIx-Class/0.08/trunk/maint/svn-log.perl 2010-01-19 17:00:12 UTC (rev 8384)
+++ DBIx-Class/0.08/trunk/maint/svn-log.perl 2010-01-19 17:19:40 UTC (rev 8385)
@@ -17,8 +17,8 @@
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 @@
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 @@
open(TAG, "svn -v list $svn_repo/tags|") or die $!;
while (<TAG>) {
- # 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
- );
+ # 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 @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
- ];
+ 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 @@
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};
+ my $tag_rec = $tag{$timestamp};
- # Skip this tag if there are no log entries.
- next unless @{$tag_rec->[TAG_LOG]};
+ # 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";
+ 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]}) {
+ 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 @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
- )
- );
+ 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
- )
- );
- }
+ 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";
+ print $time_line, "\n\n";
- # Blank lines should have the indent level of whitespace. This
- # makes it easier for other utilities to parse them.
+ # 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) {
+ 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;
- }
+ # 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);
- }
- }
+ # 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 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 ($url, @flags) = @_;
- my (@log, @stack);
+ 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};
+ 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;
+ 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 "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 "logentry") {
+ $log[-1][LOG_REV] = $att->{revision};
+ return;
+ }
- if ($tag eq "msg") {
- $log[-1][LOG_MESSAGE] = $att->{0};
- 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 "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
- ]
- );
+ 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_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;
- }
+ $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";
+ my $cmd = "svn -v --xml @flags log $url";
+ #warn "Command: $cmd\n";
- open(LOG, "$cmd|") or die $!;
- $parser->parse(*LOG);
- close LOG;
+ open(LOG, "$cmd|") or die $!;
+ $parser->parse(*LOG);
+ close LOG;
- return @log;
+ return @log;
}
Modified: DBIx-Class/0.08/trunk/t/06notabs.t
===================================================================
--- DBIx-Class/0.08/trunk/t/06notabs.t 2010-01-19 17:00:12 UTC (rev 8384)
+++ DBIx-Class/0.08/trunk/t/06notabs.t 2010-01-19 17:19:40 UTC (rev 8385)
@@ -23,6 +23,6 @@
}
}
-all_perl_files_ok();
+all_perl_files_ok(qw/t lib script maint/);
done_testing;
Modified: DBIx-Class/0.08/trunk/t/101populate_rs.t
===================================================================
--- DBIx-Class/0.08/trunk/t/101populate_rs.t 2010-01-19 17:00:12 UTC (rev 8384)
+++ DBIx-Class/0.08/trunk/t/101populate_rs.t 2010-01-19 17:19:40 UTC (rev 8385)
@@ -20,11 +20,11 @@
## 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 @@
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';
+ ## 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.
- ok $cd1->year == 2005;
- ok $cd1->title eq '003Title1';
- }
+ $schema->populate('Artist', [
- ARTIST4CDS: {
-
- my ($cd1) = $undef->cds->search(undef, {order_by=>'year ASC'});
-
- isa_ok $cd1, 'DBICTest::CD';
+ [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}
+ ]],
+ ]);
- ok $cd1->year == 2010;
- ok $cd1->title eq '004Title1';
- }
-
- ## Need to do some cleanup so that later tests don't get borked
-
- $undef->delete;
+ 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 @@
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
+ ## These first set of tests are cake because array context just delegates
+ ## all it's processing to $resultset->create
- 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?
+ HAS_MANY_NO_PKS: {
- 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");
+ ## 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
- ## 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?
+ 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 },
+ ],
+ },
+ ];
- 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");
+ ## Get the result row objects.
- ## 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: {
+ my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists);
- ## 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);
-
+ ## Do we have the right object?
- 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( $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($cdB, 'DBICTest::CD', 'Created CD');
- isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
- is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD');
- }
+ ## Find the expected information?
- BELONGS_TO_WITH_PKs: {
+ 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");
- ## 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;
+ ## Create the expected children sub objects?
- 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");
- }
+ 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 @@
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
+ ## 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.
- 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?
+ HAS_MANY_WITH_PKS: {
- 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: {
+ ## 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
- ## 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 $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");
- }
+ my $first_aid = ++$aid;
- BELONGS_TO_NO_PKs: {
+ 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 },
+ ],
+ },
+ ];
- ## 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
+ ## Get the result row objects.
- 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?
+ $art_rs->populate($artists);
- 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");
+ my ($undef, $girl, $formerly, $damn, $crap) = $art_rs->search(
- ## Did the cds get expected information?
-
- my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
+ {name=>[ map { $_->{name} } @$artists]},
+ {order_by=>'name 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");
- }
+ ## 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 @@
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 @@
[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 @@
}
VOID_CONTEXT_WITH_COND_FROM_RS: {
-
+
$restricted_art_rs->populate([
{
name => 'VOID Mega Lamer',
@@ -680,10 +680,10 @@
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;
Modified: DBIx-Class/0.08/trunk/t/73oracle.t
===================================================================
--- DBIx-Class/0.08/trunk/t/73oracle.t 2010-01-19 17:00:12 UTC (rev 8384)
+++ DBIx-Class/0.08/trunk/t/73oracle.t 2010-01-19 17:19:40 UTC (rev 8385)
@@ -229,28 +229,29 @@
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;
Modified: DBIx-Class/0.08/trunk/t/76select.t
===================================================================
--- DBIx-Class/0.08/trunk/t/76select.t 2010-01-19 17:00:12 UTC (rev 8384)
+++ DBIx-Class/0.08/trunk/t/76select.t 2010-01-19 17:19:40 UTC (rev 8385)
@@ -33,8 +33,8 @@
$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');
Modified: DBIx-Class/0.08/trunk/t/bind/bindtype_columns.t
===================================================================
--- DBIx-Class/0.08/trunk/t/bind/bindtype_columns.t 2010-01-19 17:00:12 UTC (rev 8384)
+++ DBIx-Class/0.08/trunk/t/bind/bindtype_columns.t 2010-01-19 17:19:40 UTC (rev 8385)
@@ -9,7 +9,7 @@
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 @@
],{ 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 @@
$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
Modified: DBIx-Class/0.08/trunk/t/multi_create/standard.t
===================================================================
--- DBIx-Class/0.08/trunk/t/multi_create/standard.t 2010-01-19 17:00:12 UTC (rev 8384)
+++ DBIx-Class/0.08/trunk/t/multi_create/standard.t 2010-01-19 17:19:40 UTC (rev 8385)
@@ -329,60 +329,60 @@
}, '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' },
- ],
+ 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');
- }
+ });
+
+ 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 @@
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 @@
}, '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',
More information about the Bast-commits
mailing list