File Coverage

blib/lib/PerlIO/via/CBC.pm

Criterion	Covered	Total	%
statement	41	61	67.2
branch	14	26	53.8
condition	2	6	33.3
subroutine	9	11	81.8
pod	4	4	100.0
total	70	108	64.8

package PerlIO::via::CBC;

use strict vars;
use warnings;

use Crypt::CBC ();

use vars '$VERSION';
$VERSION = '0.08';

my $Config = {};

sub config {
	my ($class, %args) = @_;
	if(%args) {
		$Config = {%args};
	} else {
		$Config = {};
	}
	return $Config;
}

sub PUSHED {
	return -1 if $_[1] ne 'r' and $_[1] ne 'w';

	my $cbc = Crypt::CBC->new($Config);
	unless($cbc) {
		require Carp;
		Carp::croak("Couldn't create CBC object");
	}

	if($_[1] eq 'r') { # open for reading: decrypt the data
		$cbc->start('decrypting');
	} else { # open for writing: encrypt the data
		$cbc->start('encrypting');
	}

	return (bless [$cbc, '', $_[1]], $_[0]);
}

sub FILL {
	my ($self, $fh) = @_;

	# Read the line from the handle
	my $line = readline($fh);

	my $cbc = $self->[0];

	# If there is something to be crypted, crypt it
	if(defined $line) {
        return ($cbc->crypt($line));

        # elsif we still have an object (and end of data reached)
        # Remove the object from PerlIO::via::Crypt object (so we'll really exit next)
        # and finish crypting
	} elsif($cbc) {
		$self->[0] = '';
		return ($cbc->finish());

		# else (end of data really reached)
		# return signalling end of data reached
	} else {
		return (undef);
	}
}

sub BINMODE {
	return (0);
}

sub READ {
	my ($self, $buffer, $len, $fh) = @_;

	# Read $len bytes from $fh into $buffer
	my $ret = read $fh, $buffer, $len;

	# On Error return undef
	return $ret unless defined $ret;

	my $cbc = $self->[0];

	# If there is something to be crypted, crypt it
	if($ret) {
		$buffer = $cbc->crypt($buffer);

		# elsif we still have an object (and end of data reached)
        # Remove the object from PerlIO::via::Crypt object (so we'll really exit next)
        # and finish crypting
	} else {
		$self->[0] = '';
		$buffer = $cbc->finish();
	}
	$self->[1] = '';

	# calc length
	$ret = length $buffer;

	# buffer is greater than required, shorten it but remember it
	if($ret > $len and $self->[0])
	{
		$self->[1] = substr($buffer, $len);
		$buffer = substr(0, $len);
		$ret = $len;
	}

	# return length of data (hopefully always less equal than $len)
	return $ret;
}

sub WRITE {
	my ($self, $buffer, $fh) = @_;

	my $buf = $self->[0]->crypt($buffer);
	return ((print {$fh} $buf) ? length ($buf) : -1);
}

sub FLUSH {
	my ($self, $fh) = @_;

	return 0 if $self->[2] eq 'r';

	my $buf = $self->[0]->finish();
	if($buf) {
		return ((print {$fh} $buf) ? 0 : -1);
	}

	return (0);
}

1;
__END__