The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#/**
# Abstract base class defining the interfaces, and providing
# simple marshalling methods, for complex object to be passed
# across a <a href='./Duplex.html'>Thread::Queue::Duplex</a>
# queue.
# <p>
# Licensed under the Academic Free License version 2.1, as specified in the
# License.txt file included in this software package, or at
# <a href="http://www.opensource.org/licenses/afl-2.1.php">OpenSource.org</a>.
#
# @author D. Arnold
# @since 2005-12-01
# @self	$obj
#*/
package Thread::Queue::Queueable;
#
#	abstract class to permit an object to be
#	marshalled in some way before pushing onto
#	a Thread::Queue::Duplex queue
#
require 5.008;

use threads;
use threads::shared;

use strict;
use warnings;

our $VERSION = '0.90';

#/**
# Marshal an object for queueing to a <A href='./Duplex.html'>Thread::Queue::Duplex</a>
# queue. Called by any of TQD's <A href='./Duplex.html#enqueue'>enqueue()</a> methods,
# as well as <A href='./Duplex.html#respond'>respond()</a> method.
# <p>
# The default implementation <A href='#curse>curse()'s</a> the input
# object into either a shared array or shared hash (depending on the base structure
# of the object), and returns a list consisting of the object's class name, and the cursed object.
#
# @returnlist	list of (object's class, object's marshalled representation)
#*/
sub onEnqueue {
	my $obj = shift;
#
#	capture class name, and create cursed
#	version of object
#
	return (ref $obj, $obj->curse());
}

#/**
# Unmarshall an object after being dequeued. Called by any of TQD's
# <a href='./Duplex.html#dequeue'>dequeue()</a> methods,
# as well as the various request side dequeueing
# methods (e.g., <a href='./Duplex.html#wait'>wait()</a>).
# <p>
# The default implementation <a href='#redeem'>redeem()'s</a> the input object
# to copy the input shared arrayref or hashref into a nonshared equivalent, then
# blessing it into the specified class, returning the redeemed object.
#
# @param $object the marshalled representation of the object
# @return		the unmarshalled <i>aka</i> "redeemed" object
#*/
sub onDequeue {
	my ($class, $obj) = @_;
#
#	reconstruct as non-shared by redeeming
#
	return $class->redeem($obj);
}

#/**
# Pure virtual function to apply any object-specific cancel processing. Called by TQD's
# <a href='./Duplex.html#cancel>cancel()</a> methods,
# as well as the <a href='./Duplex.html#respond>respond()</a> method
# when a cancelled operation is detected.
#
# @return		1
#*/
sub onCancel {
	my $obj = shift;
	return 1;
}
#/**
# Marshal an object into a value that can be passed via
# a <a href='./Duplex.html'>Thread::Queue::Duplex</a> object.
# <p>
# Called by TQD's various <a href='./Duplex.html#enqueue'>enqueue()</a> and
# <a href='./Duplex.html#respond'>respond()</a> methods
# when the TQQ object is being enqueue'd. Should return an unblessed,
# shared version of the input object.
# <p>
# Default returns a shared
# arrayref or hashref, depending on the object's base structure, with
# copies of all scalar members.
# <p>
# <b>Note</b> that objects with more complex members will need to
# implement an object specific <code>curse()</code> to do any deepcopying,
# including curse()ing any subordinate objects.
#
# @return		marshalled version of the object
#*/
sub curse {
	my $obj = shift;
#
#	if we're already shared, don't share again
#
	return $obj if threads::shared::_id($obj);

	if ($obj->isa('HASH')) {
		my %cursed : shared = ();
		$cursed{$_} = $obj->{$_}
			foreach (keys %$obj);
		return \%cursed;
	}

	my @cursed : shared = ();
	$cursed[$_] = $obj->[$_]
		foreach (0..$#$obj);
	return \@cursed;
}
#/**
# Unmarshall an object back into its blessed form.
# <p>
# Called by TQD's various <a href='./Duplex.html#dequeue'>dequeue()</a> and
# <a href='./Duplex.html#wait'>wait</a> methods to
# "redeem" (i.e., rebless) the object into its original class.
# <p>
# Default creates non-shared copy of the input object structure,
# copying its scalar contents, and blessing it into the specified class.
# <p>
# <b>Note</b> that objects with complex members need to implement
# an object specific <code>redeem()</code>, possibly recursively
# redeem()ing subordinate objects <i>(be careful
# of circular references!)</i>
#
# @param $object	marshalled <i>aka</i> "cursed" version of the object
#
# @return		unmarshalled, blessed version of the object
#*/
sub redeem {
	my ($class, $obj) = @_;
#
#	if object is already shared, just rebless it
#	NOTE: we can only do this when threads::shared::_id() is defined
#
	return bless $obj, $class
		if threads::shared->can('_id') && threads::shared::_id($obj);
#
#	we *could* just return the blessed object,
#	which would be shared...but that might
#	not be the expected behavior...
#
	if (ref $obj eq 'HASH') {
		my $redeemed = {};
		$redeemed->{$_} = $obj->{$_}
			foreach (keys %$obj);
		return bless $redeemed, $class;
	}

	my $redeemed = [];
	$redeemed->[$_] = $obj->[$_]
		foreach (0..$#$obj);
	return bless $redeemed, $class;
}

1;