File Coverage

blib/lib/Parallel/Workers/Shared.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Parallel::Workers::Shared;

use warnings;
use strict;
use Carp;
use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted
                        weaken isvstring looks_like_number set_prototype);
use threads 1.39;
use threads::shared;
use Thread::Queue;
use Data::Dumper;


our (@ISA, @EXPORT, @EXPORT_OK);
@ISA = qw(Exporter);

@EXPORT = qw(shared_hash_set shared_share);
@EXPORT_OK = ();

# Adds fields to a shared object
sub shared_hash_set{
  my ($this, $tag, $value) = @_;
  share ($this) unless is_shared($this);
  lock($this);
  $this->{$tag} = shared_share($value);
}

# Make a thread-shared version of a complex data structure or object
sub shared_share{
  my $in = shift;
# If already thread-shared, then just return the input
  return ($in) if (is_shared($in));
#  print "shared_share( ".ref($in).")\n";

# Make copies of array, hash and scalar refs
  my $out;
  if (my $ref_type = reftype($in)) {
# Copy an array ref
    if ($ref_type eq 'ARRAY') {
# Make empty shared array ref
      $out = &share([]);
# Recursively copy and add contents
      foreach my $val (@$in) {
        push(@$out, shared_share($val));
      }
    }

# Copy a hash ref
    elsif ($ref_type eq 'HASH') {
# Make empty shared hash ref
      $out = &share({});
# Recursively copy and add contents
      foreach my $key (keys(%{$in})) {
        $out->{$key} = shared_share($in->{$key});
      }
    }

# Copy a scalar ref
    elsif ($ref_type eq 'SCALAR') {
      $out = \do{ my $scalar = $$in; };
        share($out);
    }
  }

# If copy created above ...
  if ($out) {
# Clone READONLY flag
    if (Internals::SvREADONLY($in)) {
      Internals::SvREADONLY($out, 1);
    }
# Make blessed copy, if applicable
    if (my $class = blessed($in)) {
      bless($out, $class);
    }
# Return copy
    return ($out);
  }

# Just return anything else
# NOTE: This will generate an error if we're thread-sharing,
#       and $in is not an ordinary scalar.
  return ($in);
}


1; # Magic true value required at end of module
__END__