File Coverage

blib/lib/Acme/Collector64.pm
Criterion Covered Total %
statement 50 52 96.1
branch 12 14 85.7
condition 2 3 66.6
subroutine 7 7 100.0
pod 3 3 100.0
total 74 79 93.6


line stmt bran cond sub pod time code
1             package Acme::Collector64;
2 4     4   110050 use strict;
  4         10  
  4         144  
3 4     4   22 use warnings;
  4         9  
  4         108  
4 4     4   95 use 5.008001;
  4         19  
  4         226  
5 4     4   27 use Carp ();
  4         8  
  4         3047  
6              
7             our $VERSION = '0.02';
8              
9             sub new {
10 3     3 1 31 my $class = shift;
11 3 50       18 my %args = @_ == 1 ? %{$_[0]} : @_;
  0         0  
12              
13 3   66     23 my $index_table = $args{index_table}
14             || join '', ('A'..'Z', 'a'..'z', '0'..'9', '+/=');
15              
16 3 50       16 unless (length $index_table == 65) {
17 0         0 Carp::croak('index_table must be 65-character string.');
18             }
19              
20 3         18 return bless {
21             index_table => $index_table,
22             }, $class;
23             }
24              
25             sub encode {
26 5     5 1 32 my ($self, $input) = @_;
27              
28 5         8 my $output = '';
29 5         6 my $i = 0;
30 5         21 while ($i < length $input) {
31 23         25 my ($chr1, $chr2, $chr3);
32 23         28 for my $chr ($chr1, $chr2, $chr3) {
33 69 100       128 $chr = $i < length $input ? ord substr($input, $i++, 1) : 0;
34             }
35 23         31 my $enc1 = $chr1 >> 2;
36 23         30 my $enc2 = (($chr1 & 3) << 4) | ($chr2 >> 4);
37 23         25 my $enc3 = (($chr2 & 15) << 2) | ($chr3 >> 6);
38 23         24 my $enc4 = $chr3 & 63;
39 23 100       73 if (!$chr2) {
    100          
40 1         2 $enc3 = $enc4 = 64;
41             } elsif (!$chr3) {
42 3         5 $enc4 = 64;
43             }
44 23         30 for my $enc ($enc1, $enc2, $enc3, $enc4) {
45 92         189 $output .= substr $self->{index_table}, $enc, 1;
46             }
47             }
48 5         33 return $output;
49             }
50              
51             sub decode {
52 6     6 1 2516 my ($self, $input) = @_;
53              
54 6         12 my $output = '';
55 6         10 my $i = 0;
56 6         31 while ($i < length $input) {
57 48         56 my ($enc1, $enc2, $enc3, $enc4);
58 48         69 for my $enc ($enc1, $enc2, $enc3, $enc4) {
59 192         479 $enc = index $self->{index_table}, substr($input, $i++, 1);
60             }
61 48         79 my $chr1 = ($enc1 << 2) | ($enc2 >> 4);
62 48         71 my $chr2 = (($enc2 & 15) << 4) | ($enc3 >> 2);
63 48         62 my $chr3 = (($enc3 & 3) << 6) | $enc4;
64 48         59 $output .= chr $chr1;
65 48 100       92 if ($enc3 != 64) {
66 47         55 $output .= chr $chr2;
67             }
68 48 100       95 if ($enc4 != 64) {
69 45         106 $output .= chr $chr3;
70             }
71             }
72 6         35 return $output;
73             }
74              
75             1;
76             __END__