#!/usr/bin/perl
#
use Data::Dumper;
package Test;
$xxx = 10;
$yyy = 15;
package Test2;
$zzz = 20;
sub myprint {
print "myprint says: $aaa\n";
}
package main;
$x = 1;
print "Before copying symbol table:\n";
print Dumper(\%Test::);
print Dumper(\%Test2::);
print *{Test2::aaa}{PACKAGE} . ", " . *{Test2:aaa}{NAME} . "\n";
%Test2:: = %Test::;
print "After copying symbol table:\n";
print Dumper(\%Test::);
print Dumper(\%Test2::);
${Test2::aaa} = 50;
print "After assigning to \$Test::aaa:\n";
print Dumper(\%Test::);
print Dumper(\%Test2::);
print "\$Test2::aaa = $Test2::aaa\n";
print join(' ', keys(%Test2::)) . "\n";
print *{Test2::aaa}{PACKAGE} . ", " . *{Test2:aaa}{NAME} . "\n";
print "\%main:::\n";
print Dumper(\%main::);
Test2::myprint();
####
Before copying symbol table:
$VAR1 = {
'xxx' => *Test::xxx,
'yyy' => *Test::yyy
};
$VAR1 = {
'myprint' => *Test2::myprint,
'aaa' => *Test2::aaa,
'zzz' => *Test2::zzz
};
Test2, Test2:aaa
After copying symbol table:
$VAR1 = {
'xxx' => *Test::xxx,
'yyy' => *Test::yyy
};
$VAR1 = {
'xxx' => *Test::xxx,
'yyy' => *Test::yyy
};
After assigning to $Test::aaa:
$VAR1 = {
'xxx' => *Test::xxx,
'yyy' => *Test::yyy
};
$VAR1 = {
'xxx' => *Test::xxx,
'yyy' => *Test::yyy
};
$Test2::aaa = 50
xxx yyy
Test2, Test2:aaa
%main:::
$VAR1 = {
'/' => *{'::/'},
'stderr' => *::stderr,
'SIG' => *::SIG,
'utf8::' => *{'::utf8::'},
'1' => *{'::1'},
'"' => *{'::"'},
'ARNING_BITS' => *{'::ARNING_BITS'},
'CORE::' => *{'::CORE::'},
'DynaLoader::' => *{'::DynaLoader::'},
'_ *{'::_ *::stdout,
'attributes::' => *{'::attributes::'},
'' => *{'::'},
'stdin' => *::stdin,
'_ *{'::_ *::ARGV,
'INC' => *::INC,
'Scalar::' => *{'::Scalar::'},
'ENV' => *::ENV,
'Regexp::' => *{'::Regexp::'},
'Test::' => *{'::Test::'},
'XSLoader::' => *{'::XSLoader::'},
'UNIVERSAL::' => *{'::UNIVERSAL::'},
'overload::' => *{'::overload::'},
'$' => *{'::$'},
'_ *{'::_ *{'::B::'},
'Test2:aaa' => *{'::Test2:aaa'},
'x' => *::x,
'main::' => *{'::main::'},
'Carp::' => *{'::Carp::'},
'Data::' => *{'::Data::'},
'-' => *{'::-'},
'_ *{'::_ *{'::PerlIO::'},
'_ *{'::_ *{'::0'},
'BEGIN' => *::BEGIN,
' => *{':'},
'@' => *{'::@'},
'_ *{'::_ *{'::Test2::'},
'!' => *{'::!'},
'STDOUT' => *::STDOUT,
'IO::' => *{'::IO::'},
'' => *{'::'},
'' => *{'::'},
'_' => *::_,
'+' => *{'::+'},
'Dumper' => *::Dumper,
'Exporter::' => *{'::Exporter::'},
'_ *{'::_ *{'::bytes::'},
'STDERR' => *::STDERR,
'Internals::' => *{'::Internals::'},
'STDIN' => *::STDIN,
'warnings::' => *{'::warnings::'},
'Config::' => *{'::Config::'},
'DB::' => *{'::DB::'},
'::' => *{'::::'}
};
myprint says: 50
####
#!/usr/bin/perl
use strict;
use warnings;
BEGIN {
package New::MyModule;
*Old::MyModule:: = \*New::MyModule::;
%My::Other::Name:: = %New::MyModule::;
sub foo { print @_ }
1;
}
New::MyModule::foo("new\n");
Old::MyModule::foo("old\n");
My::Other::Name::foo("other\n");
$New::MyModule::extra1 = 'set as $New::MyModule::extra1';
$Old::MyModule::extra2 = 'set as $Old::MyModule::extra2';
$My::Other::Name::extra3 = 'set as $My::Other::Name::extra3';
# This is to avoid warnings about the above being used only once
my @array = (
$New::MyModule::extra1,
$Old::MyModule::extra2,
$My::Other::Name::extra3,
);
print "\nNew::MyModule:\n";
foreach my $key (keys %New::MyModule::) {
print "$key: $New::MyModule::{$key}\n";
}
print "\nOld::MyModule:\n";
foreach my $key (keys %Old::MyModule::) {
print "$key: $Old::MyModule::{$key}\n";
}
print "\nMy::Other::Name:\n";
foreach my $key (keys %My::Other::Name::) {
print "$key: $My::Other::Name::{$key}\n";
}
####
new
old
other
New::MyModule:
extra2: *New::MyModule::extra2
extra1: *New::MyModule::extra1
foo: *New::MyModule::foo
Old::MyModule:
extra2: *New::MyModule::extra2
extra1: *New::MyModule::extra1
foo: *New::MyModule::foo
My::Other::Name:
extra3: *My::Other::Name::extra3
foo: *New::MyModule::foo