#!/usr/bin/perl

use strict;
use warnings;

use threads;
use threads::shared;

package My::Class; {
    use threads::shared qw(share is_shared shared_clone);
    use Scalar::Util qw(reftype blessed);

    # Constructor
    sub new
    {
        my $class = shift;
        share(my %self);

        # Add arguments to object hash
        while (my $tag = shift) {
            if (!@_) {
                require Carp;
                Carp::croak("Missing value for '$tag'");
            }
            $self{$tag} = shared_clone(shift);
        }

        return (bless(\%self, $class));
    }

    # Adds fields to a shared object
    sub set
    {
        my ($self, $tag, $value) = @_;
        lock($self);
        $self->{$tag} = shared_clone($value);
    }
}


package main;

MAIN:
{
    # Create an object containing some complex elements
    my $obj = My::Class->new('bar' => { 'ima' => 'hash' },
                       'baz' => [ qw(shared array) ]);

    # Create a thread
    threads->create(sub {
        # The thread shares the object
        print("Object has a $obj->{'bar'}->{'ima'}\n");

        # Add some more data to the object
        push(@{$obj->{'baz'}}, qw(with five elements));

        # Add a complex field to the object
        $obj->set('funk' => { 'yet' => [ qw(another hash) ] });

    })->join();

    # Show that the object picked up the data set by the thread
    print('Object has a ', join(' ', @{$obj->{'baz'}}), "\n");
    print('Object has yet ', join(' ', @{$obj->{'funk'}->{'yet'}}), "\n");
}

exit(0);

__END__

=head1 NAME

class.pl - Example 'threadsafe' class code

=head1 DESCRIPTION

This example class illustrates how to create hash-based objects that can be
shared between threads using L<threads::shared>.  In addition, it shows how to
permit the objects' fields to contain arbitrarily complex data structures.

=over

=item my $obj = My::Class->new('key' => $value, ...)

The class contructor takes parameters in the form of C<key=E<gt>value> pairs,
and adds them as fields to the newly created shared object.  The I<values> may
be any complex data structures, and are themselves made I<shared>.

=item $obj->set('key' => $value)

This method adds/sets a field for a shared object, making the value for the
field I<shared> if necessary.

=back

=head1 SEE ALSO

L<threads>, L<threads::shared>

=head1 AUTHOR

Jerry D. Hedden, S<E<lt>jdhedden AT cpan DOT orgE<gt>>

=head1 COPYRIGHT AND LICENSE

Copyright 2006 - 2009 Jerry D. Hedden. All rights reserved.

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

=cut