FYI, here's some code. Uncomment/comment Clone/Storable, clone/dclone as reqd:
#!/usr/bin/perl -w
+
use strict;
use threads;
use threads::shared;
use Clone qw(clone);
#use Storable qw(dclone);
+
my (
$thr1, # thread handle
$key,
$v1, $v2, $v3, $tmp1, $tmp2,
$key1, $key2, $key3
);
+
# pkg test
{
+
package cfg;
+
%cfg::thash = ();
threads::shared::share(%cfg::thash);
}
+
{
lock(%cfg::thash);
$tmp1 = {};
$tmp2 = {};
share($tmp1);
share($tmp2);
+
+
$v1="B";
$v2="2";
$cfg::thash{$v1} = $tmp1;
$cfg::thash{$v1}{$v2} = $tmp2;
$cfg::thash{$v1}{$v2}{server} ='b.a.com';
print "$cfg::thash{$v1}{$v2}{server}\n";
+
$tmp1 = {};
share($tmp1);
$tmp2 = {};
share($tmp2);
+
$v1='A';
$v2='1';
$cfg::thash{$v1} = $tmp1;
$cfg::thash{$v1}{$v2} = $tmp2;
$cfg::thash{$v1}{$v2}{server} ='a.a.com';
print "$cfg::thash{$v1}{$v2}{server}\n";
print "$cfg::thash{'B'}{'2'}{server}\n";
+
$tmp1 = {};
share($tmp1);
$tmp2 = {};
share($tmp2);
$v1='C';
$v2='3';
$cfg::thash{$v1} = $tmp1;
$cfg::thash{$v1}{$v2} = $tmp2;
$cfg::thash{$v1}{$v2}{server} ='c.a.com';
+
}
for $key1 (sort keys %cfg::thash)
{
print "ISP:$key1\t";
for $key2 (sort keys %{$cfg::thash{$key1}} )
{
print "RANK:$key2\t";
for $key3 (sort keys %{$cfg::thash{$key1}{$key2}})
{
print "$key3 $cfg::thash{$key1}{$key2}{$key3}\n";
}
}
}
+
+
$thr1 = threads->new(\&sub5, "one");
exit;
+
sub sub5
{
my $thr = $_[0];
my %thash=();
my $key ='test';
while (1)
{
{
lock(%cfg::thash);
print "Before: thread $thr: thash = $cfg::thash{'A'}{'1'}{ser
+ver}\n";
print "After: thread $thr: thash = $cfg::thash{'B'}{'2'}{serv
+er}\n";
# $thash{$key} = dclone($cfg::thash{'B'});
$thash{$key} = clone($cfg::thash{'B'});
}
}
}
|