1 package DBIx::Class::Storage::Statistics;
6 use DBIx::Class::_Util qw(sigwarn_silencer qsub);
14 DBIx::Class::Storage::Statistics - SQL Statistics
20 This class is called by DBIx::Class::Storage::DBI as a means of collecting
21 statistics on its actions. Using this class alone merely prints the SQL
22 executed, the fact that it completes and begin/end notification for
25 To really use this class you should subclass it and create your own method
26 for collecting the statistics as discussed in L<DBIx::Class::Manual::Cookbook>.
32 Returns a new L<DBIx::Class::Storage::Statistics> object.
36 Sets or retrieves the filehandle used for trace/debug output. This should
37 be an L<IO::Handle> compatible object (only the
38 L<< print|IO::Handle/METHODS >> method is used). By
39 default it is initially set to STDERR - although see discussion of the
40 L<DBIC_TRACE|DBIx::Class::Storage/DBIC_TRACE> environment variable.
42 Invoked as a getter it will lazily open a filehandle and set it to
43 L<< autoflush|perlvar/HANDLE->autoflush( EXPR ) >> (if one is not
48 # FIXME - there ought to be a way to fold this into _debugfh itself
49 # having the undef re-trigger the builder (or better yet a default
50 # which can be folded in as a qsub)
54 return $self->_debugfh(@_) if @_;
55 $self->_debugfh || $self->_build_debugfh;
61 trigger => qsub '$_[0]->_defaulted_to_stderr(undef)',
62 builder => '_build_debugfh',
68 my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} || $ENV{DBIC_TRACE};
70 if (defined($debug_env) and ($debug_env =~ /=(.+)$/)) {
72 or die("Cannot open trace file $1: $!\n");
75 open ($fh, '>&STDERR')
76 or die("Duplication of STDERR for debug output failed (perhaps your STDERR is closed?): $!\n");
77 $_[0]->_defaulted_to_stderr(1);
85 has [qw(_defaulted_to_stderr silence callback)] => (
91 Prints the specified string to our debugging filehandle. Provided to save our
92 methods the worry of how to display the message.
96 my ($self, $msg) = @_;
98 return if $self->silence;
100 my $fh = $self->debugfh;
102 # not using 'no warnings' here because all of this can change at runtime
103 local $SIG{__WARN__} = sigwarn_silencer(qr/^Wide character in print/)
104 if $self->_defaulted_to_stderr;
111 Turn off all output if set to true.
115 Called when a transaction begins.
121 return if $self->callback;
123 $self->print("BEGIN WORK\n");
128 Called when a transaction is rolled back.
134 return if $self->callback;
136 $self->print("ROLLBACK\n");
141 Called when a transaction is committed.
147 return if $self->callback;
149 $self->print("COMMIT\n");
154 Called when a savepoint is created.
158 my ($self, $name) = @_;
160 return if $self->callback;
162 $self->print("SAVEPOINT $name\n");
167 Called when a savepoint is released.
171 my ($self, $name) = @_;
173 return if $self->callback;
175 $self->print("RELEASE SAVEPOINT $name\n");
180 Called when rolling back to a savepoint.
184 my ($self, $name) = @_;
186 return if $self->callback;
188 $self->print("ROLLBACK TO SAVEPOINT $name\n");
193 Called before a query is executed. The first argument is the SQL string being
194 executed and subsequent arguments are the parameters used for the query.
198 my ($self, $string, @bind) = @_;
200 my $message = "$string: ".join(', ', @bind)."\n";
202 if(defined($self->callback)) {
203 $string =~ m/^(\w+)/;
204 $self->callback->($1, $message);
208 $self->print($message);
213 Called when a query finishes executing. Has the same arguments as query_start.
218 my ($self, $string) = @_;
221 =head1 FURTHER QUESTIONS?
223 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
225 =head1 COPYRIGHT AND LICENSE
227 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
228 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
229 redistribute it and/or modify it under the same terms as the
230 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.