Merge 'trunk' into 'on_connect_call'
Rafael Kitover [Sat, 27 Jun 2009 22:20:25 +0000 (22:20 +0000)]
r5665@hlagh (orig r6780):  ribasushi | 2009-06-24 02:08:02 -0700
Properly name the relinfo variable
r5666@hlagh (orig r6781):  ribasushi | 2009-06-24 03:12:49 -0700
find_related fix for single-type relationships
r5667@hlagh (orig r6782):  nigel | 2009-06-24 08:28:33 -0700
 r11786@hex:  nigel | 2009-06-24 16:27:58 +0100
 Fixed set_$rel with where restriction deleting rows outside the restriction

r5668@hlagh (orig r6783):  nigel | 2009-06-24 08:47:31 -0700
 r11788@hex:  nigel | 2009-06-24 16:47:04 +0100
 Rework of set_$rel patch with less obfuscation

r5691@hlagh (orig r6788):  ribasushi | 2009-06-25 00:19:10 -0700
Commit test inspired by joel - it seemingly fails on Mac?
r5692@hlagh (orig r6789):  ribasushi | 2009-06-25 02:04:26 -0700
Minor cleanups
r5721@hlagh (orig r6792):  teejay | 2009-06-26 05:43:05 -0700
normalised artist_id, and plural relationships to plural names making use of alias/relname less ambiguous than relname/tablename being the same, also added a little more info on joining/relationships
r5722@hlagh (orig r6793):  tomboh | 2009-06-26 06:25:19 -0700
Documentation fix:
- timezone is no longer an extra setting
- fix a typo of 'subsequently'

r5723@hlagh (orig r6794):  gphat | 2009-06-26 07:33:35 -0700
Fix typo in ResultSet docs

r5724@hlagh (orig r6802):  ribasushi | 2009-06-27 03:39:03 -0700
Todoified (unsolvable) test from RT#42466
r5725@hlagh (orig r6803):  ribasushi | 2009-06-27 03:52:26 -0700
POD patch from RT#46808
r5726@hlagh (orig r6804):  ribasushi | 2009-06-27 04:59:03 -0700
Adjust sqlt schema parser to add tables in FK dependency order
r5727@hlagh (orig r6805):  ribasushi | 2009-06-27 05:08:35 -0700
Bump author SQLT dependency for early developer testing
Regenerate SQLite schema with new parser/sqlt
Use throw_exception in lieu of plain die when possible

20 files changed:
Changes
Makefile.PL
lib/DBIx/Class/InflateColumn/DateTime.pm
lib/DBIx/Class/Manual/Cookbook.pod
lib/DBIx/Class/Relationship/Base.pm
lib/DBIx/Class/Relationship/ManyToMany.pm
lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/ResultSource.pm
lib/DBIx/Class/Schema.pm
lib/SQL/Translator/Parser/DBIx/Class.pm
t/46where_attribute.t
t/85utf8.t
t/86sqlt.t
t/lib/DBICTest/Schema/ArtistUndirectedMap.pm
t/lib/DBICTest/Schema/Genre.pm
t/lib/DBICTest/Schema/Track.pm
t/lib/sqlite.sql
t/relationship/update_or_create_multi.t [new file with mode: 0644]
t/relationship/update_or_create_single.t [new file with mode: 0644]
t/zzzzzzz_sqlite_deadlock.t [new file with mode: 0644]

diff --git a/Changes b/Changes
index 5ebf0e7..074cbf0 100644 (file)
--- a/Changes
+++ b/Changes
@@ -9,6 +9,8 @@ Revision history for DBIx::Class
           which in turn returns a single count value
         - make_column_dirty() now overwrites the deflated value with an
           inflated one if such exists
+        - Fixed set_$rel with where restriction deleting rows outside 
+          the restriction
 
 0.08107 2009-06-14 08:21:00 (UTC)
         - Fix serialization regression introduced in 0.08103 (affects
index 7f935b1..2369dd5 100644 (file)
@@ -59,7 +59,7 @@ resources 'MailingList' => 'http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/db
 
 my %force_requires_if_author = (
   'Test::Pod::Coverage'       => 1.04,
-  'SQL::Translator'           => 0.09004,
+  'SQL::Translator'           => 0.09007,
 
   # CDBI-compat related
   'DBIx::ContextualFetch'     => 0,
index 5646768..50539d6 100644 (file)
@@ -211,7 +211,7 @@ __END__
 
 =head1 USAGE NOTES
 
-If you have a datetime column with the C<timezone> extra setting, and subsenquently 
+If you have a datetime column with an associated C<timezone>, and subsequently
 create/update this column with a DateTime object in the L<DateTime::TimeZone::Floating>
 timezone, you will get a warning (as there is a very good chance this will not have the
 result you expect). For example:
index b13b05a..bde68ea 100644 (file)
@@ -240,7 +240,7 @@ any of your aliases using either of these:
   my $rs = $schema->resultset('Artist')->search(
     {},
     {
-      columns => [ qw/artistid name rank/ ],
+      columns => [ qw/artist_id name rank/ ],
       distinct => 1
     } 
   );
@@ -248,15 +248,15 @@ any of your aliases using either of these:
   my $rs = $schema->resultset('Artist')->search(
     {},
     {
-      columns => [ qw/artistid name rank/ ],
-      group_by => [ qw/artistid name rank/ ],
+      columns => [ qw/artist_id name rank/ ],
+      group_by => [ qw/artist_id name rank/ ],
     }
   );
 
   # Equivalent SQL:
-  # SELECT me.artistid, me.name, me.rank
+  # SELECT me.artist_id, me.name, me.rank
   # FROM artist me
-  # GROUP BY artistid, name, rank
+  # GROUP BY artist_id, name, rank
 
 =head2 SELECT COUNT(DISTINCT colname)
 
@@ -336,7 +336,7 @@ from, select, and +select attributes.
   my $rs = $cdrs->search({
     year => {
       '=' => $cdrs->search(
-        { artistid => { '=' => \'me.artistid' } },
+        { artist_id => { '=' => \'me.artist_id' } },
         { alias => 'inner' }
       )->get_column('year')->max_rs->as_query,
     },
@@ -349,7 +349,7 @@ That creates the following SQL:
    WHERE year = (
       SELECT MAX(inner.year)
         FROM cd inner
-       WHERE artistid = me.artistid
+       WHERE artist_id = me.artist_id
       )
 
 =head3 EXPERIMENTAL
@@ -429,15 +429,20 @@ C<bind> attributes:
 =head2 Using joins and prefetch
 
 You can use the C<join> attribute to allow searching on, or sorting your
-results by, one or more columns in a related table. To return all CDs matching
-a particular artist name:
+results by, one or more columns in a related table.
+
+This requires that you have defined the L<DBIx::Class::Relationship>. For example :
+
+  My::Schema::CD->has_many( artists => 'My::Schema::Artist', 'artist_id');
+
+To return all CDs matching a particular artist name, you specify the name of the relationship ('artists'):
 
   my $rs = $schema->resultset('CD')->search(
     {
-      'artist.name' => 'Bob Marley'    
+      'artists.name' => 'Bob Marley'    
     },
     {
-      join => 'artist', # join the artist table
+      join => 'artists', # join the artist table
     }
   );
 
@@ -446,16 +451,19 @@ a particular artist name:
   # JOIN artist ON cd.artist = artist.id
   # WHERE artist.name = 'Bob Marley'
 
+In that example both the join, and the condition use the relationship name rather than the table name
+(see DBIx::Class::Manual::Joining for more details on aliasing ).
+
 If required, you can now sort on any column in the related tables by including
-it in your C<order_by> attribute:
+it in your C<order_by> attribute, (again using the aliased relation name rather than table name) :
 
   my $rs = $schema->resultset('CD')->search(
     {
-      'artist.name' => 'Bob Marley'
+      'artists.name' => 'Bob Marley'
     },
     {
-      join     => 'artist',
-      order_by => [qw/ artist.name /]
+      join     => 'artists',
+      order_by => [qw/ artists.name /]
     }
   );
 
@@ -492,12 +500,12 @@ This allows you to fetch results from related tables in advance:
 
   my $rs = $schema->resultset('CD')->search(
     {
-      'artist.name' => 'Bob Marley'
+      'artists.name' => 'Bob Marley'
     },
     {
-      join     => 'artist',
-      order_by => [qw/ artist.name /],
-      prefetch => 'artist' # return artist data too!
+      join     => 'artists',
+      order_by => [qw/ artists.name /],
+      prefetch => 'artists' # return artist data too!
     }
   );
 
@@ -1100,8 +1108,8 @@ declaration, like so...
   
   __PACKAGE__->table('database1.artist'); # will use "database1.artist" in FROM clause
   
-  __PACKAGE__->add_columns(qw/ artistid name /);
-  __PACKAGE__->set_primary_key('artistid');
+  __PACKAGE__->add_columns(qw/ artist_id name /);
+  __PACKAGE__->set_primary_key('artist_id');
   __PACKAGE__->has_many('cds' => 'MyDatabase::Main::Cd');
 
   1;
index 8c2e4fd..8f02598 100644 (file)
@@ -176,13 +176,13 @@ sub related_resultset {
   $self->throw_exception("Can't call *_related as class methods")
     unless ref $self;
   my $rel = shift;
-  my $rel_obj = $self->relationship_info($rel);
+  my $rel_info = $self->relationship_info($rel);
   $self->throw_exception( "No such relationship ${rel}" )
-    unless $rel_obj;
+    unless $rel_info;
   
   return $self->{related_resultsets}{$rel} ||= do {
     my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
-    $attrs = { %{$rel_obj->{attrs} || {}}, %$attrs };
+    $attrs = { %{$rel_info->{attrs} || {}}, %$attrs };
 
     $self->throw_exception( "Invalid query: @_" )
       if (@_ > 1 && (@_ % 2 == 1));
@@ -190,7 +190,7 @@ sub related_resultset {
 
     my $source = $self->result_source;
     my $cond = $source->_resolve_condition(
-      $rel_obj->{cond}, $rel, $self
+      $rel_info->{cond}, $rel, $self
     );
     if ($cond eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
       my $reverse = $source->reverse_relationship_info($rel);
@@ -390,22 +390,22 @@ set them in the storage.
 
 sub set_from_related {
   my ($self, $rel, $f_obj) = @_;
-  my $rel_obj = $self->relationship_info($rel);
-  $self->throw_exception( "No such relationship ${rel}" ) unless $rel_obj;
-  my $cond = $rel_obj->{cond};
+  my $rel_info = $self->relationship_info($rel);
+  $self->throw_exception( "No such relationship ${rel}" ) unless $rel_info;
+  my $cond = $rel_info->{cond};
   $self->throw_exception(
     "set_from_related can only handle a hash condition; the ".
     "condition for $rel is of type ".
     (ref $cond ? ref $cond : 'plain scalar')
   ) unless ref $cond eq 'HASH';
   if (defined $f_obj) {
-    my $f_class = $rel_obj->{class};
+    my $f_class = $rel_info->{class};
     $self->throw_exception( "Object $f_obj isn't a ".$f_class )
       unless Scalar::Util::blessed($f_obj) and $f_obj->isa($f_class);
   }
   $self->set_columns(
     $self->result_source->_resolve_condition(
-       $rel_obj->{cond}, $f_obj, $rel));
+       $rel_info->{cond}, $f_obj, $rel));
   return 1;
 }
 
index bab7bb1..2f47aab 100644 (file)
@@ -107,7 +107,14 @@ EOW
         "{$set_meth} needs a list of objects or hashrefs"
       );
       my @to_set = (ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_);
-      $self->search_related($rel, {})->delete;
+      # if there is a where clause in the attributes, ensure we only delete
+      # rows that are within the where restriction
+      if ($rel_attrs && $rel_attrs->{where}) {
+        $self->search_related( $rel, $rel_attrs->{where},{join => $f_rel})->delete;
+      } else {
+        $self->search_related( $rel, {} )->delete;
+      }
+      # add in the set rel objects
       $self->$add_meth($_, ref($_[1]) ? $_[1] : {}) for (@to_set);
     };
 
index 117563d..b012e03 100644 (file)
@@ -513,6 +513,14 @@ sub find {
     my $unique_query = $self->_build_unique_query($input_query, \@unique_cols);
     $query = $self->_add_alias($unique_query, $alias);
   }
+  elsif ($self->{attrs}{accessor} and $self->{attrs}{accessor} eq 'single') {
+    # This means that we got here after a merger of relationship conditions
+    # in ::Relationship::Base::search_related (the row method), and furthermore
+    # the relationship is of the 'single' type. This means that the condition
+    # provided by the relationship (already attached to $self) is sufficient,
+    # as there can be only one row in the databse that would satisfy the 
+    # relationship
+  }
   else {
     my @unique_queries = $self->_unique_queries($input_query, $attrs);
     $query = @unique_queries
@@ -521,27 +529,14 @@ sub find {
   }
 
   # Run the query
-  if (keys %$attrs) {
-    my $rs = $self->search($query, $attrs);
-    if (keys %{$rs->_resolved_attrs->{collapse}}) {
-      my $row = $rs->next;
-      carp "Query returned more than one row" if $rs->next;
-      return $row;
-    }
-    else {
-      return $rs->single;
-    }
+  my $rs = $self->search ($query, $attrs);
+  if (keys %{$rs->_resolved_attrs->{collapse}}) {
+    my $row = $rs->next;
+    carp "Query returned more than one row" if $rs->next;
+    return $row;
   }
   else {
-    if (keys %{$self->_resolved_attrs->{collapse}}) {
-      my $rs = $self->search($query);
-      my $row = $rs->next;
-      carp "Query returned more than one row" if $rs->next;
-      return $row;
-    }
-    else {
-      return $self->single($query);
-    }
+    return $rs->single;
   }
 }
 
@@ -2448,12 +2443,12 @@ sub related_resultset {
 
   $self->{related_resultsets} ||= {};
   return $self->{related_resultsets}{$rel} ||= do {
-    my $rel_obj = $self->result_source->relationship_info($rel);
+    my $rel_info = $self->result_source->relationship_info($rel);
 
     $self->throw_exception(
       "search_related: result source '" . $self->result_source->source_name .
         "' has no such relationship $rel")
-      unless $rel_obj;
+      unless $rel_info;
 
     my ($from,$seen) = $self->_resolve_from($rel);
 
@@ -2554,7 +2549,7 @@ sub current_source_alias {
 # with a relation_chain_depth less than the depth of the
 # current prefetch is not considered)
 sub _resolve_from {
-  my ($self, $extra_join) = @_;
+  my ($self, $rel) = @_;
   my $source = $self->result_source;
   my $attrs = $self->{attrs};
 
@@ -2578,7 +2573,7 @@ sub _resolve_from {
 
   ++$seen->{-relation_chain_depth};
 
-  push @$from, $source->_resolve_join($extra_join, $attrs->{alias}, $seen);
+  push @$from, $source->_resolve_join($rel, $attrs->{alias}, $seen);
 
   ++$seen->{-relation_chain_depth};
 
@@ -3213,7 +3208,7 @@ Makes the resultset paged and specifies the page to retrieve. Effectively
 identical to creating a non-pages resultset and then calling ->page($page)
 on it.
 
-If L<rows> attribute is not specified it defualts to 10 rows per page.
+If L<rows> attribute is not specified it defaults to 10 rows per page.
 
 When you have a paged resultset, L</count> will only return the number
 of rows in the page. To get the total, use the L</pager> and call
index 2287bef..d6fd004 100644 (file)
@@ -1083,26 +1083,23 @@ sub resolve_join {
 
 # Returns the {from} structure used to express JOIN conditions
 sub _resolve_join {
-  my ($self, $join, $alias, $seen, $force_left, $jpath) = @_;
+  my ($self, $join, $alias, $seen, $jpath, $force_left) = @_;
 
   # we need a supplied one, because we do in-place modifications, no returns
   $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
     unless $seen;
 
-  $force_left ||= { force => 0 };
-
   # This isn't quite right, we should actually dive into $seen and reconstruct
   # the entire path (the reference entry point would be the join conditional
   # with depth == current_depth - 1. At this point however nothing depends on
   # having the entire path, transcending related_resultset, so just leave it
   # as is, hairy enough already.
-  $jpath ||= [];  
+  $jpath ||= [];
 
   if (ref $join eq 'ARRAY') {
     return
       map {
-        local $force_left->{force} = $force_left->{force};
-        $self->_resolve_join($_, $alias, $seen, $force_left, [@$jpath]);
+        $self->_resolve_join($_, $alias, $seen, [@$jpath], $force_left);
       } @$join;
   } elsif (ref $join eq 'HASH') {
     return
@@ -1110,9 +1107,9 @@ sub _resolve_join {
         my $as = ($seen->{$_} ? join ('_', $_, $seen->{$_} + 1) : $_);  # the actual seen value will be incremented below
         local $force_left->{force} = $force_left->{force};
         (
-          $self->_resolve_join($_, $alias, $seen, $force_left, [@$jpath]),
+          $self->_resolve_join($_, $alias, $seen, [@$jpath], $force_left),
           $self->related_source($_)->_resolve_join(
-            $join->{$_}, $as, $seen, $force_left, [@$jpath, $_]
+            $join->{$_}, $as, $seen, [@$jpath, $_], $force_left
           )
         );
       } keys %$join;
@@ -1126,11 +1123,11 @@ sub _resolve_join {
     my $rel_info = $self->relationship_info($join);
     $self->throw_exception("No such relationship ${join}") unless $rel_info;
     my $type;
-    if ($force_left->{force}) {
+    if ($force_left) {
       $type = 'left';
     } else {
       $type = $rel_info->{attrs}{join_type} || '';
-      $force_left->{force} = 1 if lc($type) eq 'left';
+      $force_left = 1 if lc($type) eq 'left';
     }
 
     my $rel_src = $self->related_source($join);
index 7040204..80c43d9 100644 (file)
@@ -1125,6 +1125,19 @@ name format is: C<$dir$schema-$version-$type.sql>.
 You may override this method in your schema if you wish to use a different
 format.
 
+ WARNING
+
+ Prior to DBIx::Class version 0.08100 this method had a different signature:
+
+    my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
+
+ In recent versions variables $dir and $version were reversed in order to
+ bring the signature in line with other Schema/Storage methods. If you 
+ really need to maintain backward compatibility, you can do the following
+ in any overriding methods:
+
+    ($dir, $version) = ($version, $dir) if ($DBIx::Class::VERSION < 0.08100);
+
 =cut
 
 sub ddl_filename {
index 97e333c..0966562 100644 (file)
@@ -14,6 +14,7 @@ $DEBUG = 0 unless defined $DEBUG;
 
 use Exporter;
 use SQL::Translator::Utils qw(debug normalize_name);
+use Carp::Clan qw/^SQL::Translator|^DBIx::Class/;
 
 use base qw(Exporter);
 
@@ -34,11 +35,11 @@ sub parse {
     my $dbicschema    = $args->{'DBIx::Class::Schema'} ||  $args->{"DBIx::Schema"} ||$data;
     $dbicschema     ||= $args->{'package'};
     my $limit_sources = $args->{'sources'};
-    
-    die 'No DBIx::Class::Schema' unless ($dbicschema);
+
+    croak 'No DBIx::Class::Schema' unless ($dbicschema);
     if (!ref $dbicschema) {
       eval "use $dbicschema;";
-      die "Can't load $dbicschema ($@)" if($@);
+      croak "Can't load $dbicschema ($@)" if($@);
     }
 
     my $schema      = $tr->schema;
@@ -47,12 +48,11 @@ sub parse {
     $schema->name( ref($dbicschema) . " v" . ($dbicschema->schema_version || '1.x'))
       unless ($schema->name);
 
-    my %seen_tables;
-
     my @monikers = sort $dbicschema->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';
+        $dbicschema->throw_exception ("'sources' parameter must be an array or hash ref")
+          unless( $ref eq 'ARRAY' || ref eq 'HASH' );
 
         # limit monikers to those specified in 
         my $sources;
@@ -76,21 +76,23 @@ sub parse {
       }
     }
 
+    my %tables;
     foreach my $moniker (sort @table_monikers)
     {
         my $source = $dbicschema->source($moniker);
-        
+        my $table_name = $source->name;
+
         # Skip custom query sources
-        next if ref($source->name);
+        next if ref $table_name;
 
-        # Its possible to have multiple DBIC source using same table
-        next if $seen_tables{$source->name}++;
+        # Its possible to have multiple DBIC sources using the same table
+        next if $tables{$table_name};
 
-        my $table = $schema->add_table(
-                                       name => $source->name,
+        $tables{$table_name}{source} = $source;
+        my $table = $tables{$table_name}{object} = SQL::Translator::Schema::Table->new(
+                                       name => $table_name,
                                        type => 'TABLE',
-                                       ) || die $schema->error;
-        my $colcount = 0;
+                                       );
         foreach my $col ($source->columns)
         {
             # assuming column_info in dbic is the same as DBI (?)
@@ -106,7 +108,8 @@ sub parse {
             if ($colinfo{is_nullable}) {
               $colinfo{default} = '' unless exists $colinfo{default};
             }
-            my $f = $table->add_field(%colinfo) || die $table->error;
+            my $f = $table->add_field(%colinfo)
+              || $dbicschema->throw_exception ($table->error);
         }
         $table->primary_key($source->primary_columns);
 
@@ -125,7 +128,7 @@ sub parse {
         my @rels = $source->relationships();
 
         my %created_FK_rels;
-        
+
         # global add_fk_index set in parser_args
         my $add_fk_index = (exists $args->{add_fk_index} && ($args->{add_fk_index} == 0)) ? 0 : 1;
 
@@ -146,7 +149,7 @@ sub parse {
             my $idx;
             my %other_columns_idx = map {'foreign.'.$_ => ++$idx } $othertable->columns;            
             my @cond = sort { $other_columns_idx{$a} cmp $other_columns_idx{$b} } keys(%{$rel_info->{cond}}); 
-      
+
             # Get the key information, mapping off the foreign/self markers
             my @refkeys = map {/^\w+\.(\w+)$/} @cond;
             my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
@@ -177,7 +180,7 @@ sub parse {
                         $cascade->{$c} = $rel_info->{attrs}{"on_$c"};
                     }
                     else {
-                        warn "SQLT attribute 'on_$c' was supplied for relationship '$moniker/$rel', which does not appear to be a foreign constraint. "
+                        carp "SQLT attribute 'on_$c' was supplied for relationship '$moniker/$rel', which does not appear to be a foreign constraint. "
                             . "If you are sure that SQLT must generate a constraint for this relationship, add 'is_foreign_key_constraint => 1' to the attributes.\n";
                     }
                 }
@@ -195,17 +198,21 @@ sub parse {
                 my $key_test = join("\x00", @keys);
                 next if $created_FK_rels{$rel_table}->{$key_test};
 
-                my $is_deferrable = $rel_info->{attrs}{is_deferrable};
-                
-                # global parser_args add_fk_index param can be overridden on the rel def
-                my $add_fk_index_rel = (exists $rel_info->{attrs}{add_fk_index}) ? $rel_info->{attrs}{add_fk_index} : $add_fk_index;
+                if (scalar(@keys)) {
+
+                  $created_FK_rels{$rel_table}->{$key_test} = 1;
 
+                  my $is_deferrable = $rel_info->{attrs}{is_deferrable};
+
+                  # do not consider deferrable constraints and self-references
+                  # for dependency calculations
+                  if (! $is_deferrable and $rel_table ne $table_name) {
+                    $tables{$table_name}{foreign_table_deps}{$rel_table}++;
+                  }
 
-                $created_FK_rels{$rel_table}->{$key_test} = 1;
-                if (scalar(@keys)) {
                   $table->add_constraint(
                                     type             => 'foreign_key',
-                                    name             => join('_', $table->name, 'fk', @keys),
+                                    name             => join('_', $table_name, 'fk', @keys),
                                     fields           => \@keys,
                                     reference_fields => \@refkeys,
                                     reference_table  => $rel_table,
@@ -213,10 +220,13 @@ sub parse {
                                     on_update        => uc ($cascade->{update} || ''),
                                     (defined $is_deferrable ? ( deferrable => $is_deferrable ) : ()),
                   );
-                    
+
+                  # global parser_args add_fk_index param can be overridden on the rel def
+                  my $add_fk_index_rel = (exists $rel_info->{attrs}{add_fk_index}) ? $rel_info->{attrs}{add_fk_index} : $add_fk_index;
+
                   if ($add_fk_index_rel) {
                       my $index = $table->add_index(
-                                                    name   => join('_', $table->name, 'idx', @keys),
+                                                    name   => join('_', $table_name, 'idx', @keys),
                                                     fields => \@keys,
                                                     type   => 'NORMAL',
                                                     );
@@ -224,31 +234,48 @@ sub parse {
               }
             }
         }
-               
-        $source->_invoke_sqlt_deploy_hook($table);
+
     }
 
+    # attach the tables to the schema in dependency order
+    my $dependencies = {
+      map { $_ => _resolve_deps ($_, \%tables) } (keys %tables)
+    };
+    for my $table (sort
+      {
+        keys %{$dependencies->{$a} || {} } <=> keys %{ $dependencies->{$b} || {} }
+          ||
+        $a cmp $b
+      }
+      (keys %tables)
+    ) {
+      $schema->add_table ($tables{$table}{object});
+      $tables{$table}{source} -> _invoke_sqlt_deploy_hook( $tables{$table}{object} );
+    }
+
+
+    my %views;
     foreach my $moniker (sort @view_monikers)
     {
         my $source = $dbicschema->source($moniker);
+        my $view_name = $source->name;
+
         # Skip custom query sources
-        next if ref($source->name);
+        next if ref $view_name;
 
         # Its possible to have multiple DBIC source using same table
-        next if $seen_tables{$source->name}++;
+        next if $views{$view_name}++;
 
-        my $view = $schema->add_view(
-          name => $source->name,
+        my $view = $schema->add_view (
+          name => $view_name,
           fields => [ $source->columns ],
           $source->view_definition ? ( 'sql' => $source->view_definition ) : ()
-        );
-        if ($source->result_class->can('sqlt_deploy_hook')) {
-          $source->result_class->sqlt_deploy_hook($view);
-        }
+        ) || $dbicschema->throw_exception ($schema->error);
 
         $source->_invoke_sqlt_deploy_hook($view);
     }
 
+
     if ($dbicschema->can('sqlt_deploy_hook')) {
       $dbicschema->sqlt_deploy_hook($schema);
     }
@@ -256,6 +283,41 @@ sub parse {
     return 1;
 }
 
+#
+# Quick and dirty dependency graph calculator
+#
+sub _resolve_deps {
+  my ($table, $tables, $seen) = @_;
+
+  my $ret = {};
+  $seen ||= {};
+
+  # copy and bump all deps by one (so we can reconstruct the chain)
+  my %seen = map { $_ => $seen->{$_} + 1 } (keys %$seen);
+  $seen{$table} = 1;
+
+  for my $dep (keys %{$tables->{$table}{foreign_table_deps}} ) {
+
+    if ($seen->{$dep}) {
+
+      # warn and remove the circular constraint so we don't get flooded with the same warning over and over
+      #carp sprintf ("Circular dependency detected, schema may not be deployable:\n%s\n",
+      #  join (' -> ', (sort { $seen->{$b} <=> $seen->{$a} } (keys %$seen) ), $table, $dep )
+      #);
+      #delete $tables->{$table}{foreign_table_deps}{$dep};
+
+      return {};
+    }
+
+    my $subdeps = _resolve_deps ($dep, $tables, \%seen);
+    $ret->{$_} += $subdeps->{$_} for ( keys %$subdeps );
+
+    ++$ret->{$dep};
+  }
+
+  return $ret;
+}
+
 1;
 
 =head1 NAME
index 6ed3125..1c03591 100644 (file)
@@ -7,7 +7,7 @@ use lib qw(t/lib);
 use DBICTest;
 my $schema = DBICTest->init_schema();
 
-plan tests => 16;
+plan tests => 19;
 
 # select from a class with resultset_attributes
 my $resultset = $schema->resultset('BooksInLibrary');
@@ -72,3 +72,14 @@ eval {$collection->add_to_objects({ value => "Wheel", type => "round" })};
 if ($@) { print $@ }
 ok( !$@, 'many_to_many add_to_$rel($hash) did not throw');
 is($round_objects->count, $round_count+1, 'many_to_many add_to_$rel($hash) count correct');
+
+# test set_$rel
+$round_count = $round_objects->count();
+$pointy_count = $pointy_objects->count();
+my @all_pointy_objects = $pointy_objects->all;
+# doing a set on pointy objects with its current set should not change any counts
+eval {$collection->set_pointy_objects(\@all_pointy_objects)};
+if ($@) { print $@ }
+ok( !$@, 'many_to_many set_$rel(\@objects) did not throw');
+is($pointy_objects->count, $pointy_count, 'many_to_many set_$rel($hash) count correct');
+is($round_objects->count, $round_count, 'many_to_many set_$rel($hash) other rel count correct');
index 438bd85..b9993a1 100644 (file)
@@ -16,33 +16,23 @@ if ($] <= 5.008000) {
     eval 'use utf8; 1' or plan skip_all => 'Need utf8 run this test';
 }
 
-plan tests => 5;
+plan tests => 6;
 
 DBICTest::Schema::CD->load_components('UTF8Columns');
 DBICTest::Schema::CD->utf8_columns('title');
 Class::C3->reinitialize();
 
-my $cd = $schema->resultset('CD')->create( { artist => 1, title => 'øni', year => 'foo' } );
+my $cd = $schema->resultset('CD')->create( { artist => 1, title => 'øni', year => '2048' } );
 my $utf8_char = 'uniuni';
 
-if ($] <= 5.008000) {
-
-    ok( Encode::is_utf8( $cd->title ), 'got title with utf8 flag' );
-    ok( !Encode::is_utf8( $cd->year ), 'got year without utf8 flag' );
-
-    Encode::_utf8_on($utf8_char);
-    $cd->title($utf8_char);
-    ok( !Encode::is_utf8( $cd->{_column_data}{title} ), 'store utf8-less chars' );
 
-} else {
+ok( _is_utf8( $cd->title ), 'got title with utf8 flag' );
+ok(! _is_utf8( $cd->year ), 'got year without utf8 flag' );
 
-    ok( utf8::is_utf8( $cd->title ), 'got title with utf8 flag' );
-    ok( !utf8::is_utf8( $cd->year ), 'got year without utf8 flag' );
+_force_utf8($utf8_char);
+$cd->title($utf8_char);
+ok(! _is_utf8( $cd->{_column_data}{title} ), 'store utf8-less chars' );
 
-    utf8::decode($utf8_char);
-    $cd->title($utf8_char);
-    ok( !utf8::is_utf8( $cd->{_column_data}{title} ), 'store utf8-less chars' );
-}
 
 my $v_utf8 = "\x{219}";
 
@@ -53,3 +43,28 @@ ok( !$cd->is_column_changed('title'), 'column is not dirty after setting the sam
 $cd->update ({ title => $v_utf8 });
 $cd->title('something_else');
 ok( $cd->is_column_changed('title'), 'column is dirty after setting to something completely different');
+
+TODO: {
+  local $TODO = 'There is currently no way to propagate aliases to inflate_result()';
+  $cd = $schema->resultset('CD')->find ({ title => $v_utf8 }, { select => 'title', as => 'name' });
+  ok (_is_utf8( $cd->get_column ('name') ), 'utf8 flag propagates via as');
+}
+
+
+sub _force_utf8 {
+  if ($] <= 5.008000) {
+    Encode::_utf8_on ($_[0]);
+  }
+  else {
+    utf8::decode ($_[0]);
+  }
+}
+
+sub _is_utf8 {
+  if ($] <= 5.008000) {
+    return Encode::is_utf8 (shift);
+  }
+  else {
+    return utf8::is_utf8 (shift);
+  }
+}
index 4b89019..467fed3 100644 (file)
@@ -45,7 +45,11 @@ my $translator = SQL::Translator->new(
     ok($output, "SQLT produced someoutput")
       or diag($translator->error);
 
-    like ($warn, qr/^SQLT attribute .+? was supplied for relationship/, 'Warn about dubious on_delete/on_update attributes');
+    like (
+      $warn,
+      qr/SQLT attribute .+? was supplied for relationship .+? which does not appear to be a foreign constraint/,
+      'Warn about dubious on_delete/on_update attributes',
+    );
 }
 
 # Note that the constraints listed here are the only ones that are tested -- if
@@ -155,7 +159,7 @@ my %fk_constraints = (
       'name' => 'artist_undirected_map_fk_id2', 'index_name' => 'artist_undirected_map_idx_id2',
       'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist', 
       'selfcols'  => ['id2'], 'foreigncols' => ['artistid'],
-      on_delete => '', on_update => 'CASCADE', deferrable => 1,
+      on_delete => '', on_update => '', deferrable => 1,
     },
   ],
 
index 1626787..2f4d85f 100644 (file)
@@ -11,7 +11,7 @@ __PACKAGE__->add_columns(
 __PACKAGE__->set_primary_key(qw/id1 id2/);
 
 __PACKAGE__->belongs_to( 'artist1', 'DBICTest::Schema::Artist', 'id1', { on_delete => 'RESTRICT', on_update => 'CASCADE'} );
-__PACKAGE__->belongs_to( 'artist2', 'DBICTest::Schema::Artist', 'id2', { on_delete => undef, on_update => 'CASCADE'} );
+__PACKAGE__->belongs_to( 'artist2', 'DBICTest::Schema::Artist', 'id2', { on_delete => undef, on_update => undef} );
 __PACKAGE__->has_many(
   'mapped_artists', 'DBICTest::Schema::Artist',
   [ {'foreign.artistid' => 'self.id1'}, {'foreign.artistid' => 'self.id2'} ],
index 3b3675a..dceabc9 100644 (file)
@@ -20,4 +20,6 @@ __PACKAGE__->add_unique_constraint ( genre_name => [qw/name/] );
 
 __PACKAGE__->has_many (cds => 'DBICTest::Schema::CD', 'genreid');
 
+__PACKAGE__->has_one (model_cd => 'DBICTest::Schema::CD', 'genreid');
+
 1;
index 70dc805..4966800 100644 (file)
@@ -46,6 +46,4 @@ __PACKAGE__->belongs_to( disc => 'DBICTest::Schema::CD' => 'cd');
 __PACKAGE__->might_have( cd_single => 'DBICTest::Schema::CD', 'single_track' );
 __PACKAGE__->might_have( lyrics => 'DBICTest::Schema::Lyrics', 'track_id' );
 
-__PACKAGE__->has_one( undying_lyric => 'DBICTest::Schema::Lyrics', 'track_id' );
-
 1;
index 441c811..f109493 100644 (file)
@@ -1,6 +1,6 @@
 -- 
 -- Created by SQL::Translator::Producer::SQLite
--- Created on Thu May 28 10:10:00 2009
+-- Created on Sat Jun 27 14:02:39 2009
 -- 
 
 
@@ -17,41 +17,6 @@ CREATE TABLE artist (
 );
 
 --
--- Table: artist_undirected_map
---
-CREATE TABLE artist_undirected_map (
-  id1 integer NOT NULL,
-  id2 integer NOT NULL,
-  PRIMARY KEY (id1, id2)
-);
-
-CREATE INDEX artist_undirected_map_idx_id1_ ON artist_undirected_map (id1);
-
-CREATE INDEX artist_undirected_map_idx_id2_ ON artist_undirected_map (id2);
-
---
--- Table: cd_artwork
---
-CREATE TABLE cd_artwork (
-  cd_id INTEGER PRIMARY KEY NOT NULL
-);
-
-CREATE INDEX cd_artwork_idx_cd_id_cd_artwor ON cd_artwork (cd_id);
-
---
--- Table: artwork_to_artist
---
-CREATE TABLE artwork_to_artist (
-  artwork_cd_id integer NOT NULL,
-  artist_id integer NOT NULL,
-  PRIMARY KEY (artwork_cd_id, artist_id)
-);
-
-CREATE INDEX artwork_to_artist_idx_artist_id_artwork_to_arti ON artwork_to_artist (artist_id);
-
-CREATE INDEX artwork_to_artist_idx_artwork_cd_id_artwork_to_ ON artwork_to_artist (artwork_cd_id);
-
---
 -- Table: bindtype_test
 --
 CREATE TABLE bindtype_test (
@@ -62,63 +27,6 @@ CREATE TABLE bindtype_test (
 );
 
 --
--- Table: bookmark
---
-CREATE TABLE bookmark (
-  id INTEGER PRIMARY KEY NOT NULL,
-  link integer NOT NULL
-);
-
-CREATE INDEX bookmark_idx_link_bookmark ON bookmark (link);
-
---
--- Table: books
---
-CREATE TABLE books (
-  id INTEGER PRIMARY KEY NOT NULL,
-  source varchar(100) NOT NULL,
-  owner integer NOT NULL,
-  title varchar(100) NOT NULL,
-  price integer
-);
-
-CREATE INDEX books_idx_owner_books ON books (owner);
-
---
--- Table: cd
---
-CREATE TABLE cd (
-  cdid INTEGER PRIMARY KEY NOT NULL,
-  artist integer NOT NULL,
-  title varchar(100) NOT NULL,
-  year varchar(100) NOT NULL,
-  genreid integer,
-  single_track integer
-);
-
-CREATE INDEX cd_idx_artist_cd ON cd (artist);
-
-CREATE INDEX cd_idx_genreid_cd ON cd (genreid);
-
-CREATE INDEX cd_idx_single_track_cd ON cd (single_track);
-
-CREATE UNIQUE INDEX cd_artist_title_cd ON cd (artist, title);
-
---
--- Table: cd_to_producer
---
-CREATE TABLE cd_to_producer (
-  cd integer NOT NULL,
-  producer integer NOT NULL,
-  attribute integer,
-  PRIMARY KEY (cd, producer)
-);
-
-CREATE INDEX cd_to_producer_idx_cd_cd_to_pr ON cd_to_producer (cd);
-
-CREATE INDEX cd_to_producer_idx_producer_cd ON cd_to_producer (producer);
-
---
 -- Table: collection
 --
 CREATE TABLE collection (
@@ -127,19 +35,6 @@ CREATE TABLE collection (
 );
 
 --
--- Table: collection_object
---
-CREATE TABLE collection_object (
-  collection integer NOT NULL,
-  object integer NOT NULL,
-  PRIMARY KEY (collection, object)
-);
-
-CREATE INDEX collection_object_idx_collection_collection_obj ON collection_object (collection);
-
-CREATE INDEX collection_object_idx_object_c ON collection_object (object);
-
---
 -- Table: employee
 --
 CREATE TABLE employee (
@@ -180,16 +75,6 @@ CREATE TABLE file_columns (
 );
 
 --
--- Table: forceforeign
---
-CREATE TABLE forceforeign (
-  artist INTEGER PRIMARY KEY NOT NULL,
-  cd integer NOT NULL
-);
-
-CREATE INDEX forceforeign_idx_artist_forcef ON forceforeign (artist);
-
---
 -- Table: fourkeys
 --
 CREATE TABLE fourkeys (
@@ -203,25 +88,6 @@ CREATE TABLE fourkeys (
 );
 
 --
--- Table: fourkeys_to_twokeys
---
-CREATE TABLE fourkeys_to_twokeys (
-  f_foo integer NOT NULL,
-  f_bar integer NOT NULL,
-  f_hello integer NOT NULL,
-  f_goodbye integer NOT NULL,
-  t_artist integer NOT NULL,
-  t_cd integer NOT NULL,
-  autopilot character NOT NULL,
-  pilot_sequence integer,
-  PRIMARY KEY (f_foo, f_bar, f_hello, f_goodbye, t_artist, t_cd)
-);
-
-CREATE INDEX fourkeys_to_twokeys_idx_f_foo_f_bar_f_hello_f_goodbye_ ON fourkeys_to_twokeys (f_foo, f_bar, f_hello, f_goodbye);
-
-CREATE INDEX fourkeys_to_twokeys_idx_t_artist_t_cd_fourkeys_to ON fourkeys_to_twokeys (t_artist, t_cd);
-
---
 -- Table: genre
 --
 CREATE TABLE genre (
@@ -229,29 +95,7 @@ CREATE TABLE genre (
   name varchar(100) NOT NULL
 );
 
-CREATE UNIQUE INDEX genre_name_genre ON genre (name);
-
---
--- Table: images
---
-CREATE TABLE images (
-  id INTEGER PRIMARY KEY NOT NULL,
-  artwork_id integer NOT NULL,
-  name varchar(100) NOT NULL,
-  data blob
-);
-
-CREATE INDEX images_idx_artwork_id_images ON images (artwork_id);
-
---
--- Table: liner_notes
---
-CREATE TABLE liner_notes (
-  liner_id INTEGER PRIMARY KEY NOT NULL,
-  notes varchar(100) NOT NULL
-);
-
-CREATE INDEX liner_notes_idx_liner_id_liner ON liner_notes (liner_id);
+CREATE UNIQUE INDEX genre_name ON genre (name);
 
 --
 -- Table: link
@@ -263,27 +107,6 @@ CREATE TABLE link (
 );
 
 --
--- Table: lyric_versions
---
-CREATE TABLE lyric_versions (
-  id INTEGER PRIMARY KEY NOT NULL,
-  lyric_id integer NOT NULL,
-  text varchar(100) NOT NULL
-);
-
-CREATE INDEX lyric_versions_idx_lyric_id_ly ON lyric_versions (lyric_id);
-
---
--- Table: lyrics
---
-CREATE TABLE lyrics (
-  lyric_id INTEGER PRIMARY KEY NOT NULL,
-  track_id integer NOT NULL
-);
-
-CREATE INDEX lyrics_idx_track_id_lyrics ON lyrics (track_id);
-
---
 -- Table: noprimarykey
 --
 CREATE TABLE noprimarykey (
@@ -292,7 +115,7 @@ CREATE TABLE noprimarykey (
   baz integer NOT NULL
 );
 
-CREATE UNIQUE INDEX foo_bar_noprimarykey ON noprimarykey (foo, bar);
+CREATE UNIQUE INDEX foo_bar ON noprimarykey (foo, bar);
 
 --
 -- Table: onekey
@@ -319,7 +142,7 @@ CREATE TABLE producer (
   name varchar(100) NOT NULL
 );
 
-CREATE UNIQUE INDEX prod_name_producer ON producer (name);
+CREATE UNIQUE INDEX prod_name ON producer (name);
 
 --
 -- Table: self_ref
@@ -330,19 +153,6 @@ CREATE TABLE self_ref (
 );
 
 --
--- Table: self_ref_alias
---
-CREATE TABLE self_ref_alias (
-  self_ref integer NOT NULL,
-  alias integer NOT NULL,
-  PRIMARY KEY (self_ref, alias)
-);
-
-CREATE INDEX self_ref_alias_idx_alias_self_ ON self_ref_alias (alias);
-
-CREATE INDEX self_ref_alias_idx_self_ref_se ON self_ref_alias (self_ref);
-
---
 -- Table: sequence_test
 --
 CREATE TABLE sequence_test (
@@ -362,15 +172,99 @@ CREATE TABLE serialized (
 );
 
 --
--- Table: tags
+-- Table: treelike
 --
-CREATE TABLE tags (
-  tagid INTEGER PRIMARY KEY NOT NULL,
-  cd integer NOT NULL,
-  tag varchar(100) NOT NULL
+CREATE TABLE treelike (
+  id INTEGER PRIMARY KEY NOT NULL,
+  parent integer,
+  name varchar(100) NOT NULL
+);
+
+CREATE INDEX treelike_idx_parent ON treelike (parent);
+
+--
+-- Table: twokeytreelike
+--
+CREATE TABLE twokeytreelike (
+  id1 integer NOT NULL,
+  id2 integer NOT NULL,
+  parent1 integer NOT NULL,
+  parent2 integer NOT NULL,
+  name varchar(100) NOT NULL,
+  PRIMARY KEY (id1, id2)
+);
+
+CREATE INDEX twokeytreelike_idx_parent1_parent2 ON twokeytreelike (parent1, parent2);
+
+CREATE UNIQUE INDEX tktlnameunique ON twokeytreelike (name);
+
+--
+-- Table: typed_object
+--
+CREATE TABLE typed_object (
+  objectid INTEGER PRIMARY KEY NOT NULL,
+  type varchar(100) NOT NULL,
+  value varchar(100) NOT NULL
+);
+
+--
+-- Table: artist_undirected_map
+--
+CREATE TABLE artist_undirected_map (
+  id1 integer NOT NULL,
+  id2 integer NOT NULL,
+  PRIMARY KEY (id1, id2)
+);
+
+CREATE INDEX artist_undirected_map_idx_id1 ON artist_undirected_map (id1);
+
+CREATE INDEX artist_undirected_map_idx_id2 ON artist_undirected_map (id2);
+
+--
+-- Table: bookmark
+--
+CREATE TABLE bookmark (
+  id INTEGER PRIMARY KEY NOT NULL,
+  link integer NOT NULL
+);
+
+CREATE INDEX bookmark_idx_link ON bookmark (link);
+
+--
+-- Table: books
+--
+CREATE TABLE books (
+  id INTEGER PRIMARY KEY NOT NULL,
+  source varchar(100) NOT NULL,
+  owner integer NOT NULL,
+  title varchar(100) NOT NULL,
+  price integer
+);
+
+CREATE INDEX books_idx_owner ON books (owner);
+
+--
+-- Table: forceforeign
+--
+CREATE TABLE forceforeign (
+  artist INTEGER PRIMARY KEY NOT NULL,
+  cd integer NOT NULL
+);
+
+CREATE INDEX forceforeign_idx_artist ON forceforeign (artist);
+
+--
+-- Table: self_ref_alias
+--
+CREATE TABLE self_ref_alias (
+  self_ref integer NOT NULL,
+  alias integer NOT NULL,
+  PRIMARY KEY (self_ref, alias)
 );
 
-CREATE INDEX tags_idx_cd_tags ON tags (cd);
+CREATE INDEX self_ref_alias_idx_alias ON self_ref_alias (alias);
+
+CREATE INDEX self_ref_alias_idx_self_ref ON self_ref_alias (self_ref);
 
 --
 -- Table: track
@@ -384,38 +278,121 @@ CREATE TABLE track (
   last_updated_at datetime
 );
 
-CREATE INDEX track_idx_cd_track ON track (cd);
+CREATE INDEX track_idx_cd ON track (cd);
 
-CREATE UNIQUE INDEX track_cd_position_track ON track (cd, position);
+CREATE UNIQUE INDEX track_cd_position ON track (cd, position);
 
-CREATE UNIQUE INDEX track_cd_title_track ON track (cd, title);
+CREATE UNIQUE INDEX track_cd_title ON track (cd, title);
 
 --
--- Table: treelike
+-- Table: cd
 --
-CREATE TABLE treelike (
+CREATE TABLE cd (
+  cdid INTEGER PRIMARY KEY NOT NULL,
+  artist integer NOT NULL,
+  title varchar(100) NOT NULL,
+  year varchar(100) NOT NULL,
+  genreid integer,
+  single_track integer
+);
+
+CREATE INDEX cd_idx_artist ON cd (artist);
+
+CREATE INDEX cd_idx_genreid ON cd (genreid);
+
+CREATE INDEX cd_idx_single_track ON cd (single_track);
+
+CREATE UNIQUE INDEX cd_artist_title ON cd (artist, title);
+
+--
+-- Table: collection_object
+--
+CREATE TABLE collection_object (
+  collection integer NOT NULL,
+  object integer NOT NULL,
+  PRIMARY KEY (collection, object)
+);
+
+CREATE INDEX collection_object_idx_collection ON collection_object (collection);
+
+CREATE INDEX collection_object_idx_object ON collection_object (object);
+
+--
+-- Table: lyrics
+--
+CREATE TABLE lyrics (
+  lyric_id INTEGER PRIMARY KEY NOT NULL,
+  track_id integer NOT NULL
+);
+
+CREATE INDEX lyrics_idx_track_id ON lyrics (track_id);
+
+--
+-- Table: cd_artwork
+--
+CREATE TABLE cd_artwork (
+  cd_id INTEGER PRIMARY KEY NOT NULL
+);
+
+CREATE INDEX cd_artwork_idx_cd_id ON cd_artwork (cd_id);
+
+--
+-- Table: liner_notes
+--
+CREATE TABLE liner_notes (
+  liner_id INTEGER PRIMARY KEY NOT NULL,
+  notes varchar(100) NOT NULL
+);
+
+CREATE INDEX liner_notes_idx_liner_id ON liner_notes (liner_id);
+
+--
+-- Table: lyric_versions
+--
+CREATE TABLE lyric_versions (
   id INTEGER PRIMARY KEY NOT NULL,
-  parent integer,
-  name varchar(100) NOT NULL
+  lyric_id integer NOT NULL,
+  text varchar(100) NOT NULL
 );
 
-CREATE INDEX treelike_idx_parent_treelike ON treelike (parent);
+CREATE INDEX lyric_versions_idx_lyric_id ON lyric_versions (lyric_id);
 
 --
--- Table: twokeytreelike
+-- Table: tags
 --
-CREATE TABLE twokeytreelike (
-  id1 integer NOT NULL,
-  id2 integer NOT NULL,
-  parent1 integer NOT NULL,
-  parent2 integer NOT NULL,
-  name varchar(100) NOT NULL,
-  PRIMARY KEY (id1, id2)
+CREATE TABLE tags (
+  tagid INTEGER PRIMARY KEY NOT NULL,
+  cd integer NOT NULL,
+  tag varchar(100) NOT NULL
+);
+
+CREATE INDEX tags_idx_cd ON tags (cd);
+
+--
+-- Table: cd_to_producer
+--
+CREATE TABLE cd_to_producer (
+  cd integer NOT NULL,
+  producer integer NOT NULL,
+  attribute integer,
+  PRIMARY KEY (cd, producer)
 );
 
-CREATE INDEX twokeytreelike_idx_parent1_parent2_twokeytre ON twokeytreelike (parent1, parent2);
+CREATE INDEX cd_to_producer_idx_cd ON cd_to_producer (cd);
+
+CREATE INDEX cd_to_producer_idx_producer ON cd_to_producer (producer);
+
+--
+-- Table: images
+--
+CREATE TABLE images (
+  id INTEGER PRIMARY KEY NOT NULL,
+  artwork_id integer NOT NULL,
+  name varchar(100) NOT NULL,
+  data blob
+);
 
-CREATE UNIQUE INDEX tktlnameunique_twokeytreelike ON twokeytreelike (name);
+CREATE INDEX images_idx_artwork_id ON images (artwork_id);
 
 --
 -- Table: twokeys
@@ -426,17 +403,40 @@ CREATE TABLE twokeys (
   PRIMARY KEY (artist, cd)
 );
 
-CREATE INDEX twokeys_idx_artist_twokeys ON twokeys (artist);
+CREATE INDEX twokeys_idx_artist ON twokeys (artist);
 
 --
--- Table: typed_object
+-- Table: artwork_to_artist
 --
-CREATE TABLE typed_object (
-  objectid INTEGER PRIMARY KEY NOT NULL,
-  type varchar(100) NOT NULL,
-  value varchar(100) NOT NULL
+CREATE TABLE artwork_to_artist (
+  artwork_cd_id integer NOT NULL,
+  artist_id integer NOT NULL,
+  PRIMARY KEY (artwork_cd_id, artist_id)
 );
 
+CREATE INDEX artwork_to_artist_idx_artist_id ON artwork_to_artist (artist_id);
+
+CREATE INDEX artwork_to_artist_idx_artwork_cd_id ON artwork_to_artist (artwork_cd_id);
+
+--
+-- Table: fourkeys_to_twokeys
+--
+CREATE TABLE fourkeys_to_twokeys (
+  f_foo integer NOT NULL,
+  f_bar integer NOT NULL,
+  f_hello integer NOT NULL,
+  f_goodbye integer NOT NULL,
+  t_artist integer NOT NULL,
+  t_cd integer NOT NULL,
+  autopilot character NOT NULL,
+  pilot_sequence integer,
+  PRIMARY KEY (f_foo, f_bar, f_hello, f_goodbye, t_artist, t_cd)
+);
+
+CREATE INDEX fourkeys_to_twokeys_idx_f_foo_f_bar_f_hello_f_goodbye ON fourkeys_to_twokeys (f_foo, f_bar, f_hello, f_goodbye);
+
+CREATE INDEX fourkeys_to_twokeys_idx_t_artist_t_cd ON fourkeys_to_twokeys (t_artist, t_cd);
+
 --
 -- View: year2000cds
 --
diff --git a/t/relationship/update_or_create_multi.t b/t/relationship/update_or_create_multi.t
new file mode 100644 (file)
index 0000000..e75fede
--- /dev/null
@@ -0,0 +1,88 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+my $schema = DBICTest->init_schema();
+
+#plan tests => 4;
+plan 'no_plan';
+
+my $artist = $schema->resultset ('Artist')->first;
+
+my $genre = $schema->resultset ('Genre')
+            ->create ({ name => 'par excellence' });
+
+is ($genre->search_related( 'cds' )->count, 0, 'No cds yet');
+
+# expect a create
+$genre->update_or_create_related ('cds', {
+  artist => $artist,
+  year => 2009,
+  title => 'the best thing since sliced bread',
+});
+
+# verify cd was inserted ok
+is ($genre->search_related( 'cds' )->count, 1, 'One cd');
+my $cd = $genre->find_related ('cds', {});
+is_deeply (
+  { map { $_, $cd->get_column ($_) } qw/artist year title/ },
+  {
+    artist => $artist->id,
+    year => 2009,
+    title => 'the best thing since sliced bread',
+  },
+  'CD created correctly',
+);
+
+# expect a year update on the only related row
+# (non-qunique column + unique column as disambiguator)
+$genre->update_or_create_related ('cds', {
+  year => 2010,
+  title => 'the best thing since sliced bread',
+});
+
+# re-fetch the cd, verify update
+is ($genre->search_related( 'cds' )->count, 1, 'Still one cd');
+$cd = $genre->find_related ('cds', {});
+is_deeply (
+  { map { $_, $cd->get_column ($_) } qw/artist year title/ },
+  {
+    artist => $artist->id,
+    year => 2010,
+    title => 'the best thing since sliced bread',
+  },
+  'CD year column updated correctly',
+);
+
+
+# expect a create, after a failed search using *only* the
+# *current* relationship and the unique column constraints
+# (so no year)
+my @sql;
+$schema->storage->debugcb(sub { push @sql, $_[1] });
+$schema->storage->debug (1);
+
+$genre->update_or_create_related ('cds', {
+  title => 'the best thing since vertical toasters',
+  artist => $artist,
+  year => 2012,
+});
+
+$schema->storage->debugcb(undef);
+
+is_same_sql (
+  $sql[0],
+  'SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+    FROM cd me 
+    WHERE ( me.artist = ? AND me.title = ? AND me.genreid = ? )
+  ',
+  'expected select issued',
+);
+
+# a has_many search without a unique constraint makes no sense
+# but I am not sure what to test for - leaving open
diff --git a/t/relationship/update_or_create_single.t b/t/relationship/update_or_create_single.t
new file mode 100644 (file)
index 0000000..63ae4b1
--- /dev/null
@@ -0,0 +1,100 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+#plan tests => 4;
+plan 'no_plan';
+
+my $artist = $schema->resultset ('Artist')->first;
+
+my $genre = $schema->resultset ('Genre')
+            ->create ({ name => 'par excellence' });
+
+is ($genre->search_related( 'model_cd' )->count, 0, 'No cds yet');
+
+# expect a create
+$genre->update_or_create_related ('model_cd', {
+  artist => $artist,
+  year => 2009,
+  title => 'the best thing since sliced bread',
+});
+
+# verify cd was inserted ok
+is ($genre->search_related( 'model_cd' )->count, 1, 'One cd');
+my $cd = $genre->find_related ('model_cd', {});
+is_deeply (
+  { map { $_, $cd->get_column ($_) } qw/artist year title/ },
+  {
+    artist => $artist->id,
+    year => 2009,
+    title => 'the best thing since sliced bread',
+  },
+  'CD created correctly',
+);
+
+# expect a year update on the only related row
+# (non-qunique column + unique column as disambiguator)
+$genre->update_or_create_related ('model_cd', {
+  year => 2010,
+  title => 'the best thing since sliced bread',
+});
+
+# re-fetch the cd, verify update
+is ($genre->search_related( 'model_cd' )->count, 1, 'Still one cd');
+$cd = $genre->find_related ('model_cd', {});
+is_deeply (
+  { map { $_, $cd->get_column ($_) } qw/artist year title/ },
+  {
+    artist => $artist->id,
+    year => 2010,
+    title => 'the best thing since sliced bread',
+  },
+  'CD year column updated correctly',
+);
+
+
+# expect an update of the only related row
+# (update a unique column)
+$genre->update_or_create_related ('model_cd', {
+  title => 'the best thing since vertical toasters',
+});
+
+# re-fetch the cd, verify update
+is ($genre->search_related( 'model_cd' )->count, 1, 'Still one cd');
+$cd = $genre->find_related ('model_cd', {});
+is_deeply (
+  { map { $_, $cd->get_column ($_) } qw/artist year title/ },
+  {
+    artist => $artist->id,
+    year => 2010,
+    title => 'the best thing since vertical toasters',
+  },
+  'CD title column updated correctly',
+);
+
+
+# expect a year update on the only related row
+# (non-qunique column only)
+$genre->update_or_create_related ('model_cd', {
+  year => 2011,
+});
+
+# re-fetch the cd, verify update
+is ($genre->search_related( 'model_cd' )->count, 1, 'Still one cd');
+$cd = $genre->find_related ('model_cd', {});
+is_deeply (
+  { map { $_, $cd->get_column ($_) } qw/artist year title/ },
+  {
+    artist => $artist->id,
+    year => 2011,
+    title => 'the best thing since vertical toasters',
+  },
+  'CD year column updated correctly without a disambiguator',
+);
+
+
diff --git a/t/zzzzzzz_sqlite_deadlock.t b/t/zzzzzzz_sqlite_deadlock.t
new file mode 100644 (file)
index 0000000..80990f4
--- /dev/null
@@ -0,0 +1,35 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib 't/lib';
+
+use File::Temp ();
+use DBICTest;
+use DBICTest::Schema;
+
+plan tests => 2;
+my $wait_for = 10;  # how many seconds to wait
+
+for my $close (0,1) {
+
+  my $tmp = File::Temp->new( UNLINK => 1, TMPDIR => 1, SUFFIX => '.sqlite' );
+  my $tmp_fn = $tmp->filename;
+  close $tmp if $close;
+
+  local $SIG{ALRM} = sub { die sprintf (
+    "Timeout of %d seconds reached (tempfile still open: %s)",
+    $wait_for, $close ? 'No' : 'Yes'
+  )};
+
+  alarm $wait_for;
+
+  lives_ok (sub {
+    my $schema = DBICTest::Schema->connect ("DBI:SQLite:$tmp_fn");
+    DBICTest->deploy_schema ($schema);
+    DBICTest->populate_schema ($schema);
+  });
+
+  alarm 0;
+}