File Coverage

blib/lib/String/TieStack.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

# Copyright (c) 2003 Ioannis Tambouras  .
# All rights reserved.


package String::TieStack ;
use 5.006;
use Carp;
use strict;
use base 'Tie::Array';
use Data::Dumper;
use Class::MethodMaker
				   new_with_init  => [qw( new TIEARRAY )],
                                   new_hash_init  => 'ihash',
                                   list           => [qw( DATA buffers )],
		 		   grouped_fields => [ tlimits=>[qw( max_entries max_KBytes)],
						       info  =>[qw( total_bytes  )], ],
                                   ;

sub STORE     { croak 'ERROR: operation prohibited.' }
*FETCH        = \& STORE      ;
*FETCHSIZE    = \& DATA_count ;
*SPLICE       = \& STORE      ;

sub import {
	my ($self, %param) = @_ ;;
	$__PACKAGE__::DEFAULTS{max_entries} = $param{max_entries} || 0  ;
	$__PACKAGE__::DEFAULTS{max_KBytes}  = $param{max_KBytes}  || 0  ;
};

sub init {
     my $self = shift;
     $self->buffers_clear;
     $self->DATA_clear;
     $self->ihash( %__PACKAGE__::DEFAULTS, @_ ) ;
     $self->{top}   =  $self->{total_bytes}  = 0 ;
}


sub limits {
      my $self = shift;
      ( @_ == 2 )   ? ( $self->max_entries( $_[0] ) ,
		        $self->max_KBytes( $_[1] )  ,  return @_[0,1] )
		    : ( return  ($self->max_entries()||0,  $self->max_KBytes|| 0 )) ;
}

sub _bytes {
       my $sum;
       $sum += length($_||'')       for @_ ;
       $sum;
}


sub _allowed_p {
	my $self      =  shift;
        my ($etarget, $new_bytes)  = ( $self->FETCHSIZE() + scalar @_ , _bytes(@_) );
	return  0     if ($self->max_entries) && ($etarget >  $self->max_entries );

        my $btarget   = ($self->{total_bytes} || 0) + $new_bytes ;
        my $blimit    = ($self->max_KBytes    || 0) * 1024 ;
        return  0     if ($self->max_KBytes)  && ($btarget >  $blimit);
        $new_bytes;
};


sub UNSHIFT {
        my ($self, @val)  = @_ ;
        return undef  unless my $bytes =  &_allowed_p ;
        $self->DATA_splice( $self->{top} , 0, @val  );
        $self->{total_bytes}           =  $self->{total_bytes} + $bytes  ;
}


sub PUSH {
	my ($self, @val)  = @_ ;
	return undef  unless my $bytes =  &_allowed_p ;
	$self->{total_bytes}           =  $self->{total_bytes} + $bytes  ;
	$self->DATA_push( @val ) ;
}

sub POP {
	my $self = shift;
	$self->dropbuf   if  $self->FETCHSIZE <= $self->{top} ;
        my $ret = $self->DATA_pop ;
	$self->total_bytes( $self->total_bytes - _bytes($ret));
	$ret;
}

sub CLEAR {
        my $self = shift;
	my ($entries , $bytes) = ($self->max_entries(), $self->max_KBytes() ) ;
	$self->init(@_);
	$self->max_entries( $entries ) ;
	$self->max_KBytes( $bytes ) ;
}

sub makebuf {
	my $self      = shift;
	return undef if $self->{top} == $self->FETCHSIZE;
	$self->{top}  = $self->FETCHSIZE ;
	$self->buffers_push ( $self->{top} );
}

sub dropbuf {
	my $self     =  shift;
	return unless $self->buffers_count;
        my $start    =  $self->buffers_pop();
	my $end      =  $self->DATA_count;
	$self->DATA_splice( $start, $end );
	$self->{top} =  $self->buffers_index( $self->buffers_count - 1 ) || 0;
}

sub desbuf {
	my $self = shift;
	return unless $self->buffers_count;
        $self->dropbuf   for $self->buffers;
}

sub queue    { shift->UNSHIFT( reverse @_ )                }
sub pdumpq   { print &dumpq                                }
*qelem       =  \& DATA_count     ;
*queued      =  \& qelem          ;
*qbuf        =  \& buffers_count  ;
*printq      =  \& DATA           ;
sub dumpq    { Data::Dumper->Dump( [shift], ['tieStack'] ) }

sub pullbuf {
	my  ($self, $num)  = shift;
	return undef  unless $self->buffers_count ;
	$num = $self->DATA_count  - $self->{top};
	$self->pull( $num );
}

sub pull    {
	my  ($self, $num)  = @_;
	$num   = (defined $num) ? $num : 1;
	return undef unless  ($self->qelem() - $num) > -1 ;
	my  @ret;
	push @ret, $self->POP    for (1..$num);
	@ret;
}

sub pullall {
	my $self = shift;
        my @ret = $self->DATA;
	$self->CLEAR;
	@ret;
};

1;
__END__