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