File Coverage

blib/lib/MCE/Shared/Sequence.pm

Criterion	Covered	Total	%
statement	23	105	21.9
branch	0	74	0.0
condition	0	19	0.0
subroutine	8	14	57.1
pod	3	3	100.0
total	34	215	15.8

###############################################################################
## ----------------------------------------------------------------------------
## Sequence helper class.
##
###############################################################################

package MCE::Shared::Sequence;

use strict;
use warnings;

use 5.010001;

no warnings qw( threads recursion uninitialized numeric );

our $VERSION = '1.885';

use Scalar::Util qw( looks_like_number );
use MCE::Shared::Base ();

use constant {
   _BEGV => 0,  # sequence begin value
   _ENDV => 1,  # sequence end value
   _STEP => 2,  # sequence step size
   _FMT  => 3,  # sequence format
   _CKSZ => 4,  # chunk_size option, default 1
   _ONLY => 5,  # bounds_only option, default 0
   _ITER => 6,  # iterator count
};

use overload (
   q("")    => \&MCE::Shared::Base::_stringify,
   q(0+)    => \&MCE::Shared::Base::_numify,
   fallback => 1
);

sub _croak {
   goto &MCE::Shared::Base::_croak;
}

sub _reset {
   my $self = shift;
   my $opts = ref($_[0]) eq 'HASH' ? shift() : {};

   @{ $self } = @_;

   _croak('invalid begin') unless looks_like_number( $self->[_BEGV] );
   _croak('invalid end'  ) unless looks_like_number( $self->[_ENDV] );

   $self->[_STEP] = ( $self->[_BEGV] <= $self->[_ENDV] ) ? 1 : -1
      unless ( defined $self->[_STEP] );

   $self->[_FMT] =~ s/%// if ( defined $self->[_FMT] );

   _croak('invalid step' ) unless looks_like_number( $self->[_STEP] );

   for my $_k (_BEGV, _ENDV, _STEP) {
      $self->[$_k] = int($self->[$_k]) unless ( $self->[$_k] =~ /\./ );
   }

   $self->[_CKSZ] = $opts->{'chunk_size' } || 1;
   $self->[_ONLY] = $opts->{'bounds_only'} // 0;

   _croak('invalid chunk_size'  ) unless ( $self->[_CKSZ] =~ /^[0-9e\+]+$/ );
   _croak('invalid bounds_only' ) unless ( $self->[_ONLY] =~ /^[01]$/ );

   $self->[_CKSZ] = int($self->[_CKSZ]);
   $self->[_ITER] = undef;

   return;
}

sub _sprintf {
   my ( $fmt, $arg ) = @_;
   # remove tainted'ness
   ($fmt) = $fmt =~ /(.*)/s;

   return sprintf("$fmt", $arg);
}

###############################################################################
## ----------------------------------------------------------------------------
## Public methods.
##
###############################################################################

# new ( begin, end [, step, format ] )
# new ( )

sub new {
   my ( $class, $self ) = ( shift, [] );

   if ( !@_ ) {
      @{ $self } = ( 0, 0, 1, '__NOOP__' );
   } else {
      _reset( $self, @_ );
   }

   bless $self, $class;
}

# next ( )

sub next {
   my ( $self ) = @_;
   my $iter = $self->[_ITER];

   if ( defined $iter ) {
      my ( $begv, $endv, $step, $fmt, $chunk_size, $bounds_only ) = @{ $self };
      my ( $begn, $seqn );

      # computes from *begv* value to not lose precision during iteration

      if ( $begv <= $endv ) {
         $begn = $seqn = $begv + ( $iter++ * $chunk_size * $step );
         return if ( $begv == $endv && $begn != $begv );
         return if ( $seqn > $endv );
      }
      else {
         $begn = $seqn = $begv - -( $iter++ * $chunk_size * $step );
         return if ( $seqn < $endv );
      }

      $self->[_ITER] = $iter;

      if ( $chunk_size == 1 || $begv == $endv ) {
         $seqn = _sprintf( "%$fmt", $seqn ) if ( defined $fmt );
         return ( $bounds_only ) ? ( $seqn, $seqn, $iter ) : $seqn;
      }

      if ( $bounds_only ) {
         my ( $seqb, $seqe ) = ( $seqn );

         if ( $begv <= $endv ) {
            if ( $step * ( $chunk_size - 1 ) + $seqn <= $endv ) {
               $seqe = $step * ( $chunk_size - 1 ) + $seqn;
            }
            elsif ( $step == 1 ) {
               $seqe = $endv;
            }
            else {
               for my $i ( 1 .. $chunk_size ) {
                  last if ( $seqn > $endv );
                  $seqe = $seqn;
                  $seqn = $step * $i + $begn;
               }
            }
         }
         else {
            if ( $step * ( $chunk_size - 1 ) + $seqn >= $endv ) {
               $seqe = $step * ( $chunk_size - 1 ) + $seqn;
            }
            elsif ( $step == -1 ) {
               $seqe = $endv;
            }
            else {
               for my $i ( 1 .. $chunk_size ) {
                  last if ( $seqn < $endv );
                  $seqe = $seqn;
                  $seqn = $step * $i + $begn;
               }
            }
         }

         return ( defined $fmt )
            ? ( _sprintf("%$fmt",$seqb), _sprintf("%$fmt",$seqe) )
            : ( $seqb, $seqe, $iter );
      }

      my @n;

      if ( $begv <= $endv ) {
         if ( !defined $fmt && $step == 1 && abs($endv) < ~1 && abs($begv) < ~1 ) {
            return ( $seqn + $chunk_size <= $endv )
               ? ( $seqn .. $seqn + $chunk_size - 1 )
               : ( $seqn .. $endv );
         }
         for my $i ( 1 .. $chunk_size ) {
            last if ( $seqn > $endv );
            push @n, defined $fmt ? _sprintf( "%$fmt", $seqn ) : $seqn;
            $seqn = $step * $i + $begn;
         }
      }
      else {
         for my $i ( 1 .. $chunk_size ) {
            last if ( $seqn < $endv );
            push @n, defined $fmt ? _sprintf( "%$fmt", $seqn ) : $seqn;
            $seqn = $step * $i + $begn;
         }
      }

      return @n;
   }

   else {
      $self->[_ITER] = 0;
      $self->next();
   }
}

# rewind ( begin, end [, step, format ] )
# rewind ( )

sub rewind {
   my $self = shift;

   if ( !@_ ) {
      $self->[_ITER] = undef unless ( $self->[_FMT] eq '__NOOP__' );
   } else {
      _reset( $self, @_ );
   }

   return;
}

1;

__END__