view release on metacpan or  search on metacpan

lib/Acme/Collector64.pm  view on Meta::CPAN

package Acme::Collector64;
use strict;
use warnings;
use 5.008001;
use Carp ();

our $VERSION = '0.02';

sub new {
    my $class = shift;
    my %args = @_ == 1 ? %{$_[0]} : @_;

    my $index_table = $args{index_table}
        || join '', ('A'..'Z', 'a'..'z', '0'..'9', '+/=');

    unless (length $index_table == 65) {
        Carp::croak('index_table must be 65-character string.');
    }

    return bless {
        index_table => $index_table,
    }, $class;
}

sub encode {
    my ($self, $input) = @_;

    my $output = '';
    my $i = 0;
    while ($i < length $input) {
        my ($chr1, $chr2, $chr3);
        for my $chr ($chr1, $chr2, $chr3) {
            $chr = $i < length $input ? ord substr($input, $i++, 1) : 0;
        }
        my $enc1 = $chr1 >> 2;
        my $enc2 = (($chr1 & 3) << 4) | ($chr2 >> 4);
        my $enc3 = (($chr2 & 15) << 2) | ($chr3 >> 6);
        my $enc4 = $chr3 & 63;
        if (!$chr2) {
            $enc3 = $enc4 = 64;
        } elsif (!$chr3) {
            $enc4 = 64;
        }
        for my $enc ($enc1, $enc2, $enc3, $enc4) {
            $output .= substr $self->{index_table}, $enc, 1;
        }
    }
    return $output;
}

sub decode {
    my ($self, $input) = @_;

    my $output = '';
    my $i = 0;
    while ($i < length $input) {
        my ($enc1, $enc2, $enc3, $enc4);
        for my $enc ($enc1, $enc2, $enc3, $enc4) {
            $enc = index $self->{index_table}, substr($input, $i++, 1);
        }
        my $chr1 = ($enc1 << 2) | ($enc2 >> 4);
        my $chr2 = (($enc2 & 15) << 4) | ($enc3 >> 2);
        my $chr3 = (($enc3 & 3) << 6) | $enc4;
        $output .= chr $chr1;
        if ($enc3 != 64) {
            $output .= chr $chr2;
        }
        if ($enc4 != 64) {
            $output .= chr $chr3;
        }
    }
    return $output;
}

1;
__END__

=encoding utf-8

=head1 NAME