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