File Coverage

blib/lib/Scalar/MultiValue.pm

Criterion	Covered	Total	%
statement	49	87	56.3
branch	11	22	50.0
condition	2	5	40.0
subroutine	11	21	52.3
pod	4	5	80.0
total	77	140	55.0

#############################################################################
## Name:        MultiValue.pm
## Purpose:     Scalar::MultiValue
## Author:      Graciliano M. P.
## Modified by:
## Created:     2004-08-31
## RCS-ID:
## Copyright:   (c) 2004 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 Scalar::MultiValue ;
use 5.006 ;

use strict qw(vars);

no warnings ;

use vars qw($VERSION @ISA) ;

$VERSION = '0.03' ;

@ISA = qw(Object::MultiType) ;

###########
# REQUIRE #
###########

  use Object::MultiType ;

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

sub new {
  my $class = shift ;
  $class = ref($class) if ref($class) ;

  my @values = ref $_[0] eq 'ARRAY' ? @{shift(@_)} : split(/\s/s , shift(@_)) ;

  my %inf = ref $_[0] eq 'HASH' ? %{shift(@_)} : ( period => shift(@_) ) ;

  my $this = Object::MultiType->new(
  scalarsub => \&content ,
  array     => \@values ,
  tiehash   => 'Scalar::MultiValue::TieHash' ,
  tieonuse  => 1 ,
  ) ;

  $$this->{period} = $inf{period} || 1 ;
  $$this->{lastpos} = $inf{lastpos} ne '' ? $inf{lastpos} : 0 ;
  $$this->{counter} = -1 ;
  $$this->{last} = '' ;

  bless($this,$class) ;
}

########
# LAST #
########

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

###########
# CONTENT #
###########

sub content {
  my $this = shift ;

  if ( $$this->{period} eq '*' ) {
    $$this->{lastpos} = int( rand(@{$$this->{a}}) ) ;
  }
  elsif ( $$this->{period} =~ /^\d+$/s ) {
    ++$$this->{counter} ;

    if ( $$this->{counter} >= $$this->{period} ) {
      $$this->{counter} = 0 ;
      ++$$this->{lastpos} ;
      $$this->{lastpos} = 0 if $$this->{lastpos} > $#{$$this->{a}} ;
    }
  }

  $$this->{last} = @{$$this->{a}}[ $$this->{lastpos} ] ;

  return $$this->{last} ;
}

#########
# RESET #
#########

sub reset {
  my $this = shift ;
  $$this->{counter} = -1 ;
}

##########
# PERIOD #
##########

sub period {
  my $this = shift ;

  if ( @_ ) {
    $$this->{period} = shift ;
  }

  return $$this->{period} ;
}

###############################
# SCALAR::MULTIVALUE::TIEHASH #
###############################

package Scalar::MultiValue::TieHash ;

use strict qw(vars);

sub TIEHASH {
  my $class = shift ;
  my $multi = shift ;

  my $this = { h => $multi } ;
  bless($this,$class) ;
}

sub FETCH {
  my $this = shift ;
  my $key = shift ;
  return $this->{h}{$key} ;
}

sub STORE {
  my $this = shift ;
  my $key = shift ;
  return $this->{h}{$key} = $_[0] ;
}

sub DELETE {
  my $this = shift ;
  my $key = shift ;
  return delete $this->{h}{$key} ;
}

sub EXISTS {
  my $this = shift ;
  my $key = shift ;
  return exists $this->{h}{$key} ;
}

sub FIRSTKEY {
  my $this = shift ;
  my $key = shift ;
  return (keys %{$this->{h}})[0] ;
}

sub NEXTKEY {
  my $this = shift ;
  my $keylast = shift ;

  my $ret_next ;
  foreach my $keys_i ( keys %{$this->{h}} ) {
    if ($ret_next) { return $keys_i ;}
    if ($keys_i eq $keylast || !defined $keylast) { $ret_next = 1 ;}
  }

  return undef ;
}

sub CLEAR {
  my $this = shift ;
  %{$this->{h}} = () ;
  return ;
}

sub UNTIE {}
sub DESTROY {}

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

1;

__END__