File Coverage

blib/lib/String/RexxStack/Named.pm

Criterion	Covered	Total	%
statement	12	12	100.0
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	16	16	100.0

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

package String::RexxStack::Named;

use 5.006;
use strict;
use warnings;
use base qw( Exporter String::TieStack );
use Filter::Simple;
use Want  qw(wantref want);
use Data::Dumper;

our $VERSION = '0.3';

our @EXPORT      = qw(  pull Pull Push Pop clear qelem Queue  );

our @extra       = qw(  newstack  printq       printq_s  info
                        qstack    delstack     dumpe     dumpe_s
                        limits    limit_bytes  limit_entries
                        makebuf   dropbuf      desbuf    qbuf
                        total_bytes ) ;

our %EXPORT_TAGS = ( 'extra' =>  [ @extra ],
                     'all'   =>  [ @EXPORT, @extra ],
                   );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'extra'} } );




FILTER {
            my $tmp;
            my $pat = qr! \[ \s* (makebuf  | dropbuf  | desbuf    | clear |
                                  newstack | delstack | qstack    |
                                  printq   | printq_s | dumpe
                                 )
                          \s* (\S*) \s* \] !ix;
            s ! $pat \s* (;?)
	      ! $tmp = lc "$1" ;
                $tmp = "$tmp $2" ;
                $tmp .= ';'  if $3 ;
                $tmp;
              !exg;
};


my  %DEFAULT = ( Max_SoStacks => 10, Max_Named=> 20 );  # NOT USED



sub _create_entry  { {  stack      =>  new String::TieStack,
	                max_sos    =>  $DEFAULT{ Max_SoStacks },
	                saved      =>  [] ,
 	             } ;
}

my  %s          =   ( SESSION => _create_entry );
my  $max_named  =   $DEFAULT{ max_named } ;
my  $num_named  =   1;


sub qstack  {   return 0  unless $s{my $name = shift||'SESSION'} ;
                1 + scalar @{ $s{$name}{saved} } ;
                                                                                }

sub Pull        {  $s{ defined $_[1]  ? shift :'SESSION' }  {stack}->pull(@_)   }
sub pull        {  ($s{ shift || 'SESSION' }{stack} || return undef)  ->pullall }
sub qelem       {  ($s{ shift || 'SESSION' }{stack} || return undef)  ->qelem   }
sub qbuf        {  ($s{ shift || 'SESSION' }{stack} || return undef)  ->qbuf    }
sub clear       {  ($s{ shift || 'SESSION' }{stack} || return undef)  ->CLEAR   }
sub makebuf     {  ($s{ shift || 'SESSION' }{stack} || return undef)  ->makebuf }
sub dropbuf     {  ($s{ shift || 'SESSION' }{stack} || return undef)  ->dropbuf }
sub desbuf      {  ($s{ shift || 'SESSION' }{stack} || return undef)  ->desbuf   }
sub printq      {  $,="\n"; print +($s{ shift||'SESSION'} {stack}|| return undef) ->printq }
sub printq_s    {  $,="\n"; +($s{ shift||'SESSION'} {stack}|| return undef) ->printq }
sub total_bytes {  ($s{ shift || 'SESSION' }{stack} || return undef)  ->total_bytes   }
*queue = \&Queue  ;
*Pop   =  \& Pull ;


sub _allow_stack {
        my $name = shift;
	qstack($name) + 1  <=  $s{$name}{max_sos}  ;
}


sub newstack   {
	my $name = shift|| 'SESSION';
	if ( exists $s{$name}{stack} ) {
		return undef unless  _allow_stack $name ;
                my  ($entries, $bytes)          =  $s{$name}{stack}->limits;
		push   @ { $s{$name}{saved} } , $s{$name}{stack};
		$s{$name}{stack}                =  new String::TieStack;

		$s{$name}{stack}->{'max_entries'} =  $entries;
		$s{$name}{stack}->{'max_KBytes'}  =  $bytes  ;
	}else{
		$s{ $name } = _create_entry ;
	}
	return qstack $name     if want('SCALAR', '!HASH') ;
        return $s{$name}        if want('HASH');
}


sub delstack  {
	my $name = shift || 'SESSION' ;
	@{ $s{$name}{saved} }   ? do{ $s{$name}{stack} = pop @{ $s{$name}{saved} } }
				: $s{$name}{stack}->CLEAR   ;
        qstack $name ;
}
sub Queue       {
	my $name = defined $_[1]  ? shift :'SESSION'  ;
	newstack $name unless $s{$name} ;
	$s{ $name }  {stack}->queue(@_)
}

sub dumpe {
	my $name = shift || 'SESSION' ;
	print Data::Dumper->Dump( [$s{$name}] , ["*$name"]     )
}

sub Push  ($;@)    {
	my $name =  $_[1] ? shift() : 'SESSION';
	newstack $name   unless exists $s{$name}{stack} ;
	$s{ $name }{stack}->PUSH(@_)
}


sub dumpe_s {
	my $name = shift || 'SESSION' ;
	Data::Dumper->Dump( [$s{$name}] , ["*$name"]     )
}


sub limit_bytes {
	my ($name, $val) = @_ ;
	(defined $val)  ?  ( ($s{$name}->{stack}||newstack($name)->{stack}) ->max_KBytes($val))
		        : $s{$name || 'SESSION'} {stack}  ->max_KBytes() ;
}

sub limit_entries {
	my ($name, $val) = @_ ;
	(defined $val)  ?  ( ($s{$name}->{stack}||newstack($name)->{stack}) ->max_entries($val))
			:  $s{$name||'SESSION'}{stack} ->max_entries() ;
}


sub limits {
	my ($q, $ent,  $byt ) = @_ ;
	#$s{$q}{stack}  || newstack $q ;
	(defined $_[1])     ?  (limit_entries( $q, $ent )    , limit_bytes( $q, $byt) )
			    :  (limit_entries( $q||'SESSION'), limit_bytes $q||'SESSION') ;
}

sub info {
	 map {
		 (limit_bytes $_)  ?  sprintf "%-15s %5d stacks %5d entries %9d bytes\n",
                                      $_, qstack( $_), qelem( $_) , total_bytes($_)
		      	           :  sprintf "%-15s %5d stacks %5d entries\n",
                                      $_, qstack( $_), qelem( $_) ;
	     }  keys  %s ;
}


1;
__END__