File Coverage

lib/Math/String/Sequence.pm

Criterion	Covered	Total	%
statement	88	101	87.1
branch	22	38	57.8
condition	3	9	33.3
subroutine	15	17	88.2
pod	8	10	80.0
total	136	175	77.7

#############################################################################
# Math/String/Sequence.pm -- defines a sequence or range of strings.
#
# Copyright (C) 2001 - 2005 by Tels.
#############################################################################

# the following hash values are used
# _first : first string
# _last	 : last string
# _set	 : charset for first/last
# _size	 : last-first
# _rev   : 1 if reversed sequence

package Math::String::Sequence;
use vars qw($VERSION);
$VERSION = '1.06';	# Current version of this package
require  5.005;		# requires this Perl version or later

use Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(sequence);

use Math::String;
use Math::String::Charset;

use strict;
my $class = "Math::String::Sequence";

# some shortcuts for easier life
sub sequence
  {
  # exportable version of new
  $class->new(@_);
  }

###############################################################################
# constructor

sub new
  {
  # takes the following arguments:
  # first, last: Math:Strings or scalars
  # charset: optional, if you pass a scalar as first or last

  my $class = shift;
  $class = ref($class) || $class;

  my $args;
  if (ref $_[0] eq 'HASH')
    {
    $args = shift;
    }
  else
    {
    $args->{first} = shift;
    $args->{last} = shift;
    $args->{charset} = shift;
    }

  my $self = {};
  bless $self, $class;
  if (ref $args eq $class)
    {
    # make copy
    for (qw/_first _last/)
      {
      $self->{$_} = Math::String->new($args->{$_});
      }
    return $self;
    }
  my $first = $args->{first};
  my $last = $args->{last};
  my $set = $args->{charset};

  $first = Math::String->new($first,$set) unless ref $first;
  $last = Math::String->new($last,$set) unless ref $last;

  die ("first is NaN") if $first->is_nan();
  die ("last is NaN") if $last->is_nan();
  #die ("$first is not smaller than $last") if
  # adjustment by $self->_size(): $self->{_rev} = $first > $last ? 1 : 0;

  bless $self, $class;
  $self->{_first} = $first;
  $self->{_last} = $last;
  $self->_initialize();
  $self;
  }

#############################################################################
# private, initialize self

sub _initialize
  {
  # init sequence
  my $self = shift;

  $self->_size();
  $self->{_set} = $self->{_first}->{_set};
  $self;
  }

sub _size
  {
  # calculate new size and adjust _rev
  my $self = shift;

  $self->{_rev} = $self->{_first} < $self->{_last} ? 0 : 1;
  $self->{_size} = $self->{_last} - $self->{_first};
  $self->{_size} = $self->{_size}->babs()->as_number();
  $self->{_size}++;
  $self;
  }

#############################################################################
# public

sub charset
  {
  my $self = shift;
  $self->{_first}->{_set};
  }

sub length
  {
  my $self = shift;
  $self->{_size};
  }

sub is_reversed
  {
  # return true if the sequence is reversed, or false
  my $self = shift;
  $self->{_rev};
  }

sub first
  {
  my $self = shift;
  if (defined $_[0])
    {
    $self->{_first} = shift;
    $self->{_first} = Math::String->new($self->{_first},$self->{_set})
      unless ref $self->{_first};
    $self->_size();
    }
  $self->{_first};
  }

sub last
  {
  my $self = shift;
  if (defined $_[0])
    {
    $self->{_last} = shift;
    $self->{_last} = Math::String->new($self->{_last},$self->{_set})
      unless ref $self->{_last};
    $self->_size();
    }
  $self->{_last};
  }

sub string
  {
  # return the Nth string in sequence or undef for out-of-range
  my $self = shift;
  my $nr = shift; $nr = 0 if !defined $nr;

  $nr = Math::BigInt->new($nr) unless ref $nr;
  my $n;
  if ($self->{_rev})
    {
    if ($nr < 0)
      {
      $n = $self->{_last}-$nr; $n--;
      }
    else
      {
      $n = $self->{_first}-$nr;
      }
    return if $n > $self->{_first} || $n < $self->{_last};
    }
  else
    {
    if ($nr < 0)
      {
      $n = $self->{_last}+$nr; $n++;
      }
    else
      {
      $n = $self->{_first}+$nr;
      }
    return if $n > $self->{_last} || $n < $self->{_first};
    }
  $n;
  }

sub error
  {
  my $self = shift;
  $self->{_set}->error();
  }

sub as_array
  {
  # return the sequence as array of strings
  my $x = shift;

  my @a;
  my $f = $x->{_first}; my $l = $x->{_last};
  if ($x->{_rev})
    {
    while ($f >= $l) { push @a,$f->copy(); $f->bdec(); }
    }
  else
    {
    while ($f <= $l) { push @a,$f->copy(); $f->binc(); }
    }
  @a;
  }

__END__