1 package DBIx::Class::Storage::Statistics;
5 use base qw/DBIx::Class/;
8 __PACKAGE__->mk_group_accessors(simple => qw/callback _debugfh silence/);
12 DBIx::Class::Storage::Statistics - SQL Statistics
18 This class is called by DBIx::Class::Storage::DBI as a means of collecting
19 statistics on its actions. Using this class alone merely prints the SQL
20 executed, the fact that it completes and begin/end notification for
23 To really use this class you should subclass it and create your own method
24 for collecting the statistics as discussed in L<DBIx::Class::Manual::Cookbook>.
32 Returns a new L<DBIx::Class::Storage::Statistics> object.
37 bless $self, (ref($_[0]) || $_[0]);
44 Sets or retrieves the filehandle used for trace/debug output. This should
45 be an IO::Handle compatible object (only the C<print> method is used). Initially
46 should be set to STDERR - although see information on the
47 L<DBIC_TRACE> environment variable.
49 As getter it will lazily open a filehandle for you if one is not already set.
57 $self->_debugfh($_[0]);
58 } elsif (!defined($self->_debugfh())) {
60 my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
62 if (defined($debug_env) && ($debug_env =~ /=(.+)$/)) {
63 $fh = IO::File->new($1, 'w')
64 or die("Cannot open trace file $1");
66 $fh = IO::File->new('>&STDERR')
67 or die('Duplication of STDERR for debug output failed (perhaps your STDERR is closed?)');
79 Prints the specified string to our debugging filehandle. Provided to save our
80 methods the worry of how to display the message.
84 my ($self, $msg) = @_;
86 return if $self->silence;
88 $self->debugfh->print($msg);
93 Turn off all output if set to true.
97 Called when a transaction begins.
103 return if $self->callback;
105 $self->print("BEGIN WORK\n");
110 Called when a transaction is rolled back.
116 return if $self->callback;
118 $self->print("ROLLBACK\n");
123 Called when a transaction is committed.
129 return if $self->callback;
131 $self->print("COMMIT\n");
136 Called when a savepoint is created.
140 my ($self, $name) = @_;
142 return if $self->callback;
144 $self->print("SAVEPOINT $name\n");
149 Called when a savepoint is released.
153 my ($self, $name) = @_;
155 return if $self->callback;
157 $self->print("RELEASE SAVEPOINT $name\n");
162 Called when rolling back to a savepoint.
166 my ($self, $name) = @_;
168 return if $self->callback;
170 $self->print("ROLLBACK TO SAVEPOINT $name\n");
175 Called before a query is executed. The first argument is the SQL string being
176 executed and subsequent arguments are the parameters used for the query.
180 my ($self, $string, @bind) = @_;
182 my $message = "$string: ".join(', ', @bind)."\n";
184 if(defined($self->callback)) {
185 $string =~ m/^(\w+)/;
186 $self->callback->($1, $message);
190 $self->print($message);
195 Called when a query finishes executing. Has the same arguments as query_start.
199 my ($self, $string) = @_;
206 Cory G. Watson <gphat@cpan.org>
210 You may distribute this code under the same license as Perl itself.