The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

BLBLACK / DBIx-Class-0.07999_06 / lib / DBIx / Class / Storage / Statistics.pm 

            

              
1
2
3
4
5
6
7
—
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
—
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
—
58
59
60
61
62
63
64
65
66
67
68
—
69
70
71
72
73
74
75
76
77
78
79
—
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
—
100
101
102
103
104
105
106
107
108
109
110
—
111
112
113
114
115
116
117
118
119
120

              
package DBIx::Class::Storage::Statistics;
use strict;
use warnings;
use base qw/Class::Accessor::Grouped/;
__PACKAGE__->mk_group_accessors(simple => qw/callback debugfh/);
=head1 NAME
DBIx::Class::Storage::Statistics - SQL Statistics
=head1 SYNOPSIS
=head1 DESCRIPTION
This class is called by DBIx::Class::Storage::DBI as a means of collecting
statistics on it's actions.  Using this class alone merely prints the SQL
executed, the fact that it completes and begin/end notification for
transactions.
To really use this class you should subclass it and create your own method
for collecting the statistics as discussed in L<DBIx::Class::Manual::Cookbook>.
=head1 METHODS
=cut
=head2 new
Returns a new L<DBIx::Class::Storage::Statistics> object.
=cut
sub new {
  my $self = {};
  bless $self, (ref($_[0]) || $_[0]);
  return $self;
}
=head2 debugfh
Sets or retrieves the filehandle used for trace/debug output.  This should
be an IO::Handle compatible object (only the C<print> method is used). Initially
should be set to STDERR - although see information on the
L<DBIC_TRACE> environment variable.
=head2 txn_begin
Called when a transaction begins.
=cut
sub txn_begin {
  my $self = shift;
  $self->debugfh->print("BEGIN WORK\n");
}
=head2 txn_rollback
Called when a transaction is rolled back.
=cut
sub txn_rollback {
  my $self = shift;
  $self->debugfh->print("ROLLBACK\n");
}
=head2 txn_commit
Called when a transaction is committed.
=cut
sub txn_commit {
  my $self = shift;
  $self->debugfh->print("COMMIT\n");
}
=head2 query_start
Called before a query is executed.  The first argument is the SQL string being
executed and subsequent arguments are the parameters used for the query.
=cut
sub query_start {
  my ($self, $string, @bind) = @_;
  my $message = "$string: ".join(', ', @bind)."\n";
  if(defined($self->callback)) {
    $string =~ m/^(\w+)/;
    $self->callback->($1, $message);
    return;
  }
  $self->debugfh->print($message);
}
=head2 query_end
Called when a query finishes executing.  Has the same arguments as query_start.
=cut
sub query_end {
  my ($self, $string) = @_;
}
1;
=head1 AUTHORS
Cory G. Watson <gphat@cpan.org>
=head1 LICENSE
You may distribute this code under the same license as Perl itself.
=cut