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'} && $Config::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     } else {
  49         die "You cannot share ref of type $_[0]\n";
  50     }
  51 }
  52
  53 sub CLONE {
  54     return unless($_[0] eq "threads::shared");
  55         foreach my $ptr (keys %shared) {
  56             if($ptr) {
  57                 thrcnt_inc($shared{$ptr});
  58             }
  59         }
  60 }
  61
  62 sub DESTROY {
  63     my $self = shift;
  64     delete($shared{$$self});
  65 }
  66
  67 package threads::shared::sv;
  68 use base 'threads::shared';
  69
  70 sub DESTROY {}
  71
  72 package threads::shared::av;
  73 use base 'threads::shared';
  74 use Scalar::Util qw(weaken);
  75 sub TIEARRAY {
  76         my $class = shift;
  77         my $value = shift;
  78         my $self = bless \threads::shared::av->new($value),'threads::shared::av';
  79         $shared{$self->ptr} = $value;
  80         weaken($shared{$self->ptr});
  81         return $self;
  82 }
  83
  84 package threads::shared::hv;
  85 use base 'threads::shared';
  86
  87 bootstrap threads::shared $VERSION;
  88
  89 __END__
  90
  91 =head1 NAME
  92
  93 threads::shared - Perl extension for sharing data structures between threads
  94
  95 =head1 SYNOPSIS
  96
  97   use threads::shared;
  98
  99   my($foo, @foo, %foo);
 100   share($foo);
 101   share(@foo);
 102   share(%hash);
 103   my $bar = share([]);
 104   $hash{bar} = share({});
 105
 106   lock(\%hash);
 107   unlock(\%hash);
 108   cond_wait($scalar);
 109   cond_broadcast(\@array);
 110   cond_signal($scalar);
 111
 112 =head1 DESCRIPTION
 113
 114 This modules allows you to share() variables. These variables will
 115 then be shared across different threads (and pseudoforks on
 116 win32). They are used together with the threads module.
 117
 118 =head2 EXPORT
 119
 120 share(), lock(), unlock(), cond_wait, cond_signal, cond_broadcast
 121
 122 =head1 BUGS
 123
 124 Not stress tested!
 125 Does not support splice on arrays!
 126
 127 =head1 AUTHOR
 128
 129 Arthur Bergman E<lt>arthur at contiller.seE<gt>
 130
 131 threads::shared is released under the same license as Perl
 132
 133 =head1 SEE ALSO
 134
 135 L<perl> L<threads>
 136
 137 =cut