File Coverage

blib/lib/Process/YAML.pm

Criterion	Covered	Total	%
statement	68	77	88.3
branch	20	32	62.5
condition	10	18	55.5
subroutine	15	15	100.0
pod	2	2	100.0
total	115	144	79.8

package Process::YAML;

# Process that is compatible with Storable after new, and after run.

use 5.005;
use strict;
use base 'Process::Serializable';
use Fcntl qw/:flock/;
use YAML::Syck   ();
use IO::Handle   ();
use IO::File     ();
use IO::String   ();
use Scalar::Util ();
use Params::Util qw/_INSTANCE/;

use vars qw{$VERSION};
BEGIN {
	$VERSION = '0.04';
}

BEGIN {
	unless ( IO::String->isa('IO::Handle') ) {
		push @IO::String::ISA, 'IO::Handle';
	}
	unless ( IO::String->isa('IO::Seekable') ) {
		push @IO::String::ISA, 'IO::Seekable';
	}
}

sub serialize {
	my $self = shift;

	# Serialize to a string (via a handle)
	if ( Params::Util::_SCALAR0($_[0]) ) {
		my $handle = IO::String->new($_[0]);
		return print $handle YAML::Syck::Dump($self);
	}

	# Serialize to a generic handle
	if ( Params::Util::_INSTANCE($_[0], 'IO::Handle') or fileno($_[0]) ) {
		my $handle = $_[0];
		return print $handle YAML::Syck::Dump($self);
	}

	# Serialize to a file name (locking it)
	if ( defined $_[0] and ! ref $_[0] and length $_[0] ) {
		my $fh;
		my $mode = '+<';
		if ( not -e $_[0] ) {
			$mode = '+>';
		}
		if ( not open($fh, $mode, $_[0]) ) {
			return undef;
		}
		if ( not flock($fh, LOCK_EX) ) {
			return undef;
		}
		if ( not truncate($fh, 0) ) {
			return undef;
		}
		if ( not print $fh YAML::Syck::Dump($self) ) {
			return undef;
		}
		if ( not close $fh ) {
			return undef;
		}
		return 1;
	}

	# We don't support anything else
	undef;
}

sub deserialize {
	my $class = shift;

	# Deserialize from a string
	if ( Params::Util::_SCALAR0($_[0]) ) {
		return YAML::Syck::Load(${$_[0]});
	}

	# Deserialize from a generic handle
	if ( Params::Util::_INSTANCE($_[0], 'IO::Handle') or fileno($_[0]) ) {
		my $handle = $_[0];
		return YAML::Syck::Load(join '', <$handle>);
	}

	# Deserialize from a file name (locking it)
	if ( defined $_[0] and ! ref $_[0] and length $_[0] ) {
		my $fh;
		if ( not open($fh, '<', $_[0]) ) {
			return undef;
		}
		if ( not flock($fh, LOCK_SH) ) {
			return undef;
		}
		return YAML::Syck::Load(join '', <$fh>);
	}

	# We don't support anything else
	undef;
}

1;

__END__