diff options
author | Tobi Oetiker <tobi@oetiker.ch> | 2007-11-14 18:33:19 +0100 |
---|---|---|
committer | Tobi Oetiker <tobi@oetiker.ch> | 2007-11-14 18:33:19 +0100 |
commit | ff7b9de82908baf1d5f9af71e35dad2369bfdc2f (patch) | |
tree | 1f9821bf2323786cbe68b4d3b0964ca449332766 /qooxdoo/source/perl/CGI/Session/Driver/DBI.pm | |
parent | d546419d19b89633f8ac3c461eb900f4c4f29b90 (diff) | |
download | smokeping-ff7b9de82908baf1d5f9af71e35dad2369bfdc2f.tar.gz smokeping-ff7b9de82908baf1d5f9af71e35dad2369bfdc2f.tar.xz |
initial qooxdoo drop for smokeping
Diffstat (limited to 'qooxdoo/source/perl/CGI/Session/Driver/DBI.pm')
-rw-r--r-- | qooxdoo/source/perl/CGI/Session/Driver/DBI.pm | 236 |
1 files changed, 236 insertions, 0 deletions
diff --git a/qooxdoo/source/perl/CGI/Session/Driver/DBI.pm b/qooxdoo/source/perl/CGI/Session/Driver/DBI.pm new file mode 100644 index 0000000..413be99 --- /dev/null +++ b/qooxdoo/source/perl/CGI/Session/Driver/DBI.pm @@ -0,0 +1,236 @@ +package CGI::Session::Driver::DBI; + +# $Id: DBI.pm 351 2006-11-24 14:16:50Z markstos $ + +use strict; + +use DBI; +use Carp; +use CGI::Session::Driver; + +@CGI::Session::Driver::DBI::ISA = ( "CGI::Session::Driver" ); +$CGI::Session::Driver::DBI::VERSION = "4.20"; + + +sub init { + my $self = shift; + if ( defined $self->{Handle} ) { + if (ref $self->{Handle} eq 'CODE') { + $self->{Handle} = $self->{Handle}->(); + } + else { + # We assume the handle is working, and there is nothing to do. + } + } + else { + $self->{Handle} = DBI->connect( + $self->{DataSource}, $self->{User}, $self->{Password}, + { RaiseError=>1, PrintError=>1, AutoCommit=>1 } + ); + unless ( $self->{Handle} ) { + return $self->set_error( "init(): couldn't connect to database: " . DBI->errstr ); + } + $self->{_disconnect} = 1; + } + return 1; +} + +# A setter/accessor method for the table name, defaulting to 'sessions' + +sub table_name { + my $self = shift; + my $class = ref( $self ) || $self; + + if ( (@_ == 0) && ref($self) && ($self->{TableName}) ) { + return $self->{TableName}; + } + + no strict 'refs'; + if ( @_ ) { + my $new_name = shift; + $self->{TableName} = $new_name; + ${ $class . "::TABLE_NAME" } = $new_name; + } + + unless (defined $self->{TableName}) { + $self->{TableName} = "sessions"; + } + + return $self->{TableName}; +} + + +sub retrieve { + my $self = shift; + my ($sid) = @_; + croak "retrieve(): usage error" unless $sid; + + + my $dbh = $self->{Handle}; + my $sth = $dbh->prepare_cached("SELECT a_session FROM " . $self->table_name . " WHERE id=?", undef, 3); + unless ( $sth ) { + return $self->set_error( "retrieve(): DBI->prepare failed with error message " . $dbh->errstr ); + } + $sth->execute( $sid ) or return $self->set_error( "retrieve(): \$sth->execute failed with error message " . $sth->errstr); + + my ($row) = $sth->fetchrow_array(); + return 0 unless $row; + return $row; +} + + +sub store { +# die; + my $self = shift; + my ($sid, $datastr) = @_; + croak "store(): usage error" unless $sid && $datastr; + + + my $dbh = $self->{Handle}; + my $sth = $dbh->prepare_cached("SELECT id FROM " . $self->table_name . " WHERE id=?", undef, 3); + unless ( defined $sth ) { + return $self->set_error( "store(): \$dbh->prepare failed with message " . $sth->errstr ); + } + + $sth->execute( $sid ) or return $self->set_error( "store(): \$sth->execute failed with message " . $sth->errstr ); + my $action_sth; + if ( $sth->fetchrow_array ) { + $action_sth = $dbh->prepare_cached("UPDATE " . $self->table_name . " SET a_session=? WHERE id=?", undef, 3); + } else { + $action_sth = $dbh->prepare_cached("INSERT INTO " . $self->table_name . " (a_session, id) VALUES(?, ?)", undef, 3); + } + + unless ( defined $action_sth ) { + return $self->set_error( "store(): \$dbh->prepare failed with message " . $dbh->errstr ); + } + $action_sth->execute($datastr, $sid) + or return $self->set_error( "store(): \$action_sth->execute failed " . $action_sth->errstr ); + return 1; +} + + +sub remove { + my $self = shift; + my ($sid) = @_; + croak "remove(): usage error" unless $sid; + + my $rc = $self->{Handle}->do( 'DELETE FROM '. $self->table_name .' WHERE id= ?',{},$sid ); + unless ( $rc ) { + croak "remove(): \$dbh->do failed!"; + } + + return 1; +} + + +sub DESTROY { + my $self = shift; + + unless ( $self->{Handle}->{AutoCommit} ) { + $self->{Handle}->commit; + } + if ( $self->{_disconnect} ) { + $self->{Handle}->disconnect; + } +} + + +sub traverse { + my $self = shift; + my ($coderef) = @_; + + unless ( $coderef && ref( $coderef ) && (ref $coderef eq 'CODE') ) { + croak "traverse(): usage error"; + } + + my $tablename = $self->table_name(); + my $sth = $self->{Handle}->prepare_cached("SELECT id FROM $tablename", undef, 3) + or return $self->set_error("traverse(): couldn't prepare SQL statement. " . $self->{Handle}->errstr); + $sth->execute() or return $self->set_error("traverse(): couldn't execute statement $sth->{Statement}. " . $sth->errstr); + + while ( my ($sid) = $sth->fetchrow_array ) { + $coderef->($sid); + } + return 1; +} + + +1; + +=pod + +=head1 NAME + +CGI::Session::Driver::DBI - Base class for native DBI-related CGI::Session drivers + +=head1 SYNOPSIS + + require CGI::Session::Driver::DBI; + @ISA = qw( CGI::Session::Driver::DBI ); + +=head1 DESCRIPTION + +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! + +=head2 NOTES + +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. + +=head1 STORAGE + +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: + + CREATE TABLE sessions ( + id CHAR(32) NOT NULL PRIMARY KEY, + a_session TEXT NOT NULL + ); + +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 >: + + $s = new CGI::Session("driver:sqlite", undef, {TableName=>'my_sessions'}); + $s = new CGI::Session("driver:mysql", undef, { + TableName=>'my_sessions', + DataSource=>'dbi:mysql:shopping_cart'}); + +=head1 DRIVER ARGUMENTS + +Following driver arguments are supported: + +=over 4 + +=item DataSource + +First argument to be passed to L<DBI|DBI>->L<connect()|DBI/connect()>. If the driver makes +the database connection itself, it will also explicitly disconnect from the database when +the driver object is DESTROYed. + +=item User + +User privileged to connect to the database defined in C<DataSource>. + +=item Password + +Password of the I<User> privileged to connect to the database defined in C<DataSource> + +=item Handle + +An existing L<DBI> database handle object. The handle can be created on demand +by providing a code reference as a argument, such as C<<sub{DBI->connect}>>. +This way, the database connection is only created if it actually needed. This can be useful +when combined with a framework plugin like L<CGI::Application::Plugin::Session>, which creates +a CGI::Session object on demand as well. + +C<Handle> will override all the above arguments, if any present. + +=item TableName + +Name of the table session data will be stored in. + +=back + +=head1 LICENSING + +For support and licensing information see L<CGI::Session|CGI::Session> + +=cut + |