File Coverage

blib/lib/Convert/AnyBase/Converter.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package Convert::AnyBase::Converter;
2              
3 1     1   657 use Moose;
  0            
  0            
4             use Convert::AnyBase::Carp;
5              
6             use Scalar::Util qw/looks_like_number/;
7              
8             has set => qw/is ro required 1 isa Str/;
9             has base => qw/is ro lazy_build 1/, init_arg => undef;
10             sub _build_base {
11             return length shift->set;
12             }
13             has normalize => qw/is ro isa CodeRef/;
14              
15             sub encode {
16             my $self = shift;
17             my $number = shift;
18              
19             croak "Can't encode \"$number\"" unless looks_like_number $number;
20              
21             my $set = $self->set;
22             my $base = $self->base;
23              
24             my ( $done, @string );
25              
26             while ( ! $done ) {
27             my $quotient = int( $number / $base );
28             my $remainder;
29             if ( $quotient != 0 ) {
30             $remainder = $number % $base;
31             $number = $quotient;
32             }
33             else {
34             $remainder = $number;
35             $done = 1;
36             }
37              
38             push @string, substr $set, $remainder, 1;
39             }
40              
41             return join '', reverse @string;
42             }
43              
44             sub decode {
45             my $self = shift;
46             my $string = shift;
47              
48             my $set = $self->set;
49             my $base = $self->base;
50             my $normalize = $self->normalize;
51              
52             if ( $normalize ) {
53             local $_ = $string;
54             $string = $normalize->();
55             }
56              
57             my $number = 0;
58             my $offset = 1;
59             my @string = reverse split m//, $string;
60              
61             for ( @string ) {
62             my $value = index $set, $_;
63             croak "Unknown character $_ in input \"$string\"\n" if -1 == $value;
64             $number += ( $value * $offset );
65             $offset *= $base;
66             }
67              
68             return $number;
69             }
70              
71             1;