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


line stmt bran cond sub pod time code
1             #############################################################################
2             # Math/String/Sequence.pm -- defines a sequence or range of strings.
3             #
4             # Copyright (C) 2001 - 2005 by Tels.
5             #############################################################################
6              
7             # the following hash values are used
8             # _first : first string
9             # _last : last string
10             # _set : charset for first/last
11             # _size : last-first
12             # _rev : 1 if reversed sequence
13              
14             package Math::String::Sequence;
15              
16             require 5.005; # requires this Perl version or later
17 2     2   8494 use strict;
  2         10  
  2         61  
18 2     2   10 use warnings;
  2         4  
  2         65  
19              
20 2     2   11 use Exporter;
  2         4  
  2         177  
21              
22             our ($VERSION, @ISA, @EXPORT_OK);
23             $VERSION = '1.30'; # Current version of this package
24             @ISA = qw(Exporter);
25             @EXPORT_OK = qw(sequence);
26              
27 2     2   330 use Math::String;
  2         4  
  2         10  
28 2     2   603 use Math::String::Charset;
  2         4  
  2         2061  
29              
30             my $class = "Math::String::Sequence";
31              
32             # some shortcuts for easier life
33             sub sequence
34             {
35             # exportable version of new
36 0     0 0 0 $class->new(@_);
37             }
38              
39             ###############################################################################
40             # constructor
41              
42             sub new
43             {
44             # takes the following arguments:
45             # first, last: Math:Strings or scalars
46             # charset: optional, if you pass a scalar as first or last
47              
48 6     6 1 47 my $class = shift;
49 6   33     26 $class = ref($class) || $class;
50              
51 6         7 my $args;
52 6 50       14 if (ref $_[0] eq 'HASH')
53             {
54 0         0 $args = shift;
55             }
56             else
57             {
58 6         15 $args->{first} = shift;
59 6         12 $args->{last} = shift;
60 6         8 $args->{charset} = shift;
61             }
62              
63 6         8 my $self = {};
64 6         12 bless $self, $class;
65 6 50       14 if (ref $args eq $class)
66             {
67             # make copy
68 0         0 for (qw/_first _last/)
69             {
70 0         0 $self->{$_} = Math::String->new($args->{$_});
71             }
72 0         0 return $self;
73             }
74 6         9 my $first = $args->{first};
75 6         11 my $last = $args->{last};
76 6         8 my $set = $args->{charset};
77              
78 6 50       22 $first = Math::String->new($first,$set) unless ref $first;
79 6 50       16 $last = Math::String->new($last,$set) unless ref $last;
80              
81 6 50       19 die ("first is NaN") if $first->is_nan();
82 6 50       40 die ("last is NaN") if $last->is_nan();
83             #die ("$first is not smaller than $last") if
84             # adjustment by $self->_size(): $self->{_rev} = $first > $last ? 1 : 0;
85              
86 6         33 bless $self, $class;
87 6         14 $self->{_first} = $first;
88 6         10 $self->{_last} = $last;
89 6         13 $self->_initialize();
90 6         89 $self;
91             }
92              
93             #############################################################################
94             # private, initialize self
95              
96             sub _initialize
97             {
98             # init sequence
99 6     6   8 my $self = shift;
100              
101 6         21 $self->_size();
102 6         12 $self->{_set} = $self->{_first}->{_set};
103 6         7 $self;
104             }
105              
106             sub _size
107             {
108             # calculate new size and adjust _rev
109 6     6   8 my $self = shift;
110              
111 6 100       16 $self->{_rev} = $self->{_first} < $self->{_last} ? 0 : 1;
112 6         224 $self->{_size} = $self->{_last} - $self->{_first};
113 6         445 $self->{_size} = $self->{_size}->babs()->as_number();
114 6         29 $self->{_size}++;
115 6         235 $self;
116             }
117              
118             #############################################################################
119             # public
120              
121             sub charset
122             {
123 0     0 1 0 my $self = shift;
124 0         0 $self->{_first}->{_set};
125             }
126              
127             sub length
128             {
129 1     1 1 3 my $self = shift;
130 1         4 $self->{_size};
131             }
132              
133             sub is_reversed
134             {
135             # return true if the sequence is reversed, or false
136 2     2 1 11 my $self = shift;
137 2         9 $self->{_rev};
138             }
139              
140             sub first
141             {
142 3     3 1 225 my $self = shift;
143 3 50       8 if (defined $_[0])
144             {
145 0         0 $self->{_first} = shift;
146             $self->{_first} = Math::String->new($self->{_first},$self->{_set})
147 0 0       0 unless ref $self->{_first};
148 0         0 $self->_size();
149             }
150 3         19 $self->{_first};
151             }
152              
153             sub last
154             {
155 3     3 1 6 my $self = shift;
156 3 50       8 if (defined $_[0])
157             {
158 0         0 $self->{_last} = shift;
159             $self->{_last} = Math::String->new($self->{_last},$self->{_set})
160 0 0       0 unless ref $self->{_last};
161 0         0 $self->_size();
162             }
163 3         9 $self->{_last};
164             }
165              
166             sub string
167             {
168             # return the Nth string in sequence or undef for out-of-range
169 11     11 1 18 my $self = shift;
170 11 50       15 my $nr = shift; $nr = 0 if !defined $nr;
  11         23  
171              
172 11 50       43 $nr = Math::BigInt->new($nr) unless ref $nr;
173 11         576 my $n;
174 11 100       23 if ($self->{_rev})
175             {
176 4 100       10 if ($nr < 0)
177             {
178 2         304 $n = $self->{_last}-$nr; $n--;
  2         116  
179             }
180             else
181             {
182 2         318 $n = $self->{_first}-$nr;
183             }
184 4 50 33     111 return if $n > $self->{_first} || $n < $self->{_last};
185             }
186             else
187             {
188 7 100       20 if ($nr < 0)
189             {
190 4         624 $n = $self->{_last}+$nr; $n++;
  4         268  
191             }
192             else
193             {
194 3         569 $n = $self->{_first}+$nr;
195             }
196 7 50 33     167 return if $n > $self->{_last} || $n < $self->{_first};
197             }
198 11         719 $n;
199             }
200              
201             sub error
202             {
203 1     1 0 29 my $self = shift;
204 1         5 $self->{_set}->error();
205             }
206              
207             sub as_array
208             {
209             # return the sequence as array of strings
210 2     2 1 5 my $x = shift;
211              
212 2         4 my @a;
213 2         4 my $f = $x->{_first}; my $l = $x->{_last};
  2         3  
214 2 100       6 if ($x->{_rev})
215             {
216 1         4 while ($f >= $l) { push @a,$f->copy(); $f->bdec(); }
  26         785  
  26         50  
217             }
218             else
219             {
220 1         3 while ($f <= $l) { push @a,$f->copy(); $f->binc(); }
  55         1605  
  55         103  
221             }
222 2         100 @a;
223             }
224              
225             __END__