File Coverage

blib/lib/Math/Int2Base.pm
Criterion Covered Total %
statement 39 39 100.0
branch 4 4 100.0
condition 23 27 85.1
subroutine 9 9 100.0
pod 0 3 0.0
total 75 82 91.4


line stmt bran cond sub pod time code
1             package Math::Int2Base;
2              
3 1     1   22201 use 5.008006;
  1         4  
4 1     1   5 use strict;
  1         5  
  1         21  
5 1     1   5 use warnings;
  1         5  
  1         32  
6 1     1   5 use Carp;
  1         1  
  1         74  
7              
8             our $VERSION = '1.01';
9              
10             require Exporter;
11 1     1   5 use base qw(Exporter);
  1         7  
  1         196  
12              
13             our @EXPORT_OK = qw( int2base base2int base_chars );
14              
15             my @Chars = ('0'..'9', 'A'..'Z', 'a'..'z');
16             my $MaxBase = scalar @Chars;
17             my $CharStr = join '', @Chars;
18              
19             #---------------------------------------------------------------------
20             # int2base( $num, $base, $minlen ); # base ||= 10 minlen ||= 1
21             sub int2base {
22              
23 134     134 0 60303 my( $ret, $num, $base, $minlen ) = ( '', @_ );
24 134   100     407 $num ||= 0;
25 134   50     401 $base ||= 10;
26 134   100     671 $minlen ||= 1;
27              
28 134 100 100     942 if( $num < 0
      100        
      100        
29             || $base < 2
30             || $MaxBase < $base
31             || $minlen < 1
32             # || $num != int( $num ) # XXX[1] do we care?
33             ) {
34 4         424 croak "not supported: int2base( '$num', $base, $minlen )" }
35              
36 130         1432 for (; $num; $num = int($num/$base) ) { $ret .= $Chars[$num % $base] }
  243         35038  
37 1     1   5 no warnings 'numeric'; # negative repeat count
  1         2  
  1         222  
38 130         1564 return scalar reverse $ret . '0'x($minlen - length($ret));
39             }
40              
41             #---------------------------------------------------------------------
42             # base2int( $num, $base ); # base ||= 10
43             sub base2int {
44              
45 68     68 0 33783 my( $ret, $num, $base ) = ( 0, @_ );
46 68   100     190 $num ||= 0;
47 68   50     146 $base ||= 10;
48 68         222 my $chars = substr $CharStr, 0, $base;
49              
50 68 100 66     903 if( $num !~ /^[$chars]+$/
      100        
51             || $base < 2
52             || $MaxBase < $base ) {
53 4         334 croak "not supported: base2int( '$num', $base )" }
54              
55 64         779 $num =~ s/^0+//; # trim leading zeros
56 64         192 for( my $i = length($num)-1, my $c = 0; $i >= 0; --$i ) {
57 170         47141 $ret += index($CharStr, substr($num, $i, 1)) * $base**$c++ }
58 64         1307 return $ret;
59             }
60              
61             #---------------------------------------------------------------------
62             # base_chars( $base ); # base ||= 10
63             sub base_chars {
64 2     2 0 499 my( $base ) = @_;
65 2   50     6 $base ||= 10;
66 2         8 return substr $CharStr, 0, $base;
67             }
68              
69             1;
70             __END__