File Coverage

blib/lib/Process/Storable.pm

Criterion	Covered	Total	%
statement	67	69	97.1
branch	20	28	71.4
condition	8	12	66.6
subroutine	13	13	100.0
pod	2	2	100.0
total	110	124	88.7

package Process::Storable;

use 5.00503;
use strict;
use Storable              ();
use IO::Handle            ();
use IO::String            ();
use Scalar::Util          ();
use Params::Util          ();
use Process::Serializable ();

use vars qw{$VERSION @ISA};
BEGIN {
	$VERSION = '0.30';
	@ISA     = 'Process::Serializable';

	# Hack IO::String to be a real IO::Handle
	unless ( IO::String->isa('IO::Handle') ) {
		@IO::String::ISA = qw{IO::Handle IO::Seekable};
	}
}

sub serialize {
	my $self = shift;

	# Serialize to a named file (locking it)
	if ( defined $_[0] and ! ref $_[0] and length $_[0] ) {
		return Storable::lock_nstore($self, shift);
	}

	# Serialize to a string (via a handle)
	if ( Params::Util::_SCALAR0($_[0]) ) {
		my $string = shift;
		$$string   = 'pst0' . Storable::nfreeze($self);
		return 1;
	}

	# Serialize to a generic handle
	if ( defined fileno($_[0]) ) {
		local $/ = undef;
		return Storable::nstore_fd($self, shift);
	}

	# Serialize to an IO::Handle object
	if ( Params::Util::_INSTANCE($_[0], 'IO::Handle') ) {
		my $string   = Storable::nfreeze($self);
		my $iohandle = shift;
		$iohandle->print( 'pst0' )  or return undef;
		$iohandle->print( $string ) or return undef;
		return 1;
	}

	# We don't support anything else
	undef;
}

sub deserialize {
	my $class = shift;
	my $self  = $class->_deserialize(@_);

	# Integrity check
	Params::Util::_INSTANCE($self, $class) or return undef;

	$self;
}

sub _deserialize {
	my $class = shift;

	# Serialize from a named file (locking it)
	if ( defined $_[0] and ! ref $_[0] and length $_[0] ) {
		return Storable::lock_retrieve(shift);
	}

	# Serialize from a string (via a handle)
	if ( Params::Util::_SCALAR0($_[0]) ) {
		my $string = shift;

		# Remove the magic header if it exists
		if ( substr($$string, 0, 4) eq 'pst0' ) {
			substr($$string, 0, 4, '');
		}

		return Storable::thaw($$string);
	}

	# Serialize from a generic handle
	if ( defined fileno($_[0]) ) {
		return Storable::retrieve_fd(shift);
	}

	# Serialize from an IO::Handle object
	if ( Params::Util::_INSTANCE($_[0], 'IO::Handle') ) {
		local $/   = undef;
		my $string = $_[0]->getline;

		# Remove the magic header if it exists
		if ( substr($string, 0, 4) eq 'pst0' ) {
			substr($string, 0, 4, '');
		}

		return Storable::thaw($string);
	}

	# We don't support anything else
	undef;
}

1;

__END__