moved from trunk
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / Statistics.pm
CommitLineData
4c248161 1package DBIx::Class::Storage::Statistics;
2use strict;
aaba9524 3use warnings;
4c248161 4
5use base qw/DBIx::Class::AccessorGroup Class::Data::Accessor/;
6__PACKAGE__->mk_group_accessors(simple => qw/callback debugfh/);
7
8=head1 NAME
9
10DBIx::Class::Storage::Statistics - SQL Statistics
11
12=head1 SYNOPSIS
13
14=head1 DESCRIPTION
15
16This class is called by DBIx::Class::Storage::DBI as a means of collecting
17statistics on it's actions. Using this class alone merely prints the SQL
18executed, the fact that it completes and begin/end notification for
19transactions.
20
21To really use this class you should subclass it and create your own method
22for collecting the statistics as discussed in L<DBIx::Class::Manual::Cookbook>.
23
24=head1 METHODS
25
26=cut
27
28=head2 new
29
30Returns a new L<DBIx::Class::Storage::Statistics> object.
31
32=cut
33sub new {
04cf5bbf 34 my $self = {};
35 bless $self, (ref($_[0]) || $_[0]);
4c248161 36
04cf5bbf 37 return $self;
4c248161 38}
39
40=head2 debugfh
41
42Sets or retrieves the filehandle used for trace/debug output. This should
43be an IO::Handle compatible object (only the C<print> method is used). Initially
44should be set to STDERR - although see information on the
6fe735fa 45L<DBIC_TRACE> environment variable.
4c248161 46
47=head2 txn_begin
48
49Called when a transaction begins.
50
51=cut
52sub txn_begin {
04cf5bbf 53 my $self = shift;
d2075431 54
04cf5bbf 55 $self->debugfh->print("BEGIN WORK\n");
4c248161 56}
57
58=head2 txn_rollback
59
60Called when a transaction is rolled back.
61
62=cut
63sub txn_rollback {
04cf5bbf 64 my $self = shift;
d2075431 65
04cf5bbf 66 $self->debugfh->print("ROLLBACK\n");
4c248161 67}
68
69=head2 txn_commit
70
71Called when a transaction is committed.
72
73=cut
74sub txn_commit {
04cf5bbf 75 my $self = shift;
d2075431 76
04cf5bbf 77 $self->debugfh->print("COMMIT\n");
4c248161 78}
79
80=head2 query_start
81
82Called before a query is executed. The first argument is the SQL string being
83executed and subsequent arguments are the parameters used for the query.
84
85=cut
86sub query_start {
04cf5bbf 87 my ($self, $string, @bind) = @_;
68fcff2f 88
04cf5bbf 89 my $message = "$string: ".join(', ', @bind)."\n";
4c248161 90
04cf5bbf 91 if(defined($self->callback)) {
92 $string =~ m/^(\w+)/;
1b7fb46e 93 $self->callback->($1, $message);
04cf5bbf 94 return;
95 }
4c248161 96
04cf5bbf 97 $self->debugfh->print($message);
4c248161 98}
99
100=head2 query_end
101
102Called when a query finishes executing. Has the same arguments as query_start.
103
104=cut
105sub query_end {
04cf5bbf 106 my ($self, $string) = @_;
4c248161 107}
108
1091;
110
111=head1 AUTHORS
112
113Cory G. Watson <gphat@cpan.org>
114
115=head1 LICENSE
116
117You may distribute this code under the same license as Perl itself.
118
119=cut