I have an object (let's call it a "box") that itself contains a
(reference to) another object (let's call it a "marble").
When I insert the marble into the box, I do a deep copy of the marble,
so that I can change the original, or delete it, and not alter the
state of the box.
I got an overview of how to do a deep copy in PERL from
http://www.stonehenge.com/merlyn/UnixReview/col30.html
So far, all is well.
Now, I'm making my app multi-threaded.
Here's where I have a few questions:
First off, the man pages say that must bless THEN share. OK, fine.
However, the act of sharing wipes out the contents of the object (or
even an ordinary hash)...so unless I put the share() in the
constructor, after the bless() before any initialization, I've got a
problem.
****
QUESTION 1 : Am I correct in observing this? It seems bizarre, but
I've written a lot of sample code to prove it to myself...
So, how to share an existing, stateful object?
It seems that I can create a hash, share it, then copy an existing
unshared hash into it, key by key, and end up with a shared, populated
hash.
Applying the same concept to objects, I modified the deep_copy()
function referenced above to do this ( code snippet below).
This worked.
However, there's a new problem.
If I use this approach on a "box" that holds a "marble", the deep copy
gets down to the marble, blesses a new one, share()s the new one,
copies the data in, then returns up the stack and tries to insert a
reference to this new marble into the share()d, bless()ed box...and
somehow the blessing "doesn't stick".
When you try to use the new deep_copied box, you find that it's a
functioning object, but the marble inside it seems to be an unblessed
hash, not a blessed marble.
****
QUESTION 2 : What is going on? How do I fix / work around this?
Finally,
****
QUESTION 3 : If I do get this working, is this feature robust
after being run through perlcc?
I've got about 10 years of C/C++ experience, but only 4 months of
Perl, so I might be doing something stupid.
A hearty "thank you" to anyone who can shed light on this.
Here's my version information:
> perl -v
This is perl, v5.8.0 built for i386-linux-thread-multi
> grep VERSION /usr/lib/perl/5.8.0/threads.pm | head -1
our $VERSION = '0.99';
> grep VERSION /usr/lib/perl/5.8.0/threads/shared.pm | head -1
our $VERSION = '0.90';
> uname -a
Linux tage 2.4.20 #5 SMP Mon Dec 16 16:24:22 EST 2002 i686 GNU/Linux
> perl -V
Summary of my perl5 (revision 5.0 version 8 subversion 0) configuration:
Platform:
osname=linux, osvers=2.4.20-xfs+ti1211,
archname=i386-linux-thread-multi
uname='linux kosh 2.4.20-xfs+ti1211 #1 sat nov 30 19:19:08 est 2002
i686 gnulinux '
config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN
-Dcccdlflags=-fPIC -Darchname=i386-linux -Dprefix=/usr -Dprivlib=/usr/share/perl/5.8.0
-Darchlib=/usr/lib/perl/5.8.0 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5
-Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local
-Dsitelib=/usr/local/share/perl/5.8.0 -Dsitearch=/usr/local/lib/perl/5.8.0
-Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dman1ext=1
-Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Uusesfio -Uusenm
-Duseshrplib -Dlibperl=libperl.so.5.8.0 -Dd_dosuid -des'
hint=recommended, useposix=true, d_sigaction=define
usethreads=define use5005threads=undef useithreads=define
usemultiplicity=define
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN
-fno-strict-aliasing -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O3',
cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing'
ccversion='', gccversion='3.3 (Debian)', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
alignbytes=4, prototype=define
Linker and Libraries:
ld='cc', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib
libs=-lgdbm -ldb -ldl -lm -lpthread -lc -lcrypt
perllibs=-ldl -lm -lpthread -lc -lcrypt
libc=/lib/libc-2.3.1.so, so=so, useshrplib=true,
libperl=libperl.so.5.8.0
gnulibc_version='2.3.1'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'
Characteristics of this binary (from libperl):
Compile-time options: MULTIPLICITY USE_ITHREADS USE_LARGE_FILES
PERL_IMPLICIT_CONTEXT
Built under linux
Compiled at Jun 5 2003 23:33:07
@INC:
/etc/perl
/usr/local/lib/perl/5.8.0
/usr/local/share/perl/5.8.0
/usr/lib/perl5
/usr/share/perl5
/usr/lib/perl/5.8.0
/usr/share/perl/5.8.0
/usr/local/lib/site_perl
.
Code snippet follows:
------------------------------ snip! ------------------------------
#!/usr/bin/perl -w
use threads;
use threads::shared;
use strict;
use warnings;
sub deep_copy($); # proto
sub deep_copy($)
{
my $this = shift;
if (not ref $this) {
$this;
} elsif (ref $this eq "ARRAY") {
print "copying an array \n";
[map deep_copy($_), @$this];
} elsif (ref $this eq "HASH") {
print "copying a hash\n";
+{map { $_ => deep_copy($this->{$_}) } keys %$this};
} elsif ((ref $this eq "box") ||
(ref $this eq "marble")) {
my $ret = {};
share ($ret);
foreach (keys %$this){
my $foo = deep_copy($this->{$_});
$ret->{$_} = $foo;
if (ref $this->{$_} eq "marble"){
print "my copy is of type " . (ref $ret->{$_}) . "\n";
bless ( $ret->{$_}, "fred");
print "my copy is of type " . (ref $ret->{$_}) . "\n";
}
}
bless($ret, (ref $this));
return($ret);
} else {
die "deep_copy(): what type is <$this>?";
}
}
package box;
sub print($)
{
my $self = shift;
print "+- box --\n";
print "| inited => " . $self->{"inited"} . "\n";
print "| contents => ";
if (defined( $self->{"contents"})){
print "\n";
print "contents == " . $self->{"contents"} . "\n";
$self->{"contents"}->print();
} else {
print "<undef>\n";
}
}
sub new()
{
my $self = {};
bless ($self, "box");
$self->{"inited"} = 1;
$self->{"contents"} = undef;
return ($self);
}
sub add_marble($ $)
{
my $self = shift;
my $marble = shift;
my $new_marble = main::deep_copy($marble);
$self->{"contents"} = $new_marble;
$self->{"contents"}->print();
}
#--------------------
#--------------------
#--------------------
package marble;
sub new()
{
my $self = {};
bless ($self, "marble");
$self->{"size"} = 2;
$self->{"color"} = "blue";
return ($self);
}
sub print($)
{
my $self = shift;
print "+- marble --\n";
print "| color => " . $self->{"color"} . "\n";
print "| size => " . $self->{"size"} . "\n";
}
sub make_red($)
{
my $self = shift;
$self->{"color"} = "red";
}
#--------------------
#--------------------
#--------------------
my $box1 = box->new();
my $marble1 = marble->new();
$box1->add_marble($marble1);
my $box2 = main::deep_copy($box1);
$box2->print();
------------------------------ snip! ------------------------------
