From: Matt S Trout Date: Thu, 28 Dec 2006 19:24:41 +0000 (+0000) Subject: Merge 'source-handle' into 'DBIx-Class-current' X-Git-Tag: v0.08010~150^2~112 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f90375dd325063c09f0c07c80239d3b8e9f756f1;hp=a6a280b9dc01e12bb880546928e2dd0365223343;p=dbsrgits%2FDBIx-Class.git Merge 'source-handle' into 'DBIx-Class-current' --- diff --git a/Changes b/Changes index 2ad05fb..31cb403 100644 --- a/Changes +++ b/Changes @@ -26,6 +26,9 @@ Revision history for DBIx::Class These accessors no longer automatically require the classes when set. +0.07004 + - fix find_related-based queries to correctly grep the unique key + 0.07003 2006-11-16 11:52:00 - fix for rt.cpan.org #22740 (use $^X instead of hardcoded "perl") - Tweaks to resultset to allow inflate_result to return an array diff --git a/lib/DBIx/Class/InflateColumn.pm b/lib/DBIx/Class/InflateColumn.pm index 6b06cb0..b88ec0c 100644 --- a/lib/DBIx/Class/InflateColumn.pm +++ b/lib/DBIx/Class/InflateColumn.pm @@ -85,7 +85,7 @@ sub _inflated_column { sub _deflated_column { my ($self, $col, $value) = @_; - return $value unless ref $value; # If it's not an object, don't touch it + return $value unless ref $value && blessed($value); # If it's not an object, don't touch it my $info = $self->column_info($col) or $self->throw_exception("No column info for $col"); return $value unless exists $info->{_inflate_info}; @@ -155,93 +155,6 @@ sub store_inflated_column { return $self->{_inflated_column}{$col} = $obj; } -=head2 get_column - -Gets a column value in the same way as L. If there -is an inflated value stored that has not yet been deflated, it is deflated -when the method is invoked. - -=cut - -sub get_column { - my ($self, $col) = @_; - if (exists $self->{_inflated_column}{$col} - && !exists $self->{_column_data}{$col}) { - $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col})); - } - return $self->next::method($col); -} - -=head2 get_columns - -Returns the get_column info for all columns as a hash, -just like L. Handles inflation just -like L. - -=cut - -sub get_columns { - my $self = shift; - if (exists $self->{_inflated_column}) { - foreach my $col (keys %{$self->{_inflated_column}}) { - $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col})) - unless exists $self->{_column_data}{$col}; - } - } - return $self->next::method; -} - -=head2 has_column_loaded - -Like L, but also returns true if there -is an inflated value stored. - -=cut - -sub has_column_loaded { - my ($self, $col) = @_; - return 1 if exists $self->{_inflated_column}{$col}; - return $self->next::method($col); -} - -=head2 update - -Updates a row in the same way as L, handling -inflation and deflation of columns appropriately. - -=cut - -sub update { - my ($class, $attrs, @rest) = @_; - foreach my $key (keys %{$attrs||{}}) { - if (ref $attrs->{$key} && $class->has_column($key) - && exists $class->column_info($key)->{_inflate_info}) { - $class->set_inflated_column($key, delete $attrs->{$key}); - } - } - return $class->next::method($attrs, @rest); -} - -=head2 new - -Creates a row in the same way as L, handling -inflation and deflation of columns appropriately. - -=cut - -sub new { - my ($class, $attrs, @rest) = @_; - my $inflated; - foreach my $key (keys %{$attrs||{}}) { - $inflated->{$key} = delete $attrs->{$key} - if ref $attrs->{$key} && $class->has_column($key) - && exists $class->column_info($key)->{_inflate_info}; - } - my $obj = $class->next::method($attrs, @rest); - $obj->{_inflated_column} = $inflated if $inflated; - return $obj; -} - =head1 SEE ALSO =over 4 diff --git a/lib/DBIx/Class/Relationship/Accessor.pm b/lib/DBIx/Class/Relationship/Accessor.pm index b77ce00..b20eb16 100644 --- a/lib/DBIx/Class/Relationship/Accessor.pm +++ b/lib/DBIx/Class/Relationship/Accessor.pm @@ -62,39 +62,4 @@ sub add_relationship_accessor { } } -sub new { - my ($class, $attrs, @rest) = @_; - my ($related, $info); - foreach my $key (keys %{$attrs||{}}) { - next unless $info = $class->relationship_info($key); - $related->{$key} = delete $attrs->{$key} - if ref $attrs->{$key} - && $info->{attrs}{accessor} - && $info->{attrs}{accessor} eq 'single'; - } - my $obj = $class->next::method($attrs, @rest); - if ($related) { - $obj->{_relationship_data} = $related; - foreach my $rel (keys %$related) { - $obj->set_from_related($rel, $related->{$rel}); - } - } - return $obj; -} - -sub update { - my ($obj, $attrs, @rest) = @_; - my $info; - foreach my $key (keys %{$attrs||{}}) { - next unless $info = $obj->relationship_info($key); - if (ref $attrs->{$key} && $info->{attrs}{accessor} - && $info->{attrs}{accessor} eq 'single') { - my $rel = delete $attrs->{$key}; - $obj->set_from_related($key => $rel); - $obj->{_relationship_data}{$key} = $rel; - } - } - return $obj->next::method($attrs, @rest); -} - 1; diff --git a/lib/DBIx/Class/Relationship/HasMany.pm b/lib/DBIx/Class/Relationship/HasMany.pm index 2c9a3bb..6bdefd4 100644 --- a/lib/DBIx/Class/Relationship/HasMany.pm +++ b/lib/DBIx/Class/Relationship/HasMany.pm @@ -16,6 +16,11 @@ sub has_many { "${class} has more" ) if $too_many; + $class->throw_exception( + "has_many needs a primary key to infer a join; ". + "${class} has none" + ) if !defined $pri && (!defined $cond || !length $cond); + my ($f_key,$guess); if (defined $cond && length $cond) { $f_key = $cond; diff --git a/lib/DBIx/Class/Relationship/HasOne.pm b/lib/DBIx/Class/Relationship/HasOne.pm index 568078c..543649b 100644 --- a/lib/DBIx/Class/Relationship/HasOne.pm +++ b/lib/DBIx/Class/Relationship/HasOne.pm @@ -17,10 +17,17 @@ sub _has_one { unless (ref $cond) { $class->ensure_class_loaded($f_class); my ($pri, $too_many) = $class->primary_columns; + $class->throw_exception( "might_have/has_one can only infer join for a single primary key; ". "${class} has more" ) if $too_many; + + $class->throw_exception( + "might_have/has_one needs a primary key to infer a join; ". + "${class} has none" + ) if !defined $pri && (!defined $cond || !length $cond); + my $f_class_loaded = eval { $f_class->columns }; my ($f_key,$guess); if (defined $cond && length $cond) { diff --git a/lib/DBIx/Class/Relationship/ManyToMany.pm b/lib/DBIx/Class/Relationship/ManyToMany.pm index e294a8c..d8d50de 100644 --- a/lib/DBIx/Class/Relationship/ManyToMany.pm +++ b/lib/DBIx/Class/Relationship/ManyToMany.pm @@ -6,6 +6,15 @@ use warnings; sub many_to_many { my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_; + + $class->throw_exception( + "missing relation in many-to-many" + ) unless $rel; + + $class->throw_exception( + "missing foreign relation in many-to-many" + ) unless $f_rel; + { no strict 'refs'; no warnings 'redefine'; diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 718cb1a..e715725 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -410,21 +410,23 @@ sub _unique_queries { ? ($attrs->{key}) : $self->result_source->unique_constraint_names; + my $where = $self->_collapse_cond($self->{attrs}{where} || {}); + my $num_where = scalar keys %$where; + my @unique_queries; foreach my $name (@constraint_names) { my @unique_cols = $self->result_source->unique_constraint_columns($name); my $unique_query = $self->_build_unique_query($query, \@unique_cols); + my $num_cols = scalar @unique_cols; my $num_query = scalar keys %$unique_query; - next unless $num_query; - # XXX: Assuming quite a bit about $self->{attrs}{where} - my $num_cols = scalar @unique_cols; - my $num_where = exists $self->{attrs}{where} - ? scalar keys %{ $self->{attrs}{where} } - : 0; - push @unique_queries, $unique_query - if $num_query + $num_where == $num_cols; + my $total = $num_query + $num_where; + if ($num_query && ($num_query == $num_cols || $total == $num_cols)) { + # The query is either unique on its own or is unique in combination with + # the existing where clause + push @unique_queries, $unique_query; + } } return @unique_queries; diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index 0e77941..8360f37 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -41,12 +41,35 @@ sub new { if ($attrs) { $new->throw_exception("attrs must be a hashref") unless ref($attrs) eq 'HASH'; - - foreach my $k (keys %$attrs) { - $new->throw_exception("No such column $k on $class") - unless $class->has_column($k); - $new->store_column($k => $attrs->{$k}); + + my ($related,$inflated); + foreach my $key (keys %$attrs) { + if (ref $attrs->{$key}) { + my $info = $class->relationship_info($key); + if ($info && $info->{attrs}{accessor} + && $info->{attrs}{accessor} eq 'single') + { + $new->set_from_related($key, $attrs->{$key}); + $related->{$key} = $attrs->{$key}; + next; + } + elsif ($class->has_column($key) + && exists $class->column_info($key)->{_inflate_info}) + { + $inflated->{$key} = $attrs->{$key}; + next; + } + } + $new->throw_exception("No such column $key on $class") + unless $class->has_column($key); + $new->store_column($key => $attrs->{$key}); } + if (my $source = delete $attrs->{-result_source}) { + $new->result_source($source); + } + + $new->{_relationship_data} = $related if $related; + $new->{_inflated_column} = $inflated if $inflated; } return $new; @@ -77,6 +100,7 @@ sub insert { $self->in_storage(1); $self->{_dirty_columns} = {}; $self->{related_resultsets} = {}; + undef $self->{_orig_ident}; return $self; } @@ -111,11 +135,30 @@ sub update { my $ident_cond = $self->ident_condition; $self->throw_exception("Cannot safely update a row in a PK-less table") if ! keys %$ident_cond; - $self->set_columns($upd) if $upd; + if ($upd) { + foreach my $key (keys %$upd) { + if (ref $upd->{$key}) { + my $info = $self->relationship_info($key); + if ($info && $info->{attrs}{accessor} + && $info->{attrs}{accessor} eq 'single') + { + my $rel = delete $upd->{$key}; + $self->set_from_related($key => $rel); + $self->{_relationship_data}{$key} = $rel; + } + elsif ($self->has_column($key) + && exists $self->column_info($key)->{_inflate_info}) + { + $self->set_inflated_column($key, delete $upd->{$key}); + } + } + } + $self->set_columns($upd); + } my %to_update = $self->get_dirty_columns; return $self unless keys %to_update; my $rows = $self->result_source->storage->update( - $self->result_source->from, \%to_update, $ident_cond); + $self->result_source->from, \%to_update, $self->{_orig_ident} || $ident_cond); if ($rows == 0) { $self->throw_exception( "Can't update ${self}: row not found" ); } elsif ($rows > 1) { @@ -123,6 +166,7 @@ sub update { } $self->{_dirty_columns} = {}; $self->{related_resultsets} = {}; + undef $self->{_orig_ident}; return $self; } @@ -131,8 +175,8 @@ sub update { $obj->delete Deletes the object from the database. The object is still perfectly -usable, but C<-Ein_storage()> will now return 0 and the object must -reinserted using C<-Einsert()> before C<-E(update()> can be used +usable, but C<< ->in_storage() >> will now return 0 and the object must +reinserted using C<< ->insert() >> before C<< ->update() >> can be used on it. If you delete an object in a class with a C relationship, all the related objects will be deleted as well. To turn this behavior off, pass C 0> in the C<$attr> @@ -169,9 +213,10 @@ sub delete { my $val = $obj->get_column($col); -Gets a column value from a row object. Currently, does not do -any queries; the column must have already been fetched from -the database and stored in the object. +Gets a column value from a row object. Does not do any queries; the column +must have already been fetched from the database and stored in the object. If +there is an inflated value stored that has not yet been deflated, it is deflated +when the method is invoked. =cut @@ -179,6 +224,10 @@ sub get_column { my ($self, $column) = @_; $self->throw_exception( "Can't fetch data as class method" ) unless ref $self; return $self->{_column_data}{$column} if exists $self->{_column_data}{$column}; + if (exists $self->{_inflated_column}{$column}) { + return $self->store_column($column, + $self->_deflated_column($column, $self->{_inflated_column}{$column})); + } $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column); return undef; } @@ -197,6 +246,7 @@ database (or set locally). sub has_column_loaded { my ($self, $column) = @_; $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self; + return 1 if exists $self->{_inflated_column}{$column}; return exists $self->{_column_data}{$column}; } @@ -210,6 +260,12 @@ Does C, for all column values at once. sub get_columns { my $self = shift; + if (exists $self->{_inflated_column}) { + foreach my $col (keys %{$self->{_inflated_column}}) { + $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col})) + unless exists $self->{_column_data}{$col}; + } + } return %{$self->{_column_data}}; } @@ -239,6 +295,7 @@ the column is marked as dirty for when you next call $obj->update. sub set_column { my $self = shift; my ($column) = @_; + $self->{_orig_ident} ||= $self->ident_condition; my $old = $self->get_column($column); my $ret = $self->store_column(@_); $self->{_dirty_columns}{$column} = 1 diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index 2c68cf1..3981b51 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -917,12 +917,17 @@ sub throw_exception { Attempts to deploy the schema to the current storage using L. Note that this feature is currently EXPERIMENTAL and may not work correctly -across all databases, or fully handle complex relationships. +across all databases, or fully handle complex relationships. Saying that, it +has been used successfully by many people, including the core dev team. See L for a list of values for C<$sqlt_args>. The most common value for this would be C<< { add_drop_table => 1, } >> to have the SQL produced include a DROP TABLE statement for each table created. +Additionally, the DBIx::Class parser accepts a C parameter as a hash +ref or an array ref, containing a list of source to deploy. If present, then +only the sources listed will get deployed. + =cut sub deploy { diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 99896da..37257c4 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -237,9 +237,18 @@ sub _join_condition { if (ref $cond eq 'HASH') { my %j; for (keys %$cond) { - my $x = '= '.$self->_quote($cond->{$_}); $j{$_} = \$x; + my $v = $cond->{$_}; + if (ref $v) { + # XXX no throw_exception() in this package and croak() fails with strange results + Carp::croak(ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'}) + if ref($v) ne 'SCALAR'; + $j{$_} = $v; + } + else { + my $x = '= '.$self->_quote($v); $j{$_} = \$x; + } }; - return $self->_recurse_where(\%j); + return scalar($self->_recurse_where(\%j)); } elsif (ref $cond eq 'ARRAY') { return join(' OR ', map { $self->_join_condition($_) } @$cond); } else { @@ -1266,6 +1275,12 @@ sub deployment_statements { $self->throw_exception($@) if $@; eval "use SQL::Translator::Producer::${type};"; $self->throw_exception($@) if $@; + + # sources needs to be a parser arg, but for simplicty allow at top level + # coming in + $sqltargs->{parser_args}{sources} = delete $sqltargs->{sources} + if exists $sqltargs->{sources}; + my $tr = SQL::Translator->new(%$sqltargs); SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema ); return "SQL::Translator::Producer::${type}"->can('produce')->($tr); diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm index 0c98f91..bec2a8f 100644 --- a/lib/DBIx/Class/Storage/DBI/Pg.pm +++ b/lib/DBIx/Class/Storage/DBI/Pg.pm @@ -21,6 +21,9 @@ sub _dbh_last_insert_id { sub last_insert_id { my ($self,$source,$col) = @_; my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col)); + $self->throw_exception("could not fetch primary key for " . $source->name . ", could not " + . "get autoinc sequence for $col (check that table and column specifications are correct " + . "and in the correct case)") unless defined $seq; $self->dbh_do($self->can('_dbh_last_insert_id'), $seq); } diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm index d8af4d6..edf6224 100644 --- a/lib/SQL/Translator/Parser/DBIx/Class.pm +++ b/lib/SQL/Translator/Parser/DBIx/Class.pm @@ -26,10 +26,11 @@ use base qw(Exporter); # We're working with DBIx::Class Schemas, not data streams. # ------------------------------------------------------------------- sub parse { - my ($tr, $data) = @_; - my $args = $tr->parser_args; - my $dbixschema = $args->{'DBIx::Schema'} || $data; - $dbixschema ||= $args->{'package'}; + my ($tr, $data) = @_; + my $args = $tr->parser_args; + my $dbixschema = $args->{'DBIx::Schema'} || $data; + $dbixschema ||= $args->{'package'}; + my $limit_sources = $args->{'sources'}; die 'No DBIx::Schema' unless ($dbixschema); if (!ref $dbixschema) { @@ -46,7 +47,23 @@ sub parse { my %seen_tables; - foreach my $moniker ($dbixschema->sources) + my @monikers = $dbixschema->sources; + if ($limit_sources) { + my $ref = ref $limit_sources || ''; + die "'sources' parameter must be an array or hash ref" unless $ref eq 'ARRAY' || ref eq 'HASH'; + + # limit monikers to those specified in + my $sources; + if ($ref eq 'ARRAY') { + $sources->{$_} = 1 for (@$limit_sources); + } else { + $sources = $limit_sources; + } + @monikers = grep { $sources->{$_} } @monikers; + } + + + foreach my $moniker (@monikers) { #eval "use $tableclass"; #print("Can't load $tableclass"), next if($@); @@ -91,6 +108,9 @@ sub parse { } my @rels = $source->relationships(); + + my %created_FK_rels; + foreach my $rel (@rels) { my $rel_info = $source->relationship_info($rel); @@ -120,12 +140,22 @@ sub parse { $on_update = $otherrelationship->{'attrs'}->{cascade_copy} ? 'CASCADE' : ''; } + # Make sure we dont create the same foreign key constraint twice + my $key_test = join("\x00", @keys); + #Decide if this is a foreign key based on whether the self #items are our primary columns. # If the sets are different, then we assume it's a foreign key from # us to another table. - if (!$source->compare_relationship_keys(\@keys, \@primary)) { + # OR: If is_foreign_key attr is explicity set on one the local columns + if ( ! exists $created_FK_rels{$rel_table}->{$key_test} + && + ( !$source->compare_relationship_keys(\@keys, \@primary) || + grep { $source->column_info($_)->{is_foreign_key} } @keys + ) + ) { + $created_FK_rels{$rel_table}->{$key_test} = 1; $table->add_constraint( type => 'foreign_key', name => "fk_$keys[0]", diff --git a/t/69update.t b/t/69update.t index b11ebde..4686876 100644 --- a/t/69update.t +++ b/t/69update.t @@ -9,7 +9,7 @@ my $schema = DBICTest->init_schema(); BEGIN { eval "use DBD::SQLite"; - plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 5); + plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 6); } my $art = $schema->resultset("Artist")->find(1); @@ -30,3 +30,7 @@ $art->discard_changes; ok($art->update({ artistid => 100 }), 'update allows pk mutation'); is($art->artistid, 100, 'pk mutation applied'); + +my $art_100 = $schema->resultset("Artist")->find(100); +$art_100->artistid(101); +ok($art_100->update(), 'update allows pk mutation via column accessor'); diff --git a/t/76joins.t b/t/76joins.t index 9401502..96836fb 100644 --- a/t/76joins.t +++ b/t/76joins.t @@ -16,7 +16,7 @@ BEGIN { eval "use DBD::SQLite"; plan $@ ? ( skip_all => 'needs DBD::SQLite for testing' ) - : ( tests => 50 ); + : ( tests => 53 ); } # figure out if we've got a version of sqlite that is older than 3.2.6, in @@ -89,6 +89,26 @@ $match = 'person mother LEFT JOIN (person child RIGHT JOIN person father ON (' ; is( $sa->_recurse_from(@j4), $match, 'join 4 (nested joins + join types) ok'); +my @j5 = ( + { child => 'person' }, + [ { father => 'person' }, { 'father.person_id' => \'!= child.father_id' }, ], + [ { mother => 'person' }, { 'mother.person_id' => 'child.mother_id' } ], +); +$match = 'person child JOIN person father ON ( father.person_id != ' + . 'child.father_id ) JOIN person mother ON ( mother.person_id ' + . '= child.mother_id )' + ; +is( $sa->_recurse_from(@j5), $match, 'join 5 (SCALAR reference for ON statement) ok' ); + +my @j6 = ( + { child => 'person' }, + [ { father => 'person' }, { 'father.person_id' => { '!=', '42' } }, ], + [ { mother => 'person' }, { 'mother.person_id' => 'child.mother_id' } ], +); +$match = qr/^\QHASH reference arguments are not supported in JOINS - try using \"..." instead\E/; +eval { $sa->_recurse_from(@j6) }; +like( $@, $match, 'join 6 (HASH reference for ON statement dies) ok' ); + my $rs = $schema->resultset("CD")->search( { 'year' => 2001, 'artist.name' => 'Caterwauler McCrae' }, { from => [ { 'me' => 'cd' }, @@ -344,6 +364,12 @@ like( $sql, qr/^SELECT tracks_2\.trackid/, "join not collapsed for search_relate $schema->storage->debug($orig_debug); $schema->storage->debugobj->callback(undef); +$rs = $schema->resultset('Artist'); +$rs->create({ artistid => 4, name => 'Unknown singer-songwriter' }); +$rs->create({ artistid => 5, name => 'Emo 4ever' }); +@artists = $rs->search(undef, { prefetch => 'cds', order_by => 'artistid' }); +is(scalar @artists, 5, 'has_many prefetch with adjacent empty rows ok'); + # ------------- # # Tests for multilevel has_many prefetch diff --git a/t/80unique.t b/t/80unique.t index eebb66e..6108f28 100644 --- a/t/80unique.t +++ b/t/80unique.t @@ -7,7 +7,7 @@ use DBICTest; my $schema = DBICTest->init_schema(); -plan tests => 43; +plan tests => 45; # Check the defined unique constraints is_deeply( @@ -126,8 +126,9 @@ is($cd8->get_column('artist'), $cd1->get_column('artist'), 'artist is correct'); is($cd8->title, $cd1->title, 'title is correct'); is($cd8->year, $cd1->year, 'year is correct'); -my $cd9 = $artist->update_or_create_related('cds', +my $cd9 = $artist->cds->update_or_create( { + cdid => $cd1->cdid, title => $title, year => 2021, }, @@ -161,7 +162,24 @@ my $row = $schema->resultset('NoPrimaryKey')->update_or_create( }, { key => 'foo_bar' } ); + ok(! $row->is_changed, 'update_or_create on table without primary key: row is clean'); is($row->foo, 1, 'foo is correct'); is($row->bar, 2, 'bar is correct'); is($row->baz, 3, 'baz is correct'); + +# Test a unique condition with extra information in the where attr +{ + my $artist = $schema->resultset('Artist')->find({ artistid => 1 }); + my $cd = $artist->cds->find_or_new( + { + cdid => 1, + title => 'Not The Real Title', + year => 3000, + }, + { key => 'primary' } + ); + + ok($cd->in_storage, 'find correctly grepped the key across a relationship'); + is($cd->cdid, 1, 'cdid is correct'); +} diff --git a/t/86sqlt.t b/t/86sqlt.t index 92d90f2..095a878 100644 --- a/t/86sqlt.t +++ b/t/86sqlt.t @@ -10,7 +10,7 @@ plan skip_all => 'SQL::Translator required' if $@; my $schema = DBICTest->init_schema; -plan tests => 53; +plan tests => 54; my $translator = SQL::Translator->new( parser_args => { @@ -24,6 +24,10 @@ $translator->producer('SQLite'); my $output = $translator->translate(); + +ok($output, "SQLT produced someoutput") + or diag($translator->error); + # Note that the constraints listed here are the only ones that are tested -- if # more exist in the Schema than are listed here and all listed constraints are # correct, the test will still pass. If you add a class with UNIQUE or FOREIGN diff --git a/t/94pk_mutation.t b/t/94pk_mutation.t index 4623332..133a27b 100644 --- a/t/94pk_mutation.t +++ b/t/94pk_mutation.t @@ -7,7 +7,7 @@ use DBICTest; my $schema = DBICTest->init_schema(); -plan tests => 5; +plan tests => 10; my $old_artistid = 1; my $new_artistid = $schema->resultset("Artist")->get_column('artistid')->max + 1; @@ -33,3 +33,30 @@ my $new_artistid = $schema->resultset("Artist")->get_column('artistid')->max + 1 ok(defined $artist, 'found an artist with the new PK'); is($artist->artistid, $new_artistid, 'artist ID matches'); } + +# Do it all over again, using a different methodology: +$old_artistid = $new_artistid; +$new_artistid++; + +# Update the PK +{ + my $artist = $schema->resultset("Artist")->find($old_artistid); + ok(defined $artist, 'found an artist with the new PK'); + + $artist->artistid($new_artistid); + $artist->update; + is($artist->artistid, $new_artistid, 'artist ID matches'); +} + +# Look for the old PK +{ + my $artist = $schema->resultset("Artist")->find($old_artistid); + ok(!defined $artist, 'no artist found with the old PK'); +} + +# Look for the new PK +{ + my $artist = $schema->resultset("Artist")->find($new_artistid); + ok(defined $artist, 'found an artist with the new PK'); + is($artist->artistid, $new_artistid, 'artist ID matches'); +} diff --git a/t/lib/DBICTest/Schema/FourKeys.pm b/t/lib/DBICTest/Schema/FourKeys.pm index 6038c94..a1e23db 100644 --- a/t/lib/DBICTest/Schema/FourKeys.pm +++ b/t/lib/DBICTest/Schema/FourKeys.pm @@ -14,7 +14,7 @@ __PACKAGE__->add_columns( __PACKAGE__->set_primary_key(qw/foo bar hello goodbye/); __PACKAGE__->has_many( - 'fourkeys_to_twokeys', '__PACKAGE___to_TwoKeys', { + 'fourkeys_to_twokeys', 'DBICTest::Schema::FourKeys_to_TwoKeys', { 'foreign.f_foo' => 'self.foo', 'foreign.f_bar' => 'self.bar', 'foreign.f_hello' => 'self.hello',