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.
51 Prints the specified string to our debugging filehandle, which we will attempt
52 to open if we haven't yet. Provided to save our methods the worry of how
53 to display the message.
57 my ($self, $msg) = @_;
59 return if $self->silence;
61 if(!defined($self->debugfh())) {
63 my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
65 if (defined($debug_env) && ($debug_env =~ /=(.+)$/)) {
66 $fh = IO::File->new($1, 'w')
67 or die("Cannot open trace file $1");
69 $fh = IO::File->new('>&STDERR')
70 or die('Duplication of STDERR for debug output failed (perhaps your STDERR is closed?)');
77 $self->debugfh->print($msg);
82 Turn off all output if set to true.
86 Called when a transaction begins.
92 return if $self->callback;
94 $self->print("BEGIN WORK\n");
99 Called when a transaction is rolled back.
105 return if $self->callback;
107 $self->print("ROLLBACK\n");
112 Called when a transaction is committed.
118 return if $self->callback;
120 $self->print("COMMIT\n");
125 Called when a savepoint is created.
129 my ($self, $name) = @_;
131 return if $self->callback;
133 $self->print("SAVEPOINT $name\n");
138 Called when a savepoint is released.
142 my ($self, $name) = @_;
144 return if $self->callback;
146 $self->print("RELEASE SAVEPOINT $name\n");
151 Called when rolling back to a savepoint.
155 my ($self, $name) = @_;
157 return if $self->callback;
159 $self->print("ROLLBACK TO SAVEPOINT $name\n");
164 Called before a query is executed. The first argument is the SQL string being
165 executed and subsequent arguments are the parameters used for the query.
169 my ($self, $string, @bind) = @_;
171 my $message = "$string: ".join(', ', @bind)."\n";
173 if(defined($self->callback)) {
174 $string =~ m/^(\w+)/;
175 $self->callback->($1, $message);
179 $self->print($message);
184 Called when a query finishes executing. Has the same arguments as query_start.
188 my ($self, $string) = @_;
195 Cory G. Watson <gphat@cpan.org>
199 You may distribute this code under the same license as Perl itself.