Storage holds a weakref to $schema now

Storage uses Schema to throw exceptions
Schema has "exception_action" accessor for custom exception objects and such

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 47e78cf..36f411c 100644 (file)
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -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
 
@@ -452,7 +453,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;
@@ -631,6 +632,7 @@ sub clone {
     my $new = $source->new($source);
     $clone->register_source($moniker => $new);
   }
+  $clone->storage->set_schema($clone) if $clone->storage;
   return $clone;
 }
 
@@ -670,6 +672,30 @@ sub populate {
   return @created;
 }
 
+=head2 exception_action
+
+=over 4
+
+=item Arguments: $code_reference
+
+=back
+
+If this accessor is set to a subroutine reference, it will be executed
+to handle exceptions where possible.  Can be set at either the class or
+object level.
+
+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(@_) });
+
 =head2 throw_exception
 
 =over 4
@@ -679,12 +705,14 @@ sub populate {
 =back
 
 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
-user's perspective.
+user's perspective.  If C<exception_action> is set for this schema class or
+object, the error will be thrown via that subref instead.
 
 =cut
 
 sub throw_exception {
-  my ($self) = shift;
+  my $self = shift;
+  $self->exception_action->(@_) if $self->exception_action;
   croak @_;
 }
 

diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm
index 9b3dd72..86b3a89 100644 (file)
--- a/lib/DBIx/Class/Storage.pm
+++ b/lib/DBIx/Class/Storage.pm
@@ -5,6 +5,7 @@ use strict;
 use warnings;
 
 sub new { die "Virtual method!" }
+sub set_schema { die "Virtual method!" }
 sub debug { die "Virtual method!" }
 sub debugcb { die "Virtual method!" }
 sub debugfh { die "Virtual method!" }

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 4f5b1a9..dff783b 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -10,6 +10,7 @@ use SQL::Abstract::Limit;
 use DBIx::Class::Storage::DBI::Cursor;
 use DBIx::Class::Storage::Statistics;
 use IO::File;
+use Scalar::Util qw/weaken/;
 use Carp::Clan qw/DBIx::Class/;
 BEGIN {
 
@@ -256,7 +257,7 @@ __PACKAGE__->load_components(qw/AccessorGroup/);
 
 __PACKAGE__->mk_group_accessors('simple' =>
   qw/_connect_info _dbh _sql_maker _sql_maker_opts _conn_pid _conn_tid
-     debug debugobj cursor on_connect_do transaction_depth/);
+     debug debugobj cursor on_connect_do transaction_depth schema/);
 
 =head1 NAME
 
@@ -272,10 +273,16 @@ This class represents the connection to the database
 
 =head2 new
 
+Constructor.  Only argument is the schema which instantiated us.
+
 =cut
 
 sub new {
-  my $new = bless({}, ref $_[0] || $_[0]);
+  my ($self, $schema) = @_;
+
+  my $new = bless({}, ref $self || $self);
+
+  $new->set_schema($schema);
   $new->cursor("DBIx::Class::Storage::DBI::Cursor");
   $new->transaction_depth(0);
 
@@ -298,6 +305,20 @@ sub new {
   return $new;
 }
 
+=head2 set_schema
+
+Used to reset the schema class or object which owns this
+storage object, such as after a C<clone()>.
+
+=cut
+
+sub set_schema {
+  my ($self, $schema) = @_;
+  $self->schema($schema);
+  weaken($self->{schema}) if ref $self->{schema};
+}
+
+
 =head2 throw_exception
 
 Throws an exception - croaks.
@@ -305,8 +326,10 @@ Throws an exception - croaks.
 =cut
 
 sub throw_exception {
-  my ($self, $msg) = @_;
-  croak($msg);
+  my $self = shift;
+
+  $self->schema->throw_exception(@_) if $self->schema;
+  croak @_;
 }
 
 =head2 connect_info