Skip to content

Commit f0ac69a

Browse files
author
jdhedden
committed
threads-shared v1.16
1 parent 0e7e0e6 commit f0ac69a

File tree

8 files changed

+240
-187
lines changed

8 files changed

+240
-187
lines changed

‎Changes‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,9 @@
11
Revision history for Perl extension threads::shared.
22

3+
1.16 Wed Feb 20 17:15:44 2008
4+
- Blead change 33256
5+
- Upgraded ppport.h to Devel::PPPort 3.13_01
6+
37
1.15 Tue Nov 6 17:20:10 2007
48
- For Perl 5.10.0 and later, fixed problem with storing shared
59
objects in shared structures

‎Makefile.PL‎

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -93,4 +93,22 @@ WriteMakefile(
9393
@conditional_params
9494
);
9595

96+
# Additional 'make' targets
97+
sub MY::postamble
98+
{
99+
return <<'_EXTRAS_';
100+
fixfiles:
101+
@dos2unix `cat MANIFEST`
102+
@$(CHMOD) 644 `cat MANIFEST`
103+
@$(CHMOD) 755 examples/*.pl
104+
105+
ppport:
106+
@( cd /tmp; perl -e 'use Devel::PPPort; Devel::PPPort::WriteFile("ppport.h");' )
107+
@if ! cmp -s ppport.h /tmp/ppport.h; then \
108+
( tkdiff ppport.h /tmp/ppport.h & ); \
109+
perl /tmp/ppport.h; \
110+
fi
111+
_EXTRAS_
112+
}
113+
96114
# EOF

‎README‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
threads::shared version 1.15
1+
threads::shared version 1.16
22
============================
33

44
This module needs Perl 5.8.0 or later compiled with USEITHREADS.

‎examples/class.pl‎

Lines changed: 169 additions & 169 deletions
Original file line numberDiff line numberDiff line change
@@ -1,169 +1,169 @@
1-
#!/usr/bin/perl
2-
3-
use strict;
4-
use warnings;
5-
6-
use threads;
7-
use threads::shared;
8-
9-
package My::Class; {
10-
use threads::shared qw(share is_shared);
11-
use Scalar::Util qw(reftype blessed);
12-
13-
# Constructor
14-
sub new
15-
{
16-
my $class = shift;
17-
share(my %self);
18-
19-
# Add arguments to object hash
20-
while (my $tag = shift) {
21-
if (!@_) {
22-
require Carp;
23-
Carp::croak("Missing value for '$tag'");
24-
}
25-
$self{$tag} = _make_shared(shift);
26-
}
27-
28-
return (bless(\%self, $class));
29-
}
30-
31-
# Adds fields to a shared object
32-
sub set
33-
{
34-
my ($self, $tag, $value) = @_;
35-
lock($self);
36-
$self->{$tag} = _make_shared($value);
37-
}
38-
39-
# Make a thread-shared version of a complex data structure or object
40-
sub _make_shared
41-
{
42-
my $in = shift;
43-
44-
# If already thread-shared, then just return the input
45-
return ($in) if (is_shared($in));
46-
47-
# Make copies of array, hash and scalar refs
48-
my $out;
49-
if (my $ref_type = reftype($in)) {
50-
# Copy an array ref
51-
if ($ref_type eq 'ARRAY') {
52-
# Make empty shared array ref
53-
$out = &share([]);
54-
# Recursively copy and add contents
55-
foreach my $val (@$in) {
56-
push(@$out, _make_shared($val));
57-
}
58-
}
59-
60-
# Copy a hash ref
61-
elsif ($ref_type eq 'HASH') {
62-
# Make empty shared hash ref
63-
$out = &share({});
64-
# Recursively copy and add contents
65-
foreach my $key (keys(%{$in})) {
66-
$out->{$key} = _make_shared($in->{$key});
67-
}
68-
}
69-
70-
# Copy a scalar ref
71-
elsif ($ref_type eq 'SCALAR') {
72-
$out = \do{ my $scalar = $$in; };
73-
share($out);
74-
}
75-
}
76-
77-
# If copy created above ...
78-
if ($out) {
79-
# Clone READONLY flag
80-
if (Internals::SvREADONLY($in)) {
81-
Internals::SvREADONLY($out, 1);
82-
}
83-
# Make blessed copy, if applicable
84-
if (my $class = blessed($in)) {
85-
bless($out, $class);
86-
}
87-
# Return copy
88-
return ($out);
89-
}
90-
91-
# Just return anything else
92-
# NOTE: This will generate an error if we're thread-sharing,
93-
# and $in is not an ordinary scalar.
94-
return ($in);
95-
}
96-
}
97-
98-
99-
package main;
100-
101-
MAIN:
102-
{
103-
# Create an object containing some complex elements
104-
my $obj = My::Class->new('bar' => { 'ima' => 'hash' },
105-
'baz' => [ qw(shared array) ]);
106-
107-
# Create a thread
108-
threads->create(sub {
109-
# The thread shares the object
110-
print("Object has a $obj->{'bar'}->{'ima'}\n");
111-
112-
# Add some more data to the object
113-
push(@{$obj->{'baz'}}, qw(with five elements));
114-
115-
# Add a complex field to the object
116-
$obj->set('funk' => { 'yet' => [ qw(another hash) ] });
117-
118-
})->join();
119-
120-
# Show that the object picked up the data set by the thread
121-
print('Object has a ', join(' ', @{$obj->{'baz'}}), "\n");
122-
print('Object has yet ', join(' ', @{$obj->{'funk'}->{'yet'}}), "\n");
123-
}
124-
125-
exit(0);
126-
127-
__END__
128-
129-
=head1 NAME
130-
131-
class.pl - Example 'threadsafe' class code
132-
133-
=head1 DESCRIPTION
134-
135-
This example class illustrates how to create hash-based objects that can be
136-
shared between threads using L<threads::shared>. In addition, it shows how to
137-
permit the objects' fields to contain arbitrarily complex data structures.
138-
139-
=over
140-
141-
=item my $obj = My::Class->new('key' => $value, ...)
142-
143-
The class contructor takes parameters in the form of C<key=E<gt>value> pairs,
144-
and adds them as fields to the newly created shared object. The I<values> may
145-
be any complex data structures, and are themselves made I<shared>.
146-
147-
=item $obj->set('key' => $value)
148-
149-
This method adds/sets a field for a shared object, making the value for the
150-
field I<shared> if necessary.
151-
152-
=back
153-
154-
=head1 SEE ALSO
155-
156-
L<threads>, L<threads::shared>
157-
158-
=head1 AUTHOR
159-
160-
Jerry D. Hedden, S<E<lt>jdhedden AT cpan DOT orgE<gt>>
161-
162-
=head1 COPYRIGHT AND LICENSE
163-
164-
Copyright 2006 - 2007 Jerry D. Hedden. All rights reserved.
165-
166-
This program is free software; you can redistribute it and/or modify it under
167-
the same terms as Perl itself.
168-
169-
=cut
1+
#!/usr/bin/perl
2+
3+
use strict;
4+
use warnings;
5+
6+
use threads;
7+
use threads::shared;
8+
9+
package My::Class; {
10+
use threads::shared qw(share is_shared);
11+
use Scalar::Util qw(reftype blessed);
12+
13+
# Constructor
14+
sub new
15+
{
16+
my $class = shift;
17+
share(my %self);
18+
19+
# Add arguments to object hash
20+
while (my $tag = shift) {
21+
if (!@_) {
22+
require Carp;
23+
Carp::croak("Missing value for '$tag'");
24+
}
25+
$self{$tag} = _make_shared(shift);
26+
}
27+
28+
return (bless(\%self, $class));
29+
}
30+
31+
# Adds fields to a shared object
32+
sub set
33+
{
34+
my ($self, $tag, $value) = @_;
35+
lock($self);
36+
$self->{$tag} = _make_shared($value);
37+
}
38+
39+
# Make a thread-shared version of a complex data structure or object
40+
sub _make_shared
41+
{
42+
my $in = shift;
43+
44+
# If already thread-shared, then just return the input
45+
return ($in) if (is_shared($in));
46+
47+
# Make copies of array, hash and scalar refs
48+
my $out;
49+
if (my $ref_type = reftype($in)) {
50+
# Copy an array ref
51+
if ($ref_type eq 'ARRAY') {
52+
# Make empty shared array ref
53+
$out = &share([]);
54+
# Recursively copy and add contents
55+
foreach my $val (@$in) {
56+
push(@$out, _make_shared($val));
57+
}
58+
}
59+
60+
# Copy a hash ref
61+
elsif ($ref_type eq 'HASH') {
62+
# Make empty shared hash ref
63+
$out = &share({});
64+
# Recursively copy and add contents
65+
foreach my $key (keys(%{$in})) {
66+
$out->{$key} = _make_shared($in->{$key});
67+
}
68+
}
69+
70+
# Copy a scalar ref
71+
elsif ($ref_type eq 'SCALAR') {
72+
$out = \do{ my $scalar = $$in; };
73+
share($out);
74+
}
75+
}
76+
77+
# If copy created above ...
78+
if ($out) {
79+
# Clone READONLY flag
80+
if (Internals::SvREADONLY($in)) {
81+
Internals::SvREADONLY($out, 1);
82+
}
83+
# Make blessed copy, if applicable
84+
if (my $class = blessed($in)) {
85+
bless($out, $class);
86+
}
87+
# Return copy
88+
return ($out);
89+
}
90+
91+
# Just return anything else
92+
# NOTE: This will generate an error if we're thread-sharing,
93+
# and $in is not an ordinary scalar.
94+
return ($in);
95+
}
96+
}
97+
98+
99+
package main;
100+
101+
MAIN:
102+
{
103+
# Create an object containing some complex elements
104+
my $obj = My::Class->new('bar' => { 'ima' => 'hash' },
105+
'baz' => [ qw(shared array) ]);
106+
107+
# Create a thread
108+
threads->create(sub {
109+
# The thread shares the object
110+
print("Object has a $obj->{'bar'}->{'ima'}\n");
111+
112+
# Add some more data to the object
113+
push(@{$obj->{'baz'}}, qw(with five elements));
114+
115+
# Add a complex field to the object
116+
$obj->set('funk' => { 'yet' => [ qw(another hash) ] });
117+
118+
})->join();
119+
120+
# Show that the object picked up the data set by the thread
121+
print('Object has a ', join(' ', @{$obj->{'baz'}}), "\n");
122+
print('Object has yet ', join(' ', @{$obj->{'funk'}->{'yet'}}), "\n");
123+
}
124+
125+
exit(0);
126+
127+
__END__
128+
129+
=head1 NAME
130+
131+
class.pl - Example 'threadsafe' class code
132+
133+
=head1 DESCRIPTION
134+
135+
This example class illustrates how to create hash-based objects that can be
136+
shared between threads using L<threads::shared>. In addition, it shows how to
137+
permit the objects' fields to contain arbitrarily complex data structures.
138+
139+
=over
140+
141+
=item my $obj = My::Class->new('key' => $value, ...)
142+
143+
The class contructor takes parameters in the form of C<key=E<gt>value> pairs,
144+
and adds them as fields to the newly created shared object. The I<values> may
145+
be any complex data structures, and are themselves made I<shared>.
146+
147+
=item $obj->set('key' => $value)
148+
149+
This method adds/sets a field for a shared object, making the value for the
150+
field I<shared> if necessary.
151+
152+
=back
153+
154+
=head1 SEE ALSO
155+
156+
L<threads>, L<threads::shared>
157+
158+
=head1 AUTHOR
159+
160+
Jerry D. Hedden, S<E<lt>jdhedden AT cpan DOT orgE<gt>>
161+
162+
=head1 COPYRIGHT AND LICENSE
163+
164+
Copyright 2006 - 2007 Jerry D. Hedden. All rights reserved.
165+
166+
This program is free software; you can redistribute it and/or modify it under
167+
the same terms as Perl itself.
168+
169+
=cut

0 commit comments

Comments
 (0)