File Coverage

blib/lib/PerlIO/via/Base64.pm

Criterion	Covered	Total	%
statement	24	24	100.0
branch	7	8	87.5
condition			n/a
subroutine	9	9	100.0
pod	1	4	25.0
total	41	45	91.1

package PerlIO::via::Base64;

# be as strict and verbose as possible
use strict;
use warnings;

# which version are we?
our $VERSION= '0.08';

# get the logic we need
use MIME::Base64 qw( encode_base64 );

# default setting for the end of line character
my $eol= "\n";

# satisfy -require-
1;

#-------------------------------------------------------------------------------

# Class methods

#-------------------------------------------------------------------------------
#  IN: 1 class (ignored)
#      2 new setting for eol (default: no change)
# OUT: 1 current setting for eol

sub eol {

    # set new value if one specified
    $eol= $_[1] if @_ >1;

    return $eol;
} #eol

#-------------------------------------------------------------------------------

# Methods for standard Perl features

#-------------------------------------------------------------------------------
#  IN: 1 class
#      2 mode string (ignored)
#      3 file handle of PerlIO layer below (ignored)
# OUT: 1 blessed object

sub PUSHED { bless [ '', $eol ], $_[0] } #PUSHED

#-------------------------------------------------------------------------------
#  IN: 1 instantiated object (ignored)
#      2 handle to read from
# OUT: 1 decoded string

sub FILL {

    # slurp everything we can
    local $/;
    my $line= readline $_[1];

    # decode if there is something decode or signal eof
    return defined $line ? MIME::Base64::decode_base64( $line ) : undef;
} #FILL

#-------------------------------------------------------------------------------
#  IN: 1 instantiated object (reference to buffer)
#      2 buffer to be written
#      3 handle to write to (ignored)
# OUT: 1 number of bytes "written"

sub WRITE {

    # add to the buffer (encoding will take place on FLUSH)
    $_[0]->[0] .= $_[1];

    # indicate we read the entire buffer
    return length $_[1];
} #WRITE

#-------------------------------------------------------------------------------
#  IN: 1 instantiated object (reference to buffer)
#      2 handle to write to
# OUT: 1 flag indicating error

sub FLUSH {

    # flush buffer
    if ( $_[0]->[0] ) {
	return -1 if !print { $_[1] } encode_base64( $_[0]->[0], $_[0]->[1] );

        # reset buffer
        $_[0]->[0]= '';
    }

    # indicate success
    return 0;
} #FLUSH

#-------------------------------------------------------------------------------
#  IN: 1 class for which to import
#      2..N parameters passed in -use-

sub import {
    my ( $class, %param )= @_;

    # store parameters using mutators
    $class->$_( $param{$_} ) foreach keys %param;
} #import

#-------------------------------------------------------------------------------

__END__