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