proxy result_class, and fix load_namespace to use it correctly
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Schema.pm
index 9f973a9..0ec1897 100644 (file)
@@ -12,6 +12,7 @@ __PACKAGE__->mk_classdata('class_mappings' => {});
 __PACKAGE__->mk_classdata('source_registrations' => {});
 __PACKAGE__->mk_classdata('storage_type' => '::DBI');
 __PACKAGE__->mk_classdata('storage');
+__PACKAGE__->mk_classdata('exception_action');
 
 =head1 NAME
 
@@ -282,83 +283,147 @@ sub load_classes {
 
 =over 4
 
-=item Arguments: None
+=item Arguments: %options?
 
 =back
 
 This is an alternative to L</load_classes> above which assumes an alternative
-layout for automatic class loading.  This variant takes no arguments.  It
-assumes that all ResultSource classes to be loaded are underneath a sub-
-namespace of the schema called "ResultSource", and any corresponding
-ResultSet classes to be underneath a sub-namespace of the schema called
-"ResultSet".
+layout for automatic class loading.  It assumes that all ResultSource classes
+to be loaded are underneath a sub-namespace of the schema called
+"ResultSource", any corresponding ResultSet classes to be underneath a
+sub-namespace of the schema called "ResultSet", and any corresponing
+Result classes to be underneath a sub-namespace of the schema called "Result".
 
-Any missing ResultSet definitions will be created in memory as basic
-inheritors of L<DBIx::Class::ResultSet>.  You don't need to explicitly
-specify the result_class of the sources unless you wish to override
-the naming convention above.
+All of those sub-namespaces are configurable if you don't like the defaults,
+via the options C<resultsource_namespace>, C<resultset_namespace>, and
+C<result_namespace>, respectively.
+
+If (and only if) you specify the option C<default_resultset_base>, any found
+ResultSource classes that have no manually-created corresponding ResultSet
+class will have one created for them in memory in the C<resultset_namespace>,
+based on C<default_resultset_base>.
+
+All of the namespace and classname options to this method are relative to
+the schema classname by default.  To specify a fully-qualified name, prefix
+it with a literal C<+>.
 
 This method requires L<Module::Find> to be installed on the system.
 
 Example:
 
-  My::Schema->load_namespaces;
-  # loads My::Schema::ResultSource::CD, My::Schema::ResultSource::Artist,
+  # load My::Schema::ResultSource::CD, My::Schema::ResultSource::Artist,
   #    My::Schema::ResultSet::CD, etc...
+  My::Schema->load_namespaces;
+
+  # Override everything...
+  My::Schema->load_namespaces(
+    resultsource_namespace => 'RSources',
+    resultset_namespace => 'RSets',
+    result_namespace => 'Results',
+    default_resultset_base => 'RSetBase',
+  );
+  # ... and if there is a My::Schema::RSources::Foo, but no matching
+  #   My::Schema::RSets::Foo, then My::Schema::RSets::Foo will be created
+  #   for you in memory, based on My::Schema::RSetBase
+
+  # Put things in other namespaces
+  My::Schema->load_namespaces(
+    resultsource_namespace => '+Some::Place::RSources',
+    resultset_namespace => '+Another::Place::RSets',
+    result_namespace => '+Crazy::Stuff::Results',
+    default_resultset_base => '+You::Never::Know::RSetBase',
+  );
+
 
 =cut
 
 sub load_namespaces {
-  my ($class) = @_;
+  my ($class, %args) = @_;
 
-  my $source_namespace = $class . '::ResultSource';
-  my $resultset_namespace = $class . '::ResultSet';
+  my $resultsource_namespace = $args{resultsource_namespace} || 'ResultSource';
+  my $resultset_namespace    = $args{resultset_namespace}    || 'ResultSet';
+  my $result_namespace       = $args{result_namespace}       || 'Result';
+  my $default_resultset_base = $args{default_resultset_base};
+
+  foreach ($resultsource_namespace, $resultset_namespace,
+           $result_namespace,       $default_resultset_base) {
+    next if !$_;
+    $_ = $class . '::' . $_ if !s/^\+//;
+  }
 
   eval "require Module::Find";
   $class->throw_exception("Couldn't load Module::Find ($@)") if $@;
 
-  my %sources = map { (substr($_, length "${source_namespace}::"), $_) }
-      Module::Find::findallmod($source_namespace);
+  my %sources = map { (substr($_, length "${resultsource_namespace}::"), $_) }
+      Module::Find::findallmod($resultsource_namespace);
 
   my %resultsets = map { (substr($_, length "${resultset_namespace}::"), $_) }
       Module::Find::findallmod($resultset_namespace);
 
+  my %results = map { (substr($_, length "${result_namespace}::"), $_) }
+      Module::Find::findallmod($result_namespace);
+
   my @to_register;
   {
     no warnings qw/redefine/;
     local *Class::C3::reinitialize = sub { };
+    use warnings qw/redefine/;
+
     foreach my $source (keys %sources) {
       my $source_class = $sources{$source};
       $class->ensure_class_loaded($source_class);
       $source_class->source_name($source) unless $source_class->source_name;
-      unless($source_class->resultset_class) {
-        if(my $rs_class = delete $resultsets{$source}) {
+
+      my $rs_class = delete $resultsets{$source};
+      my $rs_set = $source_class->resultset_class;
+      if(!$rs_set || $rs_set eq 'DBIx::Class::ResultSet') {
+        if($rs_class) {
           $class->ensure_class_loaded($rs_class);
           $source_class->resultset_class($rs_class);
         }
-        else {
-          require DBIx::Class::ResultSet;
-          my $rs_class = "${class}::ResultSet::$source";
-          @{"$rs_class::ISA"} = 'DBIx::Class::ResultSet';
+        elsif($default_resultset_base) {
+          $class->ensure_class_loaded($default_resultset_base);
+          $rs_class = "$resultset_namespace\::$source";
+          { no strict qw/refs/; @{"$rs_class\::ISA"} = ($default_resultset_base); }
           $source_class->resultset_class($rs_class);
         }
       }
+      elsif($rs_set && $rs_class) {
+        warn "We found ResultSet class '$rs_class' for '$source', but it seems "
+           . "that you had already set '$source' to use '$rs_set' instead";
+      }
+
+      my $r_class = delete $results{$source};
+      if($r_class) {
+        my $r_set = $source_class->result_class;
+        if(!$r_set || $r_set eq $sources{$source}) {
+          $class->ensure_class_loaded($r_class);
+          $source_class->result_class($r_class);
+        }
+        else {
+          warn "We found Result class '$r_class' for '$source', but it seems "
+             . "that you had already set '$source' to use '$r_set' instead";
+        }
+      }
 
       push(@to_register, [ $source_class->source_name, $source_class ]);
     }
   }
 
-  foreach (keys %resultsets) {
-    warn "load_namespaces found ResultSet $_ with no "
+  foreach (sort keys %resultsets) {
+    warn "load_namespaces found ResultSet class $_ with no "
+      . 'corresponding ResultSource';
+  }
+
+  foreach (sort keys %results) {
+    warn "load_namespaces found Result class $_ with no "
       . 'corresponding ResultSource';
   }
 
   Class::C3->reinitialize;
+  $class->register_class(@$_) for (@to_register);
 
-  foreach my $to (@to_register) {
-    $class->register_class(@$to);
-    #  if $class->can('result_source_instance');
-  }
+  return;
 }
 
 =head2 compose_connection
@@ -535,7 +600,7 @@ sub connection {
   $self->throw_exception(
     "No arguments to load_classes and couldn't load ${storage_class} ($@)"
   ) if $@;
-  my $storage = $storage_class->new;
+  my $storage = $storage_class->new($self);
   $storage->connect_info(\@info);
   $self->storage($storage);
   return $self;
@@ -714,6 +779,7 @@ sub clone {
     my $new = $source->new($source);
     $clone->register_source($moniker => $new);
   }
+  $clone->storage->set_schema($clone) if $clone->storage;
   return $clone;
 }
 
@@ -753,6 +819,38 @@ sub populate {
   return @created;
 }
 
+=head2 exception_action
+
+=over 4
+
+=item Arguments: $code_reference
+
+=back
+
+If C<exception_action> is set for this class/object, L</throw_exception>
+will prefer to call this code reference with the exception as an argument,
+rather than its normal <croak> action.
+
+Your subroutine should probably just wrap the error in the exception
+object/class of your choosing and rethrow.  If, against all sage advice,
+you'd like your C<exception_action> to suppress a particular exception
+completely, simply have it return true.
+
+Example:
+
+   package My::Schema;
+   use base qw/DBIx::Class::Schema/;
+   use My::ExceptionClass;
+   __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
+   __PACKAGE__->load_classes;
+
+   # or:
+   my $schema_obj = My::Schema->connect( .... );
+   $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
+
+   # suppress all exceptions, like a moron:
+   $schema_obj->exception_action(sub { 1 });
+
 =head2 throw_exception
 
 =over 4
@@ -762,13 +860,14 @@ sub populate {
 =back
 
 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
-user's perspective.
+user's perspective.  See L</exception_action> for details on overriding
+this method's behavior.
 
 =cut
 
 sub throw_exception {
-  my ($self) = shift;
-  croak @_;
+  my $self = shift;
+  croak @_ if !$self->exception_action || !$self->exception_action->(@_);
 }
 
 =head2 deploy (EXPERIMENTAL)