← Index
Performance Profile   « block view • line view • sub view »
For opac/opac-main.pl
  Run on Fri Jul 18 13:58:34 2008
Reported on Fri Jul 18 13:58:40 2008

File/usr/share/perl5/CGI/Session/Driver/DBI.pm
Statements Executed30
Total Time0.001151 seconds

Subroutines — ordered by inclusive time then name
CallsInclusive
Time		Subroutine
10.00002CGI::Session::Driver::DBI::table_name
10.00001CGI::Session::Driver::DBI::init
00CGI::Session::Driver::DBI::BEGIN
00CGI::Session::Driver::DBI::DESTROY
00CGI::Session::Driver::DBI::remove
00CGI::Session::Driver::DBI::retrieve
00CGI::Session::Driver::DBI::store
00CGI::Session::Driver::DBI::traverse

LineStmts.Exclusive
Time		Avg.Code
1package CGI::Session::Driver::DBI;
2
3# $Id: DBI.pm 351 2006-11-24 14:16:50Z markstos $
4
530.000039e-06use strict;
# spent 9e-06s making 1 calls to strict::import
6
730.000030.00001use DBI;
# spent 0.00005s making 1 calls to Exporter::import
830.000039e-06use Carp;
# spent 0.00005s making 1 calls to Exporter::import
930.000310.00010use CGI::Session::Driver;
# spent 4e-06s making 1 calls to 1
10
1113e-063e-06@CGI::Session::Driver::DBI::ISA = ( "CGI::Session::Driver" );
1211e-061e-06$CGI::Session::Driver::DBI::VERSION = "4.20";
13
14
15
# spent 0.00001s within CGI::Session::Driver::DBI::init which was called: # 1 times (0.00001s) by CGI::Session::Driver::mysql::init at line 41 of /usr/share/perl5/CGI/Session/Driver/mysql.pm
sub init {
1634e-061e-06 my $self = shift;
17 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 return 1;
36}
37
38# A setter/accessor method for the table name, defaulting to 'sessions'
39
40
# spent 0.00002s within CGI::Session::Driver::DBI::table_name which was called: # 1 times (0.00002s) by CGI::Session::Driver::mysql::table_name at line 62 of /usr/share/perl5/CGI/Session/Driver/mysql.pm
sub table_name {
4169e-061e-06 my $self = shift;
42 my $class = ref( $self ) || $self;
43
44 if ( (@_ == 0) && ref($self) && ($self->{TableName}) ) {
45 return $self->{TableName};
46 }
47
4830.000700.00023 no strict 'refs';
# spent 0.00003s making 1 calls to strict::unimport
49 if ( @_ ) {
50 my $new_name = shift;
51 $self->{TableName} = $new_name;
52 ${ $class . "::TABLE_NAME" } = $new_name;
53 }
54
55 unless (defined $self->{TableName}) {
56 $self->{TableName} = "sessions";
57 }
58
59 return $self->{TableName};
60}
61
62
63sub retrieve {
64 my $self = shift;
65 my ($sid) = @_;
66 croak "retrieve(): usage error" unless $sid;
67
68
69 my $dbh = $self->{Handle};
70 my $sth = $dbh->prepare_cached("SELECT a_session FROM " . $self->table_name . " WHERE id=?", undef, 3);
71 unless ( $sth ) {
72 return $self->set_error( "retrieve(): DBI->prepare failed with error message " . $dbh->errstr );
73 }
74 $sth->execute( $sid ) or return $self->set_error( "retrieve(): \$sth->execute failed with error message " . $sth->errstr);
75
76 my ($row) = $sth->fetchrow_array();
77 return 0 unless $row;
78 return $row;
79}
80
81
82sub store {
83# die;
84 my $self = shift;
85 my ($sid, $datastr) = @_;
86 croak "store(): usage error" unless $sid && $datastr;
87
88
89 my $dbh = $self->{Handle};
90 my $sth = $dbh->prepare_cached("SELECT id FROM " . $self->table_name . " WHERE id=?", undef, 3);
91 unless ( defined $sth ) {
92 return $self->set_error( "store(): \$dbh->prepare failed with message " . $sth->errstr );
93 }
94
95 $sth->execute( $sid ) or return $self->set_error( "store(): \$sth->execute failed with message " . $sth->errstr );
96 my $action_sth;
97 if ( $sth->fetchrow_array ) {
98 $action_sth = $dbh->prepare_cached("UPDATE " . $self->table_name . " SET a_session=? WHERE id=?", undef, 3);
99 } else {
100 $action_sth = $dbh->prepare_cached("INSERT INTO " . $self->table_name . " (a_session, id) VALUES(?, ?)", undef, 3);
101 }
102
103 unless ( defined $action_sth ) {
104 return $self->set_error( "store(): \$dbh->prepare failed with message " . $dbh->errstr );
105 }
106 $action_sth->execute($datastr, $sid)
107 or return $self->set_error( "store(): \$action_sth->execute failed " . $action_sth->errstr );
108 return 1;
109}
110
111
112sub remove {
113 my $self = shift;
114 my ($sid) = @_;
115 croak "remove(): usage error" unless $sid;
116
117 my $rc = $self->{Handle}->do( 'DELETE FROM '. $self->table_name .' WHERE id= ?',{},$sid );
118 unless ( $rc ) {
119 croak "remove(): \$dbh->do failed!";
120 }
121
122 return 1;
123}
124
125
126sub DESTROY {
12730.000030.00001 my $self = shift;
128
129 unless ( $self->{Handle}->{AutoCommit} ) {
# spent 0.00002s making 1 calls to DBI::common::FETCH
130 $self->{Handle}->commit;
131 }
132 if ( $self->{_disconnect} ) {
133 $self->{Handle}->disconnect;
134 }
135}
136
137
138sub traverse {
139 my $self = shift;
140 my ($coderef) = @_;
141
142 unless ( $coderef && ref( $coderef ) && (ref $coderef eq 'CODE') ) {
143 croak "traverse(): usage error";
144 }
145
146 my $tablename = $self->table_name();
147 my $sth = $self->{Handle}->prepare_cached("SELECT id FROM $tablename", undef, 3)
148 or return $self->set_error("traverse(): couldn't prepare SQL statement. " . $self->{Handle}->errstr);
149 $sth->execute() or return $self->set_error("traverse(): couldn't execute statement $sth->{Statement}. " . $sth->errstr);
150
151 while ( my ($sid) = $sth->fetchrow_array ) {
152 $coderef->($sid);
153 }
154 return 1;
155}
156
157
15815e-065e-061;
159
160=pod
161
162=head1 NAME
163
164CGI::Session::Driver::DBI - Base class for native DBI-related CGI::Session drivers
165
166=head1 SYNOPSIS
167
168 require CGI::Session::Driver::DBI;
169 @ISA = qw( CGI::Session::Driver::DBI );
170
171=head1 DESCRIPTION
172
173In 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!
174
175=head2 NOTES
176
177CGI::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.
178
179=head1 STORAGE
180
181Before 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:
182
183 CREATE TABLE sessions (
184 id CHAR(32) NOT NULL PRIMARY KEY,
185 a_session TEXT NOT NULL
186 );
187
188Your 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 >:
189
190 $s = new CGI::Session("driver:sqlite", undef, {TableName=>'my_sessions'});
191 $s = new CGI::Session("driver:mysql", undef, {
192 TableName=>'my_sessions',
193 DataSource=>'dbi:mysql:shopping_cart'});
194
195=head1 DRIVER ARGUMENTS
196
197Following driver arguments are supported:
198
199=over 4
200
201=item DataSource
202
203First argument to be passed to L<DBI|DBI>->L<connect()|DBI/connect()>. If the driver makes
204the database connection itself, it will also explicitly disconnect from the database when
205the driver object is DESTROYed.
206
207=item User
208
209User privileged to connect to the database defined in C<DataSource>.
210
211=item Password
212
213Password of the I<User> privileged to connect to the database defined in C<DataSource>
214
215=item Handle
216
217An existing L<DBI> database handle object. The handle can be created on demand
218by providing a code reference as a argument, such as C<<sub{DBI->connect}>>.
219This way, the database connection is only created if it actually needed. This can be useful
220when combined with a framework plugin like L<CGI::Application::Plugin::Session>, which creates
221a CGI::Session object on demand as well.
222
223C<Handle> will override all the above arguments, if any present.
224
225=item TableName
226
227Name of the table session data will be stored in.
228
229=back
230
231=head1 LICENSING
232
233For support and licensing information see L<CGI::Session|CGI::Session>
234
235=cut
236
Report produced by the NYTProf 2.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.