File Coverage

blib/lib/Number/Latin.pm
Criterion Covered Total %
statement 29 29 100.0
branch 19 28 67.8
condition 3 5 60.0
subroutine 8 8 100.0
pod 4 4 100.0
total 63 74 85.1


line stmt bran cond sub pod time code
1              
2             require 5;
3             package Number::Latin;
4             $VERSION = '1.01'; # Time-stamp: "2001-02-22 16:43:53 MST"
5             @ISA = ('Exporter');
6             @EXPORT = ('int2latin', 'int2Latin', 'int2LATIN', 'latin2int');
7 1     1   13630 use strict;
  1         3  
  1         67  
8 1     1   1018 use integer;
  1         13  
  1         9  
9             require Exporter;
10              
11             #---------------------------------------------------------------------------
12             sub int2latin ($) {
13 60 50   60 1 11160 return undef unless defined $_[0];
14 60 50       139 return '0' if $_[0] == 0;
15 60 100       156 return '-' . _i2l( abs int $_[0] ) if $_[0] <= -1;
16 30         137 return _i2l( int $_[0] );
17             }
18              
19             sub int2Latin ($) {
20             # just the above plus ucfirst
21 2 50   2 1 9 return undef unless defined $_[0];
22 2 50       10 return '0' if $_[0] == 0;
23 2 100       10 return '-' . ucfirst(_i2l( abs int $_[0] )) if $_[0] <= -1;
24 1         7 return ucfirst(_i2l( int $_[0] ));
25             }
26              
27             sub int2LATIN ($) {
28             # just the above plus uc
29 2 50   2 1 9 return undef unless defined $_[0];
30 2 50       8 return '0' if $_[0] == 0;
31 2 100       34 return '-' . uc(_i2l( abs int $_[0] )) if $_[0] <= -1;
32 1         8 return uc(_i2l( int $_[0] ));
33             }
34              
35             {
36             my @alpha = ('a' .. 'z');
37              
38             sub _i2l { # the real work
39 208   100 208   810 my $int = shift(@_) || return "";
40 144         545 _i2l(int (($int - 1) / 26)) . $alpha[$int % 26 - 1]; # yes, recursive
41             }
42             }
43              
44             #---------------------------------------------------------------------------
45             sub latin2int ($);
46             sub latin2int ($) {
47 96 50   96 1 332 return undef unless defined $_[0];
48 96 50 33     719 return 0 if $_[0] eq '0' or $_[0] =~ m/^0+$/s; # special case
49 96         138 my $in = $_[0];
50 96 100       275 return scalar(-latin2int($1)) if $in =~ m<^-([a-zA-Z]+)$>s;
51 64 50       243 return undef unless $_[0] =~ m<^[a-zA-Z]+$>s;
52 64         128 $in =~ tr/A-Z/a-z/;
53 64         114 _l2i($in);
54             }
55              
56             # use Number::Latin; print ">\n"; print latin2int('aaa'), "\n";
57              
58             sub _l2i { # the real work. DESTRUCTIVE to $_[0]
59             #print "<$_[0]> => ";
60 144     144   851 my $sval = ord(
61             # my $x =
62             chop($_[0])
63             ) - ord('a') + 1;
64             #print "sval: $x=>$sval leaving <$_[0]>\n";
65 144 100       674 (length $_[0]) ? ($sval + 26 * _l2i($_[0])) : $sval; # yes, recursive
66             }
67              
68             #---------------------------------------------------------------------------
69             1;
70              
71             __END__