The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package LWP::Sink::base64;

use strict;
use vars qw(@ISA);

require LWP::Sink::_Pipe;
require LWP::Sink;

@ISA=qw(LWP::Sink::_Pipe
        LWP::Sink
       );

sub new
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{'buf'} = '';
    $self;
}

sub put
{
    die "Must use a specific subclass";
}

package LWP::Sink::base64::encode;
use base 'LWP::Sink::base64';

use MIME::Base64 qw(encode_base64);

sub _flush
{
    my($self, $len, $flush) = @_;
    my $sink = $self->{'sink'} || die "Missing sink";
    $len = int($len/57) * 57;
    $sink->put(encode_base64(substr($self->{'buf'}, 0, $len)));
    substr($self->{'buf'}, 0, $len) = '';
    $sink->flush if $flush;
}

sub put
{
    my $self = shift;
    my $len = length($self->{'buf'} .= shift);
    return $self if $len < 100*57;  # allow 100 lines to accumulate
    $self->_flush($len);
    $self;
}

sub flush
{
    my $self = shift;
    my $len = length($self->{'buf'});
    return $self if $len < 57;
    $self->_flush($len, 1);
    1;
}

sub close
{
    my $self = shift;
    my $sink = delete $self->{'sink'};
    my $buf  = delete $self->{'buf'};
    return 0 unless $sink;
    $sink->put(encode_base64($buf)) if length $buf;
    return $sink->close;
}


package LWP::Sink::base64::decode;
use base 'LWP::Sink::base64';

use MIME::Base64 qw(decode_base64);

sub put
{
    my $self = shift;
    my $len = length($self->{'buf'} .= shift);
    return $self if $len < 8*1024;
    $self->flush;
    $self;
}

sub flush
{
    my($self) = @_;
    my $sink = $self->{'sink'} || die "Missing sink";
    $self->{'buf'} =~ tr[A-Za-z0-9+/][]cd;
    my $len = int(length($self->{'buf'})/4) * 4;
    $sink->put(decode_base64(substr($self->{'buf'}, 0, $len)));
    substr($self->{'buf'}, 0, $len) = '';
    1;
}

sub close
{
    my $self = shift;
    my $sink = delete $self->{'sink'};
    my $buf  = delete $self->{'buf'};
    return 0 unless $sink;
    if (my $len = length $buf) {
	local($^W) = 0;  # avoid warning on bad padding at end
	$sink->put(decode_base64($buf));
    }
    return $sink->close;
}

1;