File Coverage

blib/lib/AutoSession/TieHandle.pm

Criterion	Covered	Total	%
statement	21	67	31.3
branch	3	24	12.5
condition	0	3	0.0
subroutine	5	12	41.6
pod			n/a
total	29	106	27.3

#############################################################################
## Name:        TieHandle.pm
## Purpose:     AutoSession::TieHandle
## 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::TieHandle ;
our $VERSION = '0.01' ;

use strict qw(vars) ;
no warnings ;

sub TIEHASH { #print STDOUT "TIEHASH>> @_\n" ;
  my $class = shift;
  return bless({ driver => $_[0] }, $class) ;
}

sub FETCH { #print STDOUT "FETCH>> @_\n" ;
  my $this = shift ;
  my $key = shift ;

  delete($this->{KEYS}) if $this->{driver}->refresh ;

  return( $this->{driver}{tree}{$key} ) ;
}

sub STORE { #print STDOUT "STORE>> @_\n" ;
  my $this = shift ;
  my $key = shift ;

  my $notdef ;
  if (! defined $this->{driver}{tree}{$key}) { $notdef = 1 ;}

  $this->{driver}{tree}{$key} = $_[0] ;
  $this->{driver}->save ;

  delete $this->{KEYS} if !$notdef ;

  return $_[0] ;
}

sub DELETE   { #print STDOUT "DELETE>> @_\n" ;
  my $this = shift ;
  my $key = shift ;

  my $ret ;

  if ( defined $this->{driver}{tree}{$key} ) {
    $ret = delete $this->{driver}{tree}{$key} ;
    $this->{driver}->save ;
    delete $this->{KEYS} ;
  }

  return $ret ;
}

sub EXISTS   { #print STDOUT "EXISTS>> @_\n" ;
  my $this = shift ;
  my $key = shift ;

  delete($this->{KEYS}) if $this->{driver}->refresh ;

  if ( defined $this->{driver}{tree}{$key} ) { return( 1 ) ;}

  return undef ;
}

sub FIRSTKEY { #my @call = caller ; print STDOUT "FIRSTKEY>> $_[0]->{TYPE} >> @call\n" ;
  my $this = shift ;

  delete($this->{KEYS}) if $this->{driver}->refresh ;

  if (! $this->{KEYS} ) {
    my %keys = map { $_ => 1 } ( keys %{$this->{driver}{tree}} ) ;
    $this->{KEYS} = [sort keys %keys] ;
  }

  return @{$this->{KEYS}}[0] ;
}

sub NEXTKEY  { #print STDOUT "NEXTKEY>> @_\n" ;
  my $this = shift ;
  my $keylast = shift ;

  delete($this->{KEYS}) if $this->{driver}->refresh ;

  if (! $this->{KEYS} ) {
    my %keys = map { $_ => 1 } ( keys %{$this->{driver}{tree}} ) ;
    $this->{KEYS} = [sort keys %keys] ;
  }

  my $ret_next ;
  foreach my $keys_i ( @{ $this->{KEYS} } ) {
    #print STDOUT "  >> $keys_i ** $keylast\n" ;
    if ($ret_next) { return($keys_i) ;}
    if ($keys_i eq $keylast || ! defined $keylast) { $ret_next = 1 ;}
  }

  return undef ;
}

sub CLEAR { #print STDOUT "CLEAR>> @_\n" ;
  my $this = shift ;
  $this->{driver}{tree} = {} ;
  $this->{driver}->save ;
  delete $this->{KEYS} ;
  return ;
}

sub UNTIE {}
sub DESTROY {}

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

1;