#/** # Abstract base class defining the interfaces, and providing # simple marshalling methods, for complex object to be passed # across a Thread::Queue::Duplex # queue. #

# Licensed under the Academic Free License version 2.1, as specified in the # License.txt file included in this software package, or at # OpenSource.org. # # @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 Thread::Queue::Duplex # queue. Called by any of TQD's enqueue() methods, # as well as respond() method. #

# The default implementation 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 # dequeue() methods, # as well as the various request side dequeueing # methods (e.g., wait()). #

# The default implementation redeem()'s 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 aka "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 # respond() 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 Thread::Queue::Duplex object. #

# Called by TQD's various enqueue() and # respond() methods # when the TQQ object is being enqueue'd. Should return an unblessed, # shared version of the input object. #

# Default returns a shared # arrayref or hashref, depending on the object's base structure, with # copies of all scalar members. #

# Note that objects with more complex members will need to # implement an object specific curse() 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. #

# Called by TQD's various dequeue() and # wait methods to # "redeem" (i.e., rebless) the object into its original class. #

# Default creates non-shared copy of the input object structure, # copying its scalar contents, and blessing it into the specified class. #

# Note that objects with complex members need to implement # an object specific redeem(), possibly recursively # redeem()ing subordinate objects (be careful # of circular references!) # # @param $object marshalled aka "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;