Merge 'trunk' into 'current'
Brandon Black [Mon, 21 May 2007 18:41:04 +0000 (18:41 +0000)]
r31109@brandon-blacks-computer (orig r3316):  blblack | 2007-05-15 08:53:49 -0500

Fix from Marc Espie for CREATE TABLE 'foo' for SQLite
r31932@brandon-blacks-computer (orig r3342):  ilmari | 2007-05-21 13:33:33 -0500
fix multiple multi-column relations to the same table
implementation by Brandon L Black, tests by me
r31933@brandon-blacks-computer (orig r3343):  blblack | 2007-05-21 13:37:38 -0500
update Changes

1  2 
Changes
lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm
lib/DBIx/Class/Schema/Loader/RelBuilder.pm
t/lib/dbixcsl_common_tests.pm

diff --combined Changes
+++ b/Changes
@@@ -1,23 -1,10 +1,26 @@@
  Revision history for Perl extension DBIx::Class::Schema::Loader
  
+         - Relationship names for multiple multi-col rels between
+           the same table fixed by ilmari
+         - Fix from Marc Espie for CREATE TABLE 'foo' for SQLite
          - skip ^sqlite_ tables in SQLite (thanks chromatic)
  
 +0.03999_01 Sat Apr 14 19:57:40 GMT 2007
 +        - Added *experimental* Oracle support from work done
 +          by Tsunoda Kazuya some months ago.  Not well tested.
 +        - Added "rescan" schema (and loader) method, which picks
 +          up newly created tables at runtime
 +        - Made dump_to_dir / dump_overwrite much more intelligent
 +          (they now preserve customizations by default)
 +        - Added support for DBI's new standard "statistics_info"
 +          method to gather unique key info (only supported by
 +          DBD::Pg trunk afaik)
 +        - columns_info_for imported from DBIx::Class
 +        - relationships are now on by default, use skip_relationships
 +          to disable them
 +        - Removed previously deprecated methods/options
 +        - Added $VERSION to all packages in this dist
 +
  0.03011 Sat Apr 14 19:03:07 UTC 2007
          - fix case-sensitivity in UNIQUE parsing for SQLite
  
@@@ -7,8 -7,6 +7,8 @@@ use Carp::Clan qw/^DBIx::Class/
  use Text::Balanced qw( extract_bracketed );
  use Class::C3;
  
 +our $VERSION = '0.03999_01';
 +
  =head1 NAME
  
  DBIx::Class::Schema::Loader::DBI::SQLite - DBIx::Class::Schema::Loader::DBI SQLite Implementation.
@@@ -18,7 -16,7 +18,7 @@@
    package My::Schema;
    use base qw/DBIx::Class::Schema::Loader/;
  
 -  __PACKAGE__->loader_optoins( relationships => 1 );
 +  __PACKAGE__->loader_options( debug => 1 );
  
    1;
  
  
  See L<DBIx::Class::Schema::Loader::Base>.
  
 +=head1 METHODS
 +
 +=head2 rescan
 +
 +SQLite will fail all further commands on a connection if the
 +underlying schema has been modified.  Therefore, any runtime
 +changes requiring C<rescan> also require us to re-connect
 +to the database.  The C<rescan> method here handles that
 +reconnection for you, but beware that this must occur for
 +any other open sqlite connections as well.
 +
  =cut
  
 +sub rescan {
 +    my ($self, $schema) = @_;
 +
 +    $schema->storage->disconnect if $schema->storage;
 +    $self->next::method($schema);
 +}
 +
  # XXX this really needs a re-factor
  sub _sqlite_parse_table {
      my ($self, $table) = @_;
@@@ -62,7 -42,7 +62,7 @@@
      $sth->finish;
  
      # Cut "CREATE TABLE ( )" blabla...
-     $sql =~ /^[\w\s]+\((.*)\)$/si;
+     $sql =~ /^[\w\s']+\((.*)\)$/si;
      my $cols = $1;
  
      # strip single-line comments
@@@ -170,7 -150,6 +170,7 @@@ sub _tables_list 
          next if $row->{tbl_name} =~ /^sqlite_/;
          push @tables, $row->{tbl_name};
      }
 +    $sth->finish;
      return @tables;
  }
  
@@@ -3,10 -3,9 +3,10 @@@ package DBIx::Class::Schema::Loader::Re
  use strict;
  use warnings;
  use Carp::Clan qw/^DBIx::Class/;
 -use Lingua::EN::Inflect ();
  use Lingua::EN::Inflect::Number ();
  
 +our $VERSION = '0.03999_01';
 +
  =head1 NAME
  
  DBIx::Class::Schema::Loader::RelBuilder - Builds relationships for DBIx::Class::Schema::Loader
@@@ -24,47 -23,43 +24,47 @@@ is module is not (yet) for external use
  
  =head2 new
  
 -Arguments: schema_class (scalar), fk_info (hashref), inflect_plural, inflect_singular
 +Arguments: schema_class (scalar), inflect_plural, inflect_singular
  
  C<$schema_class> should be a schema class name, where the source
  classes have already been set up and registered.  Column info, primary
  key, and unique constraints will be drawn from this schema for all
  of the existing source monikers.
  
 -The fk_info hashref's contents should take the form:
 -
 -  {
 -      TableMoniker => [
 -          {
 -              local_columns => [ 'col2', 'col3' ],
 -              remote_columns => [ 'col5', 'col7' ],
 -              remote_moniker => 'AnotherTableMoniker',
 -          },
 -          # ...
 -      ],
 -      AnotherTableMoniker => [
 -          # ...
 -      ],
 -      # ...
 -  }
 -
  Options inflect_plural and inflect_singular are optional, and are better documented
  in L<DBIx::Class::Schema::Loader::Base>.
  
  =head2 generate_code
  
 -This method will return the generated relationships as a hashref per table moniker,
 -containing an arrayref of code strings which can be "eval"-ed in the context of
 -the source class, like:
 +Arguments: local_moniker (scalar), fk_info (arrayref)
 +
 +This generates the code for the relationships of a given table.
 +
 +C<local_moniker> is the moniker name of the table which had the REFERENCES
 +statements.  The fk_info arrayref's contents should take the form:
 +
 +    [
 +        {
 +            local_columns => [ 'col2', 'col3' ],
 +            remote_columns => [ 'col5', 'col7' ],
 +            remote_moniker => 'AnotherTableMoniker',
 +        },
 +        {
 +            local_columns => [ 'col1', 'col4' ],
 +            remote_columns => [ 'col1', 'col2' ],
 +            remote_moniker => 'YetAnotherTableMoniker',
 +        },
 +        # ...
 +    ],
 +
 +This method will return the generated relationships as a hashref keyed on the
 +class names.  The values are arrayrefs of hashes containing method name and
 +arguments, like so:
  
    {
        'Some::Source::Class' => [
 -          "belongs_to( col1 => 'AnotherTableMoniker' )",
 -          "has_many( anothers => 'AnotherTableMoniker', 'col15' )",
 +          { method => 'belongs_to', arguments => [ 'col1', 'Another::Source::Class' ],
 +          { method => 'has_many', arguments => [ 'anothers', 'Yet::Another::Source::Class', 'col15' ],
        ],
        'Another::Source::Class' => [
            # ...
        # ...
    }
  
  =cut
  
  sub new {
 -    my ( $class, $schema, $fk_info, $inflect_pl, $inflect_singular ) = @_;
 +    my ( $class, $schema, $inflect_pl, $inflect_singular ) = @_;
  
      my $self = {
          schema => $schema,
 -        fk_info => $fk_info,
          inflect_plural => $inflect_pl,
          inflect_singular => $inflect_singular,
      };
@@@ -102,7 -102,9 +102,7 @@@ sub _inflect_plural 
          return $inflected if $inflected;
      }
  
 -    return $self->{legacy_default_inflections}
 -        ? Lingua::EN::Inflect::PL($relname)
 -        : Lingua::EN::Inflect::Number::to_PL($relname);
 +    return Lingua::EN::Inflect::Number::to_PL($relname);
  }
  
  # Singularize a relationship name
@@@ -118,90 -120,97 +118,92 @@@ sub _inflect_singular 
          return $inflected if $inflected;
      }
  
 -    return $self->{legacy_default_inflections}
 -        ? $relname
 -        : Lingua::EN::Inflect::Number::to_S($relname);
 +    return Lingua::EN::Inflect::Number::to_S($relname);
  }
  
  sub generate_code {
 -    my $self = shift;
 +    my ($self, $local_moniker, $rels) = @_;
  
      my $all_code = {};
  
 -    foreach my $local_moniker (keys %{$self->{fk_info}}) {
 -        my $local_table = $self->{schema}->source($local_moniker)->from;
 -        my $local_class = $self->{schema}->class($local_moniker);
 -        my $rels = $self->{fk_info}->{$local_moniker};
 +    my $local_table = $self->{schema}->source($local_moniker)->from;
 +    my $local_class = $self->{schema}->class($local_moniker);
          
 -        my %counters;
 -        foreach my $rel (@$rels) {
 -            next if !$rel->{remote_source};
 -            $counters{$rel->{remote_source}}++;
 +    my %counters;
 +    foreach my $rel (@$rels) {
 +        next if !$rel->{remote_source};
 +        $counters{$rel->{remote_source}}++;
 +    }
 +
 +    foreach my $rel (@$rels) {
 +        next if !$rel->{remote_source};
 +        my $local_cols = $rel->{local_columns};
 +        my $remote_cols = $rel->{remote_columns};
 +        my $remote_moniker = $rel->{remote_source};
 +        my $remote_obj = $self->{schema}->source($remote_moniker);
 +        my $remote_class = $self->{schema}->class($remote_moniker);
 +        my $remote_table = $remote_obj->from;
 +        $remote_cols ||= [ $remote_obj->primary_columns ];
 +
 +        if($#$local_cols != $#$remote_cols) {
 +            croak "Column count mismatch: $local_moniker (@$local_cols) "
 +                . "$remote_moniker (@$remote_cols)";
          }
  
 -        foreach my $rel (@$rels) {
 -            next if !$rel->{remote_source};
 -            my $local_cols = $rel->{local_columns};
 -            my $remote_cols = $rel->{remote_columns};
 -            my $remote_moniker = $rel->{remote_source};
 -            my $remote_obj = $self->{schema}->source($remote_moniker);
 -            my $remote_class = $self->{schema}->class($remote_moniker);
 -            my $remote_table = $remote_obj->from;
 -            $remote_cols ||= [ $remote_obj->primary_columns ];
 -
 -            if($#$local_cols != $#$remote_cols) {
 -                croak "Column count mismatch: $local_moniker (@$local_cols) "
 -                    . "$remote_moniker (@$remote_cols)";
 -            }
 +        my %cond;
 +        foreach my $i (0 .. $#$local_cols) {
 +            $cond{$remote_cols->[$i]} = $local_cols->[$i];
 +        }
  
-         # If more than one rel between this pair of tables, use the
-         #  local col name(s) as the relname in the foreign source, instead
-         #  of the local table name.
 -            my %cond;
 -            foreach my $i (0 .. $#$local_cols) {
 -                $cond{$remote_cols->[$i]} = $local_cols->[$i];
 -            }
 +        my $local_relname;
-         if($counters{$remote_moniker} > 1) {
-             $local_relname = $self->_inflect_plural(
-                 lc($local_table) . q{_} . join(q{_}, @$local_cols)
-             );
-         } else {
-             $local_relname = $self->_inflect_plural(lc $local_table);
-         }
-         # for single-column case, set the relname to the column name,
-         # to make filter accessors work
 +        my $remote_relname;
 -            my $local_relname;
 -            my $remote_relname;
++        # for single-column case, set the remote relname to the column
++        # name, to make filter accessors work
 +        if(scalar keys %cond == 1) {
 +            my ($col) = keys %cond;
 +            $remote_relname = $self->_inflect_singular($cond{$col});
 +        }
 +        else {
 +            $remote_relname = $self->_inflect_singular(lc $remote_table);
 +        }
  
 -            # for single-column case, set the remote relname to the column
 -            # name, to make filter accessors work
 -            if(scalar keys %cond == 1) {
 -                my ($col) = keys %cond;
 -                $remote_relname = $self->_inflect_singular($cond{$col});
 -            }
 -            else {
 -                $remote_relname = $self->_inflect_singular(lc $remote_table);
 -            }
++        # If more than one rel between this pair of tables, use the local
++        # col names to distinguish
++        if($counters{$remote_moniker} > 1) {
++            my $colnames = q{_} . join(q{_}, @$local_cols);
++            $local_relname = $self->_inflect_plural(
++                lc($local_table) . $colnames
++            );
++            $remote_relname .= $colnames if keys %cond > 1;
++        } else {
++            $local_relname = $self->_inflect_plural(lc $local_table);
++        }
 -            # If more than one rel between this pair of tables, use the local
 -            # col names to distinguish
 -            if($counters{$remote_moniker} > 1) {
 -                my $colnames = q{_} . join(q{_}, @$local_cols);
 -                $local_relname = $self->_inflect_plural(
 -                    lc($local_table) . $colnames
 -                );
 -                $remote_relname .= $colnames if keys %cond > 1;
 -            } else {
 -                $local_relname = $self->_inflect_plural(lc $local_table);
 -            }
 +        my %rev_cond = reverse %cond;
  
 -            my %rev_cond = reverse %cond;
 +        for (keys %rev_cond) {
 +            $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
 +            delete $rev_cond{$_};
 +        }
  
 -            for (keys %rev_cond) {
 -                $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
 -                delete $rev_cond{$_};
 +        push(@{$all_code->{$local_class}},
 +            { method => 'belongs_to',
 +              args => [ $remote_relname,
 +                        $remote_class,
 +                        \%cond,
 +              ],
              }
 -
 -            push(@{$all_code->{$local_class}},
 -                { method => 'belongs_to',
 -                  args => [ $remote_relname,
 -                            $remote_class,
 -                            \%cond,
 -                  ],
 -                }
 -            );
 -
 -            push(@{$all_code->{$remote_class}},
 -                { method => 'has_many',
 -                  args => [ $local_relname,
 -                            $local_class,
 -                            \%rev_cond,
 -                  ],
 -                }
 -            );
 -        }
 +        );
 +
 +        push(@{$all_code->{$remote_class}},
 +            { method => 'has_many',
 +              args => [ $local_relname,
 +                        $local_class,
 +                        \%rev_cond,
 +              ],
 +            }
 +        );
      }
  
      return $all_code;
@@@ -43,7 -43,7 +43,7 @@@ sub _monikerize 
  sub run_tests {
      my $self = shift;
  
-     plan tests => 80;
 -    plan tests => 84;
++    plan tests => 88;
  
      $self->create();
  
      }
  
      my $conn = $schema_class->clone;
 -    my $monikers = $schema_class->loader->monikers;
 -    my $classes = $schema_class->loader->classes;
 +    my $monikers = {};
 +    my $classes = {};
 +    foreach my $source_name ($schema_class->sources) {
 +        my $table_name = $schema_class->source($source_name)->from;
 +        $monikers->{$table_name} = $source_name;
 +        $classes->{$table_name} = $schema_class . q{::} . $source_name;
 +    }
  
      my $moniker1 = $monikers->{loader_test1};
      my $class1   = $classes->{loader_test1};
          my $class22   = $classes->{loader_test22};
          my $rsobj22   = $conn->resultset($moniker22);
  
+         my $moniker25 = $monikers->{loader_test25};
+         my $class25   = $classes->{loader_test25};
+         my $rsobj25   = $conn->resultset($moniker25);
+         my $moniker26 = $monikers->{loader_test26};
+         my $class26   = $classes->{loader_test26};
+         my $rsobj26   = $conn->resultset($moniker26);
          isa_ok( $rsobj3, "DBIx::Class::ResultSet" );
          isa_ok( $rsobj4, "DBIx::Class::ResultSet" );
          isa_ok( $rsobj5, "DBIx::Class::ResultSet" );
          isa_ok( $rsobj20, "DBIx::Class::ResultSet" );
          isa_ok( $rsobj21, "DBIx::Class::ResultSet" );
          isa_ok( $rsobj22, "DBIx::Class::ResultSet" );
+         isa_ok( $rsobj25, "DBIx::Class::ResultSet" );
+         isa_ok( $rsobj26, "DBIx::Class::ResultSet" );
  
          # basic rel test
          my $obj4 = $rsobj4->find(123);
          
          # XXX test double-fk m:m 21 <- 22 -> 21
  
+         # test double multi-col fk 26 -> 25
+         my $obj26 = $rsobj26->find(33);
+         my $rs_rel25_one = $obj26->loader_test25_id_rel1;
+         isa_ok($rs_rel25_one, $class25);
+         is($rs_rel25_one->dat, 'x25');
+         my $rs_rel25_two = $obj26->loader_test25_id_rel2;
+         isa_ok($rs_rel25_two, $class25);
+         is($rs_rel25_two->dat, 'y25');
+         my $obj25 = $rsobj25->find(3,42);
+         my $rs_rel26 = $obj25->search_related('loader_test26_id_rel1s');
+         isa_ok($rs_rel26->first, $class26);
+         is($rs_rel26->first->id, 3);
          # from Chisel's tests...
          SKIP: {
              if($self->{vendor} =~ /sqlite/i) {
              isa_ok( $obj15->loader_test14, $class14 );
          }
      }
 +
 +    # rescan test
 +    SKIP: {
 +        skip $self->{skip_rels}, 4 if $self->{skip_rels};
 +
 +        my @statements_rescan = (
 +            qq{
 +                CREATE TABLE loader_test25 (
 +                    id INTEGER NOT NULL PRIMARY KEY,
 +                    loader_test2 INTEGER NOT NULL,
 +                    FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id)
 +                ) $self->{innodb}
 +            },
 +            q{ INSERT INTO loader_test25 (id,loader_test2) VALUES(123, 1) },
 +            q{ INSERT INTO loader_test25 (id,loader_test2) VALUES(321, 2) },
 +        );
 +
 +        my $dbh = $self->dbconnect(1);
 +        $dbh->do($_) for @statements_rescan;
 +        $dbh->disconnect;
 +
 +        my @new = $conn->rescan;
 +        is(scalar(@new), 1);
 +        is($new[0], 'LoaderTest25');
 +
 +        my $rsobj25   = $conn->resultset('LoaderTest25');
 +        isa_ok($rsobj25, 'DBIx::Class::ResultSet');
 +        my $obj25 = $rsobj25->find(123);
 +        isa_ok( $obj25->loader_test2, $class2);
 +    }
  }
  
  sub dbconnect {
@@@ -706,6 -697,32 +732,32 @@@ sub create 
          q{ INSERT INTO loader_test22 (parent, child) VALUES (7,11)},
          q{ INSERT INTO loader_test22 (parent, child) VALUES (11,13)},
          q{ INSERT INTO loader_test22 (parent, child) VALUES (13,17)},
+       qq{
+             CREATE TABLE loader_test25 (
+                 id1 INTEGER NOT NULL,
+                 id2 INTEGER NOT NULL,
+                 dat VARCHAR(8),
+                 PRIMARY KEY (id1,id2)
+             ) $self->{innodb}
+         },
+         q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (33,5,'x25') },
+         q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (33,7,'y25') },
+         q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (3,42,'z25') },
+         qq{
+             CREATE TABLE loader_test26 (
+                id INTEGER NOT NULL PRIMARY KEY,
+                rel1 INTEGER NOT NULL,
+                rel2 INTEGER NOT NULL,
+                FOREIGN KEY (id, rel1) REFERENCES loader_test25 (id1, id2),
+                FOREIGN KEY (id, rel2) REFERENCES loader_test25 (id1, id2)
+             ) $self->{innodb}
+         },
+         q{ INSERT INTO loader_test26 (id,rel1,rel2) VALUES (33,5,7) },
+         q{ INSERT INTO loader_test26 (id,rel1,rel2) VALUES (3,42,42) },
      );
  
      my @statements_advanced = (
          },
  
          q{ INSERT INTO loader_test15 (id,loader_test14) VALUES (1,123) },
 -   );
 +    );
  
      $self->drop_tables;
  
@@@ -830,6 -847,8 +882,8 @@@ sub drop_tables 
          loader_test18
          loader_test22
          loader_test21
+         loader_test26
+         loader_test25
      /;
  
      my @tables_advanced = qw/
          loader_test14
      /;
  
 +    my @tables_rescan = qw/ loader_test25 /;
 +
      my $drop_fk_mysql =
          q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk;};
  
          unless($self->{no_implicit_rels}) {
              $dbh->do("DROP TABLE $_") for (@tables_implicit_rels);
          }
 +        $dbh->do("DROP TABLE $_") for (@tables_rescan);
      }
      $dbh->do("DROP TABLE $_") for (@tables);
      $dbh->disconnect;