This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
More fixes that were made to the core and not in the libnet src
[perl5.git] / ext / threads / shared / shared.pm
CommitLineData
b050c948
AB
1package threads::shared;
2
3use strict;
4use warnings;
5use Config;
6use Scalar::Util qw(weaken);
7use attributes qw(reftype);
8
9BEGIN {
9ece3ee6 10 if($Config{'useithreads'} && $threads::threads) {
b050c948
AB
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
22require Exporter;
23require DynaLoader;
24our @ISA = qw(Exporter DynaLoader);
25
26our @EXPORT = qw(share cond_wait cond_broadcast cond_signal unlock lock);
27our $VERSION = '0.01';
28
29our %shared;
30
b050c948
AB
31sub cond_wait_disabled { return @_ };
32sub cond_signal_disabled { return @_};
33sub cond_broadcast_disabled { return @_};
34sub unlock_disabled { 1 };
35sub lock_disabled { 1 }
36sub share_disabled { return @_}
37
38sub share_enabled (\[$@%]) { # \]
39 my $value = $_[0];
40 my $ref = reftype($value);
41 if($ref eq 'SCALAR') {
aaf3876d
AB
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;
8669ce85
AB
48 } elsif($ref eq "HASH") {
49 tie %$value, "threads::shared::hv", $value;
b050c948
AB
50 } else {
51 die "You cannot share ref of type $_[0]\n";
52 }
53}
54
55sub 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
aaf3876d
AB
64sub DESTROY {
65 my $self = shift;
866fba46 66 _thrcnt_dec($$self);
aaf3876d
AB
67 delete($shared{$$self});
68}
69
b050c948
AB
70package threads::shared::sv;
71use base 'threads::shared';
72
aaf3876d
AB
73sub DESTROY {}
74
b050c948
AB
75package threads::shared::av;
76use base 'threads::shared';
aaf3876d
AB
77use Scalar::Util qw(weaken);
78sub 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}
b050c948
AB
86
87package threads::shared::hv;
88use base 'threads::shared';
8669ce85
AB
89use Scalar::Util qw(weaken);
90sub 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}
b050c948 98
8669ce85 99package threads::shared;
b050c948
AB
100bootstrap threads::shared $VERSION;
101
102__END__
103
104=head1 NAME
105
106threads::shared - Perl extension for sharing data structures between threads
107
108=head1 SYNOPSIS
109
110 use threads::shared;
111
112 my($foo, @foo, %foo);
aaf3876d
AB
113 share($foo);
114 share(@foo);
115 share(%hash);
b050c948
AB
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
ad91d581
JH
127This modules allows you to share() variables. These variables will
128then be shared across different threads (and pseudoforks on
129win32). They are used together with the threads module.
b050c948
AB
130
131=head2 EXPORT
132
133share(), lock(), unlock(), cond_wait, cond_signal, cond_broadcast
134
135=head1 BUGS
136
137Not stress tested!
b050c948 138Does not support splice on arrays!
b050c948
AB
139
140=head1 AUTHOR
141
aaf3876d 142Arthur Bergman E<lt>arthur at contiller.seE<gt>
b050c948 143
aaf3876d 144threads::shared is released under the same license as Perl
b050c948
AB
145
146=head1 SEE ALSO
147
148L<perl> L<threads>
149
150=cut