X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FStatistics.pm;h=1ee5299135002a3bbfe2b1f21352037bfb76b1fd;hb=e9f71ab2a;hp=22dcadc6f21a1f3bfb1d73d980ab493d3c7588f9;hpb=dcdf7b2cd485cc015ddbfd816f6735be075c3386;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/Statistics.pm b/lib/DBIx/Class/Storage/Statistics.pm index 22dcadc..1ee5299 100644 --- a/lib/DBIx/Class/Storage/Statistics.pm +++ b/lib/DBIx/Class/Storage/Statistics.pm @@ -2,10 +2,10 @@ package DBIx::Class::Storage::Statistics; use strict; use warnings; -use base qw/Class::Accessor::Grouped/; -use IO::File; +use base qw/DBIx::Class/; +use namespace::clean; -__PACKAGE__->mk_group_accessors(simple => qw/callback debugfh silence/); +__PACKAGE__->mk_group_accessors(simple => qw/callback _debugfh silence/); =head1 NAME @@ -16,7 +16,7 @@ DBIx::Class::Storage::Statistics - SQL Statistics =head1 DESCRIPTION This class is called by DBIx::Class::Storage::DBI as a means of collecting -statistics on it's actions. Using this class alone merely prints the SQL +statistics on its actions. Using this class alone merely prints the SQL executed, the fact that it completes and begin/end notification for transactions. @@ -46,35 +46,45 @@ be an IO::Handle compatible object (only the C method is used). Initially should be set to STDERR - although see information on the L environment variable. -=head2 print - -Prints the specified string to our debugging filehandle, which we will attempt -to open if we haven't yet. Provided to save our methods the worry of how -to display the message. +As getter it will lazily open a filehandle for you if one is not already set. =cut -sub print { - my ($self, $msg) = @_; - return if $self->silence; +sub debugfh { + my $self = shift; - if(!defined($self->debugfh())) { + if (@_) { + $self->_debugfh($_[0]); + } elsif (!defined($self->_debugfh())) { my $fh; my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} || $ENV{DBIC_TRACE}; if (defined($debug_env) && ($debug_env =~ /=(.+)$/)) { - $fh = IO::File->new($1, 'w') - or die("Cannot open trace file $1"); + open ($fh, '>>', $1) + or die("Cannot open trace file $1: $!"); } else { - $fh = IO::File->new('>&STDERR') - or die('Duplication of STDERR for debug output failed (perhaps your STDERR is closed?)'); + open ($fh, '>&STDERR') + or die("Duplication of STDERR for debug output failed (perhaps your STDERR is closed?): $!"); } - $fh->autoflush(); - $self->debugfh($fh); + $self->_debugfh($fh); } - $self->debugfh->print($msg); + $self->_debugfh; +} + +=head2 print + +Prints the specified string to our debugging filehandle. Provided to save our +methods the worry of how to display the message. + +=cut +sub print { + my ($self, $msg) = @_; + + return if $self->silence; + + $self->debugfh->printflush($msg); } =head2 silence @@ -89,6 +99,8 @@ Called when a transaction begins. sub txn_begin { my $self = shift; + return if $self->callback; + $self->print("BEGIN WORK\n"); } @@ -100,6 +112,8 @@ Called when a transaction is rolled back. sub txn_rollback { my $self = shift; + return if $self->callback; + $self->print("ROLLBACK\n"); } @@ -111,6 +125,8 @@ Called when a transaction is committed. sub txn_commit { my $self = shift; + return if $self->callback; + $self->print("COMMIT\n"); } @@ -122,6 +138,8 @@ Called when a savepoint is created. sub svp_begin { my ($self, $name) = @_; + return if $self->callback; + $self->print("SAVEPOINT $name\n"); } @@ -133,7 +151,9 @@ Called when a savepoint is released. sub svp_release { my ($self, $name) = @_; - $self->print("RELEASE SAVEPOINT $name\n"); + return if $self->callback; + + $self->print("RELEASE SAVEPOINT $name\n"); } =head2 svp_rollback @@ -144,7 +164,9 @@ Called when rolling back to a savepoint. sub svp_rollback { my ($self, $name) = @_; - $self->print("ROLLBACK TO SAVEPOINT $name\n"); + return if $self->callback; + + $self->print("ROLLBACK TO SAVEPOINT $name\n"); } =head2 query_start @@ -178,12 +200,12 @@ sub query_end { 1; -=head1 AUTHORS +=head1 AUTHOR AND CONTRIBUTORS -Cory G. Watson +See L and L in DBIx::Class =head1 LICENSE -You may distribute this code under the same license as Perl itself. +You may distribute this code under the same terms as Perl itself. =cut