← Index
Performance Profile   « block view • line view • sub view »
For /home/chris/git/koha.git/cataloguing/addbiblio.pl
  Run on Tue Aug 25 11:37:23 2009
Reported on Tue Aug 25 11:37:53 2009

File /usr/share/perl5/CGI/Session/Driver/DBI.pm
Statements Executed 42
Total Time 0.0020624 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
21138µs38µsCGI::Session::Driver::DBI::::table_nameCGI::Session::Driver::DBI::table_name
11137µs1.53msCGI::Session::Driver::DBI::::retrieveCGI::Session::Driver::DBI::retrieve
11119µs19µsCGI::Session::Driver::DBI::::initCGI::Session::Driver::DBI::init
0000s0sCGI::Session::Driver::DBI::::BEGINCGI::Session::Driver::DBI::BEGIN
0000s0sCGI::Session::Driver::DBI::::DESTROYCGI::Session::Driver::DBI::DESTROY
0000s0sCGI::Session::Driver::DBI::::removeCGI::Session::Driver::DBI::remove
0000s0sCGI::Session::Driver::DBI::::storeCGI::Session::Driver::DBI::store
0000s0sCGI::Session::Driver::DBI::::traverseCGI::Session::Driver::DBI::traverse
LineStmts.Exclusive
Time		Avg.Code
1package CGI::Session::Driver::DBI;
2
3# $Id: DBI.pm 447 2008-11-01 03:46:08Z markstos $
4
53154µs51µsuse strict;
# spent 15µs making 1 call to strict::import
6
7342µs14µsuse DBI;
# spent 48µs making 1 call to Exporter::import
8346µs15µsuse Carp;
# spent 71µs making 1 call to Exporter::import
93320µs107µsuse CGI::Session::Driver;
# spent 27µs making 1 call to UNIVERSAL::import
10
11111µs11µs@CGI::Session::Driver::DBI::ISA = ( "CGI::Session::Driver" );
121600ns600ns$CGI::Session::Driver::DBI::VERSION = '4.38';
13
14
15
# spent 19µs within CGI::Session::Driver::DBI::init which was called # once (19µs+0s) by CGI::Session::Driver::mysql::init at line 41 of /usr/share/perl5/CGI/Session/Driver/mysql.pm
sub init {
1611µs1µs my $self = shift;
1714µs4µ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 }
3512µs2µs return 1;
36}
37
38# A setter/accessor method for the table name, defaulting to 'sessions'
39
40
# spent 38µs within CGI::Session::Driver::DBI::table_name which was called 2 times, avg 19µs/call: # 2 times (38µs+0s) by CGI::Session::Driver::mysql::table_name at line 61 of /usr/share/perl5/CGI/Session/Driver/mysql.pm, avg 19µs/call
sub table_name {
4122µs900ns my $self = shift;
4223µs2µs my $class = ref( $self ) || $self;
43
4428µs4µs if ( (@_ == 0) && ref($self) && ($self->{TableName}) ) {
45 return $self->{TableName};
46 }
47
483849µs283µs no strict 'refs';
# spent 42µ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.53ms (37µs+1.49) within CGI::Session::Driver::DBI::retrieve which was called # once (37µs+1.49ms) by CGI::Session::load at line 719 of /usr/share/perl5/CGI/Session.pm
sub retrieve {
6211µs1µs my $self = shift;
6312µs2µs my ($sid) = @_;
641400ns400ns croak "retrieve(): usage error" unless $sid;
65
66
6711µs1µs my $dbh = $self->{Handle};
68157µs57µs my $sth = $dbh->prepare_cached("SELECT $self->{DataColName} FROM " . $self->table_name . " WHERE $self->{IdColName}=?", undef, 3);
# spent 544µs making 1 call to DBI::db::prepare_cached # spent 42µs making 1 call to CGI::Session::Driver::mysql::table_name
691500ns500ns unless ( $sth ) {
70 return $self->set_error( "retrieve(): DBI->prepare failed with error message " . $dbh->errstr );
71 }
721371µs371µs $sth->execute( $sid ) or return $self->set_error( "retrieve(): \$sth->execute failed with error message " . $sth->errstr);
# spent 544µs making 1 call to DBI::st::execute
73
74138µs38µs my ($row) = $sth->fetchrow_array();
# spent 180µs making 1 call to DBI::st::fetchrow_array
75
76134µs34µs $sth->finish;
# spent 181µs making 1 call to DBI::st::finish
77
781300ns300ns return 0 unless $row;
7913µs3µs return $row;
80}
81
82
83sub 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
119sub 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
133sub DESTROY {
1341900ns900ns my $self = shift;
135
136165µs65µs unless ( defined $self->{Handle} && $self->{Handle} -> ping ) {
# spent 61µs making 1 call to DBI::db::ping
137 $self->set_error(__PACKAGE__ . '::DESTROY(). Database handle has gone away');
138 return;
139 }
140
141138µs38µs unless ( $self->{Handle}->{AutoCommit} ) {
# spent 26µs making 1 call to DBI::common::FETCH
142 $self->{Handle}->commit;
143 }
14412µs2µs if ( $self->{_disconnect} ) {
145 $self->{Handle}->disconnect;
146 }
147}
148
149
150sub 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
17315µs5µs1;
174
175=pod
176
177=head1 NAME
178
179CGI::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
188In 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
192CGI::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
196Before 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
203Your 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 = new CGI::Session('driver:sqlite', undef, {TableName=>'my_sessions'});
206 $s = new CGI::Session('driver:mysql', undef,
207 {
208 TableName=>'my_sessions',
209 DataSource=>'dbi:mysql:shopping_cart'.
210 });
211
212To use different column names, change the 'create table' statement, and then simply do this:
213
214 $s = new CGI::Session('driver:pg', undef,
215 {
216 TableName=>'session',
217 IdColName=>'my_id',
218 DataColName=>'my_data',
219 DataSource=>'dbi:pg:dbname=project',
220 });
221
222or
223
224 $s = new CGI::Session('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
234Following driver arguments are supported:
235
236=over 4
237
238=item DataSource
239
240First argument to be passed to L<DBI|DBI>->L<connect()|DBI/connect()>. If the driver makes
241the database connection itself, it will also explicitly disconnect from the database when
242the driver object is DESTROYed.
243
244=item User
245
246User privileged to connect to the database defined in C<DataSource>.
247
248=item Password
249
250Password of the I<User> privileged to connect to the database defined in C<DataSource>
251
252=item Handle
253
254An existing L<DBI> database handle object. The handle can be created on demand
255by providing a code reference as a argument, such as C<<sub{DBI->connect}>>.
256This way, the database connection is only created if it actually needed. This can be useful
257when combined with a framework plugin like L<CGI::Application::Plugin::Session>, which creates
258a CGI::Session object on demand as well.
259
260C<Handle> will override all the above arguments, if any present.
261
262=item TableName
263
264Name of the table session data will be stored in.
265
266=back
267
268=head1 LICENSING
269
270For support and licensing information see L<CGI::Session|CGI::Session>
271
272=cut
273
Report produced by the NYTProf 2.10 Perl profiler, developed by Tim Bunce and Adam Kaplan.