ext/threads/shared/shared.pm

   1 package threads::shared;
   2
   3 use strict;
   4 use warnings;
   5 use Config;
   6 use Scalar::Util qw(weaken);
   7 use attributes qw(reftype);
   8
   9 BEGIN {
  10     if($Config{'useithreads'} && $threads::threads) {
  11         *share = \&share_enabled;
  12         *cond_wait = \&cond_wait_disabled;
  13         *cond_signal = \&cond_signal_disabled;
  14         *cond_broadcast = \&cond_broadcast_disabled;
  15         *unlock = \&unlock_disabled;
  16         *lock = \&lock_disabled;
  17     } else {
  18         *share = \&share_enabled;
  19     }
  20 }
  21
  22 require Exporter;
  23 require DynaLoader;
  24 our @ISA = qw(Exporter DynaLoader);
  25
  26 our @EXPORT = qw(share cond_wait cond_broadcast cond_signal unlock lock);
  27 our $VERSION = '0.01';
  28
  29 our %shared;
  30
  31 sub cond_wait_disabled { return @_ };
  32 sub cond_signal_disabled { return @_};
  33 sub cond_broadcast_disabled { return @_};
  34 sub unlock_disabled { 1 };
  35 sub lock_disabled { 1 }
  36 sub share_disabled { return @_}
  37
  38 sub share_enabled (\[$@%]) { # \]
  39     my $value = $_[0];
  40     my $ref = reftype($value);
  41     if($ref eq 'SCALAR') {
  42         my $obj = \threads::shared::sv->new($$value);
  43         bless $obj, 'threads::shared::sv';
  44         $shared{$$obj} = $value;
  45         weaken($shared{$$obj});
  46     } elsif($ref eq "ARRAY") {
  47         tie @$value, 'threads::shared::av', $value;
  48     } elsif($ref eq "HASH") {
  49         tie %$value, "threads::shared::hv", $value;
  50     } else {
  51         die "You cannot share ref of type $_[0]\n";
  52     }
  53 }
  54
  55 sub CLONE {
  56     return unless($_[0] eq "threads::shared");
  57         foreach my $ptr (keys %shared) {
  58             if($ptr) {
  59                 thrcnt_inc($shared{$ptr});
  60             }
  61         }
  62 }
  63
  64 sub DESTROY {
  65     my $self = shift;
  66     _thrcnt_dec($$self);
  67     delete($shared{$$self});
  68 }
  69
  70 package threads::shared::sv;
  71 use base 'threads::shared';
  72
  73 sub DESTROY {}
  74
  75 package threads::shared::av;
  76 use base 'threads::shared';
  77 use Scalar::Util qw(weaken);
  78 sub TIEARRAY {
  79         my $class = shift;
  80         my $value = shift;
  81         my $self = bless \threads::shared::av->new($value),'threads::shared::av';
  82         $shared{$self->ptr} = $value;
  83         weaken($shared{$self->ptr});
  84         return $self;
  85 }
  86
  87 package threads::shared::hv;
  88 use base 'threads::shared';
  89 use Scalar::Util qw(weaken);
  90 sub TIEHASH {
  91     my $class = shift;
  92     my $value = shift;
  93     my $self = bless \threads::shared::hv->new($value),'threads::shared::hv';
  94     $shared{$self->ptr} = $value;
  95     weaken($shared{$self->ptr});
  96     return $self;
  97 }
  98
  99 package threads::shared;
 100 bootstrap threads::shared $VERSION;
 101
 102 __END__
 103
 104 =head1 NAME
 105
 106 threads::shared - Perl extension for sharing data structures between threads
 107
 108 =head1 SYNOPSIS
 109
 110   use threads::shared;
 111
 112   my($foo, @foo, %foo);
 113   share($foo);
 114   share(@foo);
 115   share(%hash);
 116   my $bar = share([]);
 117   $hash{bar} = share({});
 118
 119   lock(\%hash);
 120   unlock(\%hash);
 121   cond_wait($scalar);
 122   cond_broadcast(\@array);
 123   cond_signal($scalar);
 124
 125 =head1 DESCRIPTION
 126
 127 This modules allows you to share() variables. These variables will
 128 then be shared across different threads (and pseudoforks on
 129 win32). They are used together with the threads module.
 130
 131 =head2 EXPORT
 132
 133 share(), lock(), unlock(), cond_wait, cond_signal, cond_broadcast
 134
 135 =head1 BUGS
 136
 137 Not stress tested!
 138 Does not support splice on arrays!
 139
 140 =head1 AUTHOR
 141
 142 Arthur Bergman E<lt>arthur at contiller.seE<gt>
 143
 144 threads::shared is released under the same license as Perl
 145
 146 =head1 SEE ALSO
 147
 148 L<perl> L<threads>
 149
 150 =cut