X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage.pm;h=34c3eac3f25f96cd9468dc4b4edb214bd07acfc6;hb=b6cd6478dc4f3fdf7a4fbee12bb40e2030571fcb;hp=a1c551e24b8757aacbb730815bf5b482b7833913;hpb=70f3927877ba6b7aac2565bc1933daaf82361308;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm index a1c551e..34c3eac 100644 --- a/lib/DBIx/Class/Storage.pm +++ b/lib/DBIx/Class/Storage.pm @@ -4,10 +4,14 @@ use strict; use warnings; use base qw/DBIx::Class/; +use mro 'c3'; -use Scalar::Util qw/weaken/; -use Carp::Clan qw/^DBIx::Class/; +use DBIx::Class::Exception; +use Scalar::Util 'weaken'; use IO::File; +use DBIx::Class::Storage::TxnScopeGuard; +use Try::Tiny; +use namespace::clean; __PACKAGE__->mk_group_accessors('simple' => qw/debug debugobj schema/); __PACKAGE__->mk_group_accessors('inherited' => 'cursor_class'); @@ -59,9 +63,22 @@ sub new { bless $new, $self; $new->set_schema($schema); - $new->debugobj(new DBIx::Class::Storage::Statistics()); - - #my $fh; + my $debugobj; + if (my $profile = $ENV{DBIC_TRACE_PROFILE}) { + require DBIx::Class::Storage::Debug::PrettyPrint; + if ($profile =~ /^\.?\//) { + require Config::Any; + my $cfg = Config::Any->load_files({ files => [$profile], use_ext => 1 }); + + my ($filename, $config) = %{$cfg->[0]}; + $debugobj = DBIx::Class::Storage::Debug::PrettyPrint->new($config) + } else { + $debugobj = DBIx::Class::Storage::Debug::PrettyPrint->new({ profile => $profile }) + } + } else { + $debugobj = DBIx::Class::Storage::Statistics->new + } + $new->debugobj($debugobj); my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} || $ENV{DBIC_TRACE}; @@ -81,7 +98,7 @@ storage object, such as during L. sub set_schema { my ($self, $schema) = @_; $self->schema($schema); - weaken($self->{schema}) if ref $self->{schema}; + weaken $self->{schema} if ref $self->{schema}; } =head2 connected @@ -118,8 +135,12 @@ Throws an exception - croaks. sub throw_exception { my $self = shift; - $self->schema->throw_exception(@_) if $self->schema; - croak @_; + if ($self->schema) { + $self->schema->throw_exception(@_); + } + else { + DBIx::Class::Exception->throw(@_); + } } =head2 txn_do @@ -152,16 +173,16 @@ For example, }; my $rs; - eval { + try { $rs = $schema->txn_do($coderef); - }; - - if ($@) { # Transaction failed + } catch { + my $error = shift; + # Transaction failed die "something terrible has happened!" # - if ($@ =~ /Rollback failed/); # Rollback failed + if ($error =~ /Rollback failed/); # Rollback failed deal_with_failed_transaction(); - } + }; In a nested transaction (calling txn_do() from within a txn_do() coderef) only the outermost transaction will issue a L, and txn_do() can be @@ -179,7 +200,8 @@ transaction failure. =cut sub txn_do { - my ($self, $coderef, @args) = @_; + my $self = shift; + my $coderef = shift; ref $coderef eq 'CODE' or $self->throw_exception ('$coderef must be a CODE reference'); @@ -189,45 +211,42 @@ sub txn_do { $self->txn_begin; # If this throws an exception, no rollback is needed my $wantarray = wantarray; # Need to save this since the context - # inside the eval{} block is independent + # inside the try{} block is independent # of the context that called txn_do() - eval { + my $args = \@_; + + try { # Need to differentiate between scalar/list context to allow for # returning a list in scalar context to get the size of the list if ($wantarray) { # list context - @return_values = $coderef->(@args); + @return_values = $coderef->(@$args); } elsif (defined $wantarray) { # scalar context - $return_value = $coderef->(@args); + $return_value = $coderef->(@$args); } else { # void context - $coderef->(@args); + $coderef->(@$args); } $self->txn_commit; - }; - - if ($@) { - my $error = $@; + } + catch { + my $error = shift; - eval { + try { $self->txn_rollback; - }; - - if ($@) { - my $rollback_error = $@; + } catch { my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION"; $self->throw_exception($error) # propagate nested rollback - if $rollback_error =~ /$exception_class/; + if $_ =~ /$exception_class/; $self->throw_exception( - "Transaction aborted: $error. Rollback failed: ${rollback_error}" + "Transaction aborted: $error. Rollback failed: $_" ); - } else { - $self->throw_exception($error); # txn failed but rollback succeeded } - } + $self->throw_exception($error); # txn failed but rollback succeeded + }; return $wantarray ? @return_values : $return_value; } @@ -247,6 +266,9 @@ sub txn_begin { die "Virtual method!" } Issues a commit of the current transaction. +It does I perform an actual storage commit unless there's a DBIx::Class +transaction currently in effect (i.e. you called L). + =cut sub txn_commit { die "Virtual method!" } @@ -261,10 +283,73 @@ which allows the rollback to propagate to the outermost transaction. sub txn_rollback { die "Virtual method!" } +=head2 svp_begin + +Arguments: $savepoint_name? + +Created a new savepoint using the name provided as argument. If no name +is provided, a random name will be used. + +=cut + +sub svp_begin { die "Virtual method!" } + +=head2 svp_release + +Arguments: $savepoint_name? + +Release the savepoint provided as argument. If none is provided, +release the savepoint created most recently. This will implicitly +release all savepoints created after the one explicitly released as well. + +=cut + +sub svp_release { die "Virtual method!" } + +=head2 svp_rollback + +Arguments: $savepoint_name? + +Rollback to the savepoint provided as argument. If none is provided, +rollback to the savepoint created most recently. This will implicitly +release all savepoints created after the savepoint we rollback to. + +=cut + +sub svp_rollback { die "Virtual method!" } + +=for comment + +=head2 txn_scope_guard + +An alternative way of transaction handling based on +L: + + my $txn_guard = $storage->txn_scope_guard; + + $row->col1("val1"); + $row->update; + + $txn_guard->commit; + +If an exception occurs, or the guard object otherwise leaves the scope +before C<< $txn_guard->commit >> is called, the transaction will be rolled +back by an explicit L call. In essence this is akin to +using a L/L pair, without having to worry +about calling L at the right places. Note that since there +is no defined code closure, there will be no retries and other magic upon +database disconnection. If you need such functionality see L. + +=cut + +sub txn_scope_guard { + return DBIx::Class::Storage::TxnScopeGuard->new($_[0]); +} + =head2 sql_maker Returns a C object - normally an object of class -C. +C. =cut @@ -281,7 +366,7 @@ shell environment. =head2 debugfh Set or retrieve the filehandle used for trace/debug output. This should be -an IO::Handle compatible ojbect (only the C method is used. Initially +an IO::Handle compatible object (only the C method is used. Initially set to be STDERR - although see information on the L environment variable. @@ -411,14 +496,29 @@ If the value is of the form C<1=/path/name> then the trace output is written to the file C. This environment variable is checked when the storage object is first -created (when you call connect on your schema). So, run-time changes -to this environment variable will not take effect unless you also +created (when you call connect on your schema). So, run-time changes +to this environment variable will not take effect unless you also re-connect on your schema. +=head2 DBIC_TRACE_PROFILE + +If C is set, L +will be used to format the output from C. The value it +is set to is the C that it will be used. If the value is a +filename the file is read with L and the results are +used as the configuration for tracing. See L +for what that structure should look like. + + =head2 DBIX_CLASS_STORAGE_DBI_DEBUG Old name for DBIC_TRACE +=head1 SEE ALSO + +L - reference storage implementation using +SQL::Abstract and DBI. + =head1 AUTHORS Matt S. Trout