view release on metacpan or  search on metacpan

lib/Apache/Session/Store/DBMS.pm  view on Meta::CPAN

			$datasource = $3;
		} elsif( $session->{data}->{_session_id} =~ m|^\s*dbms://([^/]+)/([^\s]+)| ) {
			$host = $1;
			$port = $session->{args}->{Port} ||
				$Apache::Session::Store::DBMS::Port;
			$datasource = $2;
		} else {
			die "Invalid session identifier ".$session->{data}->{_session_id};
			};
	} elsif(	( exists $session->{args}->{DataSource} ) &&
			( $session->{args}->{DataSource} =~ m|^\s*dbms://| ) ) {
		if( $session->{args}->{DataSource} =~ m|^\s*dbms://([^:]+):(\d+)/([^\s]+)| ) {
			$host = $1;
			$port = $2;
			$datasource = $3;
		} elsif( $session->{args}->{DataSource} =~ m|^\s*dbms://([^/]+)/([^\s]+)| ) {
			$host = $1;
			$port = $session->{args}->{Port} ||
				$Apache::Session::Store::DBMS::Port;
			$datasource = $2;
		} else {
			die "Invalid session identifier ".$session->{data}->{_session_id};
			};
	} else {
		$datasource = $session->{args}->{DataSource} ||
        		$Apache::Session::Store::DBMS::DataSource;
		$host = $session->{args}->{Host} ||
			$Apache::Session::Store::DBMS::Host;
		$port = $session->{args}->{Port} ||
			$Apache::Session::Store::DBMS::Port;
		};

#print "TIE: $datasource, $mode, $bt_compare, $host, $port (session_id=".$session->{data}->{_session_id}.")\n";

	$self->{dbh} = tie %{$self->{dbms}}, 'DBMS', $datasource, $mode, $bt_compare, $host, $port
		or die $DBMS::ERROR."\n";
	};

sub new {
	my $class = shift;

	return bless {dbms => {}}, $class;
	};

sub insert {
	my $self    = shift;
	my $session = shift;
    
	return
		if( $session->{isObjectPerKey} );

	$self->connection($session);

	if (exists $self->{dbms}->{$session->{data}->{_session_id}}) {
		die "Object already exists in the data store";
		};

	$self->{dbms}->{$session->{data}->{_session_id}} = $session->{serialized}; # single session-id object
	};

sub update {
	my $self = shift;
	my $session = shift;
    
	return
		if( $session->{isObjectPerKey} );

	$self->connection($session);

	$self->{dbms}->{$session->{data}->{_session_id}} = $session->{serialized}
		if(defined $session->{data}->{_session_id});
	};

sub materialize {
	my $self = shift;
	my $session = shift;
    
	return
		if( $session->{isObjectPerKey} );

	$self->connection($session);

	$session->{serialized} = $self->{dbms}->{$session->{data}->{_session_id}};

	if (!defined $session->{serialized}) {
		die "Object does not exist in data store";
		};
	};

sub remove {
	my $self = shift;
	my $session = shift;
    
	return
		if( $session->{isObjectPerKey} );

	$self->connection($session);

	delete $self->{dbms}->{$session->{data}->{_session_id}};
	};

sub DESTROY {
	my $self = shift;

	if(defined $self->{dbh}) {
		delete $self->{dbh};
		untie %{$self->{dbms}};
		};
	};

1;

=pod

=head1 NAME

Apache::Session::Store::DBMS - Use DBMS to store persistent objects

=head1 SYNOPSIS

 use Apache::Session::Store::DBMS;