From 55490b1bfb539386b63e25a8fd90e56c0200c1e8 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Tue, 23 Aug 2011 13:59:15 +0000 Subject: clean out smoketrace --- qooxdoo/source/perl/CGI/Session/Driver/DBI.pm | 236 --------------------- qooxdoo/source/perl/CGI/Session/Driver/db_file.pm | 201 ------------------ qooxdoo/source/perl/CGI/Session/Driver/file.pm | 217 ------------------- qooxdoo/source/perl/CGI/Session/Driver/mysql.pm | 113 ---------- .../source/perl/CGI/Session/Driver/postgresql.pm | 134 ------------ qooxdoo/source/perl/CGI/Session/Driver/sqlite.pm | 99 --------- 6 files changed, 1000 deletions(-) delete mode 100644 qooxdoo/source/perl/CGI/Session/Driver/DBI.pm delete mode 100644 qooxdoo/source/perl/CGI/Session/Driver/db_file.pm delete mode 100644 qooxdoo/source/perl/CGI/Session/Driver/file.pm delete mode 100644 qooxdoo/source/perl/CGI/Session/Driver/mysql.pm delete mode 100644 qooxdoo/source/perl/CGI/Session/Driver/postgresql.pm delete mode 100644 qooxdoo/source/perl/CGI/Session/Driver/sqlite.pm (limited to 'qooxdoo/source/perl/CGI/Session/Driver') 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 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 - 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 by default. You may use a different name if you wish. To do this you have to pass I 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->L. 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. - -=item Password - -Password of the I privileged to connect to the database defined in C - -=item Handle - -An existing L database handle object. The handle can be created on demand -by providing a code reference as a argument, such as C<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, which creates -a CGI::Session object on demand as well. - -C 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 - -=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 stores session data in BerkelyDB file using L - Perl module. All sessions will be stored -in a single file, specified in I driver argument as in the above example. If I isn't given, -defaults to F, 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 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 - -=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 ( ) { - $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, I will be assumed. -I - 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, 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 option, which denotes location of the directory -where session ids are to be kept. If B 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 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 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 - -=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 stores session records in a MySQL table. For details see L, 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 driver supports all the arguments documented in L. In addition, I 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. 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. - -=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 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 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). If you know there is no chance of ever having a null character in the serialized data, you can leave off the I attribute. Using a I column type and C<< ColumnType => 'binary' >> is recommended when using L 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, parent class. - -Also see L, 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 , 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 - -=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 driver stores session data in SQLite files using L DBI driver. More details see L, its parent class. - -=head1 DRIVER ARGUMENTS - -Supported driver arguments are I and I. B only one of these arguments can be set while creating session object. - -I should be in the form of C. If C is missing it will be prepended for you. If I is present it should be database handle (C<$dbh>) returned by L. - -As of version 1.7 of this driver, the third argument is B 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 option to I<'/tmp/sessions.sqlt'>. - -=head1 BUGS AND LIMITATIONS - -None known. - -=head1 LICENSING - -For support and licensing see L - -=cut - -- cgit v1.2.3-24-g4f1b