File Coverage

blib/lib/Apache/Session/Lazy.pm

Criterion	Covered	Total	%
statement	9	54	16.6
branch	0	10	0.0
condition	0	9	0.0
subroutine	3	13	23.0
pod	0	1	0.0
total	12	87	13.7

package Apache::Session::Lazy;
use 5.006;
use strict;
use warnings;
our $VERSION = '0.05';

# Thanks for the perltie info, Merlyn.

sub TIEHASH {
  my $class = shift;
  return unless checks(@_);

  if ( $@ ) {      # whoops, there was an error
      warn( $@ );  # require'ing $class; perhaps
      return;      # it doesn't exist?
  }

  if ( ( caller(1) )[3] eq '(eval)' && defined $_[1]) { # The assumption is
      my $object = $_[0]->TIEHASH( $_[1..$#_] );        # that you are checking
      $object->DESTROY();                               # to see if a session
  }                                                     # exists.

  bless [@_], $class; # remember real args
}

sub FETCH {
  ## DO NOT USE shift HERE
  $_[0] = delete($_[0]->[0])->TIEHASH(@{$_[0]});
  goto &{$_[0]->can("FETCH")};
}

sub STORE {
  ## DO NOT USE shift HERE
  $_[0] = delete($_[0]->[0])->TIEHASH(@{$_[0]});
  goto &{$_[0]->can("STORE")};
}

sub DELETE   {
  $_[0] = delete($_[0]->[0])->TIEHASH(@{$_[0]});
  goto &{$_[0]->can("DELETE")};
}

sub CLEAR {

  if ( defined $_[0]->[1] && $_[0]->[1] ) {  # Why Clear An Uncreated Sesion?
    $_[0] = delete($_[0]->[0])->TIEHASH(@{$_[0]});
    goto &{$_[0]->can("CLEAR")};
  }

}

sub EXISTS {
  $_[0] = delete($_[0]->[0])->TIEHASH(@{$_[0]});
  goto &{$_[0]->can("EXISTS")};
}

sub FIRSTKEY {
  $_[0] = delete($_[0]->[0])->TIEHASH(@{$_[0]});
  goto &{$_[0]->can("FIRSTKEY")};
}

sub NEXTKEY {
  $_[0] = delete($_[0]->[0])->TIEHASH(@{$_[0]});
  goto &{$_[0]->can("NEXTKEY")};
}

sub DESTROY {

  if ( defined $_[0]->[1] && $_[0]->[1] ) {  # Why Destroy An Uncreated Sesion?
    $_[0] = delete($_[0]->[0])->TIEHASH(@{$_[0]});
    goto &{$_[0]->can("DESTROY")};
  }

}

sub checks {
  eval "require $_[0]";  # You can overload this.
  !$@;
}

1;
__END__