X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema.pm;h=9357566e2b49f5d7fe0e91a2556d2bc43e2ce6e0;hb=db5dc23362a8bdd86013192d0561399407abf06c;hp=ff5c868ac5e10db84b9847a3e76100bebde448d1;hpb=c0f61310b99afbd58564d971aaea89bc196172b5;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index ff5c868..9357566 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -4,6 +4,7 @@ use strict; use warnings; use Carp::Clan qw/^DBIx::Class/; +use Scalar::Util qw/weaken/; use base qw/DBIx::Class/; @@ -11,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 @@ -94,6 +96,7 @@ sub register_source { $reg{$moniker} = $source; $self->source_registrations(\%reg); $source->schema($self); + weaken($source->{schema}) if ref($self); if ($source->result_class) { my %map = %{$self->class_mappings}; $map{$source->result_class} = $moniker; @@ -261,13 +264,7 @@ sub load_classes { foreach my $prefix (keys %comps_for) { foreach my $comp (@{$comps_for{$prefix}||[]}) { my $comp_class = "${prefix}::${comp}"; - eval "use $comp_class"; # If it fails, assume the user fixed it - if ($@) { - $comp_class =~ s/::/\//g; - die $@ unless $@ =~ /Can't locate.+$comp_class\.pm\sin\s\@INC/; - warn $@ if $@; - } - + $class->ensure_class_loaded($comp_class); $comp_class->source_name($comp) unless $comp_class->source_name; push(@to_register, [ $comp_class->source_name, $comp_class ]); @@ -394,6 +391,8 @@ sub compose_namespace { $target_class => $source->result_class, ($base ? $base : ()) ); $source->result_class($target_class); + $target_class->result_source_instance($source) + if $target_class->can('result_source_instance'); } } Class::C3->reinitialize(); @@ -454,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; @@ -526,12 +525,11 @@ exception) an exception is thrown that includes a "Rollback failed" message. For example, my $author_rs = $schema->resultset('Author')->find(1); + my @titles = qw/Night Day It/; my $coderef = sub { - my ($author, @titles) = @_; - # If any one of these fails, the entire transaction fails - $author->create_related('books', { + $author_rs->create_related('books', { title => $_ }) foreach (@titles); @@ -540,16 +538,14 @@ For example, my $rs; eval { - $rs = $schema->txn_do($coderef, $author_rs, qw/Night Day It/); + $rs = $schema->txn_do($coderef); }; - if ($@) { - my $error = $@; - if ($error =~ /Rollback failed/) { - die "something terrible has happened!"; - } else { - deal_with_failed_transaction(); - } + if ($@) { # Transaction failed + die "something terrible has happened!" # + if ($@ =~ /Rollback failed/); # Rollback failed + + deal_with_failed_transaction(); } In a nested transaction (calling txn_do() from within a txn_do() coderef) only @@ -562,8 +558,8 @@ context and it will behave as expected. sub txn_do { my ($self, $coderef, @args) = @_; - ref $self or $self->throw_exception - ('Cannot execute txn_do as a class method'); + $self->storage or $self->throw_exception + ('txn_do called on $schema without storage'); ref $coderef eq 'CODE' or $self->throw_exception ('$coderef must be a CODE reference'); @@ -636,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; } @@ -675,6 +672,38 @@ sub populate { return @created; } +=head2 exception_action + +=over 4 + +=item Arguments: $code_reference + +=back + +If C is set for this class/object, L +will prefer to call this code reference with the exception as an argument, +rather than its normal 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 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 @@ -684,13 +713,14 @@ sub populate { =back Throws an exception. Defaults to using L to report errors from -user's perspective. +user's perspective. See L 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) @@ -706,6 +736,10 @@ Attempts to deploy the schema to the current storage using L. Note that this feature is currently EXPERIMENTAL and may not work correctly across all databases, or fully handle complex relationships. +See L 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. + =cut sub deploy { @@ -738,12 +772,21 @@ sub create_ddl_dir $self->storage->create_ddl_dir($self, @_); } +=head2 ddl_filename (EXPERIMENTAL) + + my $filename = $table->ddl_filename($type, $dir, $version) + +Creates a filename for a SQL file based on the table class name. Not +intended for direct end user use. + +=cut + sub ddl_filename { my ($self, $type, $dir, $version) = @_; my $filename = ref($self); - $filename =~ s/^.*:://; + $filename =~ s/::/-/; $filename = "$dir$filename-$version-$type.sql"; return $filename;