[Ispman-cvs] CVS: ispman-utils/lib/CGI/Session DB_File.pm,NONE,1.1 File.pm,NONE,1.1 MD5.pm,NONE,1.1 MySQL.pm,NONE,1.1

[Atif G. <ma...@us...>]

Update of /cvsroot/ispman/ispman-utils/lib/CGI/Session
In directory usw-pr-cvs1:/tmp/cvs-serv32484/CGI/Session

Added Files:
	DB_File.pm File.pm MD5.pm MySQL.pm 
Log Message:


--- NEW FILE ---
package CGI::Session::DB_File;

use strict;
use vars qw($VERSION);
use base qw(CGI::Session CGI::Session::MD5);

use File::Spec;
use Data::Dumper;
use Fcntl qw(:DEFAULT :flock);
use DB_File;

$VERSION = "2.4";


# do not use any indentation
$Data::Dumper::Indent = 0;

sub retrieve {
    my ($self, $sid, $options) = @_;

    my $file    = $options->{FileName};
    my $lckdir  = $options->{LockDirectory};

	my $lckfile = File::Spec->catfile($lckdir, "CGI-Session-$sid.lck");
	sysopen (LCK, $lckfile, O_RDWR|O_CREAT, 0664) 
		or $self->error("Couldn't create lockfile $lckfile, $!"), return;
	flock (LCK, LOCK_SH) 
		or $self->error("Couldn't lock $lckfile	, $!"), return;

    tie my %session, "DB_File", $file, O_RDWR|O_CREAT, 0777 
		or $self->error("Couldn't open $file, $!"), return;

    my $tmp = $session{$sid} or $self->error("Session ID '$sid' doesn't exist"), return;
    
	untie %session;
	close (LCK);

	my $data = {};	eval $tmp;

	return $data;
}





sub store {
    my ($self, $sid, $hashref, $options) = @_;

    my $file    = $options->{FileName};
    my $lckdir  = $options->{LockDirectory};

	my $lckfile = File::Spec->catfile($lckdir, "CGI-Session-$sid.lck");
	sysopen (LCK, $lckfile, O_RDWR|O_CREAT, 0664) or $self->error("Couldn't create lockfile $lckfile, $!"), return;
	flock (LCK, LOCK_EX) 
		or $self->error("Couldn't lock $lckfile, $!"), return;
	
    tie my %session, "DB_File", $file, O_RDWR|O_CREAT, 0777 
		or $self->error("Couldn't open $file: $!"), return;
	
	my $d = Data::Dumper->new([$hashref], ["data"]);
    
	$session{$sid} = $d->Dump();
    
	untie %session;
	close (LCK);

    return 1;
}



sub tear_down {
	my ($self, $sid, $options) = @_;
	
	my $file = $options->{FileName};
	my $lckdir = $options->{LockDirectory};

	tie (my %session, "DB_File", $file) or die $!;
	delete $session{$sid};
	untie %session;

}

1;

=pod

=head1 NAME

CGI::Session::DB_File - Driver for CGI::Session class

=head1 SYNOPSIS

	use constant COOKIE => "TEST_SID";	# cookie to store the session id

	use CGI::Session::DB_File;
	use CGI;

	my $cgi = new CGI;

	# getting the 
	my $c_sid = $cgi->cookie(COOKIE) || undef;
	
	my $session = new CGI::Session::DB_File($c_sid, 
		{
			LockDirectory	=>'/tmp/locks', 
			FileName		=> '/tmp/sessions.db'
		});
	
	# now let's create a sid cookie and send it to the client's browser.
	# if it is an existing session, it will be the same as before,
	# but if it's a new session, $session->id() will return a new session id.
	{
		my $new_cookie = $cgi->cookie(-name=>COOKIE, -value=>$session->id);
		print $cgi->header(-cookie=>$new_cookie);
	}

	print $cgi->start_html("CGI::Session::File");

	# assuming we already saved the users first name in the session
	# when he visited it couple of days ago, we can greet him with
	# his first name

	print "Hello", $session->param("f_name"), ", how have you been?";

	print $cgi->end_html();

=head1 DESCRIPTION

C<CGI::Session::DB_File> is the driver for C<CGI::Session> to store and retrieve
the session data in and from the Berkeley DB 1.x. To be able to write your own
drivers for the L<CGI::Session>, please consult L<developer section|CGI::Session/DEVEROPER SECTION>
of the L<manual|CGI::Session>.

Constructor requires two arguments, as all other L<CGI::Session> drivers do.
The first argument has to be session id to be initialized (or undef to tell
the L<CGI::Session>  to create a new session id). The second argument has to be
a reference to a hash with two following require key/value pairs:

=over 4

=item C<Filename>

path to a file where all the session data will be stored

=item C<LockDirectory>

path in the file system where all the lock files for the sessions will be stored

=back

C<CGI::Session::DB_File> uses L<Data::Dumper|Data::Dumper> to serialize the session data
before storing it in the session file. 

=head2 Example
	
	# get the sessino id either from the SID cookie, or from
	# the sid parameter in the URL
	my $c_sid = $cgi->cookie("SID") || $cgi->param("sid") || undef;
	my $session = new CGI::Session::DB_File($c_sid, 
		{
			LockDirectory=>'/tmp', 
			FileName=>'/tmp/sessions.db'
		});

For more extensive examples of the C<CGI::Session> usage, please refer to L<CGI::Session manual|CGI::Session>

=head1 AUTHOR

Sherzod B. Ruzmetov <she...@cp...>

=head1 COPYRIGHT

This library is free software and can be redistributed under the same
conditions as Perl itself.

=head1 SEE ALSO

L<CGI::Session>, L<CGI::Session::File>, L<CGI::Session::DB_File>,
L<CGI::Session::MySQL>, L<Apache::Session>

=cut

--- NEW FILE ---
package CGI::Session::File;

use strict;
use vars qw($VERSION);
use Carp;
use base qw(CGI::Session CGI::Session::MD5);

use File::Spec;
use Fcntl qw(:DEFAULT :flock);
use Data::Dumper;

# do not use any indentation
$Data::Dumper::Indent = 0;
$VERSION = "2.4";


# constructor is inherited from CGI::Session
sub retrieve {
    my ($self, $sid, $options) = @_;

    # getting the options passed to the constructor
    my $dir     = $options->{Directory};
    my $lckdir  = $options->{LockDirectory};

	unless ( $dir && $lckdir ) {
		my $class = ref($self);
		croak "Usage: $class->new(\$sid, {Directory=>'/some/dir', LockDirectory=>'/some/dir'})";
	}

    # creating an OS independant path to the session file and the lockfile
    my $file    = File::Spec->catfile($dir, "CGI-Session-$sid.dat");
    my $lckfile =File::Spec->catfile($lckdir, "CGI-Session-$sid.lck");

    # opening the lockfile
    sysopen(LCK, $lckfile, O_RDWR|O_CREAT, 0644) or $self->error("Couldn't create lockfile, $!"), return;
    flock(LCK, LOCK_SH) or $self->error("Couldn't acquire lock on $lckfile, $!"), return;

	
    # getting the data from the session file
    local ( $/, *FH );
    sysopen(FH, $file, O_RDONLY) or $self->error("Couldn't open data file ($file), $!"), return;
    my $tmp = <FH>;
    close (FH); close (LCK);

    # intializing the hashref
    my $data = {}; eval $tmp;

    # did something go wrong?
    if ( $@ ) { $self->error("Couldn't eval() the data, $!"), return }

    # returning the eval()ed data
    return $data;
}


sub store {
    my ($self, $sid, $hashref, $options) = @_;

    # getting the options passed to the constructor
    my $dir     = $options->{Directory};
    my $lckdir  = $options->{LockDirectory};

    # creating an OS independant path
    my $file    = File::Spec->catfile($dir, "CGI-Session-$sid.dat");
    my $lckfile = File::Spec->catfile($lckdir, "CGI-Session-$sid.lck");
	

    # opening the lockfile
    sysopen (LCK, $lckfile, O_RDWR|O_CREAT, 0664) or $self->error("Couldn't open $lckfile, $!"), return;
    flock(LCK, LOCK_EX) or $self->error("Couldn't acquire lock on $lckfile, $!"), return;

    # storing the data in the session file
    local (*FH);
    sysopen (FH, $file, O_RDWR|O_CREAT|O_TRUNC, 0664) or $self->error("Couldn't create $file, $!"), return;

    # creating a Data::Dumper object of $hashref
    my $d = Data::Dumper->new([$hashref], ["data"]);

    # dumping the $hashref into a session file
    print FH $d->Dump();
    close (FH); close LCK;

    return 1;
}


sub tear_down {
    my ($self, $sid, $options) = @_;

    # getting the options passed to the constructor
    my $dir = $options->{Directory};

    # discovering the session filename
    my $file = File::Spec->catfile($dir, "CGI-Session-$sid.dat");

    # deleting the file
    unlink $file or $self->error("Couldn't delete the session data $file: $!"), return;

    return 1;
}



1;

=pod

=head1 NAME

CGI::Session::File - CGI::Session driver for

=head1 SYNOPSIS

	use constant COOKIE => "TEST_SID";	# cookie to store the session id

	use CGI::Session::File;
	use CGI;

	my $cgi = new CGI;

	# getting the session id from the cookie
	my $c_sid = $cgi->cookie(COOKIE) || undef;
	
	my $session = new CGI::Session::File($c_sid, 
		{
			LockDirectory	=>'/tmp/locks', 
			Directory		=>'/tmp/sessions'
		});
	
	# now let's create a sid cookie and send it to the client's browser.
	# if it is an existing session, it will be the same as before,
	# but if it's a new session, $session->id() will return a fresh one
	{
		my $new_cookie = $cgi->cookie(-name=>COOKIE, -value=>$session->id);
		print $cgi->header(-cookie=>$new_cookie);
	}

	print $cgi->start_html("CGI::Session::File");

	# assuming we already saved the users first name in the session
	# when he visited it couple of days ago, we can greet him with
	# his first name

	print "Hello", $session->param("f_name"), ", how have you been?";

	print $cgi->end_html();

=head1 DESCRIPTION

C<CGI::Session::File> is the driver for the L<CGI::Session|CGI::Session> to store and retrieve
the session data in and from the plain text files. To be able to write your own
drivers for the L<CGI::Session|CGI::Session>, please consult L<developer section|CGI::Session/DEVELOPER SECTION>
of the L<manual|CGI::Session>

Constructor requires two arguments, as all other L<CGI::Session> drivers do.
The first argument has to be session id to be initialized (or undef to tell
the CGI::Session  to create a new session id). The second argument has to be
a reference to a hash with two following require key/value pairs:

=over 4

=item C<Directory>

path in the file system where all the session data will be stored

=item C<LockDirectory>

path in the file system where all the lock files for the sessions will be stored

=back

C<CGI::Session::File> uses L<Data::Dumper|Data::Dumper> to serialize the session data
before storing it in the session file. 

=head2 Example
	
	# get the sessino id either from the SID cookie, or from
	# the sid parameter in the URL
	my $c_sid = $cgi->cookie("SID") || $cgi->param("sid") || undef;
	my $session = new CGI::Session::File($c_sid, 
		{
			LockDirectory => '/tmp', 
			Directory	  => '/tmp'
		});

For more extensive examples of the L<CGI::Session|CGI::Session> usage, please refer to 
L<CGI::Session> manual.

=head1 AUTHOR

Sherzod B. Ruzmetov <she...@cp...>

=head1 COPYRIGHT

This library is free software and can be redistributed under the same
conditions as Perl itself.

=head1 SEE ALSO

L<CGI::Session>, L<CGI::Session::File>, L<CGI::Session::DB_File>,
L<CGI::Session::MySQL>, L<Apache::Session>

=cut


--- NEW FILE ---
package CGI::Session::MD5;

use strict;
use Carp;
use vars qw($VERSION);

eval "require Digest::MD5";
if ( $@ ) {
    croak "Dependency detected: Digest::MD5 module needs to be installed in the system";
}

srand( time ^ ($$ + ($$ << 15)) );

sub generate_id {
	my $self = shift;

	my $digest = new Digest::MD5;
	$digest->add(rand(9999), time(), $$);

    my $id = $digest->b64digest();

	$id =~ s/\W/-/g;

	return $id;
}

1;


=pod

=head1 NAME

CGI::Session::MD5 - provides default C<generate_id()> method for CGI::Session

=head1 SYNOPSIS

	my $session_id = $self->generate_id()

=head1 DESCRIPTION
	
You normaly do not have to use it. It will be called by L<CGI::Session|CGI::Session>
whenever a new session identifier is required. But if you want, you can 
override the default C<generate_id()>. ( see L<developer section|CGI::Session/DEVELOPER SECTION>
of the L<CGI::Session manual|CGI::Session>)

=head1 AUTHOR

	Sherzod B. Ruzmetov <she...@cp...>

=head1 COPYRIGHT

	This library is a free software. You can modify and/or redistribute it
	under the same terms as Perl itself

=head1 SEE ALSO

L<CGI::Session>, L<CGI::Session::File>, L<CGI::Sessino::DB_File>,
L<CGI::Session::MySQL>

=cut


--- NEW FILE ---
package CGI::Session::MySQL;

use strict;
use vars qw($VERSION $TABLE_NAME);
use base qw(CGI::Session CGI::Session::MD5);

use Data::Dumper;
use Carp;
eval "require DBI";

if ( $@ ) {
	$CGI::Session::errstr = $@;
}

$VERSION = "2.3";

# chose the most compat from of serialization in Data::Dumper
$Data::Dumper::Indent = 0;

# This is the sessions table. Change it if you want to 
# use some other table for your sessions data
$TABLE_NAME = 'sessions';

# returns $dbh and $lckh
sub MYSQL_dbh {
	my ($self, $option) = @_;

	my $dbh     = $option->{Handle};
    my $lckh    = $option->{LockHandle};
    my $dsn     = $option->{DataSource};
    my $username= $option->{UserName};
    my $psswd   = $option->{Password};
    my $lcksn   = $option->{LockDataSource} || $dsn;
    my $lckuser = $option->{LockUserName} || $username;
    my $lckpsswd= $option->{LockPassword} || $psswd;

	if ( $dbh && $lckh ) {
		return ($dbh, $lckh);
	}

	$dbh	= DBI->connect($dsn, $username, $psswd) or $self->error($DBI::errstr), return;
	$lckh	= DBI->connect($lcksn, $lckuser, $lckpsswd) or $self->error($DBI::errstr), return;

	return ($dbh, $lckh);
}









sub retrieve {
    my ($self, $sid, $option) = @_;

    my ($dbh, $lckh) = $self->MYSQL_dbh($option) or return;
	$lckh->do("LOCK TABLES $TABLE_NAME READ");

    my ($tmp) = $dbh->selectrow_array(qq|SELECT a_session FROM $TABLE_NAME WHERE id=?|, undef, $sid);	

	$lckh->do("UNLOCK TABLES");	
	
	my $data = {}; eval $tmp;

	if ( $@ ) {
		$self->error("Couldn't eval() the data, $@"), return;
	}

	return $data;
}










sub store {
    my ($self, $sid, $hashref, $option) = @_;

	my ($dbh, $lckh) = $self->MYSQL_dbh($option);	
    my $d = Data::Dumper->new([$hashref], ["data"]);
    my $exists = $dbh->selectrow_array(qq|SELECT a_session FROM $TABLE_NAME WHERE id=?|, undef, $sid);

	$lckh->do("LOCK TABLES $TABLE_NAME WRITE");

    if ( $exists ) {		
        my $rv = $dbh->do(qq|UPDATE $TABLE_NAME SET a_session=? WHERE id=?|, undef, $d->Dump(), $sid);
		$lckh->do("UNLOCK TABLES");
		return $rv;
    }

    my $rv =  $dbh->do(qq|INSERT INTO $TABLE_NAME SET id=?, a_session=?|, undef, $sid, $d->Dump());
	$lckh->do("UNLOCK TABLES");
	return $rv;
}








sub tear_down {
    my ($self, $sid, $option) = @_;

	my ($dbh, $lckh) = $self->MYSQL_dbh($option);    

	$lckh->do("LOCK TABLES $TABLE_NAME WRITE");
    my $rv =  $dbh->do(qq|DELETE FROM $TABLE_NAME WHERE id=?|, undef, $sid);  
	$lckh->do("UNLOCK TABLES");
	return $rv;
}







1;


=pod

=head1 NAME

CGI::Session::MySQL - Driver for CGI::Session class

=head1 SYNOPSIS

	use constant COOKIE => "TEST_SID";	# cookie to store the session id

	use CGI::Session::MySQL;
	use CGI;
	use DBI;

	my $dbh = DBI->connect("DBI:mysql:dev", "dev", "marley01");
	my $cgi = new CGI;

	# getting the session id from the cookie
	my $c_sid = $cgi->cookie(COOKIE) || undef;
	
	my $session = new CGI::Session::MySQL($c_sid, 
		{
			LockHandle		=> $dbh,
			Handle			=> $dbh
		});
	
	# now let's create a sid cookie and send it to the client's browser.
	# if it is an existing session, it will be the same as before,
	# but if it's a new session, $session->id() will return a new session id.
	{
		my $new_cookie = $cgi->cookie(-name=>COOKIE, -value=>$session->id);
		print $cgi->header(-cookie=>$new_cookie);
	}

	print $cgi->start_html("CGI::Session::MySQL");

	# assuming we already saved the users first name in the session
	# when he visited it couple of days ago, we can greet him with
	# his first name

	print "Hello", $session->param("f_name"), ", how have you been?";

	print $cgi->end_html();

=head1 DESCRIPTION

C<CGI::Session::MySQL> is the driver for the L<CGI::Session> class to store 
and retrieve the session data in and from the MySQL database 

To be able to write your own drivers for L<CGI::Session>, please consult 
L<CGI::Session manual|CGI::Session>.

Constructor requires two arguments, as all other L<CGI::Session> drivers do.
The first argument has to be session id to be initialized (or undef to tell
the L<CGI::Session>  to create a new session id). The second argument has to be
a reference to a hash with two following required key/value pairs:

=over 4

=item C<Handle>

this has to be a database handler returned from the C<DBI->connect()> 
(see L<DBI manual|DBI>, L<DBD::mysql manual|DBD::mysql>)

=item C<LockHandle>

This is also a handler returned from the C<DBI->connect()> for locking the sessions
table.

=back

You can also ask C<CGI::Session::MySQL> to create a handler for you. To do this
you will need to pass it the following key/value pairs as the second argument:

=over 4

=item C<DataSource>

Name of the datasource L<DBI> has to use. Usually C<DBI:mysql:db_name>

=item C<UserName>

Username who is able to access the above C<DataSource>

=item C<Password>

Password the C<UserName> has to provide to be able to access the C<DataSource>.

=back

It also expects C<LockDatasource>, C<LockUserName> and C<LockPassword> key/values,
but if they are missing defaults to the ones provided by C<DataSource>, C<UserName> 
and C<Password> respectively. 

C<CGI::Session::MySQL> uses L<Data::Dumper|Data::Dumper> to serialize the session data
before storing it in the session file. 

=head1 STORAGE

Since the data should be stored in the mysql table, you will first need to
create a sessions table in your mysql database. The following command should
suffice for basic use of the library:

	CREATE TABLE sessions (
		id CHAR(32) NOT NULL PRIMARY KEY,
		a_session TEXT
	);

=head1 Example
	
	# get the sessino id either from the SID cookie, or from
	# the sid parameter in the URL
	my $c_sid = $cgi->cookie("SID") || $cgi->param("sid") || undef;
	my $session = new CGI::Session::MySQL($c_sid, 
		{
			Handle => $dbh,
			LockHandle => $dbh
		});

For more extensive examples of the L<CGI::Session> usage, please refer to 
the L<manual|CGI::Session>

=head1 BUGS

Currently no bugs have been detected, but eval() in retrive() method
produces the following error:

	Use of uninitialized value in string at blib/lib/CGI/Session/MySQL.pm line 65.

Of which I am quite embarrased. Coulld not figure out how to get rid of it.
So if you can think of any solution, please take this guilt off my conscious
ASAP.

=head1 AUTHOR

Sherzod B. Ruzmetov <she...@cp...>

=head1 COPYRIGHT

This library is free software and can be redistributed under the same
conditions as Perl itself.

=head1 SEE ALSO

L<CGI::Session>, L<CGI::Session::File>, L<CGI::Session::DB_File>,
L<CGI::Session::MySQL>, L<Apache::Session>

=cut