ext/threads/shared/shared.pm

   1
   2 package threads::shared;
   3
   4 use strict;
   5 use warnings;
   6 use Config;
   7 use Scalar::Util qw(weaken);
   8 use attributes qw(reftype);
   9
  10 BEGIN {
  11     if($Config{'useithreads'} && $Config::threads) {
  12         *share = \&share_enabled;
  13         *cond_wait = \&cond_wait_disabled;
  14         *cond_signal = \&cond_signal_disabled;
  15         *cond_broadcast = \&cond_broadcast_disabled;
  16         *unlock = \&unlock_disabled;
  17         *lock = \&lock_disabled;
  18     } else {
  19         *share = \&share_enabled;
  20     }
  21 }
  22
  23 require Exporter;
  24 require DynaLoader;
  25 our @ISA = qw(Exporter DynaLoader);
  26
  27 our @EXPORT = qw(share cond_wait cond_broadcast cond_signal unlock lock);
  28 our $VERSION = '0.01';
  29
  30 our %shared;
  31
  32
  33 sub cond_wait_disabled { return @_ };
  34 sub cond_signal_disabled { return @_};
  35 sub cond_broadcast_disabled { return @_};
  36 sub unlock_disabled { 1 };
  37 sub lock_disabled { 1 }
  38 sub share_disabled { return @_}
  39
  40 sub share_enabled (\[$@%]) { # \]
  41     my $value = $_[0];
  42     my $ref = reftype($value);
  43     if($ref eq 'SCALAR') {
  44       my $obj = \threads::shared::sv->new($$value);
  45       bless $obj, 'threads::shared::sv';
  46       $shared{$$obj} = $value;
  47       weaken($shared{$$obj});
  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
  63 package threads::shared::sv;
  64 use base 'threads::shared';
  65
  66 package threads::shared::av;
  67 use base 'threads::shared';
  68
  69 package threads::shared::hv;
  70 use base 'threads::shared';
  71
  72
  73 bootstrap threads::shared $VERSION;
  74
  75 __END__
  76
  77 =head1 NAME
  78
  79 threads::shared - Perl extension for sharing data structures between threads
  80
  81 =head1 SYNOPSIS
  82
  83   use threads::shared;
  84
  85   my($foo, @foo, %foo);
  86   share(\$foo);
  87   share(\@foo);
  88   share(\%hash);
  89   my $bar = share([]);
  90   $hash{bar} = share({});
  91
  92   lock(\%hash);
  93   unlock(\%hash);
  94   cond_wait($scalar);
  95   cond_broadcast(\@array);
  96   cond_signal($scalar);
  97
  98 =head1 DESCRIPTION
  99
 100  This modules allows you to share() variables. These variables will then be shared across different threads (and pseudoforks on win32). They are used together with the threads module.
 101
 102 =head2 EXPORT
 103
 104 share(), lock(), unlock(), cond_wait, cond_signal, cond_broadcast
 105
 106 =head1 BUGS
 107
 108 Not stress tested!
 109 Does not support references
 110 Does not support splice on arrays!
 111 The exported functions need a reference due to unsufficent prototyping!
 112
 113 =head1 AUTHOR
 114
 115 Artur Bergman <lt>artur at contiller.se<gt>
 116
 117 threads is released under the same license as Perl
 118
 119 =head1 SEE ALSO
 120
 121 L<perl> L<threads>
 122
 123 =cut
 124
 125