Profile of CGI/Session/Driver/DBI.pm

Filename	/usr/share/perl5/CGI/Session/Driver/DBI.pm
Statements	Executed 48 statements in 490µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	486µs	560µs	CGI::Session::Driver::DBI::::BEGIN@9CGI::Session::Driver::DBI::BEGIN@9
9	1	1	270µs	1.83ms	CGI::Session::Driver::DBI::::retrieveCGI::Session::Driver::DBI::retrieve
9	3	2	213µs	487µs	CGI::Session::Driver::DBI::::DESTROYCGI::Session::Driver::DBI::DESTROY
18	1	1	119µs	119µs	CGI::Session::Driver::DBI::::table_nameCGI::Session::Driver::DBI::table_name
9	1	1	50µs	50µs	CGI::Session::Driver::DBI::::initCGI::Session::Driver::DBI::init
1	1	1	14µs	22µs	CGI::Session::Driver::DBI::::BEGIN@5CGI::Session::Driver::DBI::BEGIN@5
1	1	1	12µs	25µs	CGI::Session::Driver::DBI::::BEGIN@7CGI::Session::Driver::DBI::BEGIN@7
1	1	1	10µs	18µs	CGI::Session::Driver::DBI::::BEGIN@48CGI::Session::Driver::DBI::BEGIN@48
1	1	1	9µs	38µs	CGI::Session::Driver::DBI::::BEGIN@8CGI::Session::Driver::DBI::BEGIN@8
0	0	0	0s	0s	CGI::Session::Driver::DBI::::removeCGI::Session::Driver::DBI::remove
0	0	0	0s	0s	CGI::Session::Driver::DBI::::storeCGI::Session::Driver::DBI::store
0	0	0	0s	0s	CGI::Session::Driver::DBI::::traverseCGI::Session::Driver::DBI::traverse

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package CGI::Session::Driver::DBI;
2
3					# $Id$
4
5			2	29µs	# spent 22µs (14+7) within CGI::Session::Driver::DBI::BEGIN@5 which was called: # once (14µs+7µs) by CGI::Session::Driver::mysql::BEGIN@7 at line 5 use strict; # spent 22µs making 1 call to CGI::Session::Driver::DBI::BEGIN@5 # spent 7µs making 1 call to strict::import
6
7			2	38µs	# spent 25µs (12+13) within CGI::Session::Driver::DBI::BEGIN@7 which was called: # once (12µs+13µs) by CGI::Session::Driver::mysql::BEGIN@7 at line 7 use DBI; # spent 25µs making 1 call to CGI::Session::Driver::DBI::BEGIN@7 # spent 13µs making 1 call to Exporter::import
8			2	68µs	# spent 38µs (9+30) within CGI::Session::Driver::DBI::BEGIN@8 which was called: # once (9µs+30µs) by CGI::Session::Driver::mysql::BEGIN@7 at line 8 use Carp; # spent 38µs making 1 call to CGI::Session::Driver::DBI::BEGIN@8 # spent 30µs making 1 call to Exporter::import
9			1	560µs	# spent 560µs (486+73) within CGI::Session::Driver::DBI::BEGIN@9 which was called: # once (486µs+73µs) by CGI::Session::Driver::mysql::BEGIN@7 at line 9 use CGI::Session::Driver; # spent 560µs making 1 call to CGI::Session::Driver::DBI::BEGIN@9
10
11					@CGI::Session::Driver::DBI::ISA = ( "CGI::Session::Driver" );
12					$CGI::Session::Driver::DBI::VERSION = '4.43';
13
14
15					# spent 50µs within CGI::Session::Driver::DBI::init which was called 9 times, avg 6µs/call: # 9 times (50µs+0s) by CGI::Session::Driver::mysql::init at line 41 of CGI/Session/Driver/mysql.pm, avg 6µs/call sub init {
16	2	600ns			my $self = shift;
17	2	4µs			if ( defined $self->{Handle} ) {
18					if (ref $self->{Handle} eq 'CODE') {
19					$self->{Handle} = $self->{Handle}->();
20					}
21					else {
22					# We assume the handle is working, and there is nothing to do.
23					}
24					}
25					else {
26					$self->{Handle} = DBI->connect(
27					$self->{DataSource}, $self->{User}, $self->{Password},
28					{ RaiseError=>1, PrintError=>1, AutoCommit=>1 }
29					);
30					unless ( $self->{Handle} ) {
31					return $self->set_error( "init(): couldn't connect to database: " . DBI->errstr );
32					}
33					$self->{_disconnect} = 1;
34					}
35	2	7µs			return 1;
36					}
37
38					# A setter/accessor method for the table name, defaulting to 'sessions'
39
40					# spent 119µs within CGI::Session::Driver::DBI::table_name which was called 18 times, avg 7µs/call: # 18 times (119µs+0s) by CGI::Session::Driver::mysql::table_name at line 61 of CGI/Session/Driver/mysql.pm, avg 7µs/call sub table_name {
41	4	1µs			my $self = shift;
42	4	3µs			my $class = ref( $self ) \|\| $self;
43
44	4	15µs			if ( (@_ == 0) && ref($self) && ($self->{TableName}) ) {
45					return $self->{TableName};
46					}
47
48			2	25µs	# spent 18µs (10+7) within CGI::Session::Driver::DBI::BEGIN@48 which was called: # once (10µs+7µs) by CGI::Session::Driver::mysql::BEGIN@7 at line 48 no strict 'refs'; # spent 18µs making 1 call to CGI::Session::Driver::DBI::BEGIN@48 # spent 7µs making 1 call to strict::unimport
49					if ( @_ ) {
50					$self->{TableName} = shift;
51					}
52
53					unless (defined $self->{TableName}) {
54					$self->{TableName} = "sessions";
55					}
56
57					return $self->{TableName};
58					}
59
60
61					# spent 1.83ms (270µs+1.56) within CGI::Session::Driver::DBI::retrieve which was called 9 times, avg 203µs/call: # 9 times (270µs+1.56ms) by CGI::Session::load at line 719 of CGI/Session.pm, avg 203µs/call sub retrieve {
62	2	600ns			my $self = shift;
63	2	1µs			my ($sid) = @_;
64	2	900ns			croak "retrieve(): usage error" unless $sid;
65
66
67	2	1µs			my $dbh = $self->{Handle};
68	2	46µs	27	576µs	my $sth = $dbh->prepare_cached("SELECT $self->{DataColName} FROM " . $self->table_name . " WHERE $self->{IdColName}=?", undef, 3); # spent 280µs making 9 calls to DBI::db::prepare_cached, avg 31µs/call # spent 207µs making 9 calls to DBD::_::db::prepare_cached, avg 23µs/call # spent 89µs making 9 calls to CGI::Session::Driver::mysql::table_name, avg 10µs/call
69	2	600ns			unless ( $sth ) {
70					return $self->set_error( "retrieve(): DBI->prepare failed with error message " . $dbh->errstr );
71					}
72	2	266µs	9	1.12ms	$sth->execute( $sid ) or return $self->set_error( "retrieve(): \$sth->execute failed with error message " . $sth->errstr); # spent 1.12ms making 9 calls to DBI::st::execute, avg 125µs/call
73
74	2	18µs	9	47µs	my ($row) = $sth->fetchrow_array(); # spent 47µs making 9 calls to DBI::st::fetchrow_array, avg 5µs/call
75
76	2	9µs	9	20µs	$sth->finish; # spent 20µs making 9 calls to DBI::st::finish, avg 2µs/call
77
78	2	600ns			return 0 unless $row;
79	2	6µs			return $row;
80					}
81
82
83					sub store {
84					# die;
85					my $self = shift;
86					my ($sid, $datastr) = @_;
87					croak "store(): usage error" unless $sid && $datastr;
88
89
90					my $dbh = $self->{Handle};
91					my $sth = $dbh->prepare_cached("SELECT $self->{IdColName} FROM " . $self->table_name . " WHERE $self->{IdColName}=?", undef, 3);
92					unless ( defined $sth ) {
93					return $self->set_error( "store(): \$dbh->prepare failed with message " . $sth->errstr );
94					}
95
96					$sth->execute( $sid ) or return $self->set_error( "store(): \$sth->execute failed with message " . $sth->errstr );
97					my $rc = $sth->fetchrow_array;
98					$sth->finish;
99
100					my $action_sth;
101					if ( $rc ) {
102					$action_sth = $dbh->prepare_cached("UPDATE " . $self->table_name . " SET $self->{DataColName}=? WHERE $self->{IdColName}=?", undef, 3);
103					} else {
104					$action_sth = $dbh->prepare_cached("INSERT INTO " . $self->table_name . " ($self->{DataColName}, $self->{IdColName}) VALUES(?, ?)", undef, 3);
105					}
106
107					unless ( defined $action_sth ) {
108					return $self->set_error( "store(): \$dbh->prepare failed with message " . $dbh->errstr );
109					}
110					$action_sth->execute($datastr, $sid)
111					or return $self->set_error( "store(): \$action_sth->execute failed " . $action_sth->errstr );
112
113					$action_sth->finish;
114
115					return 1;
116					}
117
118
119					sub remove {
120					my $self = shift;
121					my ($sid) = @_;
122					croak "remove(): usage error" unless $sid;
123
124					my $rc = $self->{Handle}->do( 'DELETE FROM ' . $self->table_name . " WHERE $self->{IdColName}= ?", {}, $sid );
125					unless ( $rc ) {
126					croak "remove(): \$dbh->do failed!";
127					}
128
129					return 1;
130					}
131
132
133					# spent 487µs (213+274) within CGI::Session::Driver::DBI::DESTROY which was called 9 times, avg 54µs/call: # 4 times (114µs+141µs) by C4::Auth::checkauth at line 775 of C4/Auth.pm, avg 64µs/call # 4 times (72µs+104µs) by C4::Search::History::get_from_session at line 390 of C4/Auth.pm, avg 44µs/call # once (27µs+30µs) by C4::Auth::check_cookie_auth at line 42 of circ/ysearch.pl sub DESTROY {
134	2	700ns			my $self = shift;
135
136	2	71µs	9	232µs	unless ( defined $self->{Handle} && $self->{Handle} -> ping ) { # spent 232µs making 9 calls to DBI::db::ping, avg 26µs/call
137					$self->set_error(__PACKAGE__ . '::DESTROY(). Database handle has gone away');
138					return;
139					}
140
141	2	32µs	9	42µs	unless ( $self->{Handle}->{AutoCommit} ) { # spent 42µs making 9 calls to DBI::common::FETCH, avg 5µs/call
142					$self->{Handle}->commit;
143					}
144	2	6µs			if ( $self->{_disconnect} ) {
145					$self->{Handle}->disconnect;
146					}
147					}
148
149
150					sub traverse {
151					my $self = shift;
152					my ($coderef) = @_;
153
154					unless ( $coderef && ref( $coderef ) && (ref $coderef eq 'CODE') ) {
155					croak "traverse(): usage error";
156					}
157
158					my $tablename = $self->table_name();
159					my $sth = $self->{Handle}->prepare_cached("SELECT $self->{IdColName} FROM $tablename", undef, 3)
160					or return $self->set_error("traverse(): couldn't prepare SQL statement. " . $self->{Handle}->errstr);
161					$sth->execute() or return $self->set_error("traverse(): couldn't execute statement $sth->{Statement}. " . $sth->errstr);
162
163					while ( my ($sid) = $sth->fetchrow_array ) {
164					$coderef->($sid);
165					}
166
167					$sth->finish;
168
169					return 1;
170					}
171
172
173					1;
174
175					=pod
176
177					=head1 NAME
178
179					CGI::Session::Driver::DBI - Base class for native DBI-related CGI::Session drivers
180
181					=head1 SYNOPSIS
182
183					require CGI::Session::Driver::DBI;
184					@ISA = qw( CGI::Session::Driver::DBI );
185
186					=head1 DESCRIPTION
187
188					In most cases you can create a new DBI-driven CGI::Session driver by simply creating an empty driver file that inherits from CGI::Session::Driver::DBI. That's exactly what L<sqlite\|CGI::Session::Driver::sqlite> does. The only reason why this class doesn't suit for a valid driver is its name isn't in lowercase. I'm serious!
189
190					=head2 NOTES
191
192					CGI::Session::Driver::DBI defines init() method, which makes DBI handle available for drivers in I<Handle> - object attribute regardless of what C<\%dsn_args> were used in creating session object. Should your driver require non-standard initialization you have to re-define init() method in your F<.pm> file, but make sure to set 'Handle' - object attribute to database handle (returned by DBI->connect(...)) if you wish to inherit any of the methods from CGI::Session::Driver::DBI.
193
194					=head1 STORAGE
195
196					Before you can use any DBI-based session drivers you need to make sure compatible database table is created for CGI::Session to work with. Following command will produce minimal requirements in most SQL databases:
197
198					CREATE TABLE sessions (
199					id CHAR(32) NOT NULL PRIMARY KEY,
200					a_session TEXT NOT NULL
201					);
202
203					Your session table can define additional columns, but the above two are required. Name of the session table is expected to be I<sessions> by default. You may use a different name if you wish. To do this you have to pass I<TableName> as part of your C< \%dsn_args >:
204
205					$s = CGI::Session->new('driver:sqlite', undef, {TableName=>'my_sessions'});
206					$s = CGI::Session->new('driver:mysql', undef,
207					{
208					TableName=>'my_sessions',
209					DataSource=>'dbi:mysql:shopping_cart'.
210					});
211
212					To use different column names, change the 'create table' statement, and then simply do this:
213
214					$s = CGI::Session->new('driver:pg', undef,
215					{
216					TableName=>'session',
217					IdColName=>'my_id',
218					DataColName=>'my_data',
219					DataSource=>'dbi:pg:dbname=project',
220					});
221
222					or
223
224					$s = CGI::Session->new('driver:pg', undef,
225					{
226					TableName=>'session',
227					IdColName=>'my_id',
228					DataColName=>'my_data',
229					Handle=>$dbh,
230					});
231
232					=head1 DRIVER ARGUMENTS
233
234					Following driver arguments are supported:
235
236					=over 4
237
238					=item DataSource
239
240					First argument to be passed to L<DBI\|DBI>->L<connect()\|DBI/connect()>. If the driver makes
241					the database connection itself, it will also explicitly disconnect from the database when
242					the driver object is DESTROYed.
243
244					=item User
245
246					User privileged to connect to the database defined in C<DataSource>.
247
248					=item Password
249
250					Password of the I<User> privileged to connect to the database defined in C<DataSource>
251
252					=item Handle
253
254					An existing L<DBI> database handle object. The handle can be created on demand
255					by providing a code reference as a argument, such as C<<sub{DBI->connect}>>.
256					This way, the database connection is only created if it actually needed. This can be useful
257					when combined with a framework plugin like L<CGI::Application::Plugin::Session>, which creates
258					a CGI::Session object on demand as well.
259
260					C<Handle> will override all the above arguments, if any present.
261
262					=item TableName
263
264					Name of the table session data will be stored in.
265
266					=back
267
268					=head1 LICENSING
269
270					For support and licensing information see L<CGI::Session\|CGI::Session>
271
272					=cut
273