CGI-Session-4.48000755000765000765 011606571771 12570 5ustar00markmark000000000000CGI-Session-4.48/Makefile.PL000444000765000765 710211606571771 14677 0ustar00markmark000000000000# $Id$ use strict; use Text::Wrap; use File::Spec; use lib './t/lib'; use ExtUtils::MakeMaker; # ------------------------------------------------ sub create_changelog_ini { my($error); eval "require Module::Metadata::Changes"; if ($@) { $error = $@; } else { # Ensure Changelog.ini is writable. if (-e 'Changelog.ini' && ! -w 'Changelog.ini') { $error = (chmod 0200, 'Changelog.ini' == 0) ? 'Could not make Changelog.ini writable' : ''; } if (! $error) { eval { print "Regenerating Changelog.ini...\n"; `ini.report.pl -c -i Changes`; if (! -e 'Changelog.ini') { # Warning: Can't use $@ to carry msg out of block(s). $error = 'Failed to generate Changelog.ini'; } else { my(@stat) = stat 'Changelog.ini'; # Was the file modified in the last 2 seconds? if ( (time() - $stat[9]) < 2) { # Yes. Do nothing. } else { $error = 'Failed to update Changelog.ini'; } } }; if ($@) { $error = $@; } } } # We ignore the precise value of $@ here. if ($error) { print "Warning: Module::Metadata::Changes's ini.report.pl failed to generate or update Changelog.ini. \n"; } else { print "Changelog.ini generated or updated. \n"; } } # End of create_changelog_ini. # ------------------------------------------------ print "-" x 40, "\n"; print fill("", "", <<'MESSAGE'); #### WARNING #### If you are using custom CGI::Session drivers they may not be compatible with the current driver specifications. You will need to make some changes to your drivers' code before proceeding with this installation to make it compatible with CGI::Session 4.x. Fortunately, current driver specifications are a lot easier to adapt to. Should you have any assistance re-coding your current drivers, please let me know. Current driver specs are documented in CGI/Session/Driver.pm #### TESTING ##### You are encouraged to run tests for the backend you will be using. The database backends that need a customized connection string won't run by default. To run them, some environment variables must be set. The simplest method is to use the standard "DBI_DSN/DBI_USER/DBI_PASS" environment variables. Otherwise, you can set these variables: MESSAGE print " For PostgreSQL: CGISESS_PG_DSN CGISESS_PG_USER CGISESS_PG_PASS For MySQL: CGISESS_MYSQL_DSN CGISESS_MYSQL_USER CGISESS_MYSQL_PASS CGISESS_MYSQL_SOCKET "; print "\n"; print "-" x 40, "\n"; create_changelog_ini(); print "-" x 40, "\n"; WriteMakefile( NAME => 'CGI::Session', VERSION_FROM => 'lib/CGI/Session.pm', PL_FILES => {}, PREREQ_PM => { 'CGI' => 3.26, 'Digest::MD5' => 0, 'Data::Dumper' => 0, # 'Test::Differences' => 0, 'Test::More' => 0, 'Scalar::Util' => 0, }, ABSTRACT => 'Persistent session data in CGI applications', AUTHOR => 'Sherzod Ruzmetov ', clean => { FILES => [ 't/cgisess.*', 't/sessiondata' ] }, EXTRA_META => " no_index: package: - CGI::Session::Test::SimpleObjectClass - CGI::Session::Test::Default - OverloadedObjectClass - OverloadedClass ", ); # # Creating place for test-scripts. Some of the scripts needs this to be present # mkdir(File::Spec->catfile('t', 'sessiondata')); package MY; use strict; sub postamble { return <<'MAKE_TEXT'; prepare_dist :: metafile manifest dist $(NOECHO) $(NOOP) MAKE_TEXT } sub libscan { my ($self, $path) = @_; return '' if $path =~ m/\.svn/; return $path; } CGI-Session-4.48/Build.PL000444000765000765 703011606571771 14221 0ustar00markmark000000000000# $Id: Build.PL 336 2006-10-26 02:17:31Z markstos $ use strict; use File::Spec; use Module::Build; use Text::Wrap; # ------------------------------------------------ sub create_changelog_ini { my($error); eval "require Module::Metadata::Changes"; if ($@) { $error = $@; } else { # Ensure Changelog.ini is writable. if (-e 'Changelog.ini' && ! -w 'Changelog.ini') { $error = (chmod 0200, 'Changelog.ini' == 0) ? 'Could not make Changelog.ini writable' : ''; } if (! $error) { eval { print "Regenerating Changelog.ini...\n"; `ini.report.pl -c -i Changes`; if (! -e 'Changelog.ini') { # Warning: Can't use $@ to carry msg out of block(s). $error = 'Failed to generate Changelog.ini'; } else { my(@stat) = stat 'Changelog.ini'; # Was the file modified in the last 2 seconds? if ( (time() - $stat[9]) < 2) { # Yes. Do nothing. } else { $error = 'Failed to update Changelog.ini'; } } }; if ($@) { $error = $@; } } } # We ignore the precise value of $@ here. if ($error) { print "Warning: Module::Metadata::Changes's ini.report.pl failed to generate or update Changelog.ini. \n"; } else { print "Changelog.ini generated or updated. \n"; } } # End of create_changelog_ini. # ------------------------------------------------ # Some of the scripts need ./t/sessiondata to be present. mkdir(File::Spec->catfile('t', 'sessiondata')); print "-" x 40, "\n"; print fill("", "", <<'MESSAGE'); #### WARNING #### If you are using custom CGI::Session drivers they may not be compatible with the current driver specifications. You will need to make some changes to your drivers' code before proceeding with this installation to make it compatible with CGI::Session 4.x. Fortunately, current driver specifications are a lot easier to adapt to. Should you have any assistance re-coding your current drivers, please let me know. Current driver specs are documented in CGI/Session/Driver.pm #### TESTING ##### You are encouraged to run tests for the backend you will be using. The database backends that need a customized connection string won't run by default. To run them, some environment variables must be set. The simplest method is to use the standard "DBI_DSN/DBI_USER/DBI_PASS" environment variables. Otherwise, you can set these variables: MESSAGE print " For PostgreSQL: CGISESS_PG_DSN CGISESS_PG_USER CGISESS_PG_PASS For MySQL: CGISESS_MYSQL_DSN CGISESS_MYSQL_USER CGISESS_MYSQL_PASS CGISESS_MYSQL_SOCKET "; print "\n"; print "-" x 40, "\n"; create_changelog_ini(); print "-" x 40, "\n"; Module::Build -> new ( module_name => 'CGI::Session', license => 'artistic', dist_abstract => 'Persistent session data in CGI applications', dist_author => 'Sherzod Ruzmetov ', configure_requires => { 'Module::Build' => 0.38 }, build_requires => { # 'Test::Differences' => 0, 'Test::More' => 0, }, requires => { 'CGI' => 3.26, 'Data::Dumper' => 0, 'Digest::MD5' => 0, 'Scalar::Util' => 0, }, no_index => { 'package' => [ 'CGI::Session::Test::SimpleObjectClass', 'CGI::Session::Test::Default', 'OverloadedObjectClass', 'OverloadedClass', ], }, meta_merge => { resources => { repository => 'http://github.com/cromedome/cgi-session', }, keywords => [ 'session','http', ], }, ) -> create_build_script(); CGI-Session-4.48/META.yml000444000765000765 471411606571771 14204 0ustar00markmark000000000000--- abstract: 'Persistent session data in CGI applications' author: - 'Sherzod Ruzmetov ' build_requires: Test::More: 0 configure_requires: Module::Build: 0.38 dynamic_config: 1 generated_by: 'Module::Build version 0.38, CPAN::Meta::Converter version 2.110930' keywords: - session - http license: artistic meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: CGI-Session no_index: package: - CGI::Session::Test::SimpleObjectClass - CGI::Session::Test::Default - OverloadedObjectClass - OverloadedClass provides: CGI::Session: file: lib/CGI/Session.pm version: 4.48 CGI::Session::Driver: file: lib/CGI/Session/Driver.pm version: 4.43 CGI::Session::Driver::DBI: file: lib/CGI/Session/Driver/DBI.pm version: 4.43 CGI::Session::Driver::db_file: file: lib/CGI/Session/Driver/db_file.pm version: 4.43 CGI::Session::Driver::file: file: lib/CGI/Session/Driver/file.pm version: 4.43 CGI::Session::Driver::mysql: file: lib/CGI/Session/Driver/mysql.pm version: 4.43 CGI::Session::Driver::postgresql: file: lib/CGI/Session/Driver/postgresql.pm version: 4.43 CGI::Session::Driver::sqlite: file: lib/CGI/Session/Driver/sqlite.pm version: 4.43 CGI::Session::ErrorHandler: file: lib/CGI/Session/ErrorHandler.pm version: 4.43 CGI::Session::ID::incr: file: lib/CGI/Session/ID/incr.pm version: 4.43 CGI::Session::ID::md5: file: lib/CGI/Session/ID/md5.pm version: 4.43 CGI::Session::ID::static: file: lib/CGI/Session/ID/static.pm version: 4.44 CGI::Session::Serialize::default: file: lib/CGI/Session/Serialize/default.pm version: 4.43 CGI::Session::Serialize::freezethaw: file: lib/CGI/Session/Serialize/freezethaw.pm version: 4.43 CGI::Session::Serialize::storable: file: lib/CGI/Session/Serialize/storable.pm version: 4.43 CGI::Session::Test::Default: file: lib/CGI/Session/Test/Default.pm version: 4.47 CGI::Session::Test::SimpleObjectClass: file: lib/CGI/Session/Test/Default.pm version: 0 CGI::Session::Tutorial: file: lib/CGI/Session/Tutorial.pm version: 4.43 OverloadedClass: file: lib/CGI/Session/Test/Default.pm version: 0 requires: CGI: 3.26 Data::Dumper: 0 Digest::MD5: 0 Scalar::Util: 0 resources: license: http://opensource.org/licenses/artistic-license.php repository: http://github.com/cromedome/cgi-session version: 4.48 CGI-Session-4.48/Changelog.ini000444000765000765 5373111606571771 15346 0ustar00markmark000000000000[Module] Name=CGI::Session Configlog.Creator=Module::Metadata::Changes V 1.01 Configlog.Parser=Config::IniFiles V 2.47 [V 4.41] Date=2009-02-06T00:00:00 Comments= < new(... ... (TableName => 'new_name'}) or after creating the object call $session -> table_name('new_name'). To retrieve the name call $name = $session -> table_name(). EOT [V 4.32] Date=2008-06-17T00:00:00 Comments=* FIX: Packaging of 4.31 release was botched. [V 4.31] Date=2008-06-10T00:00:00 Comments= < {} to Makefile.PL to beat ExtUtils::MakeMaker over the head otherwise it executes 'perl Build.PL Build' * NEW: Support specification of both the id column name and the a_session column name in the sessions table by extending the options acceptable in CGI::Session->new(....{here}). Allow: {TableName => 'session' IdColName => 'my_id' DataColName => 'my_data'}. Default: {TableName => 'sessions' IdColName => 'id' DataColName => 'a_session'}. Allow any 1 2 or 3 of these options. Missing keys default as specified. (Patch by Chris RT#2224. Implemented differently by Ron Savage). Supported drivers: o MySQL (native to CGI::Session) o ODBC (separate distro CGI::Session::Driver::odbc V 1.01) o Oracle (separate distro CGI::Session::Driver::oracle V 1.01) o Postgres (native) o SQLite (native) EOT [V 4.20_1] Date=2006-11-24T00:00:00 Comments= < sub {DBI->connect} (Mark Stosberg) Finally be aware that since 4.0 some people have reported problems with the auto-flushing code. There may be an unresolved. You always call flush() to be safe. Input or code contributions for the issue are appreciated. Some related tickets include: http://rt.cpan.org/Public/Bug/Display.html?id=14604 http://rt.cpan.org/Public/Bug/Display.html?id=16861 http://rt.cpan.org/Public/Bug/Display.html?id=17541 http://rt.cpan.org/Public/Bug/Display.html?id=17299 EOT [V 4.03] Date=2005-10-05T00:00:00 Comments= <clear('email') work for 3.95 compatibility (Mark Stosberg) * FIX: Added back is_new() for compatibility with 3.95. (Mark Stosberg) * FIX: Support for CGI::Simple is confirmed resolving RT#6141 (Mark Stosberg) * FIX: Add code and tests for $CGI::Session::MySQL::TABLE_NAME which worked in 3.x (Mark Stosberg) * DOCS: CGI::Session now has a public Subversion repository thanks to Jason Crome. See the bottom of the CGI::Session docs for details. EOT [V 4.00_08] Date=2005-03-15T00:00:00 Comments=* FIX: Changes made in 4.00_07 rolled back [V 4.00_07] Date=2005-03-13T00:00:00 Comments=* FIX: overloaded objects are now stored properly [V 4.00_06] Date=2005-02-24T00:00:00 Comments= < new(..., ..., (TableName => 'new_name'}) or, after creating the object, call $session -> table_name('new_name'). To retrieve the name, call $name = $session -> table_name(). 4.32 - Tuesday, June 17, 2008 * FIX: Packaging of 4.31 release was botched. 4.31 - Tuesday, June 10, 2008 * FIX: Patch CGI::Session::Driver::DBI to check that the DBI handle still exists before trying to ping it. This handles the case where the DBI object is destroyed before the session object. See RT#35925. * FIX: Patch CGI::Session::Driver::DBI's remove() which still hard-coded the column name 'id' instead of using the new feature which allows the user to specify the name of the column. See RT#36235. * FIX: Patch POD yet again to emphasize that an explicit call to destroy() should be followed by explicit call to flush(), in particular in the case where the program is not exiting and hence auto-flushing is not activated. Sections patched are 'A Warning about Auto-flushing' and the docs for delete(). See RT#34668. 4.30 - Friday, April 25, 2008 * FIX: Patch POD for CGI::Session in various places, to emphasize even more that auto-flushing is unreliable, and that flush() should always be called explicitly before the program exits. The changes are a new section just after SYNOPSIS and DESCRIPTION, and the PODs for flush(), and delete(). See RT#17299 and RT#34668 * NEW: Add t/new_with_undef.t and t/load_with_undef.t to explicitly demonstrate the effects of calling new() and load() with various types of undefined or fake parameters. See RT#34668 * FIX: Patch POD for new() and load() to clarify the result of calling these with undef, or with an initialized CGI object with an undefined or fake CGISESSID. See RT#34668. Specifically: You are strongly advised to run the old-fashioned 'make test TEST_FILES=t/new_with_undef.t TEST_VERBOSE=1' or the new-fangled 'prove -v t/new_with_undef.t', for both new*.t and load*.t, and examine the output * FIX: Patch POD in various tiny ways to improve the grammar 4.29_2 - Thursday, March 27, 2008 * FIX: stop ExtUtils::MakeMaker trying to create Build.PL (Ron Savage) * FIX: Disable trying to use utf8 in tests. (Ron Savage) Ref RT#21981, RT#28516 4.29_1 - Saturday, March 15, 2008 Special Thanks to Ron Savage who did the bulk of the work to put this release together. * FIX: Patch CGI::Session to fix RT#29138 (Patch by Barry Friedman) * NEW: Add a note to CGI::Session's POD referring to utf8 problems, and include references to RT#21981 (Reported by erwan) and RT#28516 (Reported by jasoncrowther) * FIX: Patch CGI::Session::Driver::DBI.pm to fix RT#24601 (Patch by latypoff) * FIX: Patch CGI::Session::Driver::DBI.pm to fix RT#24355 (Reported by fenlisesi, patch by Ron Savage) * NEW: Add t/bug24285.t to ensure session data files are created properly when the user specifies a directory other than /tmp (Reported by William Pearson RT#24285, patch by Ron Savage) * FIX: Patch t/ip_matches.t and t/bug21592.t to remove test files left in /tmp, to fix RT#29969 (Reported by ANDK, patch by Ron Savage) * FIX: Patch POD for CGI::Session::Driver::file to clarify how to use the option to change the file name pattern used to created session files (Report by appleaday RT#33635, patch by Ron Savage) * FIX: Patch CGI::Session::Driver::sqlite to add sub DESTROY to fix RT#32932 (Patch by Alexander Batyrshin, corrected by Ron Savage) * FIX: Remove CGI::Session::Seralize::json and t/g4_dbfile_json.t until such time as this code can be made to work reliably. Both JSON::Syck and JSON::XS have been tried, and in both cases t/g4_dbfile_json.t dies horribly (but differently). Patch POD for CGI::Session to remove references to JSON. RT#25325 (Reported by bkw, patch by Ron Savage) * NEW: Patch CGI::Session's POD and load() to allow the session/cookie name default of CGISESSID to be overridden. (Patch by Lee Carmichael RT#33437, reformatted by Ron Savage). Lee has also patched t/name.t to test the new functionality * NEW: Split CGI::Session::Serialize::yaml out into its own distro. Get it hot from CPAN! * NEW: Add Build.PL for Module::Build users. This also requires adding PL_FILES => {} to Makefile.PL to beat ExtUtils::MakeMaker over the head, otherwise it executes 'perl Build.PL Build' * NEW: Support specification of both the id column name and the a_session column name in the sessions table, by extending the options acceptable in CGI::Session->new(..,..,{here}). Allow: {TableName => 'session', IdColName => 'my_id', DataColName => 'my_data'}. Default: {TableName => 'sessions', IdColName => 'id', DataColName => 'a_session'}. Allow any 1, 2 or 3 of these options. Missing keys default as specified. (Patch by Chris RT#2224. Implemented differently by Ron Savage). Supported drivers: o MySQL (native to CGI::Session) o ODBC (separate distro, CGI::Session::Driver::odbc V 1.01) o Oracle (separate distro, CGI::Session::Driver::oracle V 1.01) o Postgres (native) o SQLite (native) 4.20 - Monday, December 4, 2006 * INTERNAL: No Changes since 4.20_1. Declaring stable. 4.20_1 - Friday, November 24, 2006 * FIX: -ip_match now works even when it's not the last import item. (RT#21779) * FIX: In the PostgreSQL driver, a race condition is when storing is now worked around. (Mark Stosberg) * FIX: Added important clarification and example to MySQL driver docs that the session column needs to be defined as a primary key to avoid duplicate sessions. (Justin Simoni, Mark Stosberg) * FIX: The default serializer now works correctly with certain data structures. (RT#?) (Matt LeBlanc) * FIX: A documentation bug in find() was fixed (Matt LeBlanc) * FIX: Documented how to declare a database handle to be used on demand, which was introduced in 4.04. (Mark Stosberg) * FIX: Connections made with SQLite now disconnect only when appropriate, instead of always. This addresses a symptom seen as "attempt to prepare on inactive database handle" (Jaldhar Vyas, Sherzod, Mark Stosberg) * FIX: Args to the constructor for CGI::Session and the drivers are now always shallow copied rather than used directly, to prevent modification. (RT#21952, Franck Porcher, Sherzod, Mark Stosberg) * FIX: The documentation for expire($param, $time) was made more explicit (pjf, Mark Stosberg) * NEW: Added recommended use of flush() to the Synopsis (Michael Renner, RT#22333) * NEW: Added links to Japanese translations of the documentation (Makio Tsukamoto) http://digit.que.ne.jp/work/index.cgi?Perldoc/ja * INTERNAL: Update test to workaround YAML versions less than 0.58. (Matt LeBlanc) * INTERNAL: param() code was refactored for clarity (Mark Stosberg, Ali ISIK, RT#21782) * INTERNAL: new() and load() were refactored (Ali Isik) * INTERNAL: renamed some environment variables used for testing (Ron Savage) * INTERNAL: Multi key-value syntax of param() now always returns number of keys successfully processed, 0 if no key/values were processed. 4.14 - Sunday, June 11, 2006 * NEW: The find() command now has better documentation. (Ron Savage, Matt LeBlanc) * FIX: find() no longer changes the access or modified times (RT#18442) (Matt LeBlanc) * FIX: param() called with two parameters now returns the value set, if any (RT#18912) (Matt LeBlanc) * FIX: driver, serializer, and id generator names are now untainted (RT#18873) (Matt LeBlanc) * INTERNAL: automatic flushing has been documented to be unreliable, although it was recommended in the past. Automatic flushing can be affected adversely in persistent environments and in some cases by third party software. There are also some cases in which flushing happened automatically in 3.x, but quit working with 4.x. See these tickets for details. http://rt.cpan.org/Ticket/Display.html?id=17541 http://rt.cpan.org/Ticket/Display.html?id=17299 4.13 - Wednesday, April 12, 2006 * FIX: Applied patch to fix cookie method (RT#18493,Nobuaki ITO) * FIX: Berkeley DB 1.x exhibits a bug when used in conjunction with O_NOFOLLOW. Because of this, we've removed it from the db_file driver. It will still attempt to stop symlinks but the open itself has dropped the flag. (Matt LeBlanc) * FIX: json and yaml db_file tests now check for the presence of DB_File. (Matt LeBlanc) 4.12 - Friday, April 7, 2006 * SECURITY: Fix possible SQL injection attack. (RT#18578, DMUEY) 4.11 - Friday, March 31, 2006 * FIX: Since 4.10, using name() as a class method was broken. This has been fixed, and regression tests for both uses have been added. (Matt LeBlanc) 4.10 - Tuesday, March 28, 2006 * SECURITY: Hopefully this settles all of the problems with symlinks. Both the file and db_file drivers now use O_NOFOLLOW with open when the file should exist and O_EXCL|O_CREAT when creating the file. Tests added for symlinks. (Matt LeBlanc) * SECURITY: sqlite driver no longer attempts to use /tmp/sessions.sqlt when no Handle or DataSource is specified. This was a mistake from a security standpoint as anyone on the machine would then be able to create and therefore insert data into your sessions. (Matt LeBlanc) * NEW: name is now an instance method (RT#17979) (Matt LeBlanc) 4.09 - Friday, March 16th, 2006 * SECURITY: Applying security patch from: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=356555 (Julien Danjou) 4.08 - Thursday, March 15th, 2006 * FIX: DESTROY was sometimes wiping out exception handling. RT#18183, Matt LeBlanc. * SECURITY: Resolve some issues in: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=356555 - db_file and file now check for symlinks either explicitly or by using O_EXCL on sysopen - file creation umask defaults to 660 * NEW: db_file and file drivers now accepts a UMask option. (Matt LeBlanc) * INTERNAL: test suite clean up (Tyler MacDonald) 4.07 - Thursday, March 9th, 2006 * INTERNAL: MANIFEST update to fix release. 4.06 - Wednesday, March 3rd, 2006 * INTERNAL: MANIFEST update to fix release. 4.06 - Wednesday, March 8th, 2006 * FIX: some stray warnings when flushing: "Use of uninitialized value in numeric eq (==)" (RT#14603) * NEW: JSON and YAML serializers (Tyler MacDonald) * INTERNAL: CGI::Session::Test::Default accepts a "skip" argument, listing tests that should be skipped. (Tyler) 4.05 - Friday, March 3rd, 2006 * FIX: Race condition fixed when writing to session files (RT#17949) 4.04 - Wednesday, March 01, 2006 * NEW: File driver now has option to disable flock (for those running Win 9x, VMS, MacPerl, VOS and RISC OS). (Matt LeBlanc) * FIX: If DBI driver was initialized using 'Handle', Driver::DBI::init() returned false, and Driver::new() thought init faild and kept returning undef. The problem was fixed by making sure Driver::DBI::init() returned true. (Sherzod) * Added .*cgisess.* to disclude cgisess.db, cgisess.id, and any session files created in the t directory. (Matt LeBlanc) * FIX: File driver now respects $CGI::Session::File::FileName for 3.9x compatibility. (Matt LeBlanc) * FIX: Default serializer now properly handles data structures that appear more than once in the serialized data structure (before it'd result in data structures that were equivalent but did not have the same address). (Matt LeBlanc) * FIX: File driver now localizes the filehandle to avoid any possibility of extended locking in persistent environments (Matt LeBlanc) * FIX: File driver now locks the file when retrieving the session data (Matt LeBlanc) * NEW: DBI Drivers now support a lazy loaded database handle. This is useful with the CGI::Application plugin system. If the session is never used, the database handle may not not need to be created. The syntax is to use a code ref: Handle => sub {DBI->connect} (Mark Stosberg) Finally, be aware that since 4.0 some people have reported problems with the auto-flushing code. There may be an unresolved. You always call flush() to be safe. Input or code contributions for the issue are appreciated. Some related tickets include: http://rt.cpan.org/Public/Bug/Display.html?id=14604 http://rt.cpan.org/Public/Bug/Display.html?id=16861 http://rt.cpan.org/Public/Bug/Display.html?id=17541 http://rt.cpan.org/Public/Bug/Display.html?id=17299 4.03 - Wednesday, October 05, 2005 * FIX: automatic flushing did not work if session object was global * FIX: Default serializer can now serialize objects (Matt LeBlanc) * INTERNAL: SQLite driver no longer needs MIME::Base64 for encoding (Matt LeBlanc) 4.02 - Friday, September 02, 2005 * FIX: remote_addr() was missing (RT #14414]) 4.01 - Thursday, September 01, 2005 * FIX: Minor POD fix 4.00 - Wednesday, August 31, 2005 *** NOTE *** The 4.0 release represents a major overhaul of the CGI::Session code base. Care has been taken to be 100% compatible with applications developed with 3.x. However, you are encouraged to run regression tests with your own applications before using this in production. * NEW: PostgreSQL driver enhanced to work better with binary serializers (Matt LeBlanc) * FIX: update to un tainting in default serializer to make "-T" happy (Matt LeBlanc) * FIX: CGI::Session (qw/-ip_match/), a 3.x feature, works again (Shawn Sorichetti) * INTERNAL: Improved documentation shown during "make", which explains how to run database-driven tests. (Mark Stosberg) * FIX: to support binary serializers SQLite driver uses MIME::Base64 (Sherzod Ruzmetov) 4.00_09 - Thursday, July 21, 2005 * CHANGE: Starting with 4.0, it will no longer work to use the syntax of CGI::Session::DriverName(). This hasn't been a documented API since CGI::Session 2.94, released in August, 2002. * FIX: documented etime(), which was present in 3.x (Mark Stosberg) * FIX: Added code, test and docs to make $CGI::Session::File::FileName work, for 3.x compatibility. (Mark Stosberg) * FIX: Providing an expire time like "-10" now works (Mark Stosberg) * FIX: Restored close() method, for 3.x compatibility. (Mark Stosberg) * FIX: Make ->clear('email') work, for 3.95 compatibility (Mark Stosberg) * FIX: Added back is_new() for compatibility with 3.95. (Mark Stosberg) * FIX: Support for CGI::Simple is confirmed, resolving RT#6141 (Mark Stosberg) * FIX: Add code and tests for $CGI::Session::MySQL::TABLE_NAME, which worked in 3.x (Mark Stosberg) * DOCS: CGI::Session now has a public Subversion repository, thanks to Jason Crome. See the bottom of the CGI::Session docs for details. 4.00_08 - Tuesday, March 15, 2005 * FIX: Changes made in 4.00_07 rolled back 4.00_07 - Sunday, March 13, 2005 * FIX: overloaded objects are now stored properly 4.00_06 - Thursday, February 24, 2005 * FIX (?): a test script was failing on Win32 * FIX: inaccurate error reporting in load() 4.00_05 - Tuesday, February 22, 2005 * FIX: case insensitivity was not enforced properly in CGI::Session::parse_dsn() 4.00_04 - Wednesday, February 16, 2005 * FIX: Minor fix in tests suits and error-checking routines of serializers and id-generators 4.00_03 - Friday, February 11, 2005 * NEW: CGI::Session::find() introduced * NEW: traverse() introduced into drivers to support CGI::Session::find() * DOCS: More complete driver specs documented 4.00_02 - Wednesday, February 09, 2005 * FIX: race conditions in Driver/file.pm pointed out by Martin Bartosch 4.00_01 - Wednesday, February 09, 2005 * NEW: load() - constructor method to prevent unnecessary session creations * NEW: is_expired() - method to intercept expired sessions * NEW: is_empty() - to intercept requests for un existing sessions * NEW: more optimized source code * NEW: updated and improved driver specs * NEW: standard testing framework * NEW: 'sqlite' driver 3.12 * cache() method introduced, which is normally used by library drivers to cache certain value within the single process * Apache::Session-like tie interface supported (EXPERIMENTAL!) * trace() and tracemsg() methods added for debugging purposes 3.8 * Abbreviations in DSN parameters are supported via Text::Abbrev. * Automatic api3 detection makes "-api3" switch obsolete * Experimental "-frozen" switch added, but not yet functional. * sync_param() utility function added * header() replacement to CGI::header() added, which outputs proper HTTP headers with session information * Private data records have been documented. * Bug in clear() kept failing if passed no arguments to be cleared. 3.x * Ability to choose between serializers, drivers and id generators while creating the session object. Supported via '-api3' switch. * New serializers added: Storable, FreezeThaw in addition to Default. * New ID generator added: Incr, which generates auto incrementing id numbers, in addition to MD5 * "-ip_match" switch enabled for additional security * Expire() method is fully functional * Ability to expire certain session parameters * Better documented drivers specifications * Main documentation is split into two: 1) CGI::Session and 2) CGI::Session::Tutorial * Bug in POD documentation is fixed (thanks to Graham Barr) $Id$ CGI-Session-4.48/INSTALL000444000765000765 215411606571771 13760 0ustar00markmark000000000000INSTALLATION ============ Using CPAN Interactive shell ---------------------------- % perl -MCPAN -e shell cpan> install CGI::Session Using Makefile.PL -------------------- % perl Makefile.PL % make % make test % make install If you don't have proper permissions to perform system-wide installations you can install CGI::Session to your private PERL5LIB folder: % perl Makefile.PL LIB=~/perllib % make % make test % make install Above set of commands install CGI::Session to your ~/perllib folder. TESTING ======== You are encouraged to run tests for the backend you will be using. The database backends that need a customized connection string won't run by default. To run them, some environment variables must be set. The simplest method is to use the standard "DBI_DSN" environment variable to define a DBI connection string. Otherwise, you can set these variables as well: For PostgreSQL: CGISESS_PGSQL_DSN CGISESS_PGSQL_USER CGISESS_PGSQL_PASSWORD For MySQL: CGISESS_MYSQL_DSN CGISESS_MYSQL_USER CGISESS_MYSQL_PASSWORD CGISESS_MYSQL_SOCKET CGI-Session-4.48/META.json000444000765000765 733011606571771 14351 0ustar00markmark000000000000{ "abstract" : "Persistent session data in CGI applications", "author" : [ "Sherzod Ruzmetov " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.38, CPAN::Meta::Converter version 2.110930", "keywords" : [ "session", "http" ], "license" : [ "artistic_1" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "CGI-Session", "no_index" : { "package" : [ "CGI::Session::Test::SimpleObjectClass", "CGI::Session::Test::Default", "OverloadedObjectClass", "OverloadedClass" ] }, "prereqs" : { "build" : { "requires" : { "Test::More" : 0 } }, "configure" : { "requires" : { "Module::Build" : "0.38" } }, "runtime" : { "requires" : { "CGI" : "3.26", "Data::Dumper" : 0, "Digest::MD5" : 0, "Scalar::Util" : 0 } } }, "provides" : { "CGI::Session" : { "file" : "lib/CGI/Session.pm", "version" : "4.48" }, "CGI::Session::Driver" : { "file" : "lib/CGI/Session/Driver.pm", "version" : "4.43" }, "CGI::Session::Driver::DBI" : { "file" : "lib/CGI/Session/Driver/DBI.pm", "version" : "4.43" }, "CGI::Session::Driver::db_file" : { "file" : "lib/CGI/Session/Driver/db_file.pm", "version" : "4.43" }, "CGI::Session::Driver::file" : { "file" : "lib/CGI/Session/Driver/file.pm", "version" : "4.43" }, "CGI::Session::Driver::mysql" : { "file" : "lib/CGI/Session/Driver/mysql.pm", "version" : "4.43" }, "CGI::Session::Driver::postgresql" : { "file" : "lib/CGI/Session/Driver/postgresql.pm", "version" : "4.43" }, "CGI::Session::Driver::sqlite" : { "file" : "lib/CGI/Session/Driver/sqlite.pm", "version" : "4.43" }, "CGI::Session::ErrorHandler" : { "file" : "lib/CGI/Session/ErrorHandler.pm", "version" : "4.43" }, "CGI::Session::ID::incr" : { "file" : "lib/CGI/Session/ID/incr.pm", "version" : "4.43" }, "CGI::Session::ID::md5" : { "file" : "lib/CGI/Session/ID/md5.pm", "version" : "4.43" }, "CGI::Session::ID::static" : { "file" : "lib/CGI/Session/ID/static.pm", "version" : "4.44" }, "CGI::Session::Serialize::default" : { "file" : "lib/CGI/Session/Serialize/default.pm", "version" : "4.43" }, "CGI::Session::Serialize::freezethaw" : { "file" : "lib/CGI/Session/Serialize/freezethaw.pm", "version" : "4.43" }, "CGI::Session::Serialize::storable" : { "file" : "lib/CGI/Session/Serialize/storable.pm", "version" : "4.43" }, "CGI::Session::Test::Default" : { "file" : "lib/CGI/Session/Test/Default.pm", "version" : "4.47" }, "CGI::Session::Test::SimpleObjectClass" : { "file" : "lib/CGI/Session/Test/Default.pm", "version" : 0 }, "CGI::Session::Tutorial" : { "file" : "lib/CGI/Session/Tutorial.pm", "version" : "4.43" }, "OverloadedClass" : { "file" : "lib/CGI/Session/Test/Default.pm", "version" : 0 } }, "release_status" : "stable", "resources" : { "license" : [ "http://opensource.org/licenses/artistic-license.php" ], "repository" : { "url" : "http://github.com/cromedome/cgi-session" } }, "version" : "4.48" } CGI-Session-4.48/MANIFEST000444000765000765 310711606571771 14057 0ustar00markmark000000000000Build.PL Changelog.ini Changes examples/purge.pl examples/subscriptions.cgi INSTALL lib/CGI/Session.pm lib/CGI/Session/Driver.pm lib/CGI/Session/Driver/db_file.pm lib/CGI/Session/Driver/DBI.pm lib/CGI/Session/Driver/file.pm lib/CGI/Session/Driver/mysql.pm lib/CGI/Session/Driver/postgresql.pm lib/CGI/Session/Driver/sqlite.pm lib/CGI/Session/ErrorHandler.pm lib/CGI/Session/ID/incr.pm lib/CGI/Session/ID/md5.pm lib/CGI/Session/ID/static.pm lib/CGI/Session/Serialize/default.pm lib/CGI/Session/Serialize/freezethaw.pm lib/CGI/Session/Serialize/storable.pm lib/CGI/Session/Test/Default.pm lib/CGI/Session/Tutorial.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.json META.yml MYMETA.json README t/api3_db_file.t t/api3_db_file_freezethaw.t t/api3_db_file_storable.t t/api3_db_file_storable_incr.t t/api3_file.t t/api3_file_freezethaw.t t/api3_file_freezethaw_incr.t t/api3_file_storable.t t/api3_file_storable_incr.t t/api3_incr.t t/api3_obj_store.t t/api3_obj_store_db_file.t t/bug21952.t t/bug21981.todo t/bug24285.t t/cgi_simple.t t/complex_ds.t t/driver_dbi.t t/expire.t t/find.t t/flush.t t/g4.t t/g4_dbfile.t t/g4_dbfile_freezethaw.t t/g4_dbfile_storable.t t/g4_freezethaw.t t/g4_mysql.t t/g4_mysql_freezethaw.t t/g4_mysql_storable.t t/g4_postgresql.t t/g4_postgresql_freezethaw.t t/g4_postgresql_storable.t t/g4_sqlite.t t/g4_sqlite_freezethaw.t t/g4_sqlite_storable.t t/g4_storable.t t/header.t t/ip_matches.t t/is_new.t t/load.t t/load_with_undef.t t/name.t t/new_with_undef.t t/parse_dsn.t t/remote_addr.t t/session_param_undef.t t/str2seconds.t t/symlink_db_file.t t/symlink_file.t CGI-Session-4.48/README000444000765000765 350611606571771 13611 0ustar00markmark000000000000NAME CGI::Session - persistent session data in CGI applications SYNOPSIS # Object initialization: use CGI::Session; $session = CGI::Session->new(); $CGISESSID = $session->id(); # send proper HTTP header with cookies: print $session->header(); # storing data in the session $session->param('f_name', 'Sherzod'); # or $session->param(-name=>'l_name', -value=>'Ruzmetov'); # retrieving data my $f_name = $session->param('f_name'); # or my $l_name = $session->param(-name=>'l_name'); # clearing a certain session parameter $session->clear(["l_name", "f_name"]); # expire '_is_logged_in' flag after 10 idle minutes: $session->expire('is_logged_in', '+10m') # expire the session itself after 1 idle hour $session->expire('+1h'); # delete the session for good $session->delete(); DESCRIPTION CGI-Session is a Perl5 library that provides an easy, reliable and modular session management system across HTTP requests. Persistency is a key feature for such applications as shopping carts, login/authentication routines, and application that need to carry data across HTTP requests. CGI::Session does that and many more. COPYRIGHT Copyright (C) 2001-2005 Sherzod Ruzmetov . All rights reserved. This library is free software. You can modify and or distribute it under the same terms as Perl itself. AUTHOR Sherzod Ruzmetov SEE ALSO * CGI::Session::Tutorial - extended CGI::Session manual * RFC 2965 - "HTTP State Management Mechanism" found at ftp://ftp.isi.edu/in-notes/rfc2965.txt * CGI - standard CGI library * Apache::Session - another fine alternative to CGI::Session CGI-Session-4.48/t000755000765000765 011606571771 13033 5ustar00markmark000000000000CGI-Session-4.48/t/api3_file_storable.t000444000765000765 171211606571771 17104 0ustar00markmark000000000000# $Id: api3_file_storable.t,v 1.2 2002/11/22 22:54:41 sherzodr Exp $ use strict; BEGIN { use Test::More; # Check if DB_File is avaialble. Otherwise, skip this test eval 'require Storable'; plan skip_all => 'Storable not available' if $@; plan(tests => 14); use_ok('CGI::Session',qw/-api3/); }; my $s = CGI::Session->new("serializer:Storable", undef, {Directory=>"t"} ); ok($s); ok($s->id); $s->param(author=>'Sherzod Ruzmetov', name => 'CGI::Session', version=>'1' ); ok($s->param('author')); ok($s->param('name')); ok($s->param('version')); $s->param(-name=>'email', -value=>'sherzodr@cpan.org'); ok($s->param(-name=>'email')); ok(!$s->expire() ); $s->expire("+10m"); ok($s->expire()); my $sid = $s->id(); $s->flush(); my $s2 = CGI::Session->new("serializer:Storable", $sid, {Directory=>'t'}); ok($s2); ok($s2->id() eq $sid); ok($s2->param('email')); ok($s2->param('author')); ok($s2->expire()); $s2->delete(); CGI-Session-4.48/t/symlink_file.t000444000765000765 317011606571771 16043 0ustar00markmark000000000000#/usr/bin/perl -T # $Id: $ use strict; use Test::More; use CGI::Session; use Carp; { no strict 'refs'; no warnings 'redefine'; *CGI::Session::ErrorHandler::set_error = sub { my $class = shift; my $error = shift; croak $error if $error; }; } if (! eval { symlink("",""); 1 }) { plan skip_all => "Your OS doesn't support symlinks"; } plan tests => 11; { no warnings; $CGI::Session::Driver::file::FileName = 'cgisess_%s'; } unlink('t/cgisess_symlink_session','t/cgisess_symlink_session_link'); ok(my $s = CGI::Session->new('driver:file;id:static','symlink_session',{Directory=>'t'}),'Create new session named symlink'); ok($s->id, 'We have an id'); $s->param('passthru',1); $s->flush(); my $path = $s->_driver->_file($s->id); # test retrieve my $new_path = $s->_driver->_file('symlink_session_link'); ok(symlink($path,$new_path), 'Created symlink'); ok(-l $new_path, 'Check to make certain symlink was created'); ok(my $ns = CGI::Session->new('driver:file;id:static','symlink_session_link',{Directory=>'t'}), 'Get our symlinked session'); ok(! -e $new_path || ! -l $new_path,'we should have wiped out the symlink'); isnt($ns->param('passthru'),1,'this session should be unique'); unlink('t/cgisess_symlink_session_link'); # swap the symlink and session ok(rename($path,$new_path),'moving session file'); ok(symlink($new_path,$path),'creating symlink'); $s->param('change',1); ok($s->flush(),'flush should wipe out the symlink'); ok(! -l $path,'original session file has been restored'); # tidy up undef($_) for $s,$ns; unlink('t/cgisess_symlink_session','t/cgisess_symlink_session_link'); CGI-Session-4.48/t/expire.t000444000765000765 145111606571771 14652 0ustar00markmark000000000000# $Id$ use strict; use Test::More qw/no_plan/; # Tests for expire(), which doesn't directly use driver-specific code. use CGI::Session; my $s = CGI::Session->new(); is($s->expire, undef, "undef is returned if nothing has been set yet. "); $s->expire(10); is($s->expire, 10, "basic set/get check"); $s->expire(-10); is($s->expire, -10, "negative set/get check"); $s->expire(0); is($s->expire, undef, "zero cancels expiration"); $s->expire('pumpkin',10); # reach into internals to test is($s->{_DATA}{_SESSION_EXPIRE_LIST}{'pumpkin'}, 10 , "setting expiration for a single param works"); $s->expire('pumpkin', 0); ok(!exists($s->{_DATA}->{_SESSION_EXPIRE_LIST}->{'pumpkin'}), "zero expires parameters"); # # Let's cleanup after ourselves $s->delete; # more related tests are in t/str2second.t CGI-Session-4.48/t/api3_db_file.t000444000765000765 210411606571771 15652 0ustar00markmark000000000000# $Id: api3_db_file.t,v 1.2 2002/11/22 22:54:41 sherzodr Exp $ use strict; BEGIN { use Test::More; # Check if DB_File is available. Otherwise, skip this test eval 'require DB_File'; plan skip_all => "DB_File not available" if $@; plan(tests => 14); use_ok('CGI::Session',qw/-api3/); }; my $s = CGI::Session->new("driver:DB_File", undef, {Directory=>"t"} ); ok($s); ok($s->id); $s->param(author=>'Sherzod Ruzmetov', name => 'CGI::Session', version=>'1' ); ok($s->param('author')); ok($s->param('name')); ok($s->param('version')); $s->param(-name=>'email', -value=>'sherzodr@cpan.org'); ok($s->param(-name=>'email')); ok(!$s->expire() ); $s->expire("+10m"); ok($s->expire()); my $sid = $s->id(); $s->flush(); my $s2 = CGI::Session->new("driver:DB_File", $sid, {Directory=>'t'}); ok($s2); ok($s2->id() eq $sid, "session ID in new session matches original ID" ); ok($s2->param('email'), "found email via param"); ok($s2->param('author'), "found author via param"); ok($s2->expire(), "expire() returns true value"); $s2->delete(); CGI-Session-4.48/t/load_with_undef.t000444000765000765 172111606571771 16511 0ustar00markmark000000000000#!/usr/bin/perl use strict; use warnings; use CGI; use CGI::Session; use Test::More tests => 6; # --------------- { my($session) = CGI::Session -> load(undef); isa_ok($session, 'CGI::Session', 'load(undef) returns an object which'); my($id) = $session -> id(); is($id, undef, "load(undef)'s session object returns an id which /is/ undef"); } { my($q) = CGI -> new(); my($session) = CGI::Session -> load($q); isa_ok($session, 'CGI::Session', 'load($q without CGISESSID) returns an object which'); my($id) = $session -> id(); is($id, undef, "load(\$q without CGISESSID)'s session object returns an id which /is/ undef"); } { my($q) = CGI -> new(); $q -> param(CGISESSID => 'Purple cats is weird'); my($session) = CGI::Session -> load($q); isa_ok($session, 'CGI::Session', 'load($q with fake CGISESSID) returns an object which'); my($id) = $session -> id(); is($id, undef, "load(\$q with fake CGISESSID)'s session object returns an id which /is/ undef"); } CGI-Session-4.48/t/g4_sqlite_storable.t000444000765000765 242611606571771 17147 0ustar00markmark000000000000use strict; use File::Spec; use Test::More; use CGI::Session::Test::Default; for ( "DBI", "DBD::SQLite", "Storable", "MIME::Base64" ) { eval "require $_"; if ( $@ ) { plan(skip_all=>"$_ is NOT available"); exit(0); } } my $dir_name = File::Spec->tmpdir(); my $file_name= File::Spec->catfile($dir_name, 'sessions.sqlt'); my %dsn = ( DataSource => "dbi:SQLite:dbname=$file_name", TableName => 'sessions' ); my $dbh = DBI->connect($dsn{DataSource}, '', '', {RaiseError=>0, PrintError=>0, sqlite_handle_binary_nulls=>1}); unless ( $dbh ) { plan(skip_all=>"Couldn't establish connection with the server. " . DBI->errstr); exit(0); } my ($count) = $dbh->selectrow_array("SELECT COUNT(*) FROM $dsn{TableName}"); unless ( defined $count ) { unless( $dbh->do(qq| CREATE TABLE $dsn{TableName} ( id CHAR(32) NOT NULL PRIMARY KEY, a_session BLOB NOT NULL )|) ) { plan(skip_all=>$dbh->errstr); exit(0); } } my $t = CGI::Session::Test::Default->new( dsn => "driver:sqlite;serializer:storable", args=>{Handle=>$dbh, TableName=>$dsn{TableName}}); plan tests => $t->number_of_tests; TODO: { # local $TODO = "SQLite doesn't work with Storable yet."; $t->run(); } unlink $file_name; CGI-Session-4.48/t/g4_mysql_freezethaw.t000444000765000765 313211606571771 17337 0ustar00markmark000000000000# $Id$ use strict; my %dsn; if (defined $ENV{DBI_DSN} && ($ENV{DBI_DSN} =~ m/^dbi:mysql:/)) { %dsn = ( DataSource => $ENV{DBI_DSN}, Password => $ENV{CGISESS_MYSQL_PASS} || undef, TableName => 'sessions' ); } else { %dsn = ( DataSource => $ENV{CGISESS_MYSQL_DSN}, User => $ENV{CGISESS_MYSQL_USER} || $ENV{USER}, Password => $ENV{CGISESS_MYSQL_PASS} || undef, Socket => $ENV{CGISESS_MYSQL_SOCKET} || undef, TableName => 'sessions' ); } use File::Spec; use Test::More; use CGI::Session::Test::Default; for (qw/DBI DBD::mysql FreezeThaw/) { eval "require $_"; if ( $@ ) { plan(skip_all=>"$_ is NOT available"); exit(0); } } require CGI::Session::Driver::mysql; my $dsnstring = CGI::Session::Driver::mysql->_mk_dsnstr(\%dsn); my $dbh; eval { $dbh = DBI->connect($dsnstring, $dsn{User}, $dsn{Password}, {RaiseError=>0, PrintError=>1}) }; unless ( $dbh ) { plan(skip_all=>"Couldn't establish connection with the MySQL server: " . (DBI->errstr || $@)); exit(0); } my ($count) = $dbh->selectrow_array("SELECT COUNT(*) FROM $dsn{TableName}"); unless ( defined $count ) { unless( $dbh->do(qq| CREATE TABLE $dsn{TableName} ( id CHAR(32) NOT NULL PRIMARY KEY, a_session TEXT NULL )|) ) { plan(skip_all=>$dbh->errstr); exit(0); } } my $t = CGI::Session::Test::Default->new( dsn => "dr:mysql:serial:FreezeThaw", args=>{Handle=>$dbh, TableName=>$dsn{TableName}}); plan tests => $t->number_of_tests; $t->run(); CGI-Session-4.48/t/header.t000444000765000765 43611606571771 14570 0ustar00markmark000000000000# $Id$ use strict; use Test::More qw/no_plan/; # Some driver independent tests for header(); use CGI::Session; my $s = CGI::Session->new(); eval { $s->header() }; is($@, '','has header() method'); eval { $s->http_header() }; is($@, '','has http_header() method'); $s->delete(); CGI-Session-4.48/t/g4_storable.t000444000765000765 55711606571771 15551 0ustar00markmark000000000000use strict; use Test::More; use File::Spec; use CGI::Session::Test::Default; eval { require Storable }; plan(skip_all=>"Storable is NOT available") if $@; my $dir_name = File::Spec->tmpdir(); my $t = CGI::Session::Test::Default->new( dsn => "driver:file;serializer:Storable", args=>{Directory=>$dir_name}); plan tests => $t->number_of_tests; $t->run(); CGI-Session-4.48/t/is_new.t000444000765000765 65411606571771 14626 0ustar00markmark000000000000# $Id$ use strict; use Test::More qw/no_plan/; BEGIN { use_ok ('CGI::Session') }; my $ses = CGI::Session->new(); eval { $ses->is_new() }; is ($@,'', "session has is_new() method"); ok( $ses->is_new(), "a brand new session is_new" ); my $ses_id = $ses->id(); my $ses2 = CGI::Session->load($ses_id); ok( ! $ses2->is_new(), "a session that has been closed and re-opened is not new"); $ses->delete(); $ses2->delete(); CGI-Session-4.48/t/flush.t000444000765000765 51211606571771 14454 0ustar00markmark000000000000use File::Spec; use Test::More qw/no_plan/; use strict; use CGI::Session; my $dir = File::Spec->tmpdir(); my $id; { my $ses = CGI::Session->new(undef,undef,{Directory=> $dir }); $id = $ses->id(); ok($id, "found session id"); } my $file = "$dir/cgisess_".$id; ok(-r $file, "found session data file"); unlink $file; CGI-Session-4.48/t/g4_dbfile_storable.t000444000765000765 67311606571771 17055 0ustar00markmark000000000000# $Id$ use strict; use Test::More; use File::Spec; use CGI::Session::Test::Default; for ( "DB_File", "Storable" ) { eval "require $_"; if ( $@ ) { plan(skip_all=>"$_ is NOT available"); exit(0); } } my $t = CGI::Session::Test::Default->new( dsn => "d:DB_File;s:Storable;id:md5", args=>{FileName => File::Spec->catfile('t', 'sessiondata', 'cgisess.db')}); plan tests => $t->number_of_tests; $t->run(); CGI-Session-4.48/t/g4_dbfile_freezethaw.t000444000765000765 67311606571771 17406 0ustar00markmark000000000000# $Id$ use strict; use Test::More; use File::Spec; use CGI::Session::Test::Default; for ( "DB_File", "FreezeThaw" ) { eval "require $_"; if ( $@ ) { plan(skip_all=>"$_ is NOT available"); exit(0); } } my $t = CGI::Session::Test::Default->new( dsn => "dr:DB_File;ser:FreezeThaw", args=>{FileName => File::Spec->catfile('t', 'sessiondata', 'cgisess.db')}); plan tests => $t->number_of_tests; $t->run(); CGI-Session-4.48/t/cgi_simple.t000444000765000765 115211606571771 15467 0ustar00markmark000000000000# $Id$ use strict; # Test CGI::Simple support in CGI::Session use Test::More; if ( eval { require CGI::Simple } ) { plan qw/no_plan/; } else { plan skip_all => 'CGI::Simple not installed, so skipping related tests.'; } use CGI::Session; my $q = CGI::Simple->new('sid=bob'); my $s; eval { $s = CGI::Session->new($q); }; is($@,'', "survives eval"); ok( $s->id(), 'CGI::Simple object is accepted when passed to new()' ); like( $s->cookie(), qr/CGISES/i, "cookie() method works with CGI::Simple"); like( $s->http_header(), qr/Content-Type/i, "http_header() method works with CGI::Simple"); $s->delete(); CGI-Session-4.48/t/g4_sqlite.t000444000765000765 600311606571771 15247 0ustar00markmark000000000000# $Id$ use strict; use File::Spec; use Test::More; use CGI::Session; use CGI::Session::Test::Default; use Data::Dumper; for ( "DBI", "DBD::SQLite" ) { eval "require $_"; if ( $@ ) { plan(skip_all=>"$_ is NOT available"); exit(0); } } my %dsn = ( DataSource => "dbi:SQLite:dbname=" . File::Spec->catfile('t', 'sessiondata', 'sessions.sqlt'), TableName => 'sessions' ); my $dbh = DBI->connect($dsn{DataSource}, undef, undef, {RaiseError=>1, PrintError=>1}); unless ( $dbh ) { plan(skip_all=>"Couldn't establish connection with the SQLite server"); exit(0); } my %tables = map{ s/['"]//g; ($_, 1) } $dbh->tables(); unless ( exists $tables{ $dsn{TableName} } ) { unless( $dbh->do(qq| CREATE TABLE $dsn{TableName} ( id CHAR(32) NOT NULL PRIMARY KEY, a_session TEXT NULL )|) ) { plan(skip_all=>"Couldn't create table $dsn{TableName}: " . $dbh->errstr); exit(0); } } my $t = CGI::Session::Test::Default->new( dsn => "driver:sqlite", args=>{Handle=> sub {$dbh}, TableName=>$dsn{TableName}}); plan tests => $t->number_of_tests + 4; { # Let's start with a clean slate... $dbh->do("DELETE FROM sessions"); # Build us a session object... my $session = CGI::Session->new('driver:sqlite', undef, \%dsn); $session->param('foo', 'bar'); $session->expire('+1d'); $session->flush(); # Check the integrity of our saved information.... ok($session->param('foo') eq 'bar', "Correct information has been saved in the session..."); # Save this for later, so we can recall the info... my $session_id = $session->id; # Hey, let's see how many rows we have... my $sth = $dbh->prepare("SELECT COUNT(*) FROM " . $dsn{TableName} ); $sth->execute(); # (Hopefully) we only have one session... ok($sth->fetchrow_array() == 1, "Only one copy of the session file..."); # In the app itself, the Session is checked upon a refresh to a new screen... # So let's get rid of what we have, and do it again... undef $session; undef $dbh; # just being thorough. # Our new DB handle... # There's no persistance in the CGI app... my $dbh2 = DBI->connect($dsn{DataSource}, undef, undef, {RaiseError=>1, PrintError=>1}); # And again.. my $dsn2_args = { Handle => $dbh2, TableName => $dsn{TableName}, }; # New Session! Should call up the same information... my $session2 = CGI::Session->load('driver:sqlite', $session_id, $dsn2_args); # Check the integrity of our saved information.... ok($session2->param('foo') eq 'bar', "Information is retrieved from past session alright..."); $session2->flush; # How many do we have?! my $sth2 = $dbh2->prepare("SELECT COUNT(*) FROM " . $dsn{TableName} ); $sth2->execute(); # One? Two? ok($sth2->fetchrow_array() == 1, "Still only one copy of the session..."); } $dbh = DBI->connect($dsn{DataSource}, undef, undef, {RaiseError=>1, PrintError=>1}); $t->run(); CGI-Session-4.48/t/g4_postgresql.t000444000765000765 314111606571771 16151 0ustar00markmark000000000000# $Id$ use strict; my %dsn; if ($ENV{DBI_DSN} && ($ENV{DBI_DSN} =~ m/^dbi:Pg:/)) { %dsn = ( DataSource => $ENV{DBI_DSN}, User => $ENV{DBI_USER}, Password => $ENV{DBI_PASS}, ); } else { %dsn = ( DataSource => $ENV{CGISESS_PG_DSN}, User => $ENV{CGISESS_PG_USER}, Password => $ENV{CGISESS_PG_PASS}, ); } %dsn = (%dsn, TableName => 'sessions', IdColName => 'id', DataColName => 'a_session'); use File::Spec; use Test::More; use CGI::Session::Test::Default; unless ( $dsn{DataSource} ) { plan(skip_all=>"DataSource is not known"); exit(0); } for ( "DBI", "DBD::Pg" ) { eval "require $_"; if ( $@ ) { plan(skip_all=>"$_ is NOT available"); exit(0); } } my $dbh = DBI->connect($dsn{DataSource}, $dsn{User}, $dsn{Password}, {RaiseError=>0, PrintError=>0}); unless ( $dbh ) { plan(skip_all=>"Couldn't establish connection with the PostgreSQL server"); exit(0); } my ($count) = $dbh->selectrow_array("SELECT COUNT(*) FROM $dsn{TableName}"); if ( defined $count ) { $dbh->do("drop table $dsn{TableName}"); } if( $dbh->do(qq| CREATE TABLE $dsn{TableName} ( $dsn{IdColName} CHAR(32) NOT NULL PRIMARY KEY, $dsn{DataColName} TEXT NULL )|) ) { #print STDERR "Created table. \n"; } else { plan(skip_all=>$dbh->errstr); exit(0); } my $t = CGI::Session::Test::Default->new( dsn => "dr:postgresql", args=>{Handle=>$dbh, TableName=>$dsn{TableName}, IdColName => $dsn{IdColName}, DataColName => $dsn{DataColName} }); plan tests => $t->number_of_tests; $t->run(); CGI-Session-4.48/t/remote_addr.t000444000765000765 70211606571771 15621 0ustar00markmark000000000000#$Id$ # # Re: [cpan #14414] method remote_addr() was removed in version 4.01 # use strict; use Test::More ( tests=>5 ); use_ok("CGI::Session"); $ENV{REMOTE_ADDR} = '127.0.0.1'; ok(my $session = CGI::Session->new); ok($session->can("remote_addr"), "remote_addr() exists"); ok(eval{$session->remote_addr}, "remote_addr() passes eval"); ok($session->remote_addr eq $ENV{REMOTE_ADDR}, "remote_addr() is " . $session->remote_addr); $session->delete; CGI-Session-4.48/t/api3_db_file_storable_incr.t000444000765000765 223011606571771 20560 0ustar00markmark000000000000# $Id: api3_db_file_storable_incr.t,v 1.2 2002/11/22 22:54:41 sherzodr Exp $ use strict; BEGIN { use Test::More; # Check if DB_File is available. Otherwise, skip this test eval 'require DB_File'; plan skip_all => "DB_File not available" if $@; eval 'require Storable'; plan skip_all => "Storable not available" if $@; plan(tests => 15); use_ok('File::Spec'); use_ok('CGI::Session',qw/-api3/); }; my $dr_args = {Directory=>'t', IDFile=>File::Spec->catfile('t', 'cgisess.id')}; my $args = "driver:DB_File;serializer;Storable;id:Incr"; my $s = CGI::Session->new($args, undef, $dr_args ); ok($s); ok($s->id); $s->param(author=>'Sherzod Ruzmetov', name => 'CGI::Session', version=>'1' ); ok($s->param('author')); ok($s->param('name')); ok($s->param('version')); $s->param(-name=>'email', -value=>'sherzodr@cpan.org'); ok($s->param(-name=>'email')); ok(!$s->expire() ); $s->expire("+10m"); ok($s->expire()); my $sid = $s->id(); $s->flush(); my $s2 = CGI::Session->new($args, $sid, $dr_args); ok($s2); ok($s2->id() eq $sid); ok($s2->param('email')); ok($s2->param('author')); ok($s2->expire()); $s2->delete(); CGI-Session-4.48/t/find.t000444000765000765 353511606571771 14303 0ustar00markmark000000000000# Name: # find.t. # # Author: # Ron Savage # http://savage.net.au/index.html use strict; my($original_purpose); BEGIN { use CGI::Session; use Test::More; if (CGI::Session->can('find') ) { plan tests => 7; # Remove any other test sessions, so sub find is called once, # which means the test count above is correct, since every extra # session would mean sub find executed 2 extra tests. unlink ; $original_purpose = "Create session simply to test deleting it with CGI::Session's sub find()"; } else { plan skip_all => "Requires a version of CGI::Session with method 'find()'"; } }; # Create a block so $s goes out of scope before we try to access the session. # Without the block we will only see sessions created by previous runs of the program. { my($s) = CGI::Session->new(undef, undef, {Directory => 't'} ); ok($s, 'The test session has been created'); # Set the expiry time so it does not get deleted somehow before we delete it. $s->expire(5); ok($s->id, "The test session's id has been set"); $s->param(purpose => $original_purpose); ok($s->param('purpose'), "The test session's parameter called 'purpose' has been set"); } sub callback { my($session) = @_; isa_ok($session, 'CGI::Session', 'CGI::Session::find() found a session whose class'); ok($session->param('purpose'), "The found session's param called 'purpose' has a true value"); is($original_purpose, $session->param('purpose'), "The found session's param called 'purpose' has the expected value"); $session->delete(); $session->flush(); diag 'The found session has been deleted and flushed'; } CGI::Session->find(undef, \&callback, {Directory => 't'}); is(CGI::Session->errstr, '', 'find() returned no errors'); CGI-Session-4.48/t/api3_obj_store.t000444000765000765 220511606571771 16256 0ustar00markmark000000000000# $Id: api3_obj_store.t,v 1.3 2002/11/22 22:54:41 sherzodr Exp $ use strict; use Data::Dumper; use CGI; use CGI::Session qw/-api3/; my @mods = qw(Storable FreezeThaw); my $ser = undef; for ( @mods ) { eval "require $_"; unless ( $@ ) { $ser = $_; next; } } unless ( $ser ) { print "1..0"; # Neither Storable nor FreezeThaw avaialble exit(0); } warn "#Using $ser as object serializer\n"; my $args = "serializer:$ser"; my $dr_args = {Directory=>'t'}; print "1..8\n"; my $cgi = CGI->new; my $s = CGI::Session->new($args, undef, $dr_args); print defined($s) ? "ok\n" : "not ok\n"; print $s->id() ? "ok\n" : "not ok\n"; $cgi->param(name => 'Sherzod'); print $cgi->param('name') ? "ok\n" : "not ok\n"; print $s->param(_CGI => $cgi) ? "ok\n" : "not ok - _CGI=>$cgi\n"; my $sid = $s->id(); $s->flush(); my $s2 = CGI::Session->new($args, $sid, $dr_args); print defined($s2) ? "ok\n" : "not ok\n"; print $s2->id eq $sid ? "ok\n" : "not ok\n"; my $old_cgi = $s2->param('_CGI'); print ref($old_cgi) ? "ok\n" : "not ok\n"; print $old_cgi->param('name') eq 'Sherzod' ? "ok\n" : "not ok\n"; $s2->delete(); CGI-Session-4.48/t/load.t000444000765000765 134711606571771 14301 0ustar00markmark000000000000# $Id$ use strict; use Test::More 'no_plan'; # Some driver independent tests for load(); use CGI::Session; { my $s = CGI::Session->load('Driver:file;serial:FreezeThaw',undef, Directory=> 'wrong' ); is($s,undef, "undefined session is created with wrong number of args to load"); like(CGI::Session->errstr, qr/Too many/, "expected error is returned for too many args"); unlike(CGI::Session->errstr, qr/new/, "don't mention new() in error when load() fails directly."); } { my $s = CGI::Session->new(); is(CGI::Session->errstr, '', "reality check: no error when calling new()"); $s->load(); like($s->errstr, qr/instance method/, "expected error when load() called as instance method."); $s->delete(); } CGI-Session-4.48/t/bug21952.t000444000765000765 1337311606571771 14564 0ustar00markmark000000000000# http://rt.cpan.org/Public/Bug/Display.html?id=21952 # Hello Mark & Sherzod # # # I just started yesterday to use CGI::Session (as an embedded component # of CGI::Forge ), and would like to report a wrong behavior. # # ----------------------------------------------------- # My environment : # # CGI::Session : Version 4.14 # uname -a : Linux perl.smartech.pf 2.6.16.4 #1 PREEMPT Mon Apr 17 # 15:12:40 TAHT 2006 i686 AMD Athlon(TM) XP 2800+ unknown GNU/Linux # perl -v : This is perl, v5.8.7 built for i386-linux # # ----------------------------------------------------- # My code (summarized) : # # 1 my $opt_dsn = ... # 2 my $cgiquery = ... # 3 my $s = CGI::Session->load('driver:file;serializer:default', # $cgiquery, $opt_dsn) or die; # 4 $s = CGI::Session->new('driver:file;serializer:default', $cgiquery, # $opt_dsn) if $s->is_empty(); # 5 # # ----------------------------------------------------- # The suspicious behavior... # # - The statement line 3 leads to the creation of a new CGI::Session # object, say A, and to the creation of a CGI::Session::Sriver::file # driver object, say B. # # - Statement 4 resets $s, so A & B, no longer reachable are DESTROYed and # garbage collected.The destruction of A is caught in CGI/Session.pm to # automagically call CGI::Session::flush() which does nothing in this # case. A new CGI::Session object is created and assigned to $s, say C, which # shares the driver B (see log below). # # - When the end of program is reached (line 5 above), C is caught to be # flushed by DESTROY. B having already disappeared out the scene, a # new driver is specially created at this time of death only to allow the # flushing (DESTROY >> flush() >> CGI::Session::_driver). # This new driver ignores $opt_dsn (for instance Directory => /my/temp), # so the flushing creates or updates session files # at the wrong place... # # And it appears that # C->{_DRIVER_ARGS} is also gone, # # ----------------------------------------------------- # My analysis of the problem # # Statement line 3 leads CGI::Session::Driver::new() to physically alter # its argument (here $opt_dsn) by turning it into a driver object (bless # $opt_dsn, ). # # So $opt_dsn data is no longer a private custom data structure : it has # turned into an object (B) elligible for a premature DESTROY # when it goes out of reach after statement 4 resets $s. # # As such, and unfortunate as it is, the garbage collection of B is also # that of $opt_dsn, and that of $s->{_DRIVER_ARGS}, # which proves to be unavailable (long gone) when used by # CGI::Session::_driver() to create a driver for the late flushing # (->new( $self->{_DRIVER_ARGS} ). # # ------------------- # My suggestion # # My idea is that the custom data, here $opt_dsn, *should not* be altered # by the underlying CGI::Session logic. # My suggestion to restore a good behavior is to prevent # CGI::Session::Driver to turn its argument into an object. # This is easily done by patching CGI::Forge::Driver::new() as follows # ( *bold* shows the suggested patch, /*bold italic*/ shows my other # "perturbations" ) : # # sub new { # /*my ($class, $args) = @_; # croak "Invalid argument type passed to driver: " . Dumper($args) if # $args && ! ref $args; # $args ||= {};*/ # # # my $self = bless ($args, $class) # wrong : $args is a custom # data that shouldn't be altered # my $self = bless (*{%$args}*, $class); # Instead make it a # shallow-clone, and only alter the clone ! # return $self if $self->init(); # return $self->set_error( "%s->init() returned false", $class); # } # # I've applied it to my CGI::Session version and the suspicious behavior # was removed. # # Cheers, and good luck. # # I hope that CGI::Session stays around up & running : it's a fine suite # of module. Thanks for contributing it. # # # Franck PORCHER # # ======================= LOGS========================== # /*Statement line 3 ... # */Oct 7 16:32:21 perl logger: [CGISESSION::LOAD::1] SESSION: # CGI::Session=HASH(0x87808ac) # Oct 7 16:32:21 perl logger: [CGISESSION::_driver] SESSION: # CGI::Session=HASH(0x87808ac) DRIVER: *DRIVERARGS: _HASH(0x87b3a20)_* # Oct 7 16:32:21 perl logger: [DRIVER::INIT] DRIVER:* # CGI::Session::Driver::file=_HASH(0x87b3a20)_* DIRECTORY: . # Oct 7 16:32:21 perl logger: [CGISESSION::LOAD::2] SESSION: # CGI::Session=HASH(0x87808ac) DRIVER: # CGI::Session::Driver::file=HASH(0x87b3a20) # # ==> The 3 lines above show how $opt_dsn (*_HASH(0x87b3a20)_*) is turned # into an object (_*CGI::Session::Driver::file=HASH(0x87b3a20)*_) # # # /*Statement lien 4 (rest of $s) ...*/ # Oct 7 16:32:21 perl logger: [*CGISESSION::DESTROY*] SESSION: # CGI::Session=HASH(0x87808ac) DRIVER: # Oct 7 16:32:21 perl logger: [*DRIVER::DESTROY*] DRIVER: # _*CGI::Session::Driver::file=HASH(0x87b3a20)*_ # # ==> these 2 lines show that (blessed)$opt_dsn is DESTROYED prematurately.. use strict; use File::Spec; use Test::More ('no_plan'); BEGIN { use_ok("CGI"); use_ok('CGI::Session'); use_ok("CGI::Session::Driver"); use_ok("CGI::Session::Driver::file"); } my $opt_dsn = {Directory=>File::Spec->tmpdir()}; ok(ref($opt_dsn) eq 'HASH', '$opt_dsn is HASH'); ok(my $q = CGI->new()); ok(my $s = CGI::Session->new("driver:file;serializer:default", $q, $opt_dsn)); ok(ref($opt_dsn) eq 'HASH', '$opt_dsn is HASH'); # Clean up /tmp as per RT#29969. $s -> delete(); undef($s); ok(!defined($s), "Session object is no longer available"); ok($opt_dsn, "\$opt_dsn still exists"); is(ref($opt_dsn),'HASH', '$opt_dsn is still a hashref'); CGI-Session-4.48/t/g4_freezethaw.t000444000765000765 206511606571771 16116 0ustar00markmark000000000000# $Id$ use strict; use Test::More; use File::Spec; use CGI::Session::Test::Default; eval { require FreezeThaw }; plan skip_all=>"FreezeThaw is NOT available" if $@; my $ses_dir = File::Spec->catdir('t', 'sessiondata'); my $t = CGI::Session::Test::Default->new( dsn => "Driver:file;serial:FreezeThaw", args=>{Directory=> $ses_dir }); plan tests => $t->number_of_tests; $t->run(); #TODO: { # local $TODO = 'figure out how to test that $CGI::Session::Driver::file::FileName # is being handled correctly.'; # local $CGI::Session::Driver::file::FileName = 'set_by_var.txt'; # ok(0,'STUB'); # #my $s = CGI::Session->new('Driver:file;serial:FreezeThaw',undef, { Directory=>$ses_dir } ); #} # #$CGI::Session::File::FileName = 'test_%s.txt'; #{ # # ok(my $s = CGI::Session->new('Driver:file;serial:FreezeThaw',undef, # { Directory=> $ses_dir } )); # is( $CGI::Session::Driver::file::FileName, # $CGI::Session::File::FileName, # 'compatibility with $CGI::Session::File::FileName has been preserved'); #} CGI-Session-4.48/t/api3_file_freezethaw.t000444000765000765 175711606571771 17446 0ustar00markmark000000000000# $Id: api3_file_freezethaw.t,v 1.2 2002/11/22 22:54:41 sherzodr Exp $ use strict; BEGIN { use Test::More; # Check if DB_File is avaialble. Otherwise, skip this test eval 'require FreezeThaw'; plan skip_all => 'FreezeThaw not available' if $@; plan(tests => 14); use_ok('CGI::Session',qw/-api3/); }; ######################### my $s = CGI::Session->new("serializer:FreezeThaw", undef, {Directory=>"t"} ); ok($s); ok($s->id); $s->param(author=>'Sherzod Ruzmetov', name => 'CGI::Session', version=>'1' ); ok($s->param('author')); ok($s->param('name')); ok($s->param('version')); $s->param(-name=>'email', -value=>'sherzodr@cpan.org'); ok($s->param(-name=>'email')); ok(!$s->expire() ); $s->expire("+10m"); ok($s->expire()); my $sid = $s->id(); $s->flush(); my $s2 = CGI::Session->new("serializer:FreezeThaw", $sid, {Directory=>'t'}); ok($s2); ok($s2->id() eq $sid); ok($s2->param('email')); ok($s2->param('author')); ok($s2->expire()); $s2->delete(); CGI-Session-4.48/t/bug24285.t000555000765000765 126711606571771 14550 0ustar00markmark000000000000use strict; use Test::More 'no_plan'; # This test is about checking {Directory=>/not_tmp} actually works; # Reference: http://rt.cpan.org/Public/Bug/Display.html?id=24285 use CGI::Session; use CGI::Session::Driver; use CGI::Session::Driver::file; my $opt_dsn; my $id; my $file_name; my($dir_name) = File::Spec->catdir('t', 'sessiondata'); { $opt_dsn = {Directory=>$dir_name}; ok(my $s = CGI::Session->new('driver:file;serializer:default', undef, $opt_dsn), 'Created CGI::Session object successfully'); $id = $s -> id(); $file_name = File::Spec->catdir($dir_name, "cgisess_$id"); } ok(-e $file_name, 'Created file outside /tmp successfully'); unlink $file_name; CGI-Session-4.48/t/session_param_undef.t000444000765000765 345311606571771 17406 0ustar00markmark000000000000#/usr/bin/perl -w package Container; sub new { my $class = shift; my $self = { items => [], }; bless ($self, $class); return $self; } sub add_item { my ($self,$item) = @_; push @{$self->{items}}, $item; return; } sub get_items { my $self = shift; return @{$self->{items}}; } package Item; sub new { my $class = shift; my $name = shift; my $self = { name => $name, }; bless ($self, $class); return $self; } sub get_name { my $self = shift; return $self->{name}; } package main; use strict; use File::Spec; use Test::More tests => 21; use_ok('CGI::Session'); my $dir_name = File::Spec->tmpdir(); STORE:{ my $session = CGI::Session->new('serializer:default;id:static','testname',{Directory=>$dir_name}); ok($session); my $item1 = Item->new("test 123"); my $container = Container->new(); $container->add_item($item1); my ($item2) = $container->get_items(); is ($item1, $item2, 'Items are still equal after storing'); $session->param('container', $container); test_can($container,$item1,'Check in STORE of original item'); test_can($container,$item2,'Check in STORE of stored/retrieved item'); # If you remove the following line (and make sure there's not an already damaged session on disk), the problem is gone. $session->param('somevar', undef); $session->flush(); } LOAD:{ my $session = CGI::Session->load('serializer:default;id:static','testname',{Directory=>$dir_name}); my $container = $session->param('container'); my ($item) = $container->get_items(); test_can($container,$item, 'Check in LOAD after loading from session'); } sub test_can { my ($container, $item, $descr) = @_; diag "$descr\n"; can_ok('Container', 'add_item'); isa_ok($container, 'Container'); can_ok($container, 'add_item'); can_ok('Item', 'get_name'); isa_ok($item, 'Item'); can_ok($item, 'get_name'); } CGI-Session-4.48/t/parse_dsn.t000444000765000765 37111606571771 15314 0ustar00markmark000000000000# $Id$ use strict; # unit tests for parse_dsn use Test::More tests => 1; use CGI::Session; my $s = CGI::Session->new(); is_deeply($s->parse_dsn('DR:FILE'), { driver => 'file'}, "parse_dsn: abbreviation and lower-casing"); $s->delete(); CGI-Session-4.48/t/api3_file.t000444000765000765 207711606571771 15216 0ustar00markmark000000000000# $Id: api3_file.t,v 1.3.4.1 2003/07/26 13:37:36 sherzodr Exp $ use strict; BEGIN { use Test::More; plan(tests => 17); use_ok('CGI::Session'); }; my $s = CGI::Session->new("dr:File;ser:Default;id:MD5", undef, {Directory=>"t"} ); ok($s); ok($s->id); $s->param(author=>'Sherzod Ruzmetov', name => 'CGI::Session', version=>'1' ); ok($s->param('author')); ok($s->param('name')); ok($s->param('version')); $s->param(-name=>'email', -value=>'sherzodr@cpan.org'); ok($s->param(-name=>'email')); ok(!$s->expire() ); $s->expire("+10m"); ok($s->expire()); my $sid = $s->id(); $s->flush(); my $s2 = CGI::Session->new(undef, $sid, {Directory=>'t'}); ok($s2); ok($s2->id() eq $sid); ok( $s2->param('email'), "found email param in session"); ok( $s2->param('author'), "found author param in session"); ok( $s2->expire() ); eval { $s2->clear('email'); }; is($@, '', '$s->clear("name") survives eval'); ok(($s2->param('email') ? 0 : 1), "email param is cleared from session"); ok($s2->param('author'), "author param is still in session"); $s2->delete(); CGI-Session-4.48/t/g4_postgresql_storable.t000444000765000765 264311606571771 20052 0ustar00markmark000000000000# $Id$ use strict; my %dsn; if ($ENV{DBI_DSN} && $ENV{DBI_DSN} =~ m/^dbi:Pg:/) { %dsn = ( DataSource => $ENV{DBI_DSN}, Password => $ENV{CGISESS_PG_PASS} || undef, TableName => 'sessions' ); } else { %dsn = ( DataSource => $ENV{CGISESS_PG_DSN}, User => $ENV{CGISESS_PG_USER} || $ENV{USER}, Password => $ENV{CGISESS_PG_PASS} || undef, TableName => 'sessions' ); } use File::Spec; use Test::More; use CGI::Session::Test::Default; unless ( $dsn{DataSource} ) { plan(skip_all=>"DataSource is not known"); exit(0); } for ( "DBI", "DBD::Pg", "Storable" ) { eval "require $_"; if ( $@ ) { plan(skip_all=>"$_ is NOT available"); exit(0); } } my $dbh = DBI->connect($dsn{DataSource}, $dsn{User}, $dsn{Password}, {RaiseError=>0, PrintError=>0}); unless ( $dbh ) { plan(skip_all=>"Couldn't establish connection with the PostgreSQL server"); exit(0); } eval { $dbh->do(qq|drop table $dsn{TableName}|) }; unless( $dbh->do(qq| CREATE TABLE $dsn{TableName} ( id CHAR(32) NOT NULL PRIMARY KEY, a_session BYTEA NULL )|) ) { plan(skip_all=>$dbh->errstr); exit(0); } my $t = CGI::Session::Test::Default->new( dsn => "dr:postgresql;serializer:storable", args=>{Handle=>$dbh, TableName=>$dsn{TableName}, ColumnType=>'binary'}); plan tests => $t->number_of_tests; $t->run(); CGI-Session-4.48/t/g4_mysql.t000444000765000765 457111606571771 15123 0ustar00markmark000000000000# $Id$ use strict; my %dsn; if ($ENV{DBI_DSN} && ($ENV{DBI_DSN} =~ m/^dbi:mysql:/)) { %dsn = ( DataSource => $ENV{DBI_DSN}, User => $ENV{DBI_USER}, Password => $ENV{DBI_PASS}, TableName => 'sessions' ); } else { %dsn = ( DataSource => $ENV{CGISESS_MYSQL_DSN}, User => $ENV{CGISESS_MYSQL_USER}, Password => $ENV{CGISESS_MYSQL_PASS}, Socket => $ENV{CGISESS_MYSQL_SOCKET}, TableName => 'sessions' ); } use File::Spec; use Test::More; use CGI::Session::Test::Default; for (qw/DBI DBD::mysql/) { eval "require $_"; if ( $@ ) { plan(skip_all=>"$_ is NOT available"); exit(0); } } require CGI::Session::Driver::mysql; my $dsnstring = CGI::Session::Driver::mysql->_mk_dsnstr(\%dsn); my $dbh; eval { $dbh = DBI->connect($dsnstring, $dsn{User}, $dsn{Password}, {RaiseError=>0, PrintError=>0}) }; if ( $@ ) { plan(skip_all=>"Couldn't establish connection with the MySQL server: " . (DBI->errstr || $@)); exit(0); } my $count; eval { ($count) = $dbh->selectrow_array("SELECT COUNT(*) FROM $dsn{TableName}") }; unless ( defined $count ) { unless( $dbh->do(qq| CREATE TABLE $dsn{TableName} ( id CHAR(32) NOT NULL PRIMARY KEY, a_session TEXT NULL )|) ) { plan(skip_all=>"Couldn't create $dsn{TableName}: " . $dbh->errstr); exit(0); } } my $t = CGI::Session::Test::Default->new( dsn => "dr:mysql", args=>{Handle=>$dbh, TableName=>$dsn{TableName}}); plan tests => $t->number_of_tests + 2; $t->run(); { # This used to test setting the global variable $CGI::Session::MySQL::TABLE_NAME. # However, since V 4.29_1, changes to CGI::Session::Driver's new() method mean # the unless test in CGI::Session::Driver::mysql's table_name() method was not executed, # and so $CGI::Session::MySQL::TABLE_NAME is never used. That 'unless' has been deleted. # V 4.32 explicitly documents this new situation. Moral: Don't use global variables. # This test was introduced in V 4.00_09. my $obj; eval { require CGI::Session::Driver::mysql; $obj = CGI::Session::Driver::mysql->new( {Handle=>$dbh} ); $obj -> table_name('my_sessions'); }; is($@,'', 'survived eval'); is($obj->table_name, 'my_sessions', "setting table name through the table_name() method works"); } CGI-Session-4.48/t/str2seconds.t000444000765000765 100511606571771 15622 0ustar00markmark000000000000# $Id$ use strict; use Test::More qw/no_plan/; use CGI::Session; my %tests = ( '1m' => '60', '+1m' => '60', '-1m' => '-60', '1h' => '3600', '1h' => '3600', '1s' => 1, '1m' => 60, '1h' => 3600, '1d' => 86400, '1w' => 604800, '1M' => 2592000, '1y' => 31536000, ); while (my ($in, $out) = each %tests) { is( CGI::Session::_str2seconds(undef,$in), $out, "got expected result when converting $in to seconds"); } CGI-Session-4.48/t/name.t000444000765000765 324311606571771 14277 0ustar00markmark000000000000#/usr/bin/perl -w use strict; use File::Spec; use Test::More tests => 14; use CGI; use CGI::Session; my $dir_name = File::Spec->tmpdir(); my $session = CGI::Session->new('id:static','testname',{Directory=>$dir_name}); ok($session); # as class method ok(CGI::Session->name,'name used as class method'); ok(CGI::Session->name('fluffy'),'name as class method w/ param'); ok(CGI::Session->name eq 'fluffy','name as class method w/ param effective?'); # as instance method ok($session->name,'name as instance method'); ok($session->name eq CGI::Session->name,'instance method falls through to class'); ok($session->name('spot'),'instance method w/ param'); ok($session->name eq 'spot','instance method w/ param effective?'); ok(CGI::Session->name eq 'fluffy','instance method did not affect class method'); ## test interface for setting session/cookie key name CGISESSID. my $s2 = CGI::Session->new( 'id:static', 'testname', { Directory => $dir_name }, { name => 'itchy' } ); is $s2->name, 'itchy', 'constructor new with name for session/cookie key'; is( CGI::Session->name, 'fluffy', 'constructor name not affecting class'); is $session->name, 'spot', 'constructor on new session not affecting old'; ## test from query $s2 = CGI::Session->new( 'id:static', CGI->new( 'itchy=2001' ), { Directory => $dir_name }, { name => 'itchy' } ); is $s2->id, 2001, 'session from query with new name'; ## should die since it won't find value from query eval { $s2 = CGI::Session->new( 'id:static', CGI->new( 'CGISESSID=2001' ), { Directory => $dir_name }, { name => 'itchy' } ); }; ok $@, "session in query with default name"; CGI-Session-4.48/t/g4_sqlite_freezethaw.t000444000765000765 213311606571771 17473 0ustar00markmark000000000000# $Id$ use strict; use File::Spec; use Test::More; use CGI::Session::Test::Default; for ( "DBI", "DBD::SQLite", "FreezeThaw", "MIME::Base64" ) { eval "require $_"; if ( $@ ) { plan(skip_all=>"$_ is NOT available"); exit(0); } } my %dsn = ( DataSource => "dbi:SQLite:dbname=" . File::Spec->catfile('t', 'sessiondata', 'sessions.sqlt'), TableName => 'sessions' ); my $dbh = DBI->connect($dsn{DataSource}, '', '', {RaiseError=>0, PrintError=>0}); unless ( $dbh ) { plan(skip_all=>"Couldn't establish connection with the server"); exit(0); } my ($count) = $dbh->selectrow_array("SELECT COUNT(*) FROM $dsn{TableName}"); unless ( defined $count ) { unless( $dbh->do(qq| CREATE TABLE $dsn{TableName} ( id CHAR(32) NOT NULL PRIMARY KEY, a_session TEXT NULL )|) ) { plan(skip_all=>$dbh->errstr); exit(0); } } my $t = CGI::Session::Test::Default->new( dsn => "driver:SQLite;serializer:FreezeThaw", args=>{Handle=>$dbh, TableName=>$dsn{TableName}}); plan tests => $t->number_of_tests; $t->run(); CGI-Session-4.48/t/ip_matches.t000444000765000765 341511606571771 15474 0ustar00markmark000000000000# $Id$ use strict; use File::Spec; use Test::More 'no_plan'; use Env; require CGI::Session; CGI::Session->import; my $save_id_1; my $save_id_2; { my $session; my $sessionid; # Testing without ip_match $ENV{REMOTE_ADDR}='127.0.0.1'; is($CGI::Session::IP_MATCH,0,'ip_match off by default'); ok($session=CGI::Session->new,'create new session'); $save_id_1 = $session->id; $session->param('TEST','VALUE'); is($session->param('TEST'),'VALUE','check param TEST set'); ok($sessionid=$session->id,'store session id'); $ENV{REMOTE_ADDR}='127.0.0.2'; $session->flush; ok($session=CGI::Session->new($sessionid),'load session with different IP'); is($session->id,$sessionid,'Same session id'); is($session->param('TEST'),'VALUE','TEST param still set'); $session->flush; # Testing with ip_match set. CGI::Session->import('-ip_match'); is($CGI::Session::IP_MATCH,1,'ip_match switched on'); $session->flush; ok($session=CGI::Session->new,'create new session'); ok($session->ip_matches,'REMOTE_IP matches session'); $session->param('TEST','VALUE'); is($session->param('TEST'),'VALUE','check param TEST set'); ok($sessionid=$session->id,'store session id'); $session->flush; ok($session=CGI::Session->new($sessionid),'new session - same ip'); is($session->id,$sessionid,'same session id'); ok($session->ip_matches,'REMOTE_IP matches session'); is($session->param('TEST'),'VALUE','check param TEST set'); $session->flush; $ENV{REMOTE_ADDR}='127.0.0.1'; ok($session=CGI::Session->new($sessionid),'new session - different ip'); $save_id_2 = $session->id; isnt($session->id,$sessionid,'new session id'); } # Emulate CGI::Session::Driver::file.pm. my $dir_name = File::Spec->tmpdir(); unlink File::Spec->catfile($dir_name, "cgisess_$save_id_1"); unlink File::Spec->catfile($dir_name, "cgisess_$save_id_2"); CGI-Session-4.48/t/api3_file_storable_incr.t000444000765000765 202411606571771 20114 0ustar00markmark000000000000# $Id: api3_file_storable_incr.t,v 1.2 2002/11/22 22:54:41 sherzodr Exp $ use strict; BEGIN { use Test::More; eval 'require Storable'; plan skip_all => 'Storable not available' if $@; plan(tests => 15); use_ok('File::Spec'); use_ok('CGI::Session',qw/-api3/); }; ######################### my $dr_args = {Directory=>'t', IDFile=>File::Spec->catfile('t', 'cgisess.id')}; my $args = "driver:File;serializer;Storable;id:Incr"; my $s = CGI::Session->new($args, undef, $dr_args ); ok($s); ok($s->id); $s->param(author=>'Sherzod Ruzmetov', name => 'CGI::Session', version=>'1' ); ok($s->param('author')); ok($s->param('name')); ok($s->param('version')); $s->param(-name=>'email', -value=>'sherzodr@cpan.org'); ok($s->param(-name=>'email')); ok(!$s->expire() ); $s->expire("+10m"); ok($s->expire()); my $sid = $s->id(); $s->flush(); my $s2 = CGI::Session->new($args, $sid, $dr_args); ok($s2); ok($s2->id() eq $sid); ok($s2->param('email')); ok($s2->param('author')); ok($s2->expire()); $s2->delete(); CGI-Session-4.48/t/g4_dbfile.t000444000765000765 57611606571771 15164 0ustar00markmark000000000000# $Id$ use strict; use Test::More; use File::Spec; use CGI::Session::Test::Default; eval "require DB_File"; if ( $@ ) { plan(skip_all=>"DB_File is NOT available"); exit(0); } my $t = CGI::Session::Test::Default->new( dsn => "DR:db_file", args=>{FileName => File::Spec->catfile('t', 'sessiondata', 'cgisess.db')}); plan tests => $t->number_of_tests; $t->run(); CGI-Session-4.48/t/complex_ds.t000444000765000765 210511606571771 15510 0ustar00markmark000000000000# $Id: complex_ds.t,v 1.2 2002/11/22 13:09:21 sherzodr Exp $ use strict; BEGIN { use Test::More tests => 10; }; # Insert your test code below, the Test module is use()ed here so read # its man page ( perldoc Test ) for help writing this test script. use CGI::Session; my $s = CGI::Session->new('driver:File',undef, {Directory=>"t"} ) or die $CGI::Session::errstr; ok($s); ok($s->id()); my $d1 = [qw(1 2 3 4 5 6)]; my $d2 = {1 => "Bir", 2 => "Ikki", 3=>"Uch", 4=>"To'rt", 5=>"Besh", 6=>"Olti"}; my $d3 = { d1 => $d1, d2 => $d2 }; $s->param(d3 => $d3); ok($s->param('d3')); ok( $s->param('d3')->{d1}->[0], 'Test 1'); ok( $s->param('d3')->{d1}->[1], 'Test 2'); ok( $s->param('d3')->{d2}->{1}, 'Bir'); my $sid = $s->id(); $s->flush(); eval { my $s1 = CGI::Session->new('driver:File',$sid, {Directory=>"t"}) or die $CGI::Session::errstr; ok($s1->param('d3')); ok( $s1->param('d3')->{d1}->[0], 'Test 1'); ok( $s1->param('d3')->{d1}->[1], 'Test 2'); ok( $s1->param('d3')->{d2}->{1}, 'Bir'); $s1->delete(); }; warn $@ if $@; CGI-Session-4.48/t/api3_db_file_freezethaw.t000444000765000765 211611606571771 20101 0ustar00markmark000000000000# $Id: api3_db_file_freezethaw.t,v 1.2 2002/11/22 22:54:41 sherzodr Exp $ use strict; BEGIN { use Test::More; # Check if DB_File is available. Otherwise, skip this test eval 'require DB_File'; plan skip_all => "DB_File not available" if $@; eval 'require FreezeThaw'; plan (skip_all => "FreezeThaw not available") if $@; plan(tests => 14); use_ok('CGI::Session', qw/-api3/); }; my $s = CGI::Session->new("driver:DB_File;serializer:FreezeThaw", undef, {Directory=>"t"} ); ok($s); ok($s->id); $s->param(author=>'Sherzod Ruzmetov', name => 'CGI::Session', version=>'1' ); ok($s->param('author')); ok($s->param('name')); ok($s->param('version')); $s->param(-name=>'email', -value=>'sherzodr@cpan.org'); ok($s->param(-name=>'email')); ok(!$s->expire() ); $s->expire("+10m"); ok($s->expire()); my $sid = $s->id(); $s->flush(); my $s2 = CGI::Session->new("driver:DB_File;serializer:FreezeThaw", $sid, {Directory=>'t'}); ok($s2); ok($s2->id() eq $sid); ok($s2->param('email')); ok($s2->param('author')); ok($s2->expire()); $s2->delete(); CGI-Session-4.48/t/api3_obj_store_db_file.t000444000765000765 227211606571771 17726 0ustar00markmark000000000000# $Id: api3_obj_store_db_file.t,v 1.3.6.1 2003/07/26 13:37:36 sherzodr Exp $ use strict; use CGI; use CGI::Session; eval "require DB_File"; if ( $@ ) { print "1..0 #Skipped: DB_File is not available\n"; exit(0) } my @mods = qw(Storable FreezeThaw); my $ser = undef; for ( @mods ) { eval "require $_"; unless ( $@ ) { $ser = $_; next; } } unless ( $ser ) { print "1..0 #Skipped: Neither Storable nor FreezeThaw avaialble\n"; exit(0); } my $args = "driver:DB_File;serializer:$ser"; my $dr_args = {Directory=>'t'}; print "1..8\n"; my $cgi = CGI->new; my $s = CGI::Session->new($args, undef, $dr_args); print defined($s) ? "ok\n" : "not ok\n"; print $s->id() ? "ok\n" : "not ok\n"; $cgi->param(name => 'Sherzod'); print $cgi->param('name') ? "ok\n" : "not ok\n"; print $s->param(_CGI => $cgi) ? "ok\n" : "not ok\n"; my $sid = $s->id(); $s->flush(); my $s2 = CGI::Session->new($args, $sid, $dr_args); print defined($s2) ? "ok\n" : "not ok\n"; print $s2->id eq $sid ? "ok\n" : "not ok\n"; my $old_cgi = $s2->param('_CGI'); print ref($old_cgi) ? "ok\n" : "not ok\n"; print $old_cgi->param('name') eq 'Sherzod' ? "ok\n" : "not ok\n"; $s2->delete(); CGI-Session-4.48/t/api3_incr.t000444000765000765 213011606571771 15220 0ustar00markmark000000000000# $Id: api3_incr.t,v 1.2 2002/11/22 22:54:41 sherzodr Exp $ use strict; BEGIN { require Test::More; Test::More->import(); plan(tests => 14); }; use File::Spec; use CGI::Session qw/-api3/; ok(1); # If we made it this far, we're ok. ######################### # Insert your test code below, the Test module is use()ed here so read # its man page ( perldoc Test ) for help writing this test script. my $dr_args = {Directory=>'t', IDFile=>File::Spec->catfile('t', 'cgisess.id')}; my $args = "id:Incr"; my $s = CGI::Session->new($args, undef, $dr_args ); ok($s); ok($s->id); $s->param(author=>'Sherzod Ruzmetov', name => 'CGI::Session', version=>'1' ); ok($s->param('author')); ok($s->param('name')); ok($s->param('version')); $s->param(-name=>'email', -value=>'sherzodr@cpan.org'); ok($s->param(-name=>'email')); ok(!$s->expire() ); $s->expire("+10m"); ok($s->expire()); my $sid = $s->id(); $s->flush(); my $s2 = CGI::Session->new($args, $sid, $dr_args); ok($s2); ok($s2->id() eq $sid); ok($s2->param('email')); ok($s2->param('author')); ok($s2->expire()); $s2->delete(); CGI-Session-4.48/t/api3_file_freezethaw_incr.t000444000765000765 213311606571771 20446 0ustar00markmark000000000000# $Id: api3_file_freezethaw_incr.t,v 1.2 2002/11/22 22:54:41 sherzodr Exp $ use strict; BEGIN { use Test::More; # Check if DB_File is avaialble. Otherwise, skip this test eval 'require FreezeThaw'; plan skip_all => 'FreezeThaw not available' if $@; plan(tests => 15); use_ok('File::Spec'); use_ok('CGI::Session',qw/-api3/); }; ######################### my $dr_args = {Directory=>'t', IDFile=>File::Spec->catfile('t', 'cgisess.id')}; my $args = "driver:File;serializer;FreezeThaw;id:Incr"; my $s = CGI::Session->new($args, undef, $dr_args ); ok($s); ok($s->id); $s->param(author=>'Sherzod Ruzmetov', name => 'CGI::Session', version=>'1' ); ok($s->param('author')); ok($s->param('name')); ok($s->param('version')); $s->param(-name=>'email', -value=>'sherzodr@cpan.org'); ok($s->param(-name=>'email')); ok(!$s->expire() ); $s->expire("+10m"); ok($s->expire()); my $sid = $s->id(); $s->flush(); my $s2 = CGI::Session->new($args, $sid, $dr_args); ok($s2); ok($s2->id() eq $sid); ok($s2->param('email')); ok($s2->param('author')); ok($s2->expire()); $s2->delete(); CGI-Session-4.48/t/driver_dbi.t000444000765000765 116211606571771 15466 0ustar00markmark000000000000# $Id$ use strict; # Some unit tests for CGI::Session::Driver::DBI BEGIN{ use Test::More; eval { require DBI; }; if ($@) { plan skip_all => 'DBI module not found'; } else { plan qw/no_plan/; } use_ok('CGI::Session::Driver::DBI'); } eval { CGI::Session::Driver::DBI->retrieve(undef); }; like($@,qr/\Qretrieve(): usage error/,'retrieve returns expected failure message when no session id is given'); eval { CGI::Session::Driver::DBI->traverse(undef); }; like($@,qr/\Qtraverse(): usage error/,'traverse returns expected failure message when no session id is given'); CGI-Session-4.48/t/g4_postgresql_freezethaw.t000444000765000765 274511606571771 20406 0ustar00markmark000000000000# $Id$ use strict; my %dsn; if ($ENV{DBI_DSN} && $ENV{DBI_DSN} =~ m/^dbi:Pg:/) { %dsn = ( DataSource => $ENV{DBI_DSN}, Password => $ENV{CGISESS_PG_PASS} || undef, TableName => 'sessions' ); } else { %dsn = ( DataSource => $ENV{CGISESS_PG_DSN}, User => $ENV{CGISESS_PG_USER} || $ENV{USER}, Password => $ENV{CGISESS_PG_PASS} || undef, TableName => 'sessions' ); } use File::Spec; use Test::More; use CGI::Session::Test::Default; unless ( $dsn{DataSource} ) { plan(skip_all=>"DataSource is not known"); exit(0); } for ( "DBI", "DBD::Pg", "FreezeThaw" ) { eval "require $_"; if ( $@ ) { plan(skip_all=>"$_ is NOT available"); exit(0); } } my $dbh = DBI->connect($dsn{DataSource}, $dsn{User}, $dsn{Password}, {RaiseError=>0, PrintError=>0}); unless ( $dbh ) { plan(skip_all=>"Couldn't establish connection with the PostgreSQL server"); exit(0); } my ($count) = $dbh->selectrow_array("SELECT COUNT(*) FROM $dsn{TableName}"); unless ( defined $count ) { unless( $dbh->do(qq| CREATE TABLE $dsn{TableName} ( id CHAR(32) NOT NULL PRIMARY KEY, a_session TEXT NULL )|) ) { plan(skip_all=>$dbh->errstr); exit(0); } } my $t = CGI::Session::Test::Default->new( dsn => "dr:postgresql;serializer:freezethaw", args=>{Handle=>$dbh, TableName=>$dsn{TableName}}); plan tests => $t->number_of_tests; $t->run(); CGI-Session-4.48/t/g4.t000444000765000765 36111606571771 13647 0ustar00markmark000000000000# $Id$ use strict; use File::Spec; use CGI::Session::Test::Default; use Test::More; my $t = CGI::Session::Test::Default->new( args=>{Directory=>File::Spec->catdir('t', 'sessiondata')}); plan tests => $t->number_of_tests; $t->run(); CGI-Session-4.48/t/bug21981.todo000444000765000765 163411606571771 15245 0ustar00markmark000000000000use encoding 'utf8'; use strict; use File::Spec; use Test::More ('no_plan'); BEGIN { use_ok('CGI::Session'); use_ok("CGI::Session::Driver"); use_ok("CGI::Session::Driver::file"); } my $id; my $s; { ok($s = CGI::Session->new('driver:file;serializer:default', undef), 'Created CGI::Session object successfully'); $id = $s -> id(); } diag("Warnings expected. Consult docs re 'utf8'"); ok($id, 'Session created successfully'); # Emulate CGI::Session::Driver::file.pm. my $dir_name = File::Spec->tmpdir(); my $file_name = File::Spec->catfile($dir_name, "cgisess_$id"); $s = undef; { $s = CGI::Session->new('driver:file;serializer:default', $id); } if ($@) { print STDERR $@; ok(1, q|Warning: Failed to recreate session. Cannot "use 'utf8'; in conjunction with CGI::Session"|); } else { ok($s, 'Recreated session succeeded'); } # Clean up /tmp as per RT 29969. unlink $file_name; CGI-Session-4.48/t/g4_mysql_storable.t000444000765000765 312711606571771 17012 0ustar00markmark000000000000# $Id$ use strict; my %dsn; if (defined $ENV{DBI_DSN} && ($ENV{DBI_DSN} =~ m/^dbi:mysql:/)) { %dsn = ( DataSource => $ENV{DBI_DSN}, Password => $ENV{CGISESS_MYSQL_PASS} || undef, TableName => 'sessions' ); } else { %dsn = ( DataSource => $ENV{CGISESS_MYSQL_DSN}, User => $ENV{CGISESS_MYSQL_USER} || $ENV{USER}, Password => $ENV{CGISESS_MYSQL_PASS} || undef, Socket => $ENV{CGISESS_MYSQL_SOCKET} || undef, TableName => 'sessions' ); } use File::Spec; use Test::More; use CGI::Session::Test::Default; for (qw/DBI DBD::mysql Storable/) { eval "require $_"; if ( $@ ) { plan(skip_all=>"$_ is NOT available"); exit(0); } } require CGI::Session::Driver::mysql; my $dsnstring = CGI::Session::Driver::mysql->_mk_dsnstr(\%dsn); my $dbh; eval { $dbh = DBI->connect($dsnstring, $dsn{User}, $dsn{Password}, {RaiseError=>0, PrintError=>1}) }; unless ( $dbh ) { plan(skip_all=>"Couldn't establish connection with the MySQL server: " . (DBI->errstr || $@)); exit(0); } my ($count) = $dbh->selectrow_array("SELECT COUNT(*) FROM $dsn{TableName}"); unless ( defined $count ) { unless( $dbh->do(qq| CREATE TABLE $dsn{TableName} ( id CHAR(32) NOT NULL PRIMARY KEY, a_session TEXT NULL )|) ) { plan(skip_all=>$dbh->errstr); exit(0); } } my $t = CGI::Session::Test::Default->new( dsn => "dr:mysql;ser:Storable", args=>{Handle=>$dbh, TableName=>$dsn{TableName}}); plan tests => $t->number_of_tests; $t->run(); CGI-Session-4.48/t/symlink_db_file.t000444000765000765 313411606571771 16510 0ustar00markmark000000000000#/usr/bin/perl -T # $Id: $ use strict; use Carp; use Test::More; use CGI::Session; use File::Spec; { no strict 'refs'; no warnings 'redefine'; *CGI::Session::ErrorHandler::set_error = sub { my $class = shift; my $error = shift; croak $error if $error; }; } eval 'require DB_File'; plan skip_all => "DB_File not available" if $@; if (! eval { symlink("",""); 1 }) { plan skip_all => "Your OS doesn't support symlinks"; } plan tests => 11; my ($path,$new_path) = ('t/cgisess_symlink.db','t/cgisess_symlink_link.db'); unlink($path,$new_path); ok(my $s = CGI::Session->new('driver:db_file;id:static','symlink_session',{Directory=>'t',FileName=>'cgisess_symlink.db'}),'Create new session named symlink'); ok($s->id, 'We have an id'); $s->param('passthru',1); $s->flush(); # test retrieve ok(symlink($path,$new_path), 'Created symlink'); ok(-l $new_path, 'Check to make certain symlink was created'); ok(my $ns = CGI::Session->new('driver:db_file;id:static','symlink_session',{Directory=>'t',FileName=>'cgisess_symlink_link.db'}), 'Get our symlinked session'); ok(! -e $new_path || ! -l $new_path,'we should have wiped out the symlink'); isnt($ns->param('passthru'),1,'this session should be unique'); unlink($new_path); # swap the symlink and session ok(rename($path,$new_path),'moving session file'); ok(symlink($new_path,$path),'creating symlink'); $s->param('change',1); ok($s->flush(),'flush should wipe out the symlink'); ok(! -l $path,'original session file has been restored'); # tidy it up undef($_) for $s,$ns; unlink($path,$new_path,map "$_.lck",$path,$new_path); CGI-Session-4.48/t/api3_db_file_storable.t000444000765000765 207211606571771 17551 0ustar00markmark000000000000# $Id: api3_db_file_storable.t,v 1.2 2002/11/22 22:54:41 sherzodr Exp $ use strict; BEGIN { use Test::More; # Check if DB_File is available. Otherwise, skip this test eval 'require DB_File'; plan skip_all => "DB_File not available" if $@; eval 'require Storable'; plan skip_all => "Storable not available" if $@; plan(tests => 14); use_ok('CGI::Session',qw/-api3/); }; my $s = CGI::Session->new("driver:DB_File;serializer:Storable", undef, {Directory=>"t"} ); ok($s); ok($s->id); $s->param(author=>'Sherzod Ruzmetov', name => 'CGI::Session', version=>'1' ); ok($s->param('author')); ok($s->param('name')); ok($s->param('version')); $s->param(-name=>'email', -value=>'sherzodr@cpan.org'); ok($s->param(-name=>'email')); ok(!$s->expire() ); $s->expire("+10m"); ok($s->expire()); my $sid = $s->id(); $s->flush(); my $s2 = CGI::Session->new("driver:DB_File;serializer:Storable", $sid, {Directory=>'t'}); ok($s2); ok($s2->id() eq $sid); ok($s2->param('email')); ok($s2->param('author')); ok($s2->expire()); $s2->delete(); CGI-Session-4.48/t/new_with_undef.t000444000765000765 173211606571771 16365 0ustar00markmark000000000000#!/usr/bin/perl use strict; use warnings; use CGI; use CGI::Session; use Test::More tests => 6; # --------------- { my($session) = CGI::Session -> new(undef); isa_ok($session, 'CGI::Session', 'new(undef) returns an object which'); my($id) = $session -> id(); isnt($id, undef, "new(undef)'s session object returns an id which is /not/ undef"); } { my($q) = CGI -> new(); my($session) = CGI::Session -> new($q); isa_ok($session, 'CGI::Session', 'new($q without CGISESSID) returns an object which'); my($id) = $session -> id(); isnt($id, undef, "new(\$q without CGISESSID)'s session object returns an id which is /not/ undef"); } { my($q) = CGI -> new(); $q -> param(CGISESSID => 'Purple cats is weird'); my($session) = CGI::Session -> new($q); isa_ok($session, 'CGI::Session', 'new($q with fake CGISESSID) returns an object which'); my($id) = $session -> id(); isnt($id, undef, "new(\$q with fake CGISESSID)'s session object returns an id which is /not/ undef"); } CGI-Session-4.48/lib000755000765000765 011606571771 13336 5ustar00markmark000000000000CGI-Session-4.48/lib/CGI000755000765000765 011606571771 13740 5ustar00markmark000000000000CGI-Session-4.48/lib/CGI/Session.pm000444000765000765 14351111606571771 16123 0ustar00markmark000000000000package CGI::Session; use strict; use Carp; use CGI::Session::ErrorHandler; @CGI::Session::ISA = qw( CGI::Session::ErrorHandler ); $CGI::Session::VERSION = '4.48'; $CGI::Session::NAME = 'CGISESSID'; $CGI::Session::IP_MATCH = 0; sub STATUS_UNSET () { 1 << 0 } # denotes session that's resetted sub STATUS_NEW () { 1 << 1 } # denotes session that's just created sub STATUS_MODIFIED () { 1 << 2 } # denotes session that needs synchronization sub STATUS_DELETED () { 1 << 3 } # denotes session that needs deletion sub STATUS_EXPIRED () { 1 << 4 } # denotes session that was expired. sub import { my ($class, @args) = @_; return unless @args; ARG: for my $arg (@args) { if ($arg eq '-ip_match') { $CGI::Session::IP_MATCH = 1; last ARG; } } } sub new { my ($class, @args) = @_; my $self; if (ref $class) { # # Called as an object method as in $session->new()... # $self = bless { %$class }, ref( $class ); $class = ref $class; $self->_reset_status(); # # Object may still have public data associated with it, but we # don't care about that, since we want to leave that to the # client's disposal. However, if new() was requested on an # expired session, we already know that '_DATA' table is # empty, since it was the job of flush() to empty '_DATA' # after deleting. How do we know flush() was already called on # an expired session? Because load() - constructor always # calls flush() on all to-be expired sessions # } else { # # Called as a class method as in CGI::Session->new() # # Start fresh with error reporting. Errors in past objects shouldn't affect this one. $class->set_error(''); $self = $class->load( @args ); if (not defined $self) { return $class->set_error( "new(): failed: " . $class->errstr ); } } my $dataref = $self->{_DATA}; unless ($dataref->{_SESSION_ID}) { # # Absence of '_SESSION_ID' can only signal: # * Expired session: Because load() - constructor is required to # empty contents of _DATA - table # * Unavailable session: Such sessions are the ones that don't # exist on datastore, but are requested by client # * New session: When no specific session is requested to be loaded # my $id = $self->_id_generator()->generate_id( $self->{_DRIVER_ARGS}, $self->{_CLAIMED_ID} ); unless (defined $id) { return $self->set_error( "Couldn't generate new SESSION-ID" ); } $dataref->{_SESSION_ID} = $id; $dataref->{_SESSION_CTIME} = $dataref->{_SESSION_ATIME} = time(); $dataref->{_SESSION_REMOTE_ADDR} = $ENV{REMOTE_ADDR} || ""; $self->_set_status( STATUS_NEW ); } return $self; } sub DESTROY { $_[0]->flush() } sub close { $_[0]->flush() } *param_hashref = \&dataref; my $avoid_single_use_warning = *param_hashref; sub dataref { $_[0]->{_DATA} } sub is_empty { !defined($_[0]->id) } sub is_expired { $_[0]->_test_status( STATUS_EXPIRED ) } sub is_new { $_[0]->_test_status( STATUS_NEW ) } sub id { return defined($_[0]->dataref) ? $_[0]->dataref->{_SESSION_ID} : undef } # Last Access Time sub atime { return defined($_[0]->dataref) ? $_[0]->dataref->{_SESSION_ATIME} : undef } # Creation Time sub ctime { return defined($_[0]->dataref) ? $_[0]->dataref->{_SESSION_CTIME} : undef } sub _driver { my $self = shift; defined($self->{_OBJECTS}->{driver}) and return $self->{_OBJECTS}->{driver}; my $pm = "CGI::Session::Driver::" . $self->{_DSN}->{driver}; defined($self->{_OBJECTS}->{driver} = $pm->new( $self->{_DRIVER_ARGS} )) or die $pm->errstr(); return $self->{_OBJECTS}->{driver}; } sub _serializer { my $self = shift; defined($self->{_OBJECTS}->{serializer}) and return $self->{_OBJECTS}->{serializer}; return $self->{_OBJECTS}->{serializer} = "CGI::Session::Serialize::" . $self->{_DSN}->{serializer}; } sub _id_generator { my $self = shift; defined($self->{_OBJECTS}->{id}) and return $self->{_OBJECTS}->{id}; return $self->{_OBJECTS}->{id} = "CGI::Session::ID::" . $self->{_DSN}->{id}; } sub ip_matches { return ( $_[0]->{_DATA}->{_SESSION_REMOTE_ADDR} eq $ENV{REMOTE_ADDR} ); } # parses the DSN string and returns it as a hash. # Notably: Allows unique abbreviations of the keys: driver, serializer and 'id'. # Also, keys and values of the returned hash are lower-cased. sub parse_dsn { my $self = shift; my $dsn_str = shift; croak "parse_dsn(): usage error" unless $dsn_str; require Text::Abbrev; my $abbrev = Text::Abbrev::abbrev( "driver", "serializer", "id" ); my %dsn_map = map { split /:/ } (split /;/, $dsn_str); my %dsn = map { $abbrev->{lc $_}, lc $dsn_map{$_} } keys %dsn_map; return \%dsn; } sub query { my $self = shift; if ( $self->{_QUERY} ) { return $self->{_QUERY}; } # require CGI::Session::Query; # return $self->{_QUERY} = CGI::Session::Query->new(); require CGI; return $self->{_QUERY} = CGI->new(); } sub name { my $self = shift; my $name = shift; if (ref $self) { unless ( defined $name ) { return $self->{_NAME} || $CGI::Session::NAME; } return $self->{_NAME} = $name; } $CGI::Session::NAME = $name if defined $name; return $CGI::Session::NAME; } sub dump { my $self = shift; require Data::Dumper; my $d = Data::Dumper->new([$self], [ref $self]); $d->Deepcopy(1); return $d->Dump(); } sub _set_status { my $self = shift; croak "_set_status(): usage error" unless @_; $self->{_STATUS} |= $_[0]; } sub _unset_status { my $self = shift; croak "_unset_status(): usage error" unless @_; $self->{_STATUS} &= ~$_[0]; } sub _reset_status { $_[0]->{_STATUS} = STATUS_UNSET; } sub _test_status { return $_[0]->{_STATUS} & $_[1]; } sub flush { my $self = shift; # Would it be better to die or err if something very basic is wrong here? # I'm trying to address the DESTROY related warning # from: http://rt.cpan.org/Ticket/Display.html?id=17541 # return unless defined $self; return unless $self->id; # <-- empty session # neither new, nor deleted nor modified return if !defined($self->{_STATUS}) or $self->{_STATUS} == STATUS_UNSET; if ( $self->_test_status(STATUS_NEW) && $self->_test_status(STATUS_DELETED) ) { $self->{_DATA} = {}; return $self->_unset_status(STATUS_NEW | STATUS_DELETED); } my $driver = $self->_driver(); my $serializer = $self->_serializer(); if ( $self->_test_status(STATUS_DELETED) ) { defined($driver->remove($self->id)) or return $self->set_error( "flush(): couldn't remove session data: " . $driver->errstr ); $self->{_DATA} = {}; # <-- removing all the data, making sure # it won't be accessible after flush() return $self->_unset_status(STATUS_DELETED); } if ( $self->_test_status(STATUS_NEW | STATUS_MODIFIED) ) { my $datastr = $serializer->freeze( $self->dataref ); unless ( defined $datastr ) { return $self->set_error( "flush(): couldn't freeze data: " . $serializer->errstr ); } defined( $driver->store($self->id, $datastr) ) or return $self->set_error( "flush(): couldn't store datastr: " . $driver->errstr); $self->_unset_status(STATUS_NEW | STATUS_MODIFIED); } return 1; } sub trace {} sub tracemsg {} sub param { my ($self, @args) = @_; if ($self->_test_status( STATUS_DELETED )) { carp "param(): attempt to read/write deleted session"; } # USAGE: $s->param(); # DESC: Returns all the /public/ parameters if (@args == 0) { return grep { !/^_SESSION_/ } keys %{ $self->{_DATA} }; } # USAGE: $s->param( $p ); # DESC: returns a specific session parameter elsif (@args == 1) { return $self->{_DATA}->{ $args[0] } } # USAGE: $s->param( -name => $n, -value => $v ); # DESC: Updates session data using CGI.pm's 'named param' syntax. # Only public records can be set! my %args = @args; my ($name, $value) = @args{ qw(-name -value) }; if (defined $name && defined $value) { if ($name =~ m/^_SESSION_/) { carp "param(): attempt to write to private parameter"; return undef; } $self->_set_status( STATUS_MODIFIED ); return $self->{_DATA}->{ $name } = $value; } # USAGE: $s->param(-name=>$n); # DESC: access to session data (public & private) using CGI.pm's 'named parameter' syntax. return $self->{_DATA}->{ $args{'-name'} } if defined $args{'-name'}; # USAGE: $s->param($name, $value); # USAGE: $s->param($name1 => $value1, $name2 => $value2 [,...]); # DESC: updates one or more **public** records using simple syntax if ((@args % 2) == 0) { my $modified_cnt = 0; ARG_PAIR: while (my ($name, $val) = each %args) { if ( $name =~ m/^_SESSION_/) { carp "param(): attempt to write to private parameter"; next ARG_PAIR; } $self->{_DATA}->{ $name } = $val; ++$modified_cnt; } $self->_set_status(STATUS_MODIFIED); return $modified_cnt; } # If we reached this far none of the expected syntax were # detected. Syntax error croak "param(): usage error. Invalid syntax"; } sub delete { $_[0]->_set_status( STATUS_DELETED ) } *header = \&http_header; my $avoid_single_use_warning_again = *header; sub http_header { my $self = shift; return $self->query->header(-cookie=>$self->cookie, -type=>'text/html', @_); } sub cookie { my $self = shift; my $query = $self->query(); my $cookie= undef; if ( $self->is_expired ) { $cookie = $query->cookie( -name=>$self->name, -value=>$self->id, -expires=> '-1d', @_ ); } elsif ( my $t = $self->expire ) { $cookie = $query->cookie( -name=>$self->name, -value=>$self->id, -expires=> '+' . $t . 's', @_ ); } else { $cookie = $query->cookie( -name=>$self->name, -value=>$self->id, @_ ); } return $cookie; } sub save_param { my $self = shift; my ($query, $params) = @_; $query ||= $self->query(); $params ||= [ $query->param ]; for my $p ( @$params ) { my @values = $query->param($p) or next; if ( @values > 1 ) { $self->param($p, \@values); } else { $self->param($p, $values[0]); } } $self->_set_status( STATUS_MODIFIED ); } sub load_param { my $self = shift; my ($query, $params) = @_; $query ||= $self->query(); $params ||= [ $self->param ]; for ( @$params ) { $query->param(-name=>$_, -value=>$self->param($_)); } } sub clear { my $self = shift; my $params = shift; #warn ref($params); if (defined $params) { $params = [ $params ] unless ref $params; } else { $params = [ $self->param ]; } for ( grep { ! /^_SESSION_/ } @$params ) { delete $self->{_DATA}->{$_}; } $self->_set_status( STATUS_MODIFIED ); } sub find { my $class = shift; my ($dsn, $coderef, $dsn_args); # find( \%code ) if ( @_ == 1 ) { $coderef = $_[0]; } # find( $dsn, \&code, \%dsn_args ) else { ($dsn, $coderef, $dsn_args) = @_; } unless ( $coderef && ref($coderef) && (ref $coderef eq 'CODE') ) { croak "find(): usage error."; } my $driver; if ( $dsn ) { my $hashref = $class->parse_dsn( $dsn ); $driver = $hashref->{driver}; } $driver ||= "file"; my $pm = "CGI::Session::Driver::" . ($driver =~ /(.*)/)[0]; eval "require $pm"; if (my $errmsg = $@ ) { return $class->set_error( "find(): couldn't load driver." . $errmsg ); } my $driver_obj = $pm->new( $dsn_args ); unless ( $driver_obj ) { return $class->set_error( "find(): couldn't create driver object. " . $pm->errstr ); } # Read-only isn't the perfect name here. In read-only mode, we skip the ip_match check, # and don't update the atime. We *do* still delete expired sessions and session params. my $read_only = 1; my $driver_coderef = sub { my ($sid) = @_; my $session = $class->load( $dsn, $sid, $dsn_args, $read_only ); unless ( $session ) { return $class->set_error( "find(): couldn't load session '$sid'. " . $class->errstr ); } $coderef->( $session ); }; defined($driver_obj->traverse( $driver_coderef )) or return $class->set_error( "find(): traverse seems to have failed. " . $driver_obj->errstr ); return 1; } # $Id$ =pod =head1 NAME CGI::Session - persistent session data in CGI applications =head1 SYNOPSIS # Object initialization: use CGI::Session; $session = CGI::Session->new(); $CGISESSID = $session->id(); # Send proper HTTP header with cookies: print $session->header(); # Storing data in the session: $session->param('f_name', 'Sherzod'); # or $session->param(-name=>'l_name', -value=>'Ruzmetov'); # Flush the data from memory to the storage driver at least before your # program finishes since auto-flushing can be unreliable. $session->flush(); # Retrieving data: my $f_name = $session->param('f_name'); # or my $l_name = $session->param(-name=>'l_name'); # Clearing a certain session parameter: $session->clear(["l_name", "f_name"]); # Expire '_is_logged_in' flag after 10 idle minutes: $session->expire('is_logged_in', '+10m') # Expire the session itself after 1 idle hour: $session->expire('+1h'); # Delete the session for good: $session->delete(); $session->flush(); # Recommended practice says use flush() after delete(). =head1 DESCRIPTION CGI::Session provides an easy, reliable and modular session management system across HTTP requests. =head1 METHODS Following is the overview of all the available methods accessible via CGI::Session object. =head2 new() =head2 new( $sid ) =head2 new( $query ) =head2 new( $dsn, $query||$sid ) =head2 new( $dsn, $query||$sid, \%dsn_args ) =head2 new( $dsn, $query||$sid, \%dsn_args, \%session_params ) Constructor. Returns new session object, or undef on failure. Error message is accessible through L. If called on an already initialized session will re-initialize the session based on already configured object. This is only useful after a call to L. Can accept up to three arguments, $dsn - Data Source Name, $query||$sid - query object OR a string representing session id, and finally, \%dsn_args, arguments used by $dsn components. If called without any arguments, $dsn defaults to I, $query||$sid defaults to C<< CGI->new() >>, and C<\%dsn_args> defaults to I. If called with a single argument, it will be treated either as C<$query> object, or C<$sid>, depending on its type. If argument is a string , C will treat it as session id and will attempt to retrieve the session from data store. If it fails, will create a new session id, which will be accessible through L. If argument is an object, L and L methods will be called on that object to recover a potential C<$sid> and retrieve it from data store. If it fails, C will create a new session id, which will be accessible through L. C will define the name of the query parameter and/or cookie name to be requested, defaults to I. If called with two arguments first will be treated as $dsn, and second will be treated as $query or $sid or undef, depending on its type. Some examples of this syntax are: $s = CGI::Session->new("driver:mysql", undef); $s = CGI::Session->new("driver:sqlite", $sid); $s = CGI::Session->new("driver:db_file", $query); $s = CGI::Session->new("serializer:storable;id:incr", $sid); # etc... Briefly, C will return an initialized session object with a valid id, whereas C may return an empty session object with an undefined id. Tests are provided (t/new_with_undef.t and t/load_with_undef.t) to clarify the result of calling C and C with undef, or with an initialized CGI object with an undefined or fake CGISESSID. You are strongly advised to run the old-fashioned 'make test TEST_FILES=t/new_with_undef.t TEST_VERBOSE=1' or the new-fangled 'prove -v t/new_with_undef.t', for both new*.t and load*.t, and examine the output. Following data source components are supported: =over 4 =item * B - CGI::Session driver. Available drivers are L, L, L and L. Third party drivers are welcome. For driver specs consider L =item * B - serializer to be used to encode the data structure before saving in the disk. Available serializers are L, L and L. Default serializer will use L. =item * B - ID generator to use when new session is to be created. Available ID generator is L =back For example, to get CGI::Session store its data using DB_File and serialize data using FreezeThaw: $s = CGI::Session->new("driver:DB_File;serializer:FreezeThaw", undef); If called with three arguments, first two will be treated as in the previous example, and third argument will be C<\%dsn_args>, which will be passed to C<$dsn> components (namely, driver, serializer and id generators) for initialization purposes. Since all the $dsn components must initialize to some default value, this third argument should not be required for most drivers to operate properly. If called with four arguments, the first three match previous examples. The fourth argument must be a hash reference with parameters to be used by the CGI::Session object. (see \%session_params above ) The following is a list of the current keys: =over =item * B - Name to use for the cookie/query parameter name. This defaults to CGISESSID. This can be altered or accessed by the C accessor. =back undef is acceptable as a valid placeholder to any of the above arguments, which will force default behavior. =head2 load() =head2 load( $query||$sid ) =head2 load( $dsn, $query||$sid ) =head2 load( $dsn, $query, \%dsn_args ) =head2 load( $dsn, $query, \%dsn_args, \%session_params ) Accepts the same arguments as new(), and also returns a new session object, or undef on failure. The difference is, L can create a new session if it detects expired and non-existing sessions, but C does not. C is useful to detect expired or non-existing sessions without forcing the library to create new sessions. So now you can do something like this: $s = CGI::Session->load() or die CGI::Session->errstr(); if ( $s->is_expired ) { print $s->header(), $cgi->start_html(), $cgi->p("Your session timed out! Refresh the screen to start new session!") $cgi->end_html(); exit(0); } if ( $s->is_empty ) { $s = $s->new() or die $s->errstr; } Notice: All I sessions are empty, but not all I sessions are expired! Briefly, C will return an initialized session object with a valid id, whereas C may return an empty session object with an undefined id. Tests are provided (t/new_with_undef.t and t/load_with_undef.t) to clarify the result of calling C and C with undef, or with an initialized CGI object with an undefined or fake CGISESSID. You are strongly advised to run the old-fashioned 'make test TEST_FILES=t/new_with_undef.t TEST_VERBOSE=1' or the new-fangled 'prove -v t/new_with_undef.t', for both new*.t and load*.t, and examine the output. =cut # pass a true value as the fourth parameter if you want to skip the changing of # access time This isn't documented more formally, because it only called by # find(). sub load { my $class = shift; return $class->set_error( "called as instance method") if ref $class; return $class->set_error( "Too many arguments provided to load()") if @_ > 5; my $self = bless { _DATA => { _SESSION_ID => undef, _SESSION_CTIME => undef, _SESSION_ATIME => undef, _SESSION_REMOTE_ADDR => $ENV{REMOTE_ADDR} || "", # # Following two attributes may not exist in every single session, and declaring # them now will force these to get serialized into database, wasting space. But they # are here to remind the coder of their purpose # # _SESSION_ETIME => undef, # _SESSION_EXPIRE_LIST => {} }, # session data _DSN => {}, # parsed DSN params _OBJECTS => {}, # keeps necessary objects _DRIVER_ARGS=> {}, # arguments to be passed to driver _CLAIMED_ID => undef, # id **claimed** by client _STATUS => STATUS_UNSET,# status of the session object _QUERY => undef # query object }, $class; my ($dsn,$query_or_sid,$dsn_args,$read_only,$params); # load($query||$sid) if ( @_ == 1 ) { $self->_set_query_or_sid($_[0]); } # Two or more args passed: # load($dsn, $query||$sid) elsif ( @_ > 1 ) { ($dsn, $query_or_sid, $dsn_args,$read_only) = @_; # Make it backwards-compatible (update_atime is an undocumented key in %$params). # In fact, update_atime as a key is not used anywhere in the code as yet. # This patch is part of the patch for RT#33437. if ( ref $read_only and ref $read_only eq 'HASH' ) { $params = {%$read_only}; $read_only = $params->{'read_only'}; if ($params->{'name'}) { $self->{_NAME} = $params->{'name'}; } } # Since $read_only is not part of the public API # we ignore any value but the one we use internally: 1. if (defined $read_only and $read_only != '1') { return $class->set_error( "Too many arguments to load(). First extra argument was: $read_only"); } if ( defined $dsn ) { # <-- to avoid 'Uninitialized value...' warnings $self->{_DSN} = $self->parse_dsn($dsn); } $self->_set_query_or_sid($query_or_sid); # load($dsn, $query, \%dsn_args); $self->{_DRIVER_ARGS} = $dsn_args if defined $dsn_args; } $self->_load_pluggables(); # Did load_pluggable fail? If so, return undef, just like $class->set_error() would return undef if $class->errstr; if (not defined $self->{_CLAIMED_ID}) { my $query = $self->query(); eval { $self->{_CLAIMED_ID} = $query->cookie( $self->name ) || $query->param( $self->name ); }; if ( my $errmsg = $@ ) { return $class->set_error( "query object $query does not support cookie() and param() methods: " . $errmsg ); } } # No session is being requested. Just return an empty session return $self unless $self->{_CLAIMED_ID}; # Attempting to load the session my $driver = $self->_driver(); my $raw_data = $driver->retrieve( $self->{_CLAIMED_ID} ); unless ( defined $raw_data ) { return $self->set_error( "load(): couldn't retrieve data: " . $driver->errstr ); } # Requested session couldn't be retrieved return $self unless $raw_data; my $serializer = $self->_serializer(); $self->{_DATA} = $serializer->thaw($raw_data); unless ( defined $self->{_DATA} ) { #die $raw_data . "\n"; return $self->set_error( "load(): couldn't thaw() data using $serializer:" . $serializer->errstr ); } unless (defined($self->{_DATA}) && ref ($self->{_DATA}) && (ref $self->{_DATA} eq 'HASH') && defined($self->{_DATA}->{_SESSION_ID}) ) { return $self->set_error( "Invalid data structure returned from thaw()" ); } # checking for expiration ticker if ( $self->{_DATA}->{_SESSION_ETIME} ) { if ( ($self->{_DATA}->{_SESSION_ATIME} + $self->{_DATA}->{_SESSION_ETIME}) <= time() ) { $self->_set_status( STATUS_EXPIRED | # <-- so client can detect expired sessions STATUS_DELETED ); # <-- session should be removed from database $self->flush(); # <-- flush() will do the actual removal! return $self; } } # checking expiration tickers of individuals parameters, if any: my @expired_params = (); if ( $self->{_DATA}->{_SESSION_EXPIRE_LIST} ) { while (my ($param, $max_exp_interval) = each %{ $self->{_DATA}->{_SESSION_EXPIRE_LIST} } ) { if ( ($self->{_DATA}->{_SESSION_ATIME} + $max_exp_interval) <= time() ) { push @expired_params, $param; } } } $self->clear(\@expired_params) if @expired_params; if (not defined $read_only) { # checking if previous session ip matches current ip if($CGI::Session::IP_MATCH) { unless($self->ip_matches) { $self->_set_status( STATUS_DELETED ); $self->flush; return $self; } } $self->{_DATA}->{_SESSION_ATIME} = time(); # <-- updating access time $self->_set_status( STATUS_MODIFIED ); # <-- access time modified above } return $self; } # set the input as a query object or session ID, depending on what it looks like. sub _set_query_or_sid { my $self = shift; my $query_or_sid = shift; if ( ref $query_or_sid){ $self->{_QUERY} = $query_or_sid } else { $self->{_CLAIMED_ID} = $query_or_sid } } sub _load_pluggables { my ($self) = @_; my %DEFAULT_FOR = ( driver => "file", serializer => "default", id => "md5", ); my %SUBDIR_FOR = ( driver => "Driver", serializer => "Serialize", id => "ID", ); my $dsn = $self->{_DSN}; for my $plug (qw(driver serializer id)) { my $mod_name = $dsn->{ $plug }; if (not defined $mod_name) { $mod_name = $DEFAULT_FOR{ $plug }; } if ($mod_name =~ /^(\w+)$/) { # Looks good. Put it into the dsn hash $dsn->{ $plug } = $mod_name = $1; # Put together the actual module name to load my $prefix = join '::', (__PACKAGE__, $SUBDIR_FOR{ $plug }, q{}); $mod_name = $prefix . $mod_name; ## See if we can load load it eval "require $mod_name"; if ($@) { my $msg = $@; return $self->set_error("couldn't load $mod_name: " . $msg); } } else { # do something here about bad name for a pluggable } } return; } =pod =head2 id() Returns effective ID for a session. Since effective ID and claimed ID can differ, valid session id should always be retrieved using this method. =head2 param($name) =head2 param(-name=E$name) Used in either of the above syntax returns a session parameter set to $name or undef if it doesn't exist. If it's called on a deleted method param() will issue a warning but return value is not defined. =head2 param($name, $value) =head2 param(-name=E$name, -value=E$value) Used in either of the above syntax assigns a new value to $name parameter, which can later be retrieved with previously introduced param() syntax. C<$value> may be a scalar, arrayref or hashref. Attempts to set parameter names that start with I<_SESSION_> will trigger a warning and undef will be returned. =head2 param_hashref() B. Use L instead. =head2 dataref() Returns reference to session's data table: $params = $s->dataref(); $sid = $params->{_SESSION_ID}; $name= $params->{name}; # etc... Useful for having all session data in a hashref, but too risky to update. =head2 save_param() =head2 save_param($query) =head2 save_param($query, \@list) Saves query parameters to session object. In other words, it's the same as calling L for every single query parameter returned by C<< $query->param() >>. The first argument, if present, should be either CGI object or any object which can provide param() method. If it's undef, defaults to the return value of L, which returns C<< CGI->new >>. If second argument is present and is a reference to an array, only those query parameters found in the array will be stored in the session. undef is a valid placeholder for any argument to force default behavior. =head2 load_param() =head2 load_param($query) =head2 load_param($query, \@list) Loads session parameters into a query object. The first argument, if present, should be query object, or any other object which can provide param() method. If second argument is present and is a reference to an array, only parameters found in that array will be loaded to the query object. =head2 clear() =head2 clear('field') =head2 clear(\@list) Clears parameters from the session object. With no parameters, all fields are cleared. If passed a single parameter or a reference to an array, only the named parameters are cleared. =head2 flush() Synchronizes data in memory with the copy serialized by the driver. Call flush() if you need to access the session from outside the current session object. You should call flush() sometime before your program exits. As a last resort, CGI::Session will automatically call flush for you just before the program terminates or session object goes out of scope. Automatic flushing has proven to be unreliable, and in some cases is now required in places that worked with CGI::Session 3.x. Always explicitly calling C on the session before the program exits is recommended. For extra safety, call it immediately after every important session update. Also see L =head2 atime() Read-only method. Returns the last access time of the session in seconds from epoch. This time is used internally while auto-expiring sessions and/or session parameters. =head2 ctime() Read-only method. Returns the time when the session was first created in seconds from epoch. =head2 expire() =head2 expire($time) =head2 expire($param, $time) Sets expiration interval relative to L. If used with no arguments, returns the expiration interval if it was ever set. If no expiration was ever set, returns undef. For backwards compatibility, a method named C does the same thing. Second form sets an expiration time. This value is checked when previously stored session is asked to be retrieved, and if its expiration interval has passed, it will be expunged from the disk immediately. Passing 0 cancels expiration. By using the third syntax you can set the expiration interval for a particular session parameter, say I<~logged-in>. This would cause the library call clear() on the parameter when its time is up. Note it only makes sense to set this value to something I than when the whole session expires. Passing 0 cancels expiration. All the time values should be given in the form of seconds. Following keywords are also supported for your convenience: +-----------+---------------+ | alias | meaning | +-----------+---------------+ | s | Second | | m | Minute | | h | Hour | | d | Day | | w | Week | | M | Month | | y | Year | +-----------+---------------+ Examples: $session->expire("2h"); # expires in two hours $session->expire(0); # cancel expiration $session->expire("~logged-in", "10m"); # expires '~logged-in' parameter after 10 idle minutes Note: all the expiration times are relative to session's last access time, not to its creation time. To expire a session immediately, call L. To expire a specific session parameter immediately, call L. =cut *expires = \&expire; my $prevent_warning = \&expires; sub etime { $_[0]->expire() } sub expire { my $self = shift; # no params, just return the expiration time. if (not @_) { return $self->{_DATA}->{_SESSION_ETIME}; } # We have just a time elsif ( @_ == 1 ) { my $time = $_[0]; # If 0 is passed, cancel expiration if ( defined $time && ($time =~ m/^\d$/) && ($time == 0) ) { $self->{_DATA}->{_SESSION_ETIME} = undef; $self->_set_status( STATUS_MODIFIED ); } # set the expiration to this time else { $self->{_DATA}->{_SESSION_ETIME} = $self->_str2seconds( $time ); $self->_set_status( STATUS_MODIFIED ); } } # If we get this far, we expect expire($param,$time) # ( This would be a great use of a Perl6 multi sub! ) else { my ($param, $time) = @_; if ( ($time =~ m/^\d$/) && ($time == 0) ) { delete $self->{_DATA}->{_SESSION_EXPIRE_LIST}->{ $param }; $self->_set_status( STATUS_MODIFIED ); } else { $self->{_DATA}->{_SESSION_EXPIRE_LIST}->{ $param } = $self->_str2seconds( $time ); $self->_set_status( STATUS_MODIFIED ); } } return 1; } # =head2 _str2seconds() # # my $secs = $self->_str2seconds('1d') # # Takes a CGI.pm-style time representation and returns an equivalent number # of seconds. # # See the docs of expire() for more detail. # # =cut sub _str2seconds { my $self = shift; my ($str) = @_; return unless defined $str; return $str if $str =~ m/^[-+]?\d+$/; my %_map = ( s => 1, m => 60, h => 3600, d => 86400, w => 604800, M => 2592000, y => 31536000 ); my ($koef, $d) = $str =~ m/^([+-]?\d+)([smhdwMy])$/; unless ( defined($koef) && defined($d) ) { die "_str2seconds(): couldn't parse '$str' into \$koef and \$d parts. Possible invalid syntax"; } return $koef * $_map{ $d }; } =pod =head2 is_new() Returns true only for a brand new session. =head2 is_expired() Tests whether session initialized using L is to be expired. This method works only on sessions initialized with load(): $s = CGI::Session->load() or die CGI::Session->errstr; if ( $s->is_expired ) { die "Your session expired. Please refresh"; } if ( $s->is_empty ) { $s = $s->new() or die $s->errstr; } =head2 is_empty() Returns true for sessions that are empty. It's preferred way of testing whether requested session was loaded successfully or not: $s = CGI::Session->load($sid); if ( $s->is_empty ) { $s = $s->new(); } Actually, the above code is nothing but waste. The same effect could've been achieved by saying: $s = CGI::Session->new( $sid ); L is useful only if you wanted to catch requests for expired sessions, and create new session afterwards. See L for an example. =head2 ip_match() Returns true if $ENV{REMOTE_ADDR} matches the remote address stored in the session. If you have an application where you are sure your users' IPs are constant during a session, you can consider enabling an option to make this check: use CGI::Session '-ip_match'; Usually you don't call ip_match() directly, but by using the above method. It is useful only if you want to call it inside of coderef passed to the L method. =head2 delete() Sets the objects status to be "deleted". Subsequent read/write requests on the same object will fail. To physically delete it from the data store you need to call L. CGI::Session attempts to do this automatically when the object is being destroyed (usually as the script exits), but see L. =head2 find( \&code ) =head2 find( $dsn, \&code ) =head2 find( $dsn, \&code, \%dsn_args ) Experimental feature. Executes \&code for every session object stored in disk, passing initialized CGI::Session object as the first argument of \&code. Useful for housekeeping purposes, such as for removing expired sessions. Following line, for instance, will remove sessions already expired, but are still in disk: The following line, for instance, will remove sessions already expired, but which are still on disk: CGI::Session->find( sub {} ); Notice, above \&code didn't have to do anything, because load(), which is called to initialize sessions inside L, will automatically remove expired sessions. Following example will remove all the objects that are 10+ days old: CGI::Session->find( \&purge ); sub purge { my ($session) = @_; next if $session->is_empty; # <-- already expired?! if ( ($session->ctime + 3600*240) <= time() ) { $session->delete(); $session->flush(); # Recommended practice says use flush() after delete(). } } B: find will not change the modification or access times on the sessions it returns. Explanation of the 3 parameters to C: =over 4 =item $dsn This is the DSN (Data Source Name) used by CGI::Session to control what type of sessions you previously created and what type of sessions you now wish method C to pass to your callback. The default value is defined above, in the docs for method C, and is 'driver:file;serializer:default;id:md5'. Do not confuse this DSN with the DSN arguments mentioned just below, under \%dsn_args. =item \&code This is the callback provided by you (i.e. the caller of method C) which is called by CGI::Session once for each session found by method C which matches the given $dsn. There is no default value for this coderef. When your callback is actually called, the only parameter is a session. If you want to call a subroutine you already have with more parameters, you can achieve this by creating an anonymous subroutine that calls your subroutine with the parameters you want. For example: CGI::Session->find($dsn, sub { my_subroutine( @_, 'param 1', 'param 2' ) } ); CGI::Session->find($dsn, sub { $coderef->( @_, $extra_arg ) } ); Or if you wish, you can define a sub generator as such: sub coderef_with_args { my ( $coderef, @params ) = @_; return sub { $coderef->( @_, @params ) }; } CGI::Session->find($dsn, coderef_with_args( $coderef, 'param 1', 'param 2' ) ); =item \%dsn_args If your $dsn uses file-based storage, then this hashref might contain keys such as: { Directory => Value 1, NoFlock => Value 2, UMask => Value 3 } If your $dsn uses db-based storage, then this hashref contains (up to) 3 keys, and looks like: { DataSource => Value 1, User => Value 2, Password => Value 3 } These 3 form the DSN, username and password used by DBI to control access to your database server, and hence are only relevant when using db-based sessions. The default value of this hashref is undef. =back B find() is meant to be convenient, not necessarily efficient. It's best suited in cron scripts. =head2 name($new_name) The $new_name parameter is optional. If supplied it sets the query or cookie parameter name to be used. It defaults to I<$CGI::Session::NAME>, which defaults to I. You are strongly discouraged from using the global variable I<$CGI::Session::NAME>, since it is deprecated (as are all global variables) and will be removed in a future version of this module. Return value: The current query or cookie parameter name. =head1 MISCELLANEOUS METHODS =head2 remote_addr() Returns the remote address of the user who created the session for the first time. Returns undef if variable REMOTE_ADDR wasn't present in the environment when the session was created. =cut sub remote_addr { return $_[0]->{_DATA}->{_SESSION_REMOTE_ADDR} } =pod =head2 errstr() Class method. Returns last error message from the library. =head2 dump() Returns a dump of the session object. Useful for debugging purposes only. =head2 header() A wrapper for C's header() method. Calling this method is equivalent to something like this: $cookie = CGI::Cookie->new(-name=>$session->name, -value=>$session->id); print $cgi->header(-cookie=>$cookie, @_); You can minimize the above into: print $session->header(); It will retrieve the name of the session cookie from C<$session->name()> which defaults to C<$CGI::Session::NAME>. If you want to use a different name for your session cookie, do something like this before creating session object: CGI::Session->name("MY_SID"); $session = CGI::Session->new(undef, $cgi, \%attrs); Now, $session->header() uses "MY_SID" as the name for the session cookie. For all additional options that can be passed, see the C docs in C. =head2 query() Returns query object associated with current session object. Default query object class is C. =head2 DEPRECATED METHODS These methods exist solely for for compatibility with CGI::Session 3.x. =head3 close() Closes the session. Using flush() is recommended instead, since that's exactly what a call to close() does now. =head1 DISTRIBUTION CGI::Session consists of several components such as L, L and L. This section lists what is available. =head2 DRIVERS The following drivers are included in the standard distribution: =over 4 =item * L - default driver for storing session data in plain files. Full name: B =item * L - for storing session data in BerkelyDB. Requires: L. Full name: B =item * L - for storing session data in MySQL tables. Requires L and L. Full name: B =item * L - for storing session data in SQLite. Requires L and L. Full name: B =back Other drivers are available from CPAN. =head2 SERIALIZERS =over 4 =item * L - default data serializer. Uses standard L. Full name: B. =item * L - serializes data using L. Requires L. Full name: B. =item * L - serializes data using L. Requires L. Full name: B =item * L - serializes data using YAML. Requires L or L. Full name: B =back =head2 ID GENERATORS The following ID generators are included in the standard distribution. =over 4 =item * L - generates 32 character long hexadecimal string. Requires L. Full name: B. =item * L - generates incremental session ids. =item * L - generates static session ids. B =back =head1 A Warning about Auto-flushing Auto-flushing can be unreliable for the following reasons. Explicit flushing after key session updates is recommended. =over 4 =item If the C handle goes out of scope before the session variable For database-stored sessions, if the C handle has gone out of scope before the auto-flushing happens, auto-flushing will fail. =item Circular references If the calling code contains a circular reference, it's possible that your C object will not be destroyed until it is too late for auto-flushing to work. You can find circular references with a tool like L. In particular, these modules are known to contain circular references which lead to this problem: =over 4 =item CGI::Application::Plugin::DebugScreen V 0.06 =item CGI::Application::Plugin::ErrorPage before version 1.20 =back =item Signal handlers If your application may receive signals, there is an increased chance that the signal will arrive after the session was updated but before it is auto-flushed at object destruction time. =back =head1 A Warning about UTF8 You are strongly encouraged to refer to, at least, the first of these articles, for help with UTF8. L L L L L Briefly, these are the issues: =over 4 =item The file containing the source code of your program Consider "use utf8;" or "use encoding 'utf8';". =item Influencing the encoding of the program's input Use: binmode STDIN, ":encoding(utf8)";. Of course, the program can get input from other sources, e.g. HTML template files, not just STDIN. =item Influencing the encoding of the program's output Use: binmode STDOUT, ":encoding(utf8)"; When using CGI.pm, you can use $q->charset('UTF-8'). This is the same as passing 'UTF-8' to CGI's C method. Alternately, when using CGI::Session, you can use $session->header(charset => 'utf-8'), which will be passed to the query object's C method. Clearly this is preferable when the query object might not be of type CGI. See L for a fuller discussion of the use of the C method in conjunction with cookies. =back =head1 TRANSLATIONS This document is also available in Japanese. =over 4 =item o Translation based on 4.14: http://digit.que.ne.jp/work/index.cgi?Perldoc/ja =item o Translation based on 3.11, including Cookbook and Tutorial: http://perldoc.jp/docs/modules/CGI-Session-3.11/ =back =head1 CREDITS CGI::Session evolved to what it is today with the help of following developers. The list doesn't follow any strict order, but somewhat chronological. Specifics can be found in F file =over 4 =item Andy Lester =item Brian King Emrbbking@mac.comE =item Olivier Dragon Edragon@shadnet.shad.caE =item Adam Jacob Eadam@sysadminsith.orgE =item Igor Plisco Eigor@plisco.ruE =item Mark Stosberg =item Matt LeBlanc Emleblanc@cpan.orgE =item Shawn Sorichetti =item Ron Savage =item Rhesa Rozendaal He suggested Devel::Cycle to help debugging. =back Also, many people on the CGI::Application and CGI::Session mailing lists have contributed ideas and suggestions, and battled publicly with bugs, all of which has helped. =head1 COPYRIGHT Copyright (C) 2001-2005 Sherzod Ruzmetov Esherzodr@cpan.orgE. All rights reserved. This library is free software. You can modify and or distribute it under the same terms as Perl itself. =head1 PUBLIC CODE REPOSITORY You can see what the developers have been up to since the last release by checking out the code repository. You can browse the git repository from here: http://github.com/cromedome/cgi-session/tree/master Or check out the code with: git clone git://github.com/cromedome/cgi-session.git =head1 SUPPORT If you need help using CGI::Session, ask on the mailing list. You can ask the list by sending your questions to cgi-session-user@lists.sourceforge.net . You can subscribe to the mailing list at https://lists.sourceforge.net/lists/listinfo/cgi-session-user . Bug reports can be submitted at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Session =head1 AUTHOR Sherzod Ruzmetov C Mark Stosberg became a co-maintainer during the development of 4.0. C. Ron Savage became a co-maintainer during the development of 4.30. C. If you would like support, ask on the mailing list as describe above. The maintainers and other users are subscribed to it. =head1 SEE ALSO To learn more both about the philosophy and CGI::Session programming style, consider the following: =over 4 =item * L - extended CGI::Session manual. Also includes library architecture and driver specifications. =item * We also provide mailing lists for CGI::Session users. To subscribe to the list or browse the archives visit https://lists.sourceforge.net/lists/listinfo/cgi-session-user =item * B - The primary spec for cookie handing in use, defining the "Cookie:" and "Set-Cookie:" HTTP headers. Available at L. A newer spec, RFC 2965 is meant to obsolete it with "Set-Cookie2" and "Cookie2" headers, but even of 2008, the newer spec is not widely supported. See L =item * L - an alternative to CGI::Session. =back =cut 1; CGI-Session-4.48/lib/CGI/Session000755000765000765 011606571771 15363 5ustar00markmark000000000000CGI-Session-4.48/lib/CGI/Session/Driver.pm000444000765000765 1651211606571771 17336 0ustar00markmark000000000000package CGI::Session::Driver; use strict; # use Carp; use CGI::Session::ErrorHandler; $CGI::Session::Driver::VERSION = '4.43'; @CGI::Session::Driver::ISA = qw(CGI::Session::ErrorHandler); sub new { my $class = shift; my $args = shift || {}; unless ( ref $args ) { croak "$class->new(): Invalid argument type passed to driver"; } # Set defaults. if (! $args->{TableName}) { $args->{TableName} = 'sessions'; } if (! $args->{IdColName}) { $args->{IdColName} = 'id'; } if (! $args->{DataColName}) { $args->{DataColName} = 'a_session'; } # perform a shallow copy of $args, to prevent modification my $self = bless ({%$args}, $class); return $self if $self->init(); return $self->set_error( "$class->init() returned false"); } sub init { 1 } sub retrieve { croak "retrieve(): " . ref($_[0]) . " failed to implement this method!"; } sub store { croak "store(): " . ref($_[0]) . " failed to implement this method!"; } sub remove { croak "remove(): " . ref($_[0]) . " failed to implement this method!"; } sub traverse { croak "traverse(): " . ref($_[0]) . " failed to implement this method!"; } sub dump { require Data::Dumper; my $d = Data::Dumper->new([$_[0]], [ref $_[0]]); return $d->Dump; } 1; __END__; =pod =head1 NAME CGI::Session::Driver - CGI::Session driver specifications =head1 SYNOPSIS require CGI::Session::Driver; @ISA = qw( CGI::Session::Driver ); =head1 DESCRIPTION CGI::Session::Driver is a base class for all CGI::Session's native drivers. It also documents driver specifications for those willing to write drivers for different databases not currently supported by CGI::Session. =head1 WHAT IS A DRIVER Driver is a piece of code that helps CGI::Session library to talk to specific database engines, or storage mechanisms. To be more precise, driver is a F<.pm> file that inherits from CGI::Session::Driver and defines L, L and L methods. =head2 BLUEPRINT The best way of learning the specs is to look at a blueprint of a driver: package CGI::Session::Driver::your_driver_name; use strict; use base qw( CGI::Session::Driver CGI::Session::ErrorHandler ); sub init { my ($self) = @_; # optional } sub DESTROY { my ($self) = @_; # optional } sub store { my ($self, $sid, $datastr) = @_; # Store $datastr, which is an already serialized string of data. } sub retrieve { my ($self, $sid) = @_; # Return $datastr, which was previously stored using above store() method. # Return $datastr if $sid was found. Return 0 or "" if $sid doesn't exist } sub remove { my ($self, $sid) = @_; # Remove storage associated with $sid. Return any true value indicating success, # or undef on failure. } sub traverse { my ($self, $coderef) = @_; # execute $coderef for each session id passing session id as the first and the only # argument } 1; All the attributes passed as the second argument to CGI::Session's new() or load() methods will automatically be made driver's object attributes. For example, if session object was initialized as following: $s = CGI::Session->new("driver:your_driver_name", undef, {Directory=>'/tmp/sessions'}); You can access value of 'Directory' from within your driver like so: sub store { my ($self, $sid, $datastr) = @_; my $dir = $self->{Directory}; # <-- in this example will be '/tmp/sessions' } Optionally, you can define C method within your driver to do driver specific global initialization. C method will be invoked only once during the lifecycle of your driver, which is the same as the lifecycle of a session object. For examples of C look into the source code of native CGI::Session drivers. =head1 METHODS This section lists and describes all driver methods. All the driver methods will receive driver object ($self) as the first argument. Methods that pertain to an individual session (such as C, C and C) will also receive session id ($sid) as the second argument. Following list describes every driver method, including its argument list and what step of session's life they will be invoked. Understanding this may help driver authors. =over 4 =item retrieve($self, $sid) Called whenever a specific session is requested either via C<< CGI::Session->new() >> or C<< CGI::Session->load() >> syntax. Method should try to retrieve data associated with C< $sid > and return it. In case no data could be retrieved for C< $sid > 0 (zero) or "" should be returned. undef must be returned only to signal error. Error message should be set via set_error(), which can be inherited from L. Tip: set_error() always returns undef. Use it for your advantage. =item store($self, $sid, $datastr) Called whenever modified session data is to be stored back to disk. This happens whenever CGI::Session->flush() is called on modified session. Since CGI::Session->DESTROY() calls flush(), store() gets requested each time session object is to be terminated. C< store() > is called both to store new sessions and to update already stored sessions. It's driver author's job to figure out which operation needs to be performed. $datastr, which is passed as the third argument to represents B session data that needs to be saved. store() can return any true value indicating success or undef on failure. Error message should be passed to set_error() =item remove($self, $sid) Called whenever session data is to be deleted, which is when CGI::Session->delete() is called. Should return any true value indicating success, undef on failure. Error message should be logged in set_error(). =item traverse($self, \&coderef) Called only from within CGI::Session->find(). Job of traverse() is to call \&coderef for every single session stored in disk passing session's id as the first and only argument: C<< $coderef->( $sid ) >> =item init($self) Optional. Called whenever driver object is to be initialized, which happens only once during the lifecycle of CGI::Session object. Here you can do driver-wide initialization, such as to open connection to a database server. =item DESTROY($self) Optional. Perl automatically calls this method on objects just before they are to be terminated. This gives your driver chance to close any database connections or close any open file handles. =back =head2 NOTES =over 4 =item * All driver F<.pm> files must be lowercase! =item * DBI-related drivers are better off using L as base, but don't have to. =back =head1 BACKWARDS COMPATIBILITY Version 4.0 of CGI::Session's driver specification is B backward compatible with the previous specification. If you already have a driver developed to work with the previous version you're highly encouraged to upgrade your driver code to make it compatible with the current version. Fortunately, current driver specs are a lot easier to adapt to. For support information see L =head1 LICENSING For support and licensing see L. =cut CGI-Session-4.48/lib/CGI/Session/Tutorial.pm000444000765000765 6337111606571771 17713 0ustar00markmark000000000000package CGI::Session::Tutorial; # $Id$ $CGI::Session::Tutorial::VERSION = '4.43'; =pod =head1 NAME CGI::Session::Tutorial - Extended CGI::Session manual =head1 STATE MAINTENANCE OVERVIEW Since HTTP is a stateless protocol, each subsequent click to a web site is treated as new request by the Web server. The server does not relate a visit with a previous one, thus all the state information from the previous requests are lost. This makes creating such applications as shopping carts, web sites requiring users to authenticate, impossible. So people had to do something about this despair situation HTTP was putting us in. For our rescue come such technologies as I and Is that help us save the users' session for a certain period. Since I and Is alone cannot take us too far (B), several other libraries have been developed to extend their capabilities and promise a more reliable solution. L is one of them. Before we discuss this library, let's look at some alternative solutions. =head2 COOKIE Cookie is a piece of text-information that a web server is entitled to place in the user's hard disk, assuming a user agent (such as Internet Explorer, Mozilla, etc) is compatible with the specification. After the cookie is placed, user agents are required to send these cookies back to the server as part of the HTTP request. This way the server application ( CGI, for example ) will have a way of relating previous requests by the same user agent, thus overcoming statelessness of HTTP. Although I seem to be promising solution for the statelessness of HTTP, they do carry certain limitations, such as limited number of cookies per domain and per user agent and limited size on each cookie. User Agents are required to store at least 300 cookies at a time, 20 cookies per domain and allow 4096 bytes of storage for each cookie. They also rise several Privacy and Security concerns, the lists of which can be found on the sections B<6-"Privacy"> and B<7-"Security Considerations"> of B. =head2 QUERY STRING Query string is a string appended to URL following a question mark (?) such as: http://my.dot.com/login.cgi?user=sherzodr;password=top-secret As you probably guessed, it can also help you pass state information from a click to another, but how secure is it do you think, considering these URLs tend to get cached by most of the user agents and also logged in the servers access log, to which everyone can have access. =head2 HIDDEN FIELDS Hidden field is another alternative to using query strings and they come in two flavors: hidden fields used in POST methods and the ones in GET. The ones used in GET methods will turn into a true query strings once submitted, so all the disadvantages of QUERY_STRINGs apply. Although POST requests do not have limitations of its sister-GET, the pages that hold them get cached by Web browser, and are available within the source code of the page (obviously). They also become unwieldily to manage when one has oodles of state information to keep track of ( for instance, a shopping cart or an advanced search engine). Query strings and hidden fields are also lost easily by closing the browser, or by clicking the browser's "Back" button. =head2 SERVER SIDE SESSION MANAGEMENT This technique is built upon the aforementioned technologies plus a server-side storage device, which saves the state data on the server side. Each session has a unique id associated with the data in the server. This id is also associated with the user agent either in the form of a I, a I, hidden field or any combination of the above. This is necessary to make the connection with the client and his data. Advantages: =over 4 =item * We no longer need to depend on User Agent constraints in cookie size. =item * Sensitive data no longer need to be traveling across the network at each request (which is the case with query strings, cookies and hidden fields). The only thing that travels is the unique id generated for the session (B<5767393932698093d0b75ef614376314>, for instance), which should make no sense to third parties. =item * User will not have sensitive data stored in his/her computer in unsecured file (which is a cookie file). =item * It's possible to handle very big and even complex data structures transparently (which I do not handle). =back That's what CGI::Session is all about - implementing server side session management. Now is a good time to get feet wet. =head1 PROGRAMMING STYLE Server side session management system might be seeming awfully convoluted if you have never dealt with it. Fortunately, with L all the complexity is handled by the library transparently. This section of the manual can be treated as an introductory tutorial to both logic behind session management, and to CGI::Session programming style. All applications making use of server side session management rely on the following pattern of operation regardless of the way the system is implemented: =over 4 =item 1 Check if the user has session cookie dropped in his computer from previous request =item 2 If the cookie does not exist, create a new session identifier, and drop it as cookie to the user's computer. =item 3 If session cookie exists, read the session ID from the cookie and load any previously saved session data from the server side storage. If session had any expiration date set it's useful to re-drop the same cookie to the user's computer so its expiration time will be reset to be relative to user's last activity time. =item 4 Store any necessary data in the session that you want to make available for the next HTTP request. =back CGI::Session will handle all of the above steps. All you have to do is to choose what to store in the session. =head2 GETTING STARTED To make L's functionality available in your program do either of the following somewhere on top of your program file: use CGI::Session; # or require CGI::Session; Whenever you're ready to create a new session in your application, do the following: $session = CGI::Session->new () or die CGI::Session->errstr; Above line will first try to re-initialize an existing session by consulting cookies and necessary QUERY_STRING parameters. If it fails will create a brand new session with a unique ID, which is normally called I, I for short, and can be accessed through L - object method. We didn't check for any session cookies above, did we? No, we didn't, but CGI::Session did. It looked for a cookie called C, and if it found it tried to load existing session from server side storage (B in our case). If cookie didn't exist it looked for a QUERY_STRING parameter called C. If all the attempts to recover session ID failed, it created a new session. NOTE: For the above syntax to work as intended your application needs to have write access to your computer's I folder, which is usually F in UNIX. If it doesn't, or if you wish to store this application's session files in a different place, you may pass the third argument like so: $session = CGI::Session->new(undef, undef, {Directory=>'../tmp/sessions'}); Now it will store all the newly created sessions in (and will attempt to initialize requested sessions from) that folder. Don't worry if the directory hierarchy you want to use doesn't already exist. It will be created for you. For details on how session data are stored refer to L, which is the default driver used in our above example. There is one small, but very important thing your application needs to perform after creating CGI::Session object as above. It needs to drop Session ID as an I into the user's computer. CGI::Session will use this cookie to identify the user at his/her next request and will be able to load his/her previously stored session data. To make sure CGI::Session will be able to read your cookie at next request you need to consult its C method for cookie's suggested name: $cookie = $query->cookie( -name => $session->name, -value => $session->id ); print $query->header( -cookie=>$cookie ); C returns C by default. If you prefer a different cookie name, you can change it as easily too, but you have to do it before CGI::Session object is created: CGI::Session->name("SID"); $session = CGI::Session->new(); Baking the cookie wasn't too difficult, was it? But there is an even easier way to send a cookie using CGI::Session: print $session->header(); The above will create the cookie using L and will return proper http headers using L's L method. Any arguments to L will be passed to L. Of course, this method of initialization will only work if client is accepting cookies. If not you would have to pass session ID in each URL of your application as QUERY_STRING. For CGI::Session to detect it the name of the parameter should be the same as returned by L: printf ("click me", $session->name, $session->id); If you already have session id to be initialized you may pass it as the only argument, or the second argument of multi-argument syntax: $session = CGI::Session->new( $sid ); $session = CGI::Session->new( "serializer:freezethaw", $sid ); $session = CGI::Session->new( "driver:mysql", $sid, {Handle=>$dbh} ); By default CGI::Session uses standard L to parse queries and cookies. If you prefer to use a different, but compatible object you can pass that object in place of $sid: $cgi = CGI::Simple->new(); $session = CGI::Session->new( $cgi ); $session = CGI::Session->new( "driver:db_file;serializer:storable", $cgi); # etc See L =head2 STORING DATA L offers L, which behaves exactly as L with identical syntax. L is used for storing data in session as well as for accessing already stored data. Imagine your customer submitted a login form on your Web site. You, as a good host, wanted to remember the guest's name, so you can a) greet him accordingly when he visits your site again, or b) to be helpful by filling out I part of his login form, so the customer can jump right to the I field without having to type his username again. my $name = $cgi->param('username'); $session->param('username', $name); Notice, we're grabbing I value of the field using CGI.pm's (or another compatible library's) C method, and storing it in session using L's L method. If you have too many stuff to transfer into session, you may find yourself typing the above code over and over again. I've done it, and believe me, it gets very boring too soon, and is also error-prone. So we introduced the following handy method: $session->save_param(['name']); If you wanted to store multiple form fields just include them all in the second list: $session->save_param(['name', 'email']); If you want to store all the available I parameters you can omit the arguments: $session->save_param(); See L for more details. When storing data in the session you're not limited to strings. You can store arrays, hashes and even most objects. You will need to pass them as references (except objects). For example, to get all the selected values of a scrolling list and store it in the session: my @fruits = $cgi->param('fruits'); $session->param('fruits', \@fruits); For parameters with multiple values save_param() will do the right thing too. So the above is the same as: $session->save_param($cgi, ['fruits']); All the updates to the session data using above methods will not reflect in the data store until your application exits, or C<$session> goes out of scope. If, for some reason, you need to commit the changes to the data store before your application exits you need to call L method: $session->flush(); I've written a lot of code, and never felt need for using C method, since CGI::Session calls this method at the end of each request. There are, however, occasions I can think of one may need to call L. =head2 ACCESSING STORED DATA There's no point of storing data if you cannot access it. You can access stored session data by using the same L you once used to store them. Remember the Username field from the previous section that we stored in the session? Let's read it back so we can partially fill the Login form for the user: $name = $session->param("name"); printf "", $name; To retrieve previously stored @fruits do not forget to de reference it: @fruits = @{ $session->param('fruits') }; Very frequently, you may find yourself having to create pre-filled and pre-selected forms, like radio buttons, checkboxes and drop down menus according to the user's preferences or previous action. With text and textareas it's not a big deal - you can simply retrieve a single parameter from the session and hard code the value into the text field. But how would you do it when you have a group of radio buttons, checkboxes and scrolling lists? For this purpose, CGI::Session provides L method, which loads given session parameters to a CGI object (assuming they have been previously saved with L or alternative): $session->load_param($cgi, ["fruits"]); Now when you say: print $cgi->checkbox_group(fruits=>['apple', 'banana', 'apricot']); See L for details. Generated checkboxes will be pre-filled using previously saved information. If you're making use of L to separate the code from the skin, you can as well associate L object with HTML::Template and access all the parameters from within HTML files. We love this trick! $template = HTML::Template->new(filename=>"some.tmpl", associate=>$session); print $template->output(); Assuming the session object stored "first_name" and "email" parameters while being associated with HTML::Template, you can access those values from within your "some.tmpl" file now: Hello ! See L for details. =head2 CLEARING SESSION DATA You store session data, you access session data and at some point you will want to clear certain session data, if not all. For this purpose L provides L method which optionally takes one argument as an arrayref indicating which session parameters should be deleted from the session object: $session->clear(["~logged-in", "email"]); Above line deletes "~logged-in" and "email" session parameters from the session. And next time you say: $email = $session->param("email"); it returns undef. If you omit the argument to L, be warned that all the session parameters you ever stored in the session object will get deleted. Note that it does not delete the session itself. Session stays open and accessible. It's just the parameters you stored in it gets deleted See L for details. =head2 DELETING A SESSION If there's a start there's an end. If session could be created, it should be possible to delete it from the disk for good: $session->delete(); The above call to L deletes the session from the disk for good. Do not confuse it with L, which only clears certain session parameters but keeps the session open. See L for details. =head2 EXPIRATION L provides limited means to expire sessions. Expiring a session is the same as deleting it via delete(), but deletion takes place automatically. To expire a session, you need to tell the library how long the session would be valid after the last access time. When that time is met, CGI::Session refuses to retrieve the session. It deletes the session and returns a brand new one. To assign expiration ticker for a session, use L: $session->expire(3600); # expire after 3600 seconds $session->expire('+1h'); # expire after 1 hour $session->expire('+15m'); # expire after 15 minutes $session->expire('+1M'); # expire after a month and so on. When session is set to expire at some time in the future, but session was not requested at or after that time has passed it will remain in the disk. When expired session is requested CGI::Session will remove the data from disk, and will initialize a brand new session. See L for details. Before CGI::Session 4.x there was no way of intercepting requests to expired sessions. CGI::Session 4.x introduced new kind of constructor, L, which is identical in use to L, but is not allowed to create sessions. It can only load them. If session is found to be expired, or session does not exist it will return an empty CGI::Session object. And if session is expired, in addition to being empty, its status will also be set to expired. You can check against these conditions using L and L methods. If session was loaded successfully object returned by C is as good a session as the one returned by C: $session = CGI::Session->load() or die CGI::Session->errstr; if ( $session->is_expired ) { die "Your session expired. Please refresh your browser to re-start your session"; } if ( $session->is_empty ) { $session = $session->new(); } Above example is worth an attention. Remember, all expired sessions are empty sessions, but not all empty sessions are expired sessions. Following this rule we have to check with C before checking with C. There is another thing about the above example. Notice how its creating new session when un existing session was requested? By calling C as an object method! Handy thing about that is, when you call C on a session object new object will be created using the same configuration as the previous object. For example: $session = CGI::Session->load("driver:mysql;serializer:storable", undef, {Handle=>$dbh}); if ( $session->is_expired ) { die "Your session is expired. Please refresh your browser to re-start your session"; } if ( $session->is_empty ) { $session = $session->new(); } Initial C<$session> object was configured with B as the driver, B as the serializer and B<$dbh> as the database handle. Calling C< new() > on this object will return an object of the same configuration. So C< $session > object returned from C< new() > in the above example will use B as the driver, B as the serializer and B<$dbh> as the database handle. See L, L, L for details. Sometimes it makes perfect sense to expire a certain session parameter, instead of the whole session. I usually do this in my login enabled sites, where after the user logs in successfully, I set his/her "_logged_in" session parameter to true, and assign an expiration ticker on that flag to something like 30 minutes. It means, after 30 idle minutes CGI::Session will L "_logged_in" flag, indicating the user should log in over again. I agree, the same effect can be achieved by simply expiring() the session itself, but by doing this we would loose other session parameters, such as user's shopping cart, session-preferences and the like. This feature can also be used to simulate layered authentication, such as, you can keep the user's access to his/her personal profile information for as long as 60 minutes after a successful login, but expire his/her access to his credit card information after 5 idle minutes. To achieve this effect, we will use L method again: $session->expire(_profile_access, '1h'); $session->expire(_cc_access, '5m'); With the above syntax, the person will still have access to his personal information even after 5 idle hours. But when he tries to access or update his/her credit card information, he may be displayed a "login again, please" screen. See L for details. This concludes our discussion of CGI::Session programming style. The rest of the manual covers some L<"SECURITY"> issues. Driver specs from the previous manual were moved to L. =head1 SECURITY "How secure is using CGI::Session?", "Can others hack down people's sessions using another browser if they can get the session id of the user?", "Are the session ids easy to guess?" are the questions I find myself answering over and over again. =head2 STORAGE Security of the library does in many aspects depend on the implementation. After making use of this library, you no longer have to send all the information to the user's cookie except for the session id. But, you still have to store the data in the server side. So another set of questions arise, can an evil person get access to session data in your server, even if he does, can he make sense out of the data in the session file, and even if he can, can he reuse the information against a person who created that session. As you see, the answer depends on yourself who is implementing it. =over 4 =item * First rule of thumb, do not store users' passwords or other sensitive data in the session, please. If you have to, use one-way encryption, such as md5, or SHA-1-1. For my own experience I can assure you that in properly implemented session-powered Web applications there is never a need for it. =item * Default configuration of the driver makes use of L class to serialize data to make it possible to save it in the disk. Data::Dumper's result is a human readable data structure, which, if opened, can be interpreted easily. If you configure your session object to use either L or L as a serializer, this would make it more difficult for bad guys to make sense out of session data. But don't use this as the only precaution. Since evil fingers can type a quick program using L or L to decipher session files very easily. =item * Do not allow anyone to update contents of session files. If you're using L serialized data string needs to be eval()ed to bring the original data structure back to life. Of course, we use L to do it safely, but your cautiousness does no harm either. =item * Do not keep sessions open for very long. This will increase the possibility that some bad guy may have someone's valid session id at a given time (acquired somehow). To do this use L method to set expiration ticker. The more sensitive the information on your Web site is, the sooner the session should be set to expire. =back =head2 SESSION IDs Session ids are not easily guessed (unless you're using L)! Default configuration of CGI::Session uses L to generate random, 32 character long identifier. Although this string cannot be guessed as easily by others, if they find it out somehow, can they use this identifier against the other person? Consider the scenario, where you just give someone either via email or an instant messaging a link to a Web site where you're currently logged in. The URL you give to that person contains a session id as part of a query string. If the site was initializing the session solely using query string parameter, after clicking on that link that person now appears to that site as you, and might have access to all of your private data instantly. Even if you're solely using cookies as the session id transporters, it's not that difficult to plant a cookie in the cookie file with the same id and trick the web browser to send that particular session id to the server. So key for security is to check if the person who's asking us to retrieve a session data is indeed the person who initially created the session data. One way to help with this is by also checking that the IP address that the session is being used from is always same. However, this turns out not to be practical in common cases because some large ISPs (such as AOL) use proxies which cause each and every request from the same user to come from different IP address. If you have an application where you are sure your users' IPs are constant during a session, you can consider enabling an option to make this check: use CGI::Session '-ip_match'; For backwards compatibility, you can also achieve this by setting $CGI::Session::IP_MATCH to a true value. This makes sure that before initializing a previously stored session, it checks if the ip address stored in the session matches the ip address of the user asking for that session. In which case the library returns the session, otherwise it dies with a proper error message. =head1 LICENSING For support and licensing see L =cut CGI-Session-4.48/lib/CGI/Session/ErrorHandler.pm000444000765000765 310511606571771 20444 0ustar00markmark000000000000package CGI::Session::ErrorHandler; # $Id$ use strict; $CGI::Session::ErrorHandler::VERSION = '4.43'; =pod =head1 NAME CGI::Session::ErrorHandler - error handling routines for CGI::Session =head1 SYNOPSIS require CGI::Session::ErrorHandler; @ISA = qw( CGI::Session::ErrorHandler ); sub some_method { my $self = shift; unless ( $some_condition ) { return $self->set_error("some_method(): \$some_condition isn't met"); } } =head1 DESCRIPTION CGI::Session::ErrorHandler provides set_error() and errstr() methods for setting and accessing error messages from within CGI::Session's components. This method should be used by driver developers for providing CGI::Session-standard error handling routines for their code =head2 METHODS =over 4 =item set_error($message) Implicitly defines $pkg_name::errstr and sets its value to $message. Return value is B undef. =cut sub set_error { my $class = shift; my $message = shift; $class = ref($class) || $class; no strict 'refs'; ${ "$class\::errstr" } = $message || ""; return; } =item errstr() Returns whatever value was set by the most recent call to set_error(). If no message as has been set yet, the empty string is returned so the message can still concatenate without a warning. =back =cut *error = \&errstr; sub errstr { my $class = shift; $class = ref( $class ) || $class; no strict 'refs'; return ${ "$class\::errstr" } || ''; } =head1 LICENSING For support and licensing information see L. =cut 1; CGI-Session-4.48/lib/CGI/Session/Serialize000755000765000765 011606571771 17312 5ustar00markmark000000000000CGI-Session-4.48/lib/CGI/Session/Serialize/default.pm000444000765000765 777011606571771 21444 0ustar00markmark000000000000package CGI::Session::Serialize::default; # $Id$ use strict; use Safe; use Data::Dumper; use CGI::Session::ErrorHandler; use Scalar::Util qw(blessed reftype refaddr); use Carp "croak"; use vars qw( %overloaded ); require overload; @CGI::Session::Serialize::default::ISA = ( "CGI::Session::ErrorHandler" ); $CGI::Session::Serialize::default::VERSION = '4.43'; sub freeze { my ($class, $data) = @_; my $d = new Data::Dumper([$data], ["D"]); $d->Indent( 0 ); $d->Purity( 1 ); $d->Useqq( 0 ); $d->Deepcopy( 0 ); $d->Quotekeys( 1 ); $d->Terse( 0 ); # ;$D added to make certain we get our data structure back when we thaw return $d->Dump() . ';$D'; } sub thaw { my ($class, $string) = @_; # To make -T happy my ($safe_string) = $string =~ m/^(.*)$/s; my $rv = Safe->new->reval( $safe_string ); if ( $@ ) { return $class->set_error("thaw(): couldn't thaw. $@"); } __walk($rv); return $rv; } sub __walk { my %seen; my @filter = __scan(shift); local %overloaded; # We allow the value assigned to a key to be undef. # Hence the defined() test is not in the while(). while (@filter) { defined(my $x = shift @filter) or next; $seen{refaddr $x || ''}++ and next; my $r = reftype $x or next; if ($r eq "HASH") { # we use this form to make certain we have aliases # to the values in %$x and not copies push @filter, __scan(@{$x}{keys %$x}); } elsif ($r eq "ARRAY") { push @filter, __scan(@$x); } elsif ($r eq "SCALAR" || $r eq "REF") { push @filter, __scan($$x); } } } # we need to do this because the values we get back from the safe compartment # will have packages defined from the safe compartment's *main instead of # the one we use sub __scan { # $_ gets aliased to each value from @_ which are aliases of the values in # the current data structure for (@_) { if (blessed $_) { if (overload::Overloaded($_)) { my $address = refaddr $_; # if we already rebuilt and reblessed this item, use the cached # copy so our ds is consistent with the one we serialized if (exists $overloaded{$address}) { $_ = $overloaded{$address}; } else { my $reftype = reftype $_; if ($reftype eq "HASH") { $_ = $overloaded{$address} = bless { %$_ }, ref $_; } elsif ($reftype eq "ARRAY") { $_ = $overloaded{$address} = bless [ @$_ ], ref $_; } elsif ($reftype eq "SCALAR" || $reftype eq "REF") { $_ = $overloaded{$address} = bless \do{my $o = $$_},ref $_; } else { croak "Do not know how to reconstitute blessed object of base type $reftype"; } } } else { bless $_, ref $_; } } } return @_; } 1; __END__; =pod =head1 NAME CGI::Session::Serialize::default - Default CGI::Session serializer =head1 DESCRIPTION This library is used by CGI::Session driver to serialize session data before storing it in disk. All the methods are called as class methods. =head1 METHODS =over 4 =item freeze($class, \%hash) Receives two arguments. First is the class name, the second is the data to be serialized. Should return serialized string on success, undef on failure. Error message should be set using C =item thaw($class, $string) Received two arguments. First is the class name, second is the I data string. Should return thawed data structure on success, undef on failure. Error message should be set using C =back =head1 LICENSING For support and licensing see L =cut CGI-Session-4.48/lib/CGI/Session/Serialize/freezethaw.pm000444000765000765 242711606571771 22156 0ustar00markmark000000000000package CGI::Session::Serialize::freezethaw; # $Id$ use strict; use FreezeThaw; use CGI::Session::ErrorHandler; $CGI::Session::Serialize::freezethaw::VERSION = 4.43; @CGI::Session::Serialize::freezethaw::ISA = ( "CGI::Session::ErrorHandler" ); sub freeze { my ($self, $data) = @_; return FreezeThaw::freeze($data); } sub thaw { my ($self, $string) = @_; return (FreezeThaw::thaw($string))[0]; } 1; __END__; =pod =head1 NAME CGI::Session::Serialize::freezethaw - serializer for CGI::Session =head1 DESCRIPTION This library can be used by CGI::Session to serialize session data. Uses L. =head1 METHODS =over 4 =item freeze($class, \%hash) Receives two arguments. First is the class name, the second is the data to be serialized. Should return serialized string on success, undef on failure. Error message should be set using C =item thaw($class, $string) Received two arguments. First is the class name, second is the I data string. Should return thawed data structure on success, undef on failure. Error message should be set using C =back =head1 LICENSING For support and licensing see L =cut CGI-Session-4.48/lib/CGI/Session/Serialize/storable.pm000444000765000765 242011606571771 21616 0ustar00markmark000000000000package CGI::Session::Serialize::storable; # $Id$ use strict; use Storable; require CGI::Session::ErrorHandler; $CGI::Session::Serialize::storable::VERSION = '4.43'; @CGI::Session::Serialize::storable::ISA = ( "CGI::Session::ErrorHandler" ); =pod =head1 NAME CGI::Session::Serialize::storable - Serializer for CGI::Session =head1 DESCRIPTION This library can be used by CGI::Session to serialize session data. Uses L. =head1 METHODS =over 4 =item freeze($class, \%hash) Receives two arguments. First is the class name, the second is the data to be serialized. Should return serialized string on success, undef on failure. Error message should be set using C =cut sub freeze { my ($self, $data) = @_; return Storable::freeze($data); } =item thaw($class, $string) Receives two arguments. First is the class name, second is the I data string. Should return thawed data structure on success, undef on failure. Error message should be set using C =back =cut sub thaw { my ($self, $string) = @_; return Storable::thaw($string); } =head1 LICENSING For support and licensing see L =cut 1; CGI-Session-4.48/lib/CGI/Session/Test000755000765000765 011606571771 16302 5ustar00markmark000000000000CGI-Session-4.48/lib/CGI/Session/Test/Default.pm000444000765000765 3613511606571771 20411 0ustar00markmark000000000000package CGI::Session::Test::Default; use strict; use Carp; use Test::More (); use Data::Dumper; use Scalar::Util "refaddr"; our $AUTOLOAD; our $CURRENT; sub ok_later (&;$); $CGI::Session::Test::Default::VERSION = '4.47'; =head1 NAME CGI::Session::Test::Default - Run a suite of tests for a given CGI::Session::Driver =head2 new() my $t = CGI::Session::Test::Default->new( # These are all optional, with default as follows dsn => "driver:file", args => undef, tests => 77, ); Create a new test object, possibly overriding some defaults. =cut sub new { my $class = shift; my $self = bless { dsn => "driver:file", args => undef, tests => 101, test_number => 0, @_ }, $class; if($self->{skip}) { $self->{_skip} = { map { $_ => $_ } @{$self->{skip}} }; } else { $self->{_skip} = {}; } return $self; } =head2 number_of_tests() my $new_num = $t->number_of_tests($new_num); A setter/accessor method to affect the number of tests to run, after C has been called and before C. =cut sub number_of_tests { my $self = shift; if ( @_ ) { $self->{tests} = $_[0]; } return $self->{tests}; } =head2 run() $t->run(); Run the test suite. See C for setting related options. =cut sub run { my $self = shift; $CURRENT = $self; use_ok("CGI::Session", "CGI::Session loaded successfully!"); my $sid = undef; FIRST: { ok(1, "=== 1 ==="); my $session = CGI::Session->load() or die CGI::Session->errstr; ok($session, "empty session should be created"); ok(!$session->id, 'Id is empty'); ok($session->is_empty, 'Session is empty'); ok(!$session->is_expired, 'Session is not expired'); undef $session; $session = CGI::Session->new($self->{dsn}, '_DOESN\'T EXIST_', $self->{args}) or die CGI::Session->errstr; ok( $session, "Session created successfully!"); # # checking if the driver object created is really the driver requested: # my $dsn = $session->parse_dsn( $self->{dsn} ); ok( ref $session->_driver eq "CGI::Session::Driver::" . $dsn->{driver}, ref $dsn->{Driver} ); ok( $session->ctime && $session->atime, "ctime & atime are set"); ok( $session->atime == $session->ctime, "ctime == atime"); ok( !$session->etime, "etime not set yet"); ok( $session->id, "session id is " . $session->id); $session->param('author', "Sherzod Ruzmetov"); $session->param(-name=>'emails', -value=>['sherzodr@cpan.org', 'sherzodr@cpan.org']); $session->param('blogs', { './lost+found' => 'http://author.cpan.org/', 'Yigitlik sarguzashtlari' => 'http://author.cpan.org/uz/' }); ok( ($session->param) == 3, "session holds 3 params" . scalar $session->param ); ok( $session->param('author') eq "Sherzod Ruzmetov", "My name's correct!"); ok( ref ($session->param('emails')) eq 'ARRAY', "'emails' holds list of values" ); ok( @{ $session->param('emails') } == 2, "'emails' holds list of two values"); ok( $session->param('emails')->[0] eq 'sherzodr@cpan.org', "first value of 'emails' is correct!"); ok( $session->param('emails')->[1] eq 'sherzodr@cpan.org', "second value of 'emails' is correct!"); ok( ref( $session->param('blogs') ) eq 'HASH', "'blogs' holds a hash"); ok( $session->param('blogs')->{'./lost+found'} eq 'http://author.cpan.org/', "first blog is correct"); ok( $session->param('blogs')->{'Yigitlik sarguzashtlari'} eq 'http://author.cpan.org/uz/', "second blog is correct"); $sid = $session->id; $session->flush(); } sleep(1); SECOND: { SKIP: { ok(1, "=== 2 ==="); my $session; eval { $session = CGI::Session->load($self->{dsn}, $sid, $self->{args}) }; if ($@ || CGI::Session->errstr) { Test::More::skip("couldn't load session, bailing out: SQLite/Storable support is TODO", 56); } is($@.CGI::Session->errstr,'','survived eval without error.'); ok($session, "Session was retrieved successfully"); ok(!$session->is_expired, "session isn't expired yet"); is($session->id,$sid, "session IDs are consistent"); ok($session->atime > $session->ctime, "ctime should be older than atime"); ok(!$session->etime, "etime shouldn't be set yet"); ok( ($session->param) == 3, "session should hold params" ); ok( $session->param('author') eq "Sherzod Ruzmetov", "my name's correct"); ok( ref ($session->param('emails')) eq 'ARRAY', "'emails' should hold list of values" ); ok( @{ $session->param('emails') } == 2, "'emails' should hold list of two values"); ok( $session->param('emails')->[0] eq 'sherzodr@cpan.org', "first value is correct!"); ok( $session->param('emails')->[1] eq 'sherzodr@cpan.org', "second value is correct!"); ok( ref( $session->param('blogs') ) eq 'HASH', "'blogs' holds a hash"); ok( $session->param('blogs')->{'./lost+found'} eq 'http://author.cpan.org/', "first blog is correct!"); ok( $session->param('blogs')->{'Yigitlik sarguzashtlari'} eq 'http://author.cpan.org/uz/', "second blog is correct!"); # TODO: test many any other variations of expire() syntax $session->expire('+1s'); ok($session->etime == 1, "etime set to 1 second"); $session->expire("+1m"); ok($session->etime == 60, "etime set to one minute"); $session->expires("2h"); ok($session->etime == 7200, "etime set to two hours"); $session->expires("5d"); ok($session->etime == 432000, "etime set to 5 days"); $session->expires("-10s"); ok($session->etime == -10, "etime set to 10 seconds in the past"); # # Setting the expiration time back to 1s, so that subsequent tests # relying on this value pass # $session->expire("1s"); ok($session->etime == 1, "etime set back to one second"); eval { $session->close(); }; is($@, '', 'calling close method survives eval'); } } sleep(1); # <-- letting the time tick my $driver; THREE: { ok(1, "=== 3 ==="); my $session = CGI::Session->load($self->{dsn}, $sid, $self->{args}) or die CGI::Session->errstr; ok($session, "Session instance loaded "); ok(!$session->id, "session doesn't have ID"); ok($session->is_empty, "session is empty, which is the same as above"); #print $session->dump; ok($session->is_expired, "session was expired"); ok(!$session->param('author'), "session data cleared"); sleep(1); $session = $session->new() or die CGI::Session->errstr; #print $session->dump(); ok($session, "new session created"); ok($session->id, "session has id :" . $session->id ); ok(!$session->is_expired, "session isn't expired"); ok(!$session->is_empty, "session isn't empty"); ok($session->atime == $session->ctime, "access and creation times are same"); ok($session->id ne $sid, "it's a completely different session than above"); $driver = $session->_driver(); $sid = $session->id; } FOUR: { # We are intentionally removing the session stored in the datastore and will be requesting # re-initialization of that id. This test is necessary since I noticed weird behaviors in # some of my web applications that kept creating new sessions when the object requested # wasn't in the datastore. ok(1, "=== 4 ==="); ok($driver->remove( $sid ), "Session '$sid' removed from datastore successfully"); my $session = CGI::Session->new($self->{dsn}, $sid, $self->{args} ) or die CGI::Session->errstr; ok($session, "session object created successfully"); ok($session->id ne $sid, "claimed ID ($sid) couldn't be recovered. New ID is: " . $session->id); $sid = $session->id; } FIVE: { ok(1, "=== 5 ==="); my $session = CGI::Session->new($self->{dsn}, $sid, $self->{args}) or die CGI::Session->errstr; ok($session, "Session object created successfully"); ok($session->id eq $sid, "claimed id ($sid) was recovered successfully!"); # Remove the object, finally! $session->delete(); } SIX: { ok(1, "=== 6 ==="); my $session = CGI::Session->new($self->{dsn}, $sid, $self->{args}) or die CGI::Session->errstr; ok($session, "Session object created successfully"); ok($session->id ne $sid, "New object created, because previous object was deleted"); $sid = $session->id; # # creating a simple object to be stored into session my $simple_class = CGI::Session::Test::SimpleObjectClass->new(); ok($simple_class, "CGI::Session::Test::SimpleObjectClass created successfully"); $simple_class->name("Sherzod Ruzmetov"); $simple_class->emails(0, 'sherzodr@cpan.org'); $simple_class->emails(1, 'sherzodr@cpan.org'); $simple_class->blogs('lost+found', 'http://author.cpan.org/'); $simple_class->blogs('yigitlik', 'http://author.cpan.org/uz/'); $session->param('simple_object', $simple_class); ok($session->param('simple_object')->name eq "Sherzod Ruzmetov"); ok($session->param('simple_object')->emails(1) eq 'sherzodr@cpan.org'); ok($session->param('simple_object')->blogs('yigitlik') eq 'http://author.cpan.org/uz/'); # # creating an overloaded object to be stored into session my $overloaded_class = OverloadedClass->new("ABCDEFG"); ok($overloaded_class, "OverloadedClass created successfully"); ok(overload::Overloaded($overloaded_class) , "OverloadedClass is properly overloaded"); ok(ref ($overloaded_class) eq "OverloadedClass", "OverloadedClass is an object"); $session->param("overloaded_object", $overloaded_class); ok($session->param("overloaded_object") eq "ABCDEFG"); my $simple_class2 = CGI::Session::Test::SimpleObjectClass->new(); ok($simple_class2, "CGI::Session::Test::SimpleObjectClass created successfully"); $simple_class2->name("Sherzod Ruzmetov"); $simple_class2->emails(0, 'sherzodr@cpan.org'); $simple_class2->emails(1, 'sherzodr@cpan.org'); $simple_class2->blogs('lost+found', 'http://author.cpan.org/'); $simple_class2->blogs('yigitlik', 'http://author.cpan.org/uz/'); my $embedded = OverloadedClass->new("Embedded"); $session->param("embedded_simple_and_overloaded",[ undef, $simple_class2, $embedded, $embedded ]); ok(!defined($session->param("embedded_simple_and_overloaded")->[0]),"First element of anonymous array undef"); ok($session->param("embedded_simple_and_overloaded")->[1]->name eq "Sherzod Ruzmetov"); ok($session->param("embedded_simple_and_overloaded")->[1]->emails(1) eq 'sherzodr@cpan.org'); ok($session->param("embedded_simple_and_overloaded")->[1]->blogs('yigitlik') eq 'http://author.cpan.org/uz/'); ok($session->param("embedded_simple_and_overloaded")->[2] eq "Embedded"); ok(refaddr($session->param("embedded_simple_and_overloaded")->[2]) == refaddr($session->param("embedded_simple_and_overloaded")->[3] ), "Overloaded objects have matching addresses"); } SEVEN: { ok(1, "=== 7 ==="); my $session = CGI::Session->new($self->{dsn}, $sid, $self->{args}) or die CGI::Session->errstr; ok($session, "Session object created successfully"); ok($session->id eq $sid, "Previously stored object loaded successfully"); my $simple_object = $session->param("simple_object"); ok(ref $simple_object eq "CGI::Session::Test::SimpleObjectClass", "CGI::Session::Test::SimpleObjectClass loaded successfully"); my $dsn = CGI::Session->parse_dsn($self->{dsn}); ok_later { $simple_object->name eq "Sherzod Ruzmetov" }; ok_later { $simple_object->emails(1) eq 'sherzodr@cpan.org' }; ok_later { $simple_object->emails(0) eq 'sherzodr@cpan.org' }; ok_later { $simple_object->blogs('lost+found') eq 'http://author.cpan.org/' }; ok(ref $session->param("overloaded_object") ); ok($session->param("overloaded_object") eq "ABCDEFG", "Object is still overloaded"); ok(overload::Overloaded($session->param("overloaded_object")), "Object is really overloaded"); ok(!defined($session->param("embedded_simple_and_overloaded")->[0]),"First element of anonymous array undef"); my $simple_object2 = $session->param("embedded_simple_and_overloaded")->[1]; ok(ref $simple_object2 eq "CGI::Session::Test::SimpleObjectClass", "CGI::Session::Test::SimpleObjectClass loaded successfully"); ok_later { $simple_object2->name eq "Sherzod Ruzmetov" }; ok_later { $simple_object2->emails(1) eq 'sherzodr@cpan.org' }; ok_later { $simple_object2->emails(0) eq 'sherzodr@cpan.org' }; ok_later { $simple_object2->blogs('lost+found') eq 'http://author.cpan.org/' }; ok($session->param("embedded_simple_and_overloaded")->[2] eq "Embedded"); ok(overload::Overloaded($session->param("embedded_simple_and_overloaded")->[2]), "Object is really overloaded"); ok(refaddr($session->param("embedded_simple_and_overloaded")->[2]) == refaddr($session->param("embedded_simple_and_overloaded")->[3]), "Overloaded objects have matching addresses"); $session->delete(); } $CURRENT = undef; $self->{test_number} = 0; } sub skip_or_run { my $test = shift; $CURRENT->{test_number} ++; SKIP: { if($CURRENT->{_skip}->{$CURRENT->{test_number}}) { Test::More::skip("Test does not apply to this setup.", 1); } no strict 'refs'; &{"Test::More::$test"}(@_); } } sub ok { skip_or_run("ok", @_); } sub use_ok { skip_or_run("use_ok", @_); } sub is { skip_or_run("is", @_); } sub ok_later (&;$) { my($code, $name) = @_; $CURRENT->{test_number} ++; $name = '' unless $name; SKIP: { if($CURRENT->{_skip}->{$CURRENT->{test_number}}) { Test::More::skip("Test does not apply to this setup.", 1); fail($name); } else { Test::More::ok($code->(), $name); } } } sub DESTROY { 1; } package CGI::Session::Test::SimpleObjectClass; use strict; use Class::Struct; struct ( name => '$', emails => '@', blogs => '%' ); package OverloadedClass; use strict; use overload ( '""' => \&as_string, 'eq' => \&equals ); sub new { return bless { str_value => $_[1] }, $_[0]; } sub as_string { return $_[0]->{str_value}; } sub equals { my ($self, $arg) = @_; return ($self->as_string eq $arg); } 1; CGI-Session-4.48/lib/CGI/Session/Driver000755000765000765 011606571771 16616 5ustar00markmark000000000000CGI-Session-4.48/lib/CGI/Session/Driver/DBI.pm000444000765000765 1771411606571771 17741 0ustar00markmark000000000000package CGI::Session::Driver::DBI; # $Id$ use strict; use DBI; use Carp; use CGI::Session::Driver; @CGI::Session::Driver::DBI::ISA = ( "CGI::Session::Driver" ); $CGI::Session::Driver::DBI::VERSION = '4.43'; 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 ( @_ ) { $self->{TableName} = shift; } 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 $self->{DataColName} FROM " . $self->table_name . " WHERE $self->{IdColName}=?", 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(); $sth->finish; 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 $self->{IdColName} FROM " . $self->table_name . " WHERE $self->{IdColName}=?", 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 $rc = $sth->fetchrow_array; $sth->finish; my $action_sth; if ( $rc ) { $action_sth = $dbh->prepare_cached("UPDATE " . $self->table_name . " SET $self->{DataColName}=? WHERE $self->{IdColName}=?", undef, 3); } else { $action_sth = $dbh->prepare_cached("INSERT INTO " . $self->table_name . " ($self->{DataColName}, $self->{IdColName}) 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 ); $action_sth->finish; 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 $self->{IdColName}= ?", {}, $sid ); unless ( $rc ) { croak "remove(): \$dbh->do failed!"; } return 1; } sub DESTROY { my $self = shift; unless ( defined $self->{Handle} && $self->{Handle} -> ping ) { $self->set_error(__PACKAGE__ . '::DESTROY(). Database handle has gone away'); return; } 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 $self->{IdColName} 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); } $sth->finish; 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 = CGI::Session->new('driver:sqlite', undef, {TableName=>'my_sessions'}); $s = CGI::Session->new('driver:mysql', undef, { TableName=>'my_sessions', DataSource=>'dbi:mysql:shopping_cart'. }); To use different column names, change the 'create table' statement, and then simply do this: $s = CGI::Session->new('driver:pg', undef, { TableName=>'session', IdColName=>'my_id', DataColName=>'my_data', DataSource=>'dbi:pg:dbname=project', }); or $s = CGI::Session->new('driver:pg', undef, { TableName=>'session', IdColName=>'my_id', DataColName=>'my_data', Handle=>$dbh, }); =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 CGI-Session-4.48/lib/CGI/Session/Driver/mysql.pm000444000765000765 1013411606571771 20475 0ustar00markmark000000000000package CGI::Session::Driver::mysql; # $Id$ 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.43'; 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("INSERT INTO " . $self->table_name . " ($self->{IdColName}, $self->{DataColName}) VALUES(?, ?) ON DUPLICATE KEY UPDATE $self->{DataColName} = ?", undef, $sid, $datastr, $datastr) or return $self->set_error( "store(): \$dbh->do failed " . $dbh->errstr ); return 1; } sub table_name { my $self = shift; return $self->SUPER::table_name(@_); } 1; __END__; =pod =head1 NAME CGI::Session::Driver::mysql - CGI::Session driver for MySQL database =head1 SYNOPSIS $s = CGI::Session->new( 'driver:mysql', $sid); $s = CGI::Session->new( 'driver:mysql', $sid, { DataSource => 'dbi:mysql:test', User => 'sherzodr', Password => 'hello' }); $s = CGI::Session->new( '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 ); To use different column names, change the 'create table' statement, and then simply do this: $s = CGI::Session->new('driver:mysql', undef, { TableName=>'session', IdColName=>'my_id', DataColName=>'my_data', DataSource=>'dbi:mysql:project', }); or $s = CGI::Session->new('driver:mysql', undef, { TableName=>'session', IdColName=>'my_id', DataColName=>'my_data', Handle=>$dbh, }); =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 = CGI::Session->new( 'driver:mysql', $sid, {DataSource=>'shopping_cart'}); # is the same as: $s = CGI::Session->new( 'driver:mysql', $sid, {DataSource=>'dbi:mysql:shopping_cart'}); =head2 BACKWARDS COMPATIBILITY As of V 4.30, the global variable $CGI::Session::MySQL::TABLE_NAME cannot be used to set the session table's name. This is due to changes in CGI::Session::Driver's new() method, which now allows the table's name to be changed (as well as allowing both the 'id' column name and the 'a_session' column name to be changed). See the documentation for CGI::Session::Driver::DBI for details. In particular, the new syntax for C applies to all database drivers, whereas the old - and bad - global variable method only applied to MySQL. Alternately, call $session -> table_name('new_name') just after creating the session object if you wish to change the session table's name. =head1 LICENSING For support and licensing see L. =cut CGI-Session-4.48/lib/CGI/Session/Driver/postgresql.pm000444000765000765 1205211606571771 21534 0ustar00markmark000000000000package CGI::Session::Driver::postgresql; # $Id$ # 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.43'; @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 . " ($self->{DataColName},$self->{IdColName}) SELECT ?, ? WHERE NOT EXISTS (SELECT 1 FROM " . $self->table_name . " WHERE $self->{IdColName}=? 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 $self->{DataColName}=? WHERE $self->{IdColName}=?"); $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 = CGI::Session->new("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 = CGI::Session->new("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. To use different column names, change the 'create table' statement, and then simply do this: $s = CGI::Session->new('driver:pg', undef, { TableName=>'session', IdColName=>'my_id', DataColName=>'my_data', DataSource=>'dbi:pg:dbname=project', }); or $s = CGI::Session->new('driver:pg', undef, { TableName=>'session', IdColName=>'my_id', DataColName=>'my_data', Handle=>$dbh, }); 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 CGI-Session-4.48/lib/CGI/Session/Driver/db_file.pm000444000765000765 1220611606571771 20716 0ustar00markmark000000000000package CGI::Session::Driver::db_file; # $Id$ 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.43'; $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 = CGI::Session->new("driver:db_file", $sid); $s = CGI::Session->new("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 CGI-Session-4.48/lib/CGI/Session/Driver/file.pm000444000765000765 1535211606571771 20256 0ustar00markmark000000000000package CGI::Session::Driver::file; # $Id$ 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.43'; $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) = @_; my $id = $sid; $id =~ s|\\|/|g; if ($id =~ m|/|) { return $self->set_error( "_file(): Session ids cannot contain \\ or / chars: $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 $path = $self -> _file($sid); 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 = CGI::Session->new(); $s = CGI::Session->new("driver:file", $sid); $s = CGI::Session->new("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: use CGI::Session::Driver::file; # This line is mandatory. # Time passes... $CGI::Session::Driver::file::FileName = "%s.dat"; $s = CGI::Session->new(); 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 CGI-Session-4.48/lib/CGI/Session/Driver/sqlite.pm000444000765000765 735611606571771 20625 0ustar00markmark000000000000package CGI::Session::Driver::sqlite; # $Id$ use strict; use File::Spec; use base 'CGI::Session::Driver::DBI'; use DBI qw(SQL_BLOB); use Fcntl; $CGI::Session::Driver::sqlite::VERSION = '4.43'; 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 $self->{IdColName} FROM " . $self->table_name . " WHERE $self->{IdColName}=?"); 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 $self->{DataColName}=? WHERE $self->{IdColName}=?",$datastr,$sid) or return $self->set_error( "store(): serialize to db failed " . $dbh->errstr ); } else { __ex_and_ret($dbh,"INSERT INTO " . $self->table_name . " ($self->{DataColName},$self->{IdColName}) VALUES(?, ?)",$datastr, $sid) or return $self->set_error( "store(): serialize to db failed " . $dbh->errstr ); } return 1; } sub DESTROY { my $self = shift; unless ( defined( $self->{Handle} ) && $self->{Handle} -> ping ) { $self->set_error(__PACKAGE__ . '::DESTROY(). Database handle has gone away'); return; } unless ( $self->{Handle}->{AutoCommit} ) { $self->{Handle}->commit; } if ( $self->{_disconnect} ) { undef $self->{Handle}; } } 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 = CGI::Session->new("driver:sqlite", $sid, {DataSource=>'/my/folder/sessions.sqlt'}); $s = CGI::Session->new("driver:sqlite", $sid, {Handle=>$dbh}); or $s = CGI::Session->new('driver:sqlite', undef, { TableName=>'session', IdColName=>'my_id', DataColName=>'my_data', 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 CGI-Session-4.48/lib/CGI/Session/ID000755000765000765 011606571771 15657 5ustar00markmark000000000000CGI-Session-4.48/lib/CGI/Session/ID/static.pm000444000765000765 241311606571771 17641 0ustar00markmark000000000000package CGI::Session::ID::static; use base 'CGI::Session::ErrorHandler'; use strict; use Carp 'croak'; use CGI::Session::ErrorHandler; $CGI::Session::ID::static::VERSION = '4.44'; sub generate_id { my ($self, $args, $claimed_id ) = @_; unless ( defined $claimed_id ) { croak "'CGI::Session::ID::Static::generate_id()' requires static id"; } return $claimed_id; } 1; __END__ =head1 NAME CGI::Session::ID::static - CGI::Session ID Driver for generating static IDs =head1 SYNOPSIS use CGI::Session; $session = CGI::Session->new( 'driver:mysql;id:static', $ENV{REMOTE_ADDR}, { Handle => $dbh } ); =head1 DESCRIPTION CGI::Session::ID::static is used to generate consistent, static session ID's. In other words, you tell CGI::Session ID you want to use, and it will honor it. Unlike the other ID drivers, this one requires that you provide an ID when creating the session object; if you pass it an undefined value, it will croak. =head1 COPYRIGHT Copyright (C) 2002 Adam Jacob , This library is free software. You can modify and distribute it under the same terms as Perl itself. =head1 AUTHORS Adam Jacob , =head1 LICENSING For additional support and licensing see L =cut CGI-Session-4.48/lib/CGI/Session/ID/md5.pm000444000765000765 136511606571771 17044 0ustar00markmark000000000000package CGI::Session::ID::md5; # $Id$ use strict; use Digest::MD5; use CGI::Session::ErrorHandler; $CGI::Session::ID::md5::VERSION = '4.43'; @CGI::Session::ID::md5::ISA = qw( CGI::Session::ErrorHandler ); *generate = \&generate_id; sub generate_id { my $md5 = Digest::MD5->new(); $md5->add($$ , time() , rand(time) ); return $md5->hexdigest(); } 1; =pod =head1 NAME CGI::Session::ID::md5 - default CGI::Session ID generator =head1 SYNOPSIS use CGI::Session; $s = CGI::Session->new("id:md5", undef); =head1 DESCRIPTION CGI::Session::ID::MD5 is to generate MD5 encoded hexadecimal random ids. The library does not require any arguments. =head1 LICENSING For support and licensing see L =cut CGI-Session-4.48/lib/CGI/Session/ID/incr.pm000444000765000765 452411606571771 17312 0ustar00markmark000000000000package CGI::Session::ID::incr; # $Id$ use strict; use File::Spec; use Carp "croak"; use Fcntl qw( :DEFAULT :flock ); use CGI::Session::ErrorHandler; $CGI::Session::ID::incr::VERSION = '4.43'; @CGI::Session::ID::incr::ISA = qw( CGI::Session::ErrorHandler ); sub generate_id { my ($self, $args) = @_; my $IDFile = $args->{IDFile} or croak "Don't know where to store the id"; my $IDIncr = $args->{IDIncr} || 1; my $IDInit = $args->{IDInit} || 0; sysopen(FH, $IDFile, O_RDWR|O_CREAT, 0666) or return $self->set_error("Couldn't open IDFile=>$IDFile: $!"); flock(FH, LOCK_EX) or return $self->set_error("Couldn't lock IDFile=>$IDFile: $!"); my $ID = || $IDInit; seek(FH, 0, 0) or return $self->set_error("Couldn't seek IDFile=>$IDFile: $!"); truncate(FH, 0) or return $self->set_error("Couldn't truncate IDFile=>$IDFile: $!"); $ID += $IDIncr; print FH $ID; close(FH) or return $self->set_error("Couldn't close IDFile=>$IDFile: $!"); return $ID; } 1; __END__; =pod =head1 NAME CGI::Session::ID::incr - CGI::Session ID driver =head1 SYNOPSIS use CGI::Session; $session = CGI::Session->new("id:Incr", undef, { Directory => '/tmp', IDFile => '/tmp/cgisession.id', IDInit => 1000, IDIncr => 2 }); =head1 DESCRIPTION CGI::Session::ID::incr is to generate auto incrementing Session IDs. Compare it with L, where session ids are truly random 32 character long strings. CGI::Session::ID::incr expects the following arguments passed to CGI::Session->new() as the third argument. =over 4 =item IDFile Location where auto incremented IDs are stored. This attribute is required. =item IDInit Initial value of the ID if it's the first ID to be generated. For example, if you want the ID numbers to start with 1000 as opposed to 0, that's where you should set your value. Default is C<0>. =item IDIncr How many digits each number should increment by. For example, if you want the first generated id to start with 1000, and each subsequent id to increment by 10, set I to 10 and I to 1000. Default is C<1>. =back =head1 LICENSING For support and licensing information see L =cut CGI-Session-4.48/examples000755000765000765 011606571771 14406 5ustar00markmark000000000000CGI-Session-4.48/examples/subscriptions.cgi000555000765000765 2673711606571771 20200 0ustar00markmark000000000000#!/usr/bin/perl -w # $Id$ use strict; use CGI; use CGI::Carp 'fatalsToBrowser'; use URI::Escape; use vars qw($SELF_URL); use lib '/home/sherzodr/perllib'; # Check for some non-standard Perl modules my @required = qw(MIME::Lite HTML::Template CGI::Session); for my $mod ( @required ) { eval "require $mod"; if ( $@ ) { print "Content-Type: text/html\n\n"; print "$mod is required. If it's installed in a non-standard path, " . "please 'use lib' line in $0"; exit(0); } } my $cgi = CGI->new(); my $session = CGI::Session->load() or die CGI::Session->errstr; if ( $session->is_expired ) { print $session->header(); print "Your session expired, inevitably!"; exit(0); } elsif ( $session->is_empty ) { $session = $session->new(); } $session->expire("+30s"); my $cmd = $cgi->param('cmd') || $session->param("last_cmd") || 'directions'; $SELF_URL = $cgi->url() || $0; # save the last executed command: $session->param(last_cmd => $cmd); if ( $cmd eq "directions" ) { print directions($cgi, $session); } elsif ( $cmd eq 'step1' ) { print step1($cgi, $session); } elsif ( $cmd eq 'step2' ) { print step2($cgi, $session); } elsif ( $cmd eq 'step3' ) { print step3($cgi, $session); } elsif ( $cmd eq 'finish') { print finish($cgi, $session); } elsif ( $cmd eq 'clear' ) { print clear($cgi, $session); } elsif ( $cmd eq "show-dump" ) { print show_dump($cgi, $session); } else { print "Error: CMD: $cmd is not valid"; } #-------------------------------------------------------------------- # functions start here #-------------------------------------------------------------------- sub directions { my ($cgi, $session) = @_; my $dirver = ref($session); my $version = $session->VERSION(); my $HTML = <Welcome to CGI::Session Demo Script
Driver: $dirver/$version

The tricks are endless! This script is to demonstrate basic usage of CGI::Session in CGI applications.

So what is the test all about?

Test consists of a single multi-page mailing list subscription form. First form asks to fill in personal information, the second screen asks to choose subscriptions you are interested in. The 3rd page is a confirmation/summary of your subscriptions. Once you click on "Finish" button, the program sends your subscription details to your email you provided during subscriptions, and also attaches the source code of this script.

During the process, application provides "Back", "Next" and"Clear Form" buttons so that you can go back to previous forms to fill in/correct the details. While going back, notice how the script remembers all the data you have previously submitted, and presents pre-filled/pre-selected form elements.

While somewhere in the middle of subscription, close the browser intentionally, and reopen the page: $SELF_URL. Notice how the script remembers which form you were filling out before you closed the browser, and displays respective form, instead of taking you to the default page. Your previously filled in form data are also kept.

In each page, the script also provides you with "show-dump" link at the bottom of each screen. You can click on the link to view internal _DATA table of CGI::Session, and see what kind of information are stored in the object at each step.

Should you have any suggestions or comments, feel free to send me an email: sherzodr\@cpan.org.

HTML return template(\$HTML, $cgi, $session); } sub step1 { my ($cgi, $session) = @_; my $HTML = <<'HTML';

Step 1 out of 3

Hi %name%! Please fill out your personal information below

Your full name:
Your email address:
Your website URL:

HTML return template(\$HTML, $cgi, $session); } sub step2 { my ($cgi, $session) = @_; $session->save_param($cgi); $session->load_param($cgi, ["subscriptions"]); my $HTML = <Step 2 out of 3

Dear %name%.

Following are available newspaper subscriptions we offer.
Choose the subscriptions you are interested in, and click "Next >>"
button. To select more than one subscription, press and hold [CTRL] key while selecting.
Should you wish to update your profile, click "<<Back" button.

Subscriptions:
%subscriptions_scrolling%
HTML return template(\$HTML, $cgi, $session); } sub step3 { my ($cgi, $session) = @_; $session->save_param($cgi, ["subscriptions"]); $session->load_param($cgi, ["subscriptions"]); my $HTML = <Step 3 out of 3 - final!

Dear %name%.

Before you finalize your subscription, you need to review the following
information you have submitted. Update if necessary.
When you are down, click on "Finish" button. Voila!

Your Profile [edit]
Name: %name%
Email address: %email%
Your website: %website%

Your Subscriptions [edit]
%subscriptions_checkbox%
HTML return template(\$HTML, $cgi, $session); } sub finish { my ($cgi, $session) = @_; my $to = sprintf("%s <%s>", $session->param('name'), $session->param('email')); my $msg = MIME::Lite->new( From => 'Sherzod Ruzmetov ', To => $to, Subject => 'CGI-Session Demo', Type => 'multipart/mixed' ); $msg->attach( Type => 'text/plain', Data => _data($cgi, $session)); $msg->attach( Type => 'application/octet-stream', Path => $0, Filename => 'session.cgi' ); open(SENDMAIL, "|/usr/sbin/sendmail -t -oi") or die $!; $msg->print(\*SENDMAIL); close(SENDMAIL); $session->clear(); return $cgi->redirect(-uri=>$ENV{SCRIPT_NAME}); } sub _data { my ($cgi, $session) = @_; my $HTML = <<'HTML'; Thank you, %name%, for trying out our CGI::Session Demo Application. Here are the information you submitted to the script. Notice that we're also attaching the source code of the script to this email together with the session object dump at the time this email was being sent. +------------------------- | Personal Info: +------------------------- name: %name% email: %email% website: %website% +------------------------- | Subscriptions: +------------------------- %subscriptions_plain% +------------------------- | Session Object Dump: +------------------------- %dump% Regards, Sherzod Ruzmetov HTML return template(\$HTML, $cgi, $session, 1); } sub template { my ($HTML, $cgi, $session, $no_html) = @_; my $t = HTML::Template->new( scalarref=>$HTML, vanguard_compatibility_mode=>1, associate => [$session, $cgi] ); my @papers = ( "The Perl Journal", "The SysAdmin Magazine", "The Coolest CGI::Session tricks mailing list", "XML.com weekly news and updates", "Perl5porters mailing list", ); my $sid = $session->id(); $t->param( edit_profile => "$SELF_URL?cmd=step1;CGISESSID=$sid", edit_subs => "$SELF_URL?cmd=step2;CGISESSID=$sid", subscriptions_scrolling => $cgi->scrolling_list( -name=>'subscriptions', -values => \@papers, -size => 5, -multiple => 1), subscriptions_checkbox => scalar($cgi->checkbox_group( -name=>'subscriptions', -values => \@papers, -linebreak=>1)), 'dump' => $session->dump(undef, 1), ); if ( $no_html ) { return $t->output(); } my $cookie = $cgi->cookie(-name=>CGI::Session->name(), -value=>$sid, -expires=>"+10h"); $HTML = $cgi->header(-cookie=>$cookie) . $cgi->start_html(-title=>"CGI::Session Test Script", -script=>{code=>_js()}, -style => {code=>_css()} ) . $t->output(); unless ( $cgi->param("cmd") ) { $cgi->param(cmd => 'directions'); } my $dump_url = sprintf("%s?cmd=show-dump;CGISESSID=%s;ref=%s", $SELF_URL, $sid, uri_escape($cgi->self_url())); if ( $session->param("_display_dump") ) { $HTML .= $cgi->a({-href=>$dump_url}, "hide-dump"); $HTML .= $cgi->pre($session->dump(undef, 1)); } else { $HTML .= $cgi->a({-href=>$dump_url}, "show-dump"); } $HTML .= $cgi->end_html(); return $HTML; } sub show_dump { my ($cgi, $session) = @_; if ( $session->param("_display_dump") ) { $session->clear(["_display_dump"]); } else { $session->param(_display_dump => 1); } return $cgi->redirect(-uri=>$cgi->param('ref') ); } sub clear { my ($cgi, $session) = @_; $session->clear([$session->param()]); return $cgi->redirect(-uri=>$ENV{SCRIPT_NAME}); } sub _js { return <<'JS'; function clearTheForm(obj) { if ( confirm("If you cancel the form, all your previously submitted data will be lost. Are you sure you want to continue?") ) { obj["cmd"].value = "clear"; obj.submit(); return true; } return false; } function updateTheForm(obj) { obj["cmd"].value = "step3"; obj.submit(); return true; } JS } sub _css { return <<'CSS'; Body { background-color:White; margin: 70px; } P { width: 600px; font-family: Verdana, Arial, Sans-serif; font-size: 13px; } CSS } # $Id$ CGI-Session-4.48/examples/purge.pl000555000765000765 47511606571771 16213 0ustar00markmark000000000000#!/usr/bin/perl # $Id$ # # This script can be installed as a cron-job to run at specific intervals # to remove all expired session data from disk # use constant DSN => 'driver:file'; use constant DSN_ARGS => {}; use CGI::Session; CGI::Session->find( DSN, sub {}, DSN_ARGS ) or die CGI::Session->errstr;