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;