开发者

Set a variable in another package

开发者 https://www.devze.com 2023-01-26 18:28 出处:网络
I\'d like to set a variable with a chosen na开发者_开发问答me in another package. How can I do this easily?

I'd like to set a variable with a chosen na开发者_开发问答me in another package. How can I do this easily?

Something like:

$variable_name = 'x';
$package::$variable_name = '0';
# now $package::x should be == '0'


You can do that, but you would have to disable strictures like so:

    package Test;

    package main;

    use strict;

    my $var_name = 'test';
    my $package = 'Test';

    no strict 'refs';
    ${"${package}::$var_name"} = 1;

print $Test::test;

So I'd not recommend that. Better to use a hash.


use 5.010;
use strict;
use warnings;

{
    no warnings 'once';
    $A::B::C::D = 5; # a test subject
}

my $pkg = 'A::B::C';
my $var = 'D';

# tearing down the walls (no warranty for you):
    say eval '$'.$pkg."::$var"; # 5

# tearing down the walls but at least feeling bad about it:
    say ${eval '\$'.$pkg."::$var" or die $@}; # 5

# entering your house with a key (but still carrying a bomb):
    say ${eval "package $pkg; *$var" or die $@}; # 5

# using `Symbol`:    
    use Symbol 'qualify_to_ref'; 
    say $${ qualify_to_ref $pkg.'::'.$var }; # 5

# letting us know you plan mild shenanigans
# of all of the methods here, this one is best
{
    no strict 'refs';
    say ${$pkg.'::'.$var}; # 5
}

and if the following make sense to you, party on:

# with a recursive function:
    sub lookup {
        @_ == 2 or unshift @_, \%::;
        my ($head, $tail) = $_[1] =~ /^([^:]+:*)(.*)$/;
        length $tail
            ? lookup($_[0]{$head}, $tail)
            : $_[0]{$head}
    }
    say ${ lookup $pkg.'::'.$var }; # 5

# as a reduction of the symbol table:
    use List::Util 'reduce';
    our ($a, $b);

    say ${+ reduce {$$a{$b}} \%::, split /(?<=::)/ => $pkg.'::'.$var }; # 5

And of course you can assign to any of these methods instead of saying them.


Given that $variable_name was validated, you could do:

eval "\$package::$variable_name = '0'";
0

精彩评论

暂无评论...
验证码 换一张
取 消