1 package DBIx::Class::Storage::Statistics;
5 use base qw/DBIx::Class/;
6 use DBIx::Class::_Util 'sigwarn_silencer';
9 __PACKAGE__->mk_group_accessors(simple => qw/callback _debugfh _defaulted_to_stderr silence/);
13 DBIx::Class::Storage::Statistics - SQL Statistics
19 This class is called by DBIx::Class::Storage::DBI as a means of collecting
20 statistics on its actions. Using this class alone merely prints the SQL
21 executed, the fact that it completes and begin/end notification for
24 To really use this class you should subclass it and create your own method
25 for collecting the statistics as discussed in L<DBIx::Class::Manual::Cookbook>.
33 Returns a new L<DBIx::Class::Storage::Statistics> object.
38 bless $self, (ref($_[0]) || $_[0]);
45 Sets or retrieves the filehandle used for trace/debug output. This should
46 be an IO::Handle compatible object (only the C<print> method is used). Initially
47 should be set to STDERR - although see information on the
48 L<DBIC_TRACE> environment variable.
50 As getter it will lazily open a filehandle for you if one is not already set.
58 $self->_debugfh($_[0]);
59 $self->_defaulted_to_stderr(undef);
60 } elsif (!defined($self->_debugfh())) {
62 my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
64 if (defined($debug_env) && ($debug_env =~ /=(.+)$/)) {
66 or die("Cannot open trace file $1: $!");
68 open ($fh, '>&STDERR')
69 or die("Duplication of STDERR for debug output failed (perhaps your STDERR is closed?): $!");
70 $self->_defaulted_to_stderr(1);
81 Prints the specified string to our debugging filehandle. Provided to save our
82 methods the worry of how to display the message.
86 my ($self, $msg) = @_;
88 return if $self->silence;
90 my $fh = $self->debugfh;
92 # not using 'no warnings' here because all of this can change at runtime
93 local $SIG{__WARN__} = sigwarn_silencer(qr/^Wide character in print/)
94 if $self->_defaulted_to_stderr;
96 $fh->printflush($msg);
101 Turn off all output if set to true.
105 Called when a transaction begins.
111 return if $self->callback;
113 $self->print("BEGIN WORK\n");
118 Called when a transaction is rolled back.
124 return if $self->callback;
126 $self->print("ROLLBACK\n");
131 Called when a transaction is committed.
137 return if $self->callback;
139 $self->print("COMMIT\n");
144 Called when a savepoint is created.
148 my ($self, $name) = @_;
150 return if $self->callback;
152 $self->print("SAVEPOINT $name\n");
157 Called when a savepoint is released.
161 my ($self, $name) = @_;
163 return if $self->callback;
165 $self->print("RELEASE SAVEPOINT $name\n");
170 Called when rolling back to a savepoint.
174 my ($self, $name) = @_;
176 return if $self->callback;
178 $self->print("ROLLBACK TO SAVEPOINT $name\n");
183 Called before a query is executed. The first argument is the SQL string being
184 executed and subsequent arguments are the parameters used for the query.
188 my ($self, $string, @bind) = @_;
190 my $message = "$string: ".join(', ', @bind)."\n";
192 if(defined($self->callback)) {
193 $string =~ m/^(\w+)/;
194 $self->callback->($1, $message);
198 $self->print($message);
203 Called when a query finishes executing. Has the same arguments as query_start.
207 my ($self, $string) = @_;
212 =head1 AUTHOR AND CONTRIBUTORS
214 See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
218 You may distribute this code under the same terms as Perl itself.