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__

=pod

=head1 NAME

Process::YAML - The Process::Serializable role implemented by YAML

=head1 SYNOPSIS

  package MyYAMLProcess;
  
  use base 'Process::YAML',
           'Process';
  
  sub prepare {
      ...
  }
  
  sub run {
      ...
  }
  
  1;

=head1 DESCRIPTION

C<Process::YAML> provides an implementation of the
L<Process::Serializable> role using the L<YAML::Syck> module from CPAN.
It is not itself a subclass of L<Process> so you
will need to inherit from both.

Objects that inherit from C<Process::YAML> must follow the C<new>,
C<prepare>, C<run> rules of L<Process::Serializable>.

L<YAML::Syck> was chosen over L<YAML> because L<YAML::Syck> is much faster.
Furthermore, L<YAML> uses L<Spiffy> which I could not get to play well with
the inheritance scheme of the L<Process> framework at the time (Spiffy 0.26).
By now, Brian Ingerson has released a fixed version of Spiffy (0.27), so
C<YAML> 0.52 and higher is compatible with Process::YAML.

=head2 METHODS

Using this class as an additional base class for your
C<Process> based classes will add two methods to your class as defined
by the L<Process::Serializable> documentation. Please refer to that module
for a description of the interface.

=over 2

=item serialize

=item deserialize

=back

=head1 SUPPORT

Bugs should be reported via the CPAN bug tracker at

L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Process-YAML>

For other issues, contact the author.

=head1 AUTHOR

Steffen Mueller E<lt>modules at steffen-mueller dot netE<gt>, L<http://steffen-mueller.net/>

=head1 COPYRIGHT

Copyright 2006 Steffen Mueller. All rights reserved.

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

=cut