pod fixes
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Storage / Statistics.pm
CommitLineData
4c248161 1package DBIx::Class::Storage::Statistics;
2use strict;
aaba9524 3use warnings;
4c248161 4
3e110410 5use base qw/Class::Accessor::Grouped/;
a0024650 6use IO::File;
3e110410 7
4c248161 8__PACKAGE__->mk_group_accessors(simple => qw/callback debugfh/);
9
10=head1 NAME
11
12DBIx::Class::Storage::Statistics - SQL Statistics
13
14=head1 SYNOPSIS
15
16=head1 DESCRIPTION
17
18This class is called by DBIx::Class::Storage::DBI as a means of collecting
19statistics on it's actions. Using this class alone merely prints the SQL
20executed, the fact that it completes and begin/end notification for
21transactions.
22
23To really use this class you should subclass it and create your own method
24for collecting the statistics as discussed in L<DBIx::Class::Manual::Cookbook>.
25
26=head1 METHODS
27
28=cut
29
30=head2 new
31
32Returns a new L<DBIx::Class::Storage::Statistics> object.
33
34=cut
35sub new {
04cf5bbf 36 my $self = {};
37 bless $self, (ref($_[0]) || $_[0]);
4c248161 38
04cf5bbf 39 return $self;
4c248161 40}
41
42=head2 debugfh
43
44Sets or retrieves the filehandle used for trace/debug output. This should
45be an IO::Handle compatible object (only the C<print> method is used). Initially
46should be set to STDERR - although see information on the
6fe735fa 47L<DBIC_TRACE> environment variable.
4c248161 48
70f39278 49=head2 print
50
51Prints the specified string to our debugging filehandle, which we will attempt
52to open if we haven't yet. Provided to save our methods the worry of how
53to display the message.
54
55=cut
56sub print {
57 my ($self, $msg) = @_;
58
59 if(!defined($self->debugfh())) {
60 my $fh;
61 my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
62 || $ENV{DBIC_TRACE};
63 if (defined($debug_env) && ($debug_env =~ /=(.+)$/)) {
64 $fh = IO::File->new($1, 'w')
65 or die("Cannot open trace file $1");
66 } else {
67 $fh = IO::File->new('>&STDERR')
68 or die('Duplication of STDERR for debug output failed (perhaps your STDERR is closed?)');
69 }
70
71 $fh->autoflush();
72 $self->debugfh($fh);
73 }
74
75 $self->debugfh->print($msg);
76}
77
4c248161 78=head2 txn_begin
79
80Called when a transaction begins.
81
82=cut
83sub txn_begin {
04cf5bbf 84 my $self = shift;
d2075431 85
70f39278 86 $self->print("BEGIN WORK\n");
4c248161 87}
88
89=head2 txn_rollback
90
91Called when a transaction is rolled back.
92
93=cut
94sub txn_rollback {
04cf5bbf 95 my $self = shift;
d2075431 96
70f39278 97 $self->print("ROLLBACK\n");
4c248161 98}
99
100=head2 txn_commit
101
102Called when a transaction is committed.
103
104=cut
105sub txn_commit {
04cf5bbf 106 my $self = shift;
d2075431 107
70f39278 108 $self->print("COMMIT\n");
4c248161 109}
110
111=head2 query_start
112
113Called before a query is executed. The first argument is the SQL string being
114executed and subsequent arguments are the parameters used for the query.
115
116=cut
117sub query_start {
04cf5bbf 118 my ($self, $string, @bind) = @_;
68fcff2f 119
04cf5bbf 120 my $message = "$string: ".join(', ', @bind)."\n";
4c248161 121
04cf5bbf 122 if(defined($self->callback)) {
123 $string =~ m/^(\w+)/;
1b7fb46e 124 $self->callback->($1, $message);
04cf5bbf 125 return;
126 }
4c248161 127
70f39278 128 $self->print($message);
4c248161 129}
130
131=head2 query_end
132
133Called when a query finishes executing. Has the same arguments as query_start.
134
135=cut
136sub query_end {
04cf5bbf 137 my ($self, $string) = @_;
4c248161 138}
139
1401;
141
142=head1 AUTHORS
143
144Cory G. Watson <gphat@cpan.org>
145
146=head1 LICENSE
147
148You may distribute this code under the same license as Perl itself.
149
150=cut