Profile: /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Storage/Statistics.pm

File	/wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Storage/Statistics.pm
Statements Executed	17
Total Time	0.000595 seconds

Subroutines — ordered by exclusive time
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	6.4e-5	6.4e-5	DBIx::Class::Storage::Statistics::	new
0	0	0	0	0	DBIx::Class::Storage::Statistics::	BEGIN
0	0	0	0	0	DBIx::Class::Storage::Statistics::	print
0	0	0	0	0	DBIx::Class::Storage::Statistics::	query_end
0	0	0	0	0	DBIx::Class::Storage::Statistics::	query_start
0	0	0	0	0	DBIx::Class::Storage::Statistics::	txn_begin
0	0	0	0	0	DBIx::Class::Storage::Statistics::	txn_commit
0	0	0	0	0	DBIx::Class::Storage::Statistics::	txn_rollback

Line	Stmts.	Exclusive Time	Avg.	Code
1				package DBIx::Class::Storage::Statistics;
2	3	3.3e-5	1.1e-5	use strict; # spent 10µs making 1 call to strict::import
3	3	3.2e-5	1.1e-5	use warnings; # spent 39µs making 1 call to warnings::import
4
5	3	2.7e-5	9.0e-6	use base qw/Class::Accessor::Grouped/; # spent 75µs making 1 call to base::import
6	3	0.00047	0.00016	use IO::File; # spent 216µs making 1 call to Exporter::import
7
8	1	1.4e-5	1.4e-5	__PACKAGE__->mk_group_accessors(simple => qw/callback debugfh/); # spent 299µs making 1 call to Class::Accessor::Grouped::mk_group_accessors
9
10				=head1 NAME
11
12				DBIx::Class::Storage::Statistics - SQL Statistics
13
14				=head1 SYNOPSIS
15
16				=head1 DESCRIPTION
17
18				This class is called by DBIx::Class::Storage::DBI as a means of collecting
19				statistics on it's actions. Using this class alone merely prints the SQL
20				executed, the fact that it completes and begin/end notification for
21				transactions.
22
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>.
25
26				=head1 METHODS
27
28				=cut
29
30				=head2 new
31
32				Returns a new L<DBIx::Class::Storage::Statistics> object.
33
34				=cut
35				# spent 64µs within DBIx::Class::Storage::Statistics::new which was called # once (64µs+0) by DBIx::Class::Storage::new at line 62 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Storage.pm sub new {
36	3	1.5e-5	5.0e-6	my $self = {};
37				bless $self, (ref($_[0]) \|\| $_[0]);
38
39				return $self;
40				}
41
42				=head2 debugfh
43
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.
48
49				=head2 print
50
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.
54
55				=cut
56				sub 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
78				=head2 txn_begin
79
80				Called when a transaction begins.
81
82				=cut
83				sub txn_begin {
84				my $self = shift;
85
86				$self->print("BEGIN WORK\n");
87				}
88
89				=head2 txn_rollback
90
91				Called when a transaction is rolled back.
92
93				=cut
94				sub txn_rollback {
95				my $self = shift;
96
97				$self->print("ROLLBACK\n");
98				}
99
100				=head2 txn_commit
101
102				Called when a transaction is committed.
103
104				=cut
105				sub txn_commit {
106				my $self = shift;
107
108				$self->print("COMMIT\n");
109				}
110
111				=head2 query_start
112
113				Called before a query is executed. The first argument is the SQL string being
114				executed and subsequent arguments are the parameters used for the query.
115
116				=cut
117				sub query_start {
118				my ($self, $string, @bind) = @_;
119
120				my $message = "$string: ".join(', ', @bind)."\n";
121
122				if(defined($self->callback)) {
123				$string =~ m/^(\w+)/;
124				$self->callback->($1, $message);
125				return;
126				}
127
128				$self->print($message);
129				}
130
131				=head2 query_end
132
133				Called when a query finishes executing. Has the same arguments as query_start.
134
135				=cut
136				sub query_end {
137				my ($self, $string) = @_;
138				}
139
140	1	4.0e-6	4.0e-6	1;
141
142				=head1 AUTHORS
143
144				Cory G. Watson <gphat@cpan.org>
145
146				=head1 LICENSE
147
148				You may distribute this code under the same license as Perl itself.
149
150				=cut