X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema.pm;h=4b945cc7aeb9c546ce5deecc1cf4c5bb1e56eab3;hb=439e2424aef332170873b12c186743f058ac781f;hp=9222f80fff5d7d6e4d2b9e8b968d3ff04c62b739;hpb=672687dbdea3bdc3c25003713f8dd459d5bea615;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 9222f80..4b945cc 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -157,9 +157,24 @@ sub _expand_relative_name {
   return $name;
 }
 
+# Finds all modules in the supplied namespace, or if omitted in the
+# namespace of $class. Untaints all findings as they can be assumed
+# to be safe
+sub _findallmod {
+  my $proto = shift;
+  my $ns = shift || ref $proto || $proto;
+
+  my @mods = Module::Find::findallmod($ns);
+
+  # try to untaint module names. mods where this fails
+  # are left alone so we don't have to change the old behavior
+  no locale; # localized \w doesn't untaint expression
+  return map { $_ =~ m/^( (?:\w+::)* \w+ )$/x ? $1 : $_ } @mods;
+}
+
 # returns a hash of $shortname => $fullname for every package
-#  found in the given namespaces ($shortname is with the $fullname's
-#  namespace stripped off)
+# found in the given namespaces ($shortname is with the $fullname's
+# namespace stripped off)
 sub _map_namespaces {
   my ($class, @namespaces) = @_;
 
@@ -168,13 +183,29 @@ sub _map_namespaces {
     push(
       @results_hash,
       map { (substr($_, length "${namespace}::"), $_) }
-      Module::Find::findallmod($namespace)
+      $class->_findallmod($namespace)
     );
   }
 
   @results_hash;
 }
 
+# returns the result_source_instance for the passed class/object,
+# or dies with an informative message (used by load_namespaces)
+sub _ns_get_rsrc_instance {
+  my $class = shift;
+  my $rs = ref ($_[0]) || $_[0];
+
+  if ($rs->can ('result_source_instance') ) {
+    return $rs->result_source_instance;
+  }
+  else {
+    $class->throw_exception (
+      "Attempt to load_namespaces() class $rs failed - are you sure this is a real Result Class?"
+    );
+  }
+}
+
 sub load_namespaces {
   my ($class, %args) = @_;
 
@@ -208,31 +239,35 @@ sub load_namespaces {
     local *Class::C3::reinitialize = sub { };
     use warnings 'redefine';
 
-    foreach my $result (keys %results) {
+    # ensure classes are loaded and fetch properly sorted classes
+    $class->ensure_class_loaded($_) foreach(values %results);
+    my @subclass_last = sort { $results{$a}->isa($results{$b}) } keys(%results);
+    
+    foreach my $result (@subclass_last) {
       my $result_class = $results{$result};
-      $class->ensure_class_loaded($result_class);
 
       my $rs_class = delete $resultsets{$result};
-      my $rs_set = $result_class->resultset_class;
+      my $rs_set = $class->_ns_get_rsrc_instance ($result_class)->resultset_class;
+      
       if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
         if($rs_class && $rs_class ne $rs_set) {
-          warn "We found ResultSet class '$rs_class' for '$result', but it seems "
+          carp "We found ResultSet class '$rs_class' for '$result', but it seems "
              . "that you had already set '$result' to use '$rs_set' instead";
         }
       }
       elsif($rs_class ||= $default_resultset_class) {
         $class->ensure_class_loaded($rs_class);
-        $result_class->resultset_class($rs_class);
+        $class->_ns_get_rsrc_instance ($result_class)->resultset_class($rs_class);
       }
 
-      my $source_name = $result_class->source_name || $result;
+      my $source_name = $class->_ns_get_rsrc_instance ($result_class)->source_name || $result;
 
       push(@to_register, [ $source_name, $result_class ]);
     }
   }
 
   foreach (sort keys %resultsets) {
-    warn "load_namespaces found ResultSet class $_ with no "
+    carp "load_namespaces found ResultSet class $_ with no "
       . 'corresponding Result class';
   }
 
@@ -310,7 +345,7 @@ sub load_classes {
     }
   } else {
     my @comp = map { substr $_, length "${class}::"  }
-                 Module::Find::findallmod($class);
+                 $class->_findallmod;
     $comps_for{$class} = \@comp;
   }
 
@@ -321,18 +356,11 @@ sub load_classes {
     foreach my $prefix (keys %comps_for) {
       foreach my $comp (@{$comps_for{$prefix}||[]}) {
         my $comp_class = "${prefix}::${comp}";
-        { # try to untaint module name. mods where this fails
-          # are left alone so we don't have to change the old behavior
-          no locale; # localized \w doesn't untaint expression
-          if ( $comp_class =~ m/^( (?:\w+::)* \w+ )$/x ) {
-            $comp_class = $1;
-          }
-        }
         $class->ensure_class_loaded($comp_class);
 
         my $snsub = $comp_class->can('source_name');
         if(! $snsub ) {
-          warn "Failed to load $comp_class. Can't find source_name method. Is $comp_class really a full DBIC result class? Fix it, move it elsewhere, or make your load_classes call more specific.";
+          carp "Failed to load $comp_class. Can't find source_name method. Is $comp_class really a full DBIC result class? Fix it, move it elsewhere, or make your load_classes call more specific.";
           next;
         }
         $comp = $snsub->($comp_class) || $comp;
@@ -471,6 +499,12 @@ Note that C<connect_info> expects an arrayref of arguments, but
 C<connect> does not. C<connect> wraps it's arguments in an arrayref
 before passing them to C<connect_info>.
 
+=head3 Overloading
+
+C<connect> is a convenience method. It is equivalent to calling
+$schema->clone->connection(@connectinfo). To write your own overloaded
+version, overload L</connection> instead.
+
 =cut
 
 sub connect { shift->clone->connection(@_) }
@@ -599,7 +633,7 @@ sub txn_do {
   $self->storage->txn_do(@_);
 }
 
-=head2 txn_scope_guard (EXPERIMENTAL)
+=head2 txn_scope_guard
 
 Runs C<txn_scope_guard> on the schema's storage. See 
 L<DBIx::Class::Storage/txn_scope_guard>.
@@ -748,6 +782,9 @@ Similar to L</connect> except sets the storage object and connection
 data in-place on the Schema class. You should probably be calling
 L</connect> to get a proper Schema object instead.
 
+=head3 Overloading
+
+Overload C<connection> to change the behaviour of C<connect>.
 
 =cut
 
@@ -978,15 +1015,17 @@ sub throw_exception {
 
 =over 4
 
-=item Arguments: $sqlt_args, $dir
+=item Arguments: \%sqlt_args, $dir
 
 =back
 
 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
 
-See L<SQL::Translator/METHODS> 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.
+See L<SQL::Translator/METHODS> 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 C<DROP TABLE> statement for each table
+created. For quoting purposes supply C<quote_table_names> and
+C<quote_field_names>.
 
 Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash 
 ref or an array ref, containing a list of source to deploy. If present, then 
@@ -1006,19 +1045,16 @@ sub deploy {
 
 =over 4
 
-=item Arguments: $rdbms_type, $sqlt_args, $dir
+=item Arguments: See L<DBIx::Class::Storage::DBI/deployment_statements>
 
 =item Return value: $listofstatements
 
 =back
 
-A convenient shortcut to storage->deployment_statements(). Returns the
-SQL statements used by L</deploy> and
-L<DBIx::Class::Schema::Storage/deploy>. C<$rdbms_type> provides the
-(optional) SQLT (not DBI) database driver name for which the SQL
-statements are produced.  If not supplied, the type is determined by
-interrogating the current connection.  The other two arguments are
-identical to those of L</deploy>.
+A convenient shortcut to
+C<< $self->storage->deployment_statements($self, @args) >>.
+Returns the SQL statements used by L</deploy> and
+L<DBIx::Class::Schema::Storage/deploy>.
 
 =cut
 
@@ -1035,42 +1071,15 @@ sub deployment_statements {
 
 =over 4
 
-=item Arguments: \@databases, $version, $directory, $preversion, $sqlt_args
+=item Arguments: See L<DBIx::Class::Storage::DBI/create_ddl_dir>
 
 =back
 
-Creates an SQL file based on the Schema, for each of the specified
-database types, in the given directory. Given a previous version number,
-this will also create a file containing the ALTER TABLE statements to
-transform the previous schema into the current one. Note that these
-statements may contain DROP TABLE or DROP COLUMN statements that can
-potentially destroy data.
+A convenient shortcut to 
+C<< $self->storage->create_ddl_dir($self, @args) >>.
 
-The file names are created using the C<ddl_filename> method below, please
-override this method in your schema if you would like a different file
-name format. For the ALTER file, the same format is used, replacing
-$version in the name with "$preversion-$version".
-
-See L<DBIx::Class::Schema/deploy> for details of $sqlt_args.
-
-If no arguments are passed, then the following default values are used:
-
-=over 4
-
-=item databases  - ['MySQL', 'SQLite', 'PostgreSQL']
-
-=item version    - $schema->schema_version
-
-=item directory  - './'
-
-=item preversion - <none>
-
-=back
-
-Note that this feature is currently EXPERIMENTAL and may not work correctly
-across all databases, or fully handle complex relationships.
-
-WARNING: Please check all SQL files created, before applying them.
+Creates an SQL file based on the Schema, for each of the specified
+database types, in the given directory.
 
 =cut
 
@@ -1244,24 +1253,33 @@ sub register_extra_source {
 sub _register_source {
   my ($self, $moniker, $source, $params) = @_;
 
+  my $orig_source = $source;
+
   $source = $source->new({ %$source, source_name => $moniker });
+  $source->schema($self);
+  weaken($source->{schema}) if ref($self);
+
+  my $rs_class = $source->result_class;
 
   my %reg = %{$self->source_registrations};
   $reg{$moniker} = $source;
   $self->source_registrations(\%reg);
 
-  $source->schema($self);
-  weaken($source->{schema}) if ref($self);
   return if ($params->{extra});
-
-  if ($source->result_class) {
-    my %map = %{$self->class_mappings};
-    if (exists $map{$source->result_class}) {
-      warn $source->result_class . ' already has a source, use register_extra_source for additional sources';
-    }
-    $map{$source->result_class} = $moniker;
-    $self->class_mappings(\%map);
+  return unless defined($rs_class) && $rs_class->can('result_source_instance');
+
+  my %map = %{$self->class_mappings};
+  if (
+    exists $map{$rs_class}
+      and
+    $map{$rs_class} ne $moniker
+      and
+    $rs_class->result_source_instance ne $orig_source
+  ) {
+    carp "$rs_class already has a source, use register_extra_source for additional sources";
   }
+  $map{$rs_class} = $moniker;
+  $self->class_mappings(\%map);
 }
 
 sub _unregister_source {
@@ -1318,7 +1336,7 @@ more information.
   sub compose_connection {
     my ($self, $target, @info) = @_;
 
-    warn "compose_connection deprecated as of 0.08000"
+    carp "compose_connection deprecated as of 0.08000"
       unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++);
 
     my $base = 'DBIx::Class::ResultSetProxy';