File Coverage

blib/lib/AutoSession.pm

Criterion	Covered	Total	%
statement	52	75	69.3
branch	7	14	50.0
condition	1	2	50.0
subroutine	12	19	63.1
pod	8	9	88.8
total	80	119	67.2

#############################################################################
## Name:        AutoSession.pm
## Purpose:     AutoSession
## Author:      Graciliano M. P.
## Modified by:
## Created:     20/5/2003
## RCS-ID:
## Copyright:   (c) 2003 Graciliano M. P.
## Licence:     This program is free software; you can redistribute it and/or
##              modify it under the same terms as Perl itself
#############################################################################

package AutoSession ;
our $VERSION = '0.01' ;

use strict qw(vars) ;
no warnings ;

 use AutoSession::TieHandle ;
 use AutoSession::Driver ;

 use overload (
 '%{}'  => '_OVER_get_hash' ,
 'fallback' => 1 ,
 ) ;

 use vars qw($AUTOLOAD $WITH_HPL $DEF_EXPIRE $DEF_IDSIZE) ;

 $DEF_EXPIRE = 60*60 ;
 $DEF_IDSIZE = 32 ;

##########
# IMPORT #
##########

sub import {
  my $class = shift ;
  if ($_[0] =~ /HPL/i) { $WITH_HPL = 1 ;}
}

############
# AUTOLOAD #
############

sub AUTOLOAD {
  my $this = shift ;
  if (! $$this->{driver}) { return ;}
  my ($sub) = ( $AUTOLOAD =~ /^\w+:+([\w:]+)/s ) ;
  $$this->{driver}->$sub(@_) ;
}

#######
# NEW #
#######

sub new {
  my $class = shift ;
  my ( %args ) = @_ ;

  my $saver = {} ;
  my $this = \$saver ;

  bless($this,$class) ;

  $$this->{driver} = AutoSession::Driver->new(@_) ;

  if (! $$this->{driver}) { return undef ;}

  my $name = $args{name} || 'SESSION' ;
  $name =~ s/\W//gs ;
  $name = uc($name) ;

  $$this->{name} = $name ;

  $this->check_expired ;

  return( $this ) ;
}

######
# ID #
######

sub id {
  my $this = shift ;
  return $$this->{driver}->{id} ;
}

########
# NAME #
########

sub name {
  my $this = shift ;
  return $$this->{name} ;
}

##########
# DRIVER #
##########

sub driver {
  my $this = shift ;
  return uc($$this->{driver}->{type}) ;
}

#############
# DIRECTORY #
#############

sub directory {
  my $this = shift ;
  return $$this->{driver}->{dir} ;
}

############
# AUTOLOAD #
############

sub autoload {
  my $this = shift ;
  return $$this->{autoload} ;
}

##########
# EXISTS #
##########

sub exists {
  my $this = shift ;
  if ( $this->exist_id ) { return 1 ;}
  return undef ;
}

###############
# COOKIE_LINE #
###############

sub cookie_line {
  my $this = shift ;
  my $name = $this->name ;
  my $id = $this->id ;

  my $line = qq`Set-Cookie: AutoSession=$name:$id` ;
  return( $line ) ;
}

############
# HASH_REF #
############

sub hash_ref {
  my $this = shift ;
  return $$this->{driver}{tree} ;
}

##################
# _OVER_GET_HASH #
##################

sub _OVER_get_hash {
  my $this = shift ;

  if ( $$this->{driver}{closed} ) { return( {} ) ;}

  if ( ! $$this->{hash} ) {
    my %hash ;
    $$this->{hash} = \%hash ;
    tie(%hash, 'AutoSession::TieHandle' , $$this->{driver}) ;
    $$this->{driver}->load ;
  }

  return( $$this->{hash} ) ;
}

###########
# DESTROY #
###########

sub DESTROY {
  my $this = shift ;

  $this->check_expired if $$this->{driver} ;

  delete $$this->{driver} ;

  untie $$this->{hash} ;
  delete $$this->{hash} ;
}

#######
# END #
#######


1;


__END__