X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FParser%2FDBIx%2FClass.pm;h=14812ac939da820a309317ba36ebce8e56e3494d;hb=f4dc39d649672ff4452cf827ca204a1e937bc8b7;hp=3af0d0476845a83b5a35a3a16d8ae0f98dee94e6;hpb=10e3756737972e77ba1eb1dd00b28bce06543d7e;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm
index 3af0d04..14812ac 100644
--- a/lib/SQL/Translator/Parser/DBIx/Class.pm
+++ b/lib/SQL/Translator/Parser/DBIx/Class.pm
@@ -15,9 +15,9 @@ $DEBUG = 0 unless defined $DEBUG;
 use Exporter;
 use SQL::Translator::Utils qw(debug normalize_name);
 use DBIx::Class::Carp qw/^SQL::Translator|^DBIx::Class|^Try::Tiny/;
-use DBIx::Class::Exception;
+use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch bag_eq );
+use Class::C3::Componentised;
 use Scalar::Util 'blessed';
-use Try::Tiny;
 use namespace::clean;
 
 use base qw(Exporter);
@@ -53,8 +53,12 @@ sub parse {
     DBIx::Class::Exception->throw('No DBIx::Class::Schema') unless ($dbicschema);
 
     if (!ref $dbicschema) {
-      eval "require $dbicschema"
-        or DBIx::Class::Exception->throw("Can't load $dbicschema: $@");
+      dbic_internal_try {
+        Class::C3::Componentised->ensure_class_loaded($dbicschema)
+      }
+      dbic_internal_catch {
+        DBIx::Class::Exception->throw("Can't load $dbicschema: $_");
+      }
     }
 
     if (
@@ -122,6 +126,10 @@ sub parse {
                                        name => $table_name,
                                        type => 'TABLE',
                                        );
+
+        my $ci = $source->columns_info;
+
+        # same order as add_columns
         foreach my $col ($source->columns)
         {
             # assuming column_info in dbic is the same as DBI (?)
@@ -132,7 +140,7 @@ sub parse {
               is_auto_increment => 0,
               is_foreign_key => 0,
               is_nullable => 0,
-              %{$source->column_info($col)}
+              %{$ci->{$col} || {}}
             );
             if ($colinfo{is_nullable}) {
               $colinfo{default} = '' unless exists $colinfo{default};
@@ -147,13 +155,11 @@ sub parse {
 
         my %unique_constraints = $source->unique_constraints;
         foreach my $uniq (sort keys %unique_constraints) {
-            if (!$source->_compare_relationship_keys($unique_constraints{$uniq}, \@primary)) {
-                $table->add_constraint(
-                            type             => 'unique',
-                            name             => $uniq,
-                            fields           => $unique_constraints{$uniq}
-                );
-            }
+            $table->add_constraint(
+                type             => 'unique',
+                name             => $uniq,
+                fields           => $unique_constraints{$uniq}
+            ) unless bag_eq( \@primary, $unique_constraints{$uniq} );
         }
 
         my @rels = $source->relationships();
@@ -169,9 +175,14 @@ sub parse {
             my $rel_info = $source->relationship_info($rel);
 
             # Ignore any rel cond that isn't a straight hash
+            #
+            # FIXME - this can be done *WAY* better via the recolcond resolver
+            # but no time to think through the implications for deploy() at
+            # the moment. Grep for {identity_map_matches_condition} for ideas
+            # how to improve this, and the /^\w+\.(\w+)$/ crap below
             next unless ref $rel_info->{cond} eq 'HASH';
 
-            my $relsource = try { $source->related_source($rel) };
+            my $relsource = dbic_internal_try { $source->related_source($rel) };
             unless ($relsource) {
               carp "Ignoring relationship '$rel' on '$moniker' - related resultsource '$rel_info->{class}' is not registered with this schema\n";
               next;
@@ -219,12 +230,12 @@ sub parse {
             # this is supposed to indicate a has_one/might_have...
             # where's the introspection!!?? :)
             else {
-                $fk_constraint = not $source->_compare_relationship_keys(\@keys, \@primary);
+                $fk_constraint = ! bag_eq( \@keys, \@primary );
             }
 
-            my ($otherrelname, $otherrelationship) = %{ $source->reverse_relationship_info($rel) };
 
             my $cascade;
+            CASCADE_TYPE:
             for my $c (qw/delete update/) {
                 if (exists $rel_info->{attrs}{"on_$c"}) {
                     if ($fk_constraint) {
@@ -235,8 +246,16 @@ sub parse {
                             . "If you are sure that SQLT must generate a constraint for this relationship, add 'is_foreign_key_constraint => 1' to the attributes.\n";
                     }
                 }
-                elsif (defined $otherrelationship and $otherrelationship->{attrs}{$c eq 'update' ? 'cascade_copy' : 'cascade_delete'}) {
-                    $cascade->{$c} = 'CASCADE';
+                else {
+                  for my $revrelinfo (values %{ $source->reverse_relationship_info($rel) } ) {
+                    ( ( $cascade->{$c} = 'CASCADE' ), next CASCADE_TYPE ) if (
+                      $revrelinfo->{attrs}
+                                  ->{ ($c eq 'update')
+                                      ? 'cascade_copy'
+                                      : 'cascade_delete'
+                                    }
+                    );
+                  }
                 }
             }
 
@@ -528,12 +547,13 @@ Limit the amount of parsed sources by supplying an explicit list of source names
 
 L<SQL::Translator>, L<DBIx::Class::Schema>
 
-=head1 AUTHORS
-
-See L<DBIx::Class/CONTRIBUTORS>.
+=head1 FURTHER QUESTIONS?
 
-=head1 LICENSE
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 
-You may distribute this code under the same terms as Perl itself.
+=head1 COPYRIGHT AND LICENSE
 
-=cut
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.