summaryrefslogtreecommitdiffstats
path: root/qooxdoo/source/perl/CGI/Session/Driver
diff options
context:
space:
mode:
Diffstat (limited to 'qooxdoo/source/perl/CGI/Session/Driver')
-rw-r--r--qooxdoo/source/perl/CGI/Session/Driver/DBI.pm236
-rw-r--r--qooxdoo/source/perl/CGI/Session/Driver/db_file.pm201
-rw-r--r--qooxdoo/source/perl/CGI/Session/Driver/file.pm217
-rw-r--r--qooxdoo/source/perl/CGI/Session/Driver/mysql.pm113
-rw-r--r--qooxdoo/source/perl/CGI/Session/Driver/postgresql.pm134
-rw-r--r--qooxdoo/source/perl/CGI/Session/Driver/sqlite.pm99
6 files changed, 0 insertions, 1000 deletions
diff --git a/qooxdoo/source/perl/CGI/Session/Driver/DBI.pm b/qooxdoo/source/perl/CGI/Session/Driver/DBI.pm
deleted file mode 100644
index 413be99..0000000
--- a/qooxdoo/source/perl/CGI/Session/Driver/DBI.pm
+++ /dev/null
@@ -1,236 +0,0 @@
-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
-
diff --git a/qooxdoo/source/perl/CGI/Session/Driver/db_file.pm b/qooxdoo/source/perl/CGI/Session/Driver/db_file.pm
deleted file mode 100644
index edfe8d6..0000000
--- a/qooxdoo/source/perl/CGI/Session/Driver/db_file.pm
+++ /dev/null
@@ -1,201 +0,0 @@
-package CGI::Session::Driver::db_file;
-
-# $Id: db_file.pm 351 2006-11-24 14:16:50Z markstos $
-
-use strict;
-
-use Carp;
-use DB_File;
-use File::Spec;
-use File::Basename;
-use CGI::Session::Driver;
-use Fcntl qw( :DEFAULT :flock );
-use vars qw( @ISA $VERSION $FILE_NAME $UMask $NO_FOLLOW );
-
-@ISA = ( "CGI::Session::Driver" );
-$VERSION = "4.20";
-$FILE_NAME = "cgisess.db";
-$UMask = 0660;
-$NO_FOLLOW = eval { O_NOFOLLOW } || 0;
-
-sub init {
- my $self = shift;
-
- $self->{FileName} ||= $CGI::Session::Driver::db_file::FILE_NAME;
- unless ( $self->{Directory} ) {
- $self->{Directory} = dirname( $self->{FileName} );
- $self->{Directory} = File::Spec->tmpdir() if $self->{Directory} eq '.' && substr($self->{FileName},0,1) ne '.';
- $self->{FileName} = basename( $self->{FileName} );
- }
- unless ( -d $self->{Directory} ) {
- require File::Path;
- File::Path::mkpath($self->{Directory}) or return $self->set_error("init(): couldn't mkpath: $!");
- }
-
- $self->{UMask} = $CGI::Session::Driver::db_file::UMask unless exists $self->{UMask};
-
- return 1;
-}
-
-
-sub retrieve {
- my $self = shift;
- my ($sid) = @_;
- croak "retrieve(): usage error" unless $sid;
-
- return 0 unless -f $self->_db_file;
- my ($dbhash, $unlock) = $self->_tie_db_file(O_RDONLY) or return;
- my $datastr = $dbhash->{$sid};
- untie(%$dbhash);
- $unlock->();
- return $datastr || 0;
-}
-
-
-sub store {
- my $self = shift;
- my ($sid, $datastr) = @_;
- croak "store(): usage error" unless $sid && $datastr;
-
- my ($dbhash, $unlock) = $self->_tie_db_file(O_RDWR, LOCK_EX) or return;
- $dbhash->{$sid} = $datastr;
- untie(%$dbhash);
- $unlock->();
- return 1;
-}
-
-
-
-sub remove {
- my $self = shift;
- my ($sid) = @_;
- croak "remove(): usage error" unless $sid;
-
-
- my ($dbhash, $unlock) = $self->_tie_db_file(O_RDWR, LOCK_EX) or return;
- delete $dbhash->{$sid};
- untie(%$dbhash);
- $unlock->();
- return 1;
-}
-
-
-sub DESTROY {}
-
-
-sub _lock {
- my $self = shift;
- my ($db_file, $lock_type) = @_;
-
- croak "_lock(): usage error" unless $db_file;
- $lock_type ||= LOCK_SH;
-
- my $lock_file = $db_file . '.lck';
- if ( -l $lock_file ) {
- unlink($lock_file) or
- die $self->set_error("_lock(): '$lock_file' appears to be a symlink and I can't remove it: $!");
- }
- sysopen(LOCKFH, $lock_file, O_RDWR|O_CREAT|$NO_FOLLOW) or die "couldn't create lock file '$lock_file': $!";
-
-
- flock(LOCKFH, $lock_type) or die "couldn't lock '$lock_file': $!";
- return sub {
- close(LOCKFH); # && unlink($lock_file); # keep the lock file around
- 1;
- };
-}
-
-
-
-sub _tie_db_file {
- my $self = shift;
- my ($o_mode, $lock_type) = @_;
- $o_mode ||= O_RDWR|O_CREAT;
-
- # DB_File will not touch a file unless it recognizes the format
- # we can't detect the version of the underlying database without some very heavy checks so the easiest thing is
- # to disable this for opening of the database
-
- # # protect against symlinks
- # $o_mode |= $NO_FOLLOW;
-
- my $db_file = $self->_db_file;
- my $unlock = $self->_lock($db_file, $lock_type);
- my %db;
-
- my $create = ! -e $db_file;
-
- if ( -l $db_file ) {
- $create = 1;
- unlink($db_file) or
- return $self->set_error("_tie_db_file(): '$db_file' appears to be a symlink and I can't remove it: $!");
- }
-
- $o_mode = O_RDWR|O_CREAT|O_EXCL if $create;
-
- unless( tie %db, "DB_File", $db_file, $o_mode, $self->{UMask} ){
- $unlock->();
- return $self->set_error("_tie_db_file(): couldn't tie '$db_file': $!");
- }
-
- return (\%db, $unlock);
-}
-
-sub _db_file {
- my $self = shift;
- return File::Spec->catfile( $self->{Directory}, $self->{FileName} );
-}
-
-sub traverse {
- my $self = shift;
- my ($coderef) = @_;
-
- unless ( $coderef && ref($coderef) && (ref $coderef eq 'CODE') ) {
- croak "traverse(): usage error";
- }
-
- my ($dbhash, $unlock) = $self->_tie_db_file(O_RDWR, LOCK_SH);
- unless ( $dbhash ) {
- return $self->set_error( "traverse(): couldn't get db handle, " . $self->errstr );
- }
- while ( my ($sid, undef) = each %$dbhash ) {
- $coderef->( $sid );
- }
- untie(%$dbhash);
- $unlock->();
- return 1;
-}
-
-
-1;
-
-__END__;
-
-=pod
-
-=head1 NAME
-
-CGI::Session::Driver::db_file - CGI::Session driver for BerkeleyDB using DB_File
-
-=head1 SYNOPSIS
-
- $s = new CGI::Session("driver:db_file", $sid);
- $s = new CGI::Session("driver:db_file", $sid, {FileName=>'/tmp/cgisessions.db'});
-
-=head1 DESCRIPTION
-
-B<db_file> stores session data in BerkelyDB file using L<DB_File|DB_File> - Perl module. All sessions will be stored
-in a single file, specified in I<FileName> driver argument as in the above example. If I<FileName> isn't given,
-defaults to F</tmp/cgisess.db>, or its equivalent on a non-UNIX system.
-
-If the directory hierarchy leading to the file does not exist, will be created for you.
-
-This module takes a B<UMask> option which will be used if DB_File has to create the database file for you. By default
-the umask is 0660.
-
-=head1 LICENSING
-
-For support and licensing information see L<CGI::Session|CGI::Session>
-
-=cut
-
diff --git a/qooxdoo/source/perl/CGI/Session/Driver/file.pm b/qooxdoo/source/perl/CGI/Session/Driver/file.pm
deleted file mode 100644
index f25dfea..0000000
--- a/qooxdoo/source/perl/CGI/Session/Driver/file.pm
+++ /dev/null
@@ -1,217 +0,0 @@
-package CGI::Session::Driver::file;
-
-# $Id: file.pm 351 2006-11-24 14:16:50Z markstos $
-
-use strict;
-
-use Carp;
-use File::Spec;
-use Fcntl qw( :DEFAULT :flock :mode );
-use CGI::Session::Driver;
-use vars qw( $FileName $NoFlock $UMask $NO_FOLLOW );
-
-BEGIN {
- # keep historical behavior
-
- no strict 'refs';
-
- *FileName = \$CGI::Session::File::FileName;
-}
-
-@CGI::Session::Driver::file::ISA = ( "CGI::Session::Driver" );
-$CGI::Session::Driver::file::VERSION = "4.20";
-$FileName = "cgisess_%s";
-$NoFlock = 0;
-$UMask = 0660;
-$NO_FOLLOW = eval { O_NOFOLLOW } || 0;
-
-sub init {
- my $self = shift;
- $self->{Directory} ||= File::Spec->tmpdir();
-
- unless ( -d $self->{Directory} ) {
- require File::Path;
- unless ( File::Path::mkpath($self->{Directory}) ) {
- return $self->set_error( "init(): couldn't create directory path: $!" );
- }
- }
-
- $self->{NoFlock} = $NoFlock unless exists $self->{NoFlock};
- $self->{UMask} = $UMask unless exists $self->{UMask};
-
- return 1;
-}
-
-sub _file {
- my ($self,$sid) = @_;
- return File::Spec->catfile($self->{Directory}, sprintf( $FileName, $sid ));
-}
-
-sub retrieve {
- my $self = shift;
- my ($sid) = @_;
-
- my $path = $self->_file($sid);
-
- return 0 unless -e $path;
-
- # make certain our filehandle goes away when we fall out of scope
- local *FH;
-
- if (-l $path) {
- unlink($path) or
- return $self->set_error("retrieve(): '$path' appears to be a symlink and I couldn't remove it: $!");
- return 0; # we deleted this so we have no hope of getting back anything
- }
- sysopen(FH, $path, O_RDONLY | $NO_FOLLOW ) || return $self->set_error( "retrieve(): couldn't open '$path': $!" );
-
- $self->{NoFlock} || flock(FH, LOCK_SH) or return $self->set_error( "retrieve(): couldn't lock '$path': $!" );
-
- my $rv = "";
- while ( <FH> ) {
- $rv .= $_;
- }
- close(FH);
- return $rv;
-}
-
-
-
-sub store {
- my $self = shift;
- my ($sid, $datastr) = @_;
-
- my $path = $self->_file($sid);
-
- # make certain our filehandle goes away when we fall out of scope
- local *FH;
-
- my $mode = O_WRONLY|$NO_FOLLOW;
-
- # kill symlinks when we spot them
- if (-l $path) {
- unlink($path) or
- return $self->set_error("store(): '$path' appears to be a symlink and I couldn't remove it: $!");
- }
-
- $mode = O_RDWR|O_CREAT|O_EXCL unless -e $path;
-
- sysopen(FH, $path, $mode, $self->{UMask}) or return $self->set_error( "store(): couldn't open '$path': $!" );
-
- # sanity check to make certain we're still ok
- if (-l $path) {
- return $self->set_error("store(): '$path' is a symlink, check for malicious processes");
- }
-
- # prevent race condition (RT#17949)
- $self->{NoFlock} || flock(FH, LOCK_EX) or return $self->set_error( "store(): couldn't lock '$path': $!" );
- truncate(FH, 0) or return $self->set_error( "store(): couldn't truncate '$path': $!" );
-
- print FH $datastr;
- close(FH) or return $self->set_error( "store(): couldn't close '$path': $!" );
- return 1;
-}
-
-
-sub remove {
- my $self = shift;
- my ($sid) = @_;
-
- my $directory = $self->{Directory};
- my $file = sprintf( $FileName, $sid );
- my $path = File::Spec->catfile($directory, $file);
- unlink($path) or return $self->set_error( "remove(): couldn't unlink '$path': $!" );
- return 1;
-}
-
-
-sub traverse {
- my $self = shift;
- my ($coderef) = @_;
-
- unless ( $coderef && ref($coderef) && (ref $coderef eq 'CODE') ) {
- croak "traverse(): usage error";
- }
-
- opendir( DIRHANDLE, $self->{Directory} )
- or return $self->set_error( "traverse(): couldn't open $self->{Directory}, " . $! );
-
- my $filename_pattern = $FileName;
- $filename_pattern =~ s/\./\\./g;
- $filename_pattern =~ s/\%s/(\.\+)/g;
- while ( my $filename = readdir(DIRHANDLE) ) {
- next if $filename =~ m/^\.\.?$/;
- my $full_path = File::Spec->catfile($self->{Directory}, $filename);
- my $mode = (stat($full_path))[2]
- or return $self->set_error( "traverse(): stat failed for $full_path: " . $! );
- next if S_ISDIR($mode);
- if ( $filename =~ /^$filename_pattern$/ ) {
- $coderef->($1);
- }
- }
- closedir( DIRHANDLE );
- return 1;
-}
-
-
-sub DESTROY {
- my $self = shift;
-}
-
-1;
-
-__END__;
-
-=pod
-
-=head1 NAME
-
-CGI::Session::Driver::file - Default CGI::Session driver
-
-=head1 SYNOPSIS
-
- $s = new CGI::Session();
- $s = new CGI::Session("driver:file", $sid);
- $s = new CGI::Session("driver:file", $sid, {Directory=>'/tmp'});
-
-
-=head1 DESCRIPTION
-
-When CGI::Session object is created without explicitly setting I<driver>, I<file> will be assumed.
-I<file> - driver will store session data in plain files, where each session will be stored in a separate
-file.
-
-Naming conventions of session files are defined by C<$CGI::Session::Driver::file::FileName> global variable.
-Default value of this variable is I<cgisess_%s>, where %s will be replaced with respective session ID. Should
-you wish to set your own FileName template, do so before requesting for session object:
-
- $CGI::Session::Driver::file::FileName = "%s.dat";
- $s = new CGI::Session();
-
-For backwards compatibility with 3.x, you can also use the variable name
-C<$CGI::Session::File::FileName>, which will override the one above.
-
-=head2 DRIVER ARGUMENTS
-
-If you wish to specify a session directory, use the B<Directory> option, which denotes location of the directory
-where session ids are to be kept. If B<Directory> is not set, defaults to whatever File::Spec->tmpdir() returns.
-So all the three lines in the SYNOPSIS section of this manual produce the same result on a UNIX machine.
-
-If specified B<Directory> does not exist, all necessary directory hierarchy will be created.
-
-By default, sessions are created with a umask of 0660. If you wish to change the umask for a session, pass
-a B<UMask> option with an octal representation of the umask you would like for said session.
-
-=head1 NOTES
-
-If your OS doesn't support flock, you should understand the risks of going without locking the session files. Since
-sessions tend to be used in environments where race conditions may occur due to concurrent access of files by
-different processes, locking tends to be seen as a good and very necessary thing. If you still want to use this
-driver but don't want flock, set C<$CGI::Session::Driver::file::NoFlock> to 1 or pass C<< NoFlock => 1 >> and this
-driver will operate without locks.
-
-=head1 LICENSING
-
-For support and licensing see L<CGI::Session|CGI::Session>
-
-=cut
diff --git a/qooxdoo/source/perl/CGI/Session/Driver/mysql.pm b/qooxdoo/source/perl/CGI/Session/Driver/mysql.pm
deleted file mode 100644
index 4d7aaf6..0000000
--- a/qooxdoo/source/perl/CGI/Session/Driver/mysql.pm
+++ /dev/null
@@ -1,113 +0,0 @@
-package CGI::Session::Driver::mysql;
-
-# $Id: mysql.pm 351 2006-11-24 14:16:50Z markstos $
-
-use strict;
-use Carp;
-use CGI::Session::Driver::DBI;
-
-@CGI::Session::Driver::mysql::ISA = qw( CGI::Session::Driver::DBI );
-$CGI::Session::Driver::mysql::VERSION = "4.20";
-
-sub _mk_dsnstr {
- my ($class, $dsn) = @_;
- unless ( $class && $dsn && ref($dsn) && (ref($dsn) eq 'HASH')) {
- croak "_mk_dsnstr(): usage error";
- }
-
- my $dsnstr = $dsn->{DataSource};
- if ( $dsn->{Socket} ) {
- $dsnstr .= sprintf(";mysql_socket=%s", $dsn->{Socket});
- }
- if ( $dsn->{Host} ) {
- $dsnstr .= sprintf(";host=%s", $dsn->{Host});
- }
- if ( $dsn->{Port} ) {
- $dsnstr .= sprintf(";port=%s", $dsn->{Port});
- }
- return $dsnstr;
-}
-
-
-sub init {
- my $self = shift;
- if ( $self->{DataSource} && ($self->{DataSource} !~ /^dbi:mysql/i) ) {
- $self->{DataSource} = "dbi:mysql:database=" . $self->{DataSource};
- }
-
- if ( $self->{Socket} && $self->{DataSource} ) {
- $self->{DataSource} .= ';mysql_socket=' . $self->{Socket};
- }
- return $self->SUPER::init();
-}
-
-sub store {
- my $self = shift;
- my ($sid, $datastr) = @_;
- croak "store(): usage error" unless $sid && $datastr;
-
- my $dbh = $self->{Handle};
- $dbh->do("REPLACE INTO " . $self->table_name . " (id, a_session) VALUES(?, ?)", undef, $sid, $datastr)
- or return $self->set_error( "store(): \$dbh->do failed " . $dbh->errstr );
- return 1;
-}
-
-
-# If the table name hasn't been defined yet, check this location for 3.x compatibility
-sub table_name {
- my $self = shift;
- unless (defined $self->{TableName}) {
- $self->{TableName} = $CGI::Session::MySQL::TABLE_NAME;
- }
- return $self->SUPER::table_name(@_);
-}
-
-1;
-
-__END__;
-
-=pod
-
-=head1 NAME
-
-CGI::Session::Driver::mysql - CGI::Session driver for MySQL database
-
-=head1 SYNOPSIS
-
- $s = new CGI::Session( "driver:mysql", $sid);
- $s = new CGI::Session( "driver:mysql", $sid, { DataSource => 'dbi:mysql:test',
- User => 'sherzodr',
- Password => 'hello' });
- $s = new CGI::Session( "driver:mysql", $sid, { Handle => $dbh } );
-
-=head1 DESCRIPTION
-
-B<mysql> stores session records in a MySQL table. For details see L<CGI::Session::Driver::DBI|CGI::Session::Driver::DBI>, its parent class.
-
-It's especially important for the MySQL driver that the session ID column be
-defined as a primary key, or at least "unique", like this:
-
- CREATE TABLE sessions (
- id CHAR(32) NOT NULL PRIMARY KEY,
- a_session TEXT NOT NULL
- );
-
-=head2 DRIVER ARGUMENTS
-
-B<mysql> driver supports all the arguments documented in L<CGI::Session::Driver::DBI|CGI::Session::Driver::DBI>. In addition, I<DataSource> argument can optionally leave leading "dbi:mysql:" string out:
-
- $s = new CGI::Session( "driver:mysql", $sid, {DataSource=>'shopping_cart'});
- # is the same as:
- $s = new CGI::Session( "driver:mysql", $sid, {DataSource=>'dbi:mysql:shopping_cart'});
-
-=head2 BACKWARDS COMPATIBILITY
-
-For backwards compatibility, you can also set the table like this before calling C<new()>. However, it is not recommended because it can cause conflicts in a persistent environment.
-
- $CGI::Session::MySQL::TABLE_NAME = 'my_sessions';
-
-=head1 LICENSING
-
-For support and licensing see L<CGI::Session|CGI::Session>.
-
-=cut
diff --git a/qooxdoo/source/perl/CGI/Session/Driver/postgresql.pm b/qooxdoo/source/perl/CGI/Session/Driver/postgresql.pm
deleted file mode 100644
index ccfdce5..0000000
--- a/qooxdoo/source/perl/CGI/Session/Driver/postgresql.pm
+++ /dev/null
@@ -1,134 +0,0 @@
-package CGI::Session::Driver::postgresql;
-
-# $Id: postgresql.pm 351 2006-11-24 14:16:50Z markstos $
-
-# CGI::Session::Driver::postgresql - PostgreSQL driver for CGI::Session
-#
-# Copyright (C) 2002 Cosimo Streppone, cosimo@cpan.org
-# This module is based on CGI::Session::Driver::mysql module
-# by Sherzod Ruzmetov, original author of CGI::Session modules
-# and CGI::Session::Driver::mysql driver.
-
-use strict;
-use Carp "croak";
-
-use CGI::Session::Driver::DBI;
-use DBD::Pg qw(PG_BYTEA PG_TEXT);
-
-$CGI::Session::Driver::postgresql::VERSION = '4.20';
-@CGI::Session::Driver::postgresql::ISA = qw( CGI::Session::Driver::DBI );
-
-
-sub init {
- my $self = shift;
- my $ret = $self->SUPER::init(@_);
-
- # Translate external ColumnType into internal value. See POD for details.
- $self->{PgColumnType} ||= (defined $self->{ColumnType} and (lc $self->{ColumnType} eq 'binary'))
- ? PG_BYTEA
- : PG_TEXT
- ;
-
- return $ret;
-}
-
-sub store {
- my $self = shift;
- my ($sid, $datastr) = @_;
- croak "store(): usage error" unless $sid && $datastr;
-
- my $dbh = $self->{Handle};
- my $type = $self->{PgColumnType};
-
- if ($type == PG_TEXT && $datastr =~ tr/\x00//) {
- croak "Unallowed characters used in session data. Please see CGI::Session::Driver::postgresql ".
- "for more information about null characters in text columns.";
- }
-
- local $dbh->{RaiseError} = 1;
- eval {
- # There is a race condition were two clients could run this code concurrently,
- # and both end up trying to insert. That's why we check for "duplicate" below
- my $sth = $dbh->prepare(
- "INSERT INTO " . $self->table_name . " (a_session,id) SELECT ?, ?
- WHERE NOT EXISTS (SELECT 1 FROM " . $self->table_name . " WHERE id=? LIMIT 1)");
-
- $sth->bind_param(1,$datastr,{ pg_type => $type });
- $sth->bind_param(2, $sid);
- $sth->bind_param(3, $sid); # in the SELECT statement
- my $rv = '';
- eval { $rv = $sth->execute(); };
- if ( $rv eq '0E0' or (defined $@ and $@ =~ m/duplicate/i) ) {
- my $sth = $dbh->prepare("UPDATE " . $self->table_name . " SET a_session=? WHERE id=?");
- $sth->bind_param(1,$datastr,{ pg_type => $type });
- $sth->bind_param(2,$sid);
- $sth->execute;
- }
- else {
- # Nothing. Our insert has already happened
- }
- };
- if ($@) {
- return $self->set_error( "store(): failed with message: $@ " . $dbh->errstr );
-
- }
- else {
- return 1;
-
- }
-
-
-}
-
-1;
-
-=pod
-
-=head1 NAME
-
-CGI::Session::Driver::postgresql - PostgreSQL driver for CGI::Session
-
-=head1 SYNOPSIS
-
- use CGI::Session;
- $session = new CGI::Session("driver:PostgreSQL", undef, {Handle=>$dbh});
-
-=head1 DESCRIPTION
-
-CGI::Session::PostgreSQL is a L<CGI::Session|CGI::Session> driver to store session data in a PostgreSQL table.
-
-=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 BYTEA NOT NULL
- );
-
-and within your code use:
-
- use CGI::Session;
- $session = new CGI::Session("driver:PostgreSQL", undef, {Handle=>$dbh, ColumnType=>"binary"});
-
-Please note the I<ColumnType> argument. PostgreSQL's text type has problems when trying to hold a null character. (Known as C<"\0"> in Perl, not to be confused with SQL I<NULL>). If you know there is no chance of ever having a null character in the serialized data, you can leave off the I<ColumnType> attribute. Using a I<BYTEA> column type and C<< ColumnType => 'binary' >> is recommended when using L<Storable|CGI::Session::Serialize::storable> as the serializer or if there's any possibility that a null value will appear in any of the serialized data.
-
-For more details see L<CGI::Session::Driver::DBI|CGI::Session::Driver::DBI>, parent class.
-
-Also see L<sqlite driver|CGI::Session::Driver::sqlite>, which exercises different method for dealing with binary data.
-
-=head1 COPYRIGHT
-
-Copyright (C) 2002 Cosimo Streppone. All rights reserved. This library is free software and can be modified and distributed under the same terms as Perl itself.
-
-=head1 AUTHORS
-
-Cosimo Streppone <cosimo@cpan.org>, heavily based on the CGI::Session::MySQL driver by Sherzod Ruzmetov, original author of CGI::Session.
-
-Matt LeBlanc contributed significant updates for the 4.0 release.
-
-=head1 LICENSING
-
-For additional support and licensing see L<CGI::Session|CGI::Session>
-
-=cut
diff --git a/qooxdoo/source/perl/CGI/Session/Driver/sqlite.pm b/qooxdoo/source/perl/CGI/Session/Driver/sqlite.pm
deleted file mode 100644
index 561e9a7..0000000
--- a/qooxdoo/source/perl/CGI/Session/Driver/sqlite.pm
+++ /dev/null
@@ -1,99 +0,0 @@
-package CGI::Session::Driver::sqlite;
-
-# $Id: sqlite.pm 351 2006-11-24 14:16:50Z markstos $
-
-use strict;
-
-use File::Spec;
-use base 'CGI::Session::Driver::DBI';
-use DBI qw(SQL_BLOB);
-use Fcntl;
-
-$CGI::Session::Driver::sqlite::VERSION = "4.20";
-
-sub init {
- my $self = shift;
-
- unless ( $self->{Handle}) {
- $self->{DataSource} = "dbi:SQLite:dbname=" . $self->{DataSource} unless ( $self->{DataSource} =~ /^dbi:sqlite/i );
- }
-
- $self->SUPER::init() or return;
-
- $self->{Handle}->{sqlite_handle_binary_nulls} = 1;
- return 1;
-}
-
-sub store {
- my $self = shift;
- my ($sid, $datastr) = @_;
- return $self->set_error("store(): usage error") unless $sid && $datastr;
-
- my $dbh = $self->{Handle};
-
- my $sth = $dbh->prepare("SELECT id FROM " . $self->table_name . " WHERE id=?");
- unless ( defined $sth ) {
- return $self->set_error( "store(): \$sth->prepare failed with message " . $dbh->errstr );
- }
-
- $sth->execute( $sid ) or return $self->set_error( "store(): \$sth->execute failed with message " . $dbh->errstr );
- if ( $sth->fetchrow_array ) {
- __ex_and_ret($dbh,"UPDATE " . $self->table_name . " SET a_session=? WHERE id=?",$datastr,$sid)
- or return $self->set_error( "store(): serialize to db failed " . $dbh->errstr );
- } else {
- __ex_and_ret($dbh,"INSERT INTO " . $self->table_name . " (a_session,id) VALUES(?, ?)",$datastr, $sid)
- or return $self->set_error( "store(): serialize to db failed " . $dbh->errstr );
- }
- return 1;
-}
-
-sub __ex_and_ret {
- my ($dbh,$sql,$datastr,$sid) = @_;
- # fix rt #18183
- local $@;
- eval {
- my $sth = $dbh->prepare($sql) or return 0;
- $sth->bind_param(1,$datastr,SQL_BLOB) or return 0;
- $sth->bind_param(2,$sid) or return 0;
- $sth->execute() or return 0;
- };
- return ! $@;
-}
-
-1;
-
-__END__;
-
-=pod
-
-=head1 NAME
-
-CGI::Session::Driver::sqlite - CGI::Session driver for SQLite
-
-=head1 SYNOPSIS
-
- $s = new CGI::Session("driver:sqlite", $sid, {DataSource=>'/my/folder/sessions.sqlt'});
- $s = new CGI::Session("driver:sqlite", $sid, {Handle=>$dbh});
-
-=head1 DESCRIPTION
-
-B<sqlite> driver stores session data in SQLite files using L<DBD::SQLite|DBD::SQLite> DBI driver. More details see L<CGI::Session::Driver::DBI|CGI::Session::Driver::DBI>, its parent class.
-
-=head1 DRIVER ARGUMENTS
-
-Supported driver arguments are I<DataSource> and I<Handle>. B<At most> only one of these arguments can be set while creating session object.
-
-I<DataSource> should be in the form of C<dbi:SQLite:dbname=/path/to/db.sqlt>. If C<dbi:SQLite:> is missing it will be prepended for you. If I<Handle> is present it should be database handle (C<$dbh>) returned by L<DBI::connect()|DBI/connect()>.
-
-As of version 1.7 of this driver, the third argument is B<NOT> optional. Using a default database in the temporary directory is a security risk since anyone on the machine can create and/or read your session data. If you understand these risks and still want the old behavior, you can set the C<DataSource> option to I<'/tmp/sessions.sqlt'>.
-
-=head1 BUGS AND LIMITATIONS
-
-None known.
-
-=head1 LICENSING
-
-For support and licensing see L<CGI::Session|CGI::Session>
-
-=cut
-
generated by cgit v1.2.3-24-g4f1b (git 2.32.0) at 2024-06-12 14:10:50 +0200