The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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

Acme::Collector64 - Yet Another Base64?

=head1 SYNOPSIS

    use utf8;
    use Acme::Collector64;

    my $japanese64 = Acme::Collector64->new(
        index_table => 'あいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもらりるれろがぎぐげござじずぜぞばびぶべぼぱぴぷぺぽやゆよわ=',
    );

    $japanese64->encode('Hello, world!');
    $japanese64->decode('てきにごふきやごけくほずへれぞりけち==');

=head1 DESCRIPTION

Let's make your own Base64!

=head1 METHODS

=over 4

=item my $c64 = Acme::Collector64->new([\%args])

Create new instance of Acme::Collector64.

=over 4

=item index_table

This is user definable index table. You have to define 65-character string.

index_table by default is "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=".

=back

=item $c64->encode($data)

This function takes B<binary string> to encode and return the encoded string.

=item $c64->decode($string)

This function takes B<text string> to decode and return the decoded data.

=back

=head1 AUTHOR

Takumi Akiyama E<lt>t.akiym at gmail.comE<gt>

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut