I'd like to set a variable with a chosen name 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'";
Related
Today I saw this piece of code:
if ( not defined($reply_address)
or not defined($from_name)
or not defined($subject)
or not defined($date) )
{
die "couldn’t glean the required information!";
}
(Jeffrey Friedl, "Mastering Regular Expressions", p. 59, 3rd ed.)
and I thought "How can I know which variable misfired?"
Of course, if there are only 4 variables to test, as in the example above, one could come up with:
if ( not defined $reply_address )
{
die "\$reply_address is not defined"
}
elsif ( not defined $from_name )
{
die "\$from_name is not defined"
}
elsif ...
But what if there are 14 variables? Or 40...?
One still needs to go through all of them, manually testing each and every one?
Isn't there a shorter, more "magical" way of telling which variable was left undefined?
You could create a table to simplify a little bit:
use strict;
use warnings;
my $reply_address = "xyz";
my $from_name;
my $subject = "test";
my $date;
my #checks = (
[\$reply_address, '$reply_adress'],
[\$from_name, '$from_name'],
[\$subject, '$subject'],
[\$date, '$date'],
);
for my $check (#checks) {
if (not defined ${$check->[0]}) {
die $check->[1] . " is not defined";
}
}
You can do what you want with symbolic references, though using them is generally not a great idea, and it can only be done with package variables, not lexically scoped variables (and lexically scoped variables are preferred to package variables -- see this answer for a brief comparison of the two).
#!/usr/bin/env perl
use strict;
use warnings;
use 5.014;
our($foo1) = 1;
our($bar1) = undef;
our($baz1) = 3;
foreach my $name (qw(foo1 bar1 baz1)) {
{
no strict 'refs';
my($value) = $$name;
warn "$name: is not defined" unless defined $value;
say "$name: <$value>";
}
}
Using warn instead of die for illustrative purposes.
</tmp> $ ./test.pl
foo1: <1>
bar1: is not defined at ./test.pl line 16.
Use of uninitialized value $value in concatenation (.) or string at ./test.pl line 17.
bar1: <>
baz1: <3>
You can also just loop through all of the variables using common code to check them:
#!/usr/bin/env perl
use strict;
use warnings;
use 5.014;
my($foo2) = 1;
my($bar2) = undef;
my($baz2) = 3;
foreach my $vardef (["foo2", $foo2], ["bar2", $bar2], ["baz2", $baz2]) {
my($name) = $vardef->[0];
my($value) = $vardef->[1];
warn "$name: is not defined" unless defined $value;
say "$name: <$value>";
}
which gives similar output:
foo2: <1>
bar2: is not defined at ./test.pl line 29.
Use of uninitialized value $value in concatenation (.) or string at ./test.pl line 30.
bar2: <>
baz2: <3>
Finally, if you can manage to get the variables into a hash, you can loop through the keys of the hash and test them that way:
#!/usr/bin/env perl
use strict;
use warnings;
use 5.014;
my($vars) = {
foo3 => 1,
bar3 => undef,
baz3 => 3,
};
foreach my $name (sort keys %$vars) {
my($value) = $vars->{$name};
warn "$name: is not defined" unless defined $value;
say "$name: <$value>";
}
I threw the sort in there because I like deterministic behavior...
bar3: is not defined at ./test.pl line 42.
Use of uninitialized value $value in concatenation (.) or string at ./test.pl line 43.
bar3: <>
baz3: <3>
foo3: <1>
If the test really was as simple as die if ! defined then I would probably just list them out:
#!/usr/bin/env perl
use strict;
use warnings;
use 5.014;
my($foo4) = 1;
my($bar4) = undef;
my($baz4) = 3;
die qq([ERROR] \$foo4 not defined\n) unless defined $foo4;
die qq([ERROR] \$bar4 not defined\n) unless defined $bar4;
die qq([ERROR] \$baz4 not defined\n) unless defined $baz4;
which just gives us:
[ERROR] $bar4 not defined
The last approach is just very straightforward and unambiguous. If the test is not as dead simple as this, then I'd go with the second approach. If you're worried about a list of 40 (or even 14) checks of this nature, then I'd look at the design.
See also this PadWalker code example for a very complicated version of the first option, but allowing lexically scoped variables.
Could be done with a string-eval:
use strict;
use warnings;
my ($reply_address, $from_name, $subject, $date) = ('', '', undef, '');
for my $var (qw(reply_address from_name subject date)) {
my $defined;
eval "\$defined = defined \$$var";
die "eval failed: $#" if $#;
die "\$$var is not defined" unless $defined;
}
I wrote a script in perl which does multi-threading, I then tried to convert it over into an object. However, I can't seem to figure out how to lock on a member variable. The closest I've come to is:
#!/usr/bin/perl
package Y;
use warnings;
use strict;
use threads;
use threads::shared;
sub new
{
my $class = shift;
my $val :shared = 0;
my $self =
{
x => \$val
};
bless $self, $class;
is_shared($self->{x}) or die "nope";
return $self;
}
package MAIN;
use warnings;
use strict;
use threads;
use threads::shared;
use Data::Dumper;
my $x = new Y();
{
lock($x->{x});
}
print Dumper('0'); # prints: $VAR = '0';
print Dumper($x->{x}); # prints: $VAR = \'0';
print "yes\n" if ($x->{x} == 0); # prints nothing
#print "yes\n" if ($$x->{x} == 0); # dies with msg: Not a SCALAR reference
my $tmp = $x->{x}; # this works. Must be a order of precedence thing.
print "yes\n" if ($$tmp == 0); # prints: yes
#++$$x->{x}; # dies with msg: Not a SCALAR reference
++$$tmp;
print Dumper($x->{x}); # prints: $VAR = \'1';
This allows me to put a lock on the member var x, but it means I'd be needing 2 member variables as the actual member var isn't really capable of being manipulated by assigning to it, incrementing it, etc. I can't even test against it.
EDIT:
I'm thinking that I should rename this question "How do you dereference a member variable in perl?" as the problem seems to boil down to that. Using $$x->{x} is invalid syntax and you can't force precedence rules with parentheses. I.e. $($x->{x}) doesn't work. Using a temporary works but it a nuisance.
I don't get what you are trying to do with threads and locking, but there are some simple errors in the way you use references.
$x->{x}
is a reference to a scalar, so the expressions
$x->{x} == 0
++$$x->{x}
both look suspect. $$x->{x} is parsed as {$$x}->{x} (dereference $x, then treat it as a hash reference and look up the value with key x). I think you mean to say
${$x->{x}} == 0
++${$x->{x}}
where ${$x->{x}} means to treat $x as a hash reference, to look up the value for key x in that hash, and then to dererence that value.
I'm reading some information from a YAML file
groceries.yaml
# comment
fruit:
apples: 1
oranges: 1
grapes: 1
vegetables:
potatoes: 1
onions: 1
leeks: 1
into a perl script
myscript.pl
#!/usr/bin/perl
use strict;
use warnings;
use YAML::Tiny;
# Create a YAML file
my $stuff = YAML::Tiny->new;
# Open the config
$stuff = YAML::Tiny->read( 'groceries.yaml' );
print "Fruit: ", %{($stuff->[0]->{fruit})},"\n";
print "Vegetables: ", %{($stuff->[0]->{vegetables})},"\n";
exit
This works fine, but I would like to have one hash for fruit and one for vegetables. My naive attempt was
my #keys = keys %{($stuff->[0])};
foreach my $key (#keys){
my %{ $key } = %{($stuff->[0]->{$key})},"\n";
}
but clearly this doesn't work.
I'd love to understand what I'm doing wrong, and am open to different work flows that accomplish the same idea :)
Try this :
#!/usr/bin/perl
use strict;
use warnings;
use YAML::Tiny;
use Data::Dumper;
# Create a YAML file
my $stuff = YAML::Tiny->new;
# Open the config
$stuff = YAML::Tiny->read( 'groceries.yaml' );
my %fruits = %{ $stuff->[0]->{fruit} };
my %vegetables = %{ $stuff->[0]->{vegetables} };
I don't know why you put some parentheses in your code :
%{($stuff->[0]->{$key})},"\n";
I think this is the problem.
To iterate over the HASHes,
use Data::Dumper;
# ...
foreach my $key (keys %{ $stuff->[0] }) {
print Dumper $stuff->[0]->{$key};
}
Edit2
#!/usr/bin/perl
use strict;
use warnings;
use YAML::Tiny;
use Data::Dumper;
# Create a YAML file
my $stuff = YAML::Tiny->new;
# Open the config
$stuff = YAML::Tiny->read( 'groceries.yaml' );
my %top_h;
foreach my $key (keys %{ $stuff->[0] }) {
$top_h{$key} = $stuff->[0]->{$key};
}
print Dumper \%top_h;
This solution enables you to access %fruit and %vegetables. They are declared as package global variables using our so that they will be in the symbol table, which then allows you to do use symbolic references or glob assignments. You'll also need to turn off strict refs to enable this. Also see this reference.
use strict;
use warnings;
use YAML::Tiny;
use Data::Dumper;
my $stuff = YAML::Tiny->read('groceries.yml');
my %groceries = %{$stuff->[0]};
our %fruit;
our %vegetables;
{
no strict 'refs';
#no strict 'vars'; # don't need above 'our' declarations with this
while (my ($key, $val) = each %groceries) {
%$key = %$val;
# or *$key = $val;
}
}
print Dumper \%fruit;
If you don't know the keys upfront, then you'll also need to turn off strict vars so you don't need to declare the hashes before assigning to them. But then you might get a warning when you use the hash directly.
But having said all of that, I think it would be simplest to just use %groceries.
my ( $fruit, $vegetables) = #{$stuff->[0]}{ qw<fruit vegetables> };
If you want to do this in a loop, first, I would save the first "document" to a local reference.
my $yaml = $stuff->[0];
And then in a while loop, do this:
while ( my ( $k, $v ) = each %$yaml ) {
say ucfirst( $k ) . ': ' . %$v;
}
You could also use List::Pairwise and do this:
mapp { say ucfirst( $a ) . ': ' . %$b } %{ $stuff->[0] };
I would like to dynamically get a list of either function names (as strings) or function references from any arbitrary Perl module available on my system. This would include modules that may or may not have, e.g., a global #EXPORT_OK array in its namespace. Is such a feat possible? How does one pull it off if so?
Edit: From reading perlmod, I see that %Some::Module:: serves as a symbol table for Some::Module. Is this the correct place to be looking? If so, how can I whittle the table down to just the function names in Some::Module?
You're on the right track. To wittle down the full symbol table to just the subs, something like this can be done (Hat tip "Mastering Perl", ch 8, for main package version of this):
use strict; # need to turn off refs when needed
package X;
sub x {1;};
sub y {1;};
our $y = 1;
our $z = 2;
package main;
foreach my $entry ( keys %X:: ) {
no strict 'refs';
if (defined &{"X::$entry"}) {
print "sub $entry is defined\n" ;
}
}
# OUTPUT
sub y is defined
sub x is defined
You may find this simple script handy:
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
# dump of object's symbol table:
foreach my $className (#ARGV)
{
print "symbols in $className:";
eval "require $className";
die "Can't load $className: $#" if $#;
no strict 'refs';
print Dumper(\%{"main::${className}::"});
}
But, if you're doing this in production code, I'd use Package::Stash instead:
my #subs_in_foo = Package::Stash->new('Foo')->list_all_symbols('CODE');
I'm using Perl 5.20. This works on my machine:
use strict;
package foo;
our $some_var;
sub func1 { return 'func1'}
sub func2 { return 'func2'}
package main;
sub callable {
my ($x) = #_;
return defined(&$x);
}
while (my ($k, $v) = each(%foo::)) {
if (callable($v)) {
print("$k\n");
}
}
# output:
# func1
# func2
In light of Michael Carman's comment, I have decided to rewrite the question. Note that 11 comments appear before this edit, and give credence to Michael's observation that I did not write the question in a way that made it clear what I was asking.
Question: What is the standard--or cleanest way--to fake the special status that $a and $b have in regard to strict by simply importing a module?
First of all some setup. The following works:
#!/bin/perl
use strict;
print "\$a=$a\n";
print "\$b=$b\n";
If I add one more line:
print "\$c=$c\n";
I get an error at compile time, which means that none of my dazzling print code gets to run.
If I comment out use strict; it runs fine. Outside of strictures, $a and $b are mainly special in that sort passes the two values to be compared with those names.
my #reverse_order = sort { $b <=> $a } #unsorted;
Thus the main functional difference about $a and $b--even though Perl "knows their names"--is that you'd better know this when you sort, or use some of the functions in List::Util.
It's only when you use strict, that $a and $b become special variables in a whole new way. They are the only variables that strict will pass over without complaining that they are not declared.
: Now, I like strict, but it strikes me that if TIMTOWTDI (There is more than one way to do it) is Rule #1 in Perl, this is not very TIMTOWDI. It says that $a and $b are special and that's it. If you want to use variables you don't have to declare $a and $b are your guys. If you want to have three variables by adding $c, suddenly there's a whole other way to do it.
Nevermind that in manipulating hashes $k and $v might make more sense:
my %starts_upper_1_to_25
= skim { $k =~ m/^\p{IsUpper}/ && ( 1 <= $v && $v <= 25 ) } %my_hash
;`
Now, I use and I like strict. But I just want $k and $v to be visible to skim for the most compact syntax. And I'd like it to be visible simply by
use Hash::Helper qw<skim>;
I'm not asking this question to know how to black-magic it. My "answer" below, should let you know that I know enough Perl to be dangerous. I'm asking if there is a way to make strict accept other variables, or what is the cleanest solution. The answer could well be no. If that's the case, it simply does not seem very TIMTOWTDI.
Others mentioned how to 'use vars' and 'our' - I just wanted to add that $a and $b are special cases, since they're used internally by the sort routines. Here's the note from the strict.pm docs:
Because of their special use by sort(), the variables $a and $b are
exempted from this check.
$a and $b are special because they're a part of the core language. While I can see why you might say that the inability to create similarly-special variables of your own is anti-TIMTOWTDI, I would say that it's no more so than the inability to create new basic commands on the order of 'print' or 'sort'. (You can define subs in modules, but that doesn't make them true keywords. It's the equivalent of using 'our $k', which you seem to be saying doesn't make $k enough like $a for you.)
For pushing names into someone else's namespace, this should be a working example of Exporter:
package SpecialK;
use strict;
use base 'Exporter';
BEGIN {
our #EXPORT = qw( $k );
}
our $k;
1;
Save this to SpecialK.pm and 'use SpecialK' should then make $k available to you. Note that only 'our' variables can be exported, not 'my'.
If I understand correctly, what you want is:
use vars qw($a $b); # Pre-5.6
or
our ($a, $b); # 5.6 +
You can read about it here.
If I'm understanding your question you want to write a module that declares variables in the user's namespace (so they don't have to) and which get localized automatically in callbacks. Is that right?
You can do this by declaring globals and exporting them. (Though do note that it's generally considered bad form to export things without being asked to.)
package Foo;
use strict;
use warnings;
require Exporter;
our #ISA = qw(Exporter);
our #EXPORT = qw(*k *v hashmap);
our ($k, $v);
sub hashmap(&\%) {
my $code = shift;
my $hash = shift;
while (local ($k, $v) = each %$hash) {
$code->();
}
}
Note: The export is of *k and *v, not $k and $v. If you don't export the entire typeglob the local in hashmap won't work correctly from the user's package. A side effect of this is that all of the various forms of k and v (%k, #v, etc.) get declared and aliased. For a full explanation of this, see Symbol Tables in perlmod.
Then in your script:
use Foo; # exports $k and $v
my %h = (a => 1, b => 2, c => 3);
hashmap { print "$k => $v\n" } %h;
__END__
c => 3
a => 1
b => 2
In Perl 5.6 and later, you can use our:
our ($k, $v);
Or you can stick with the older "use vars":
use vars qw($k $v);
Or you might just stick with "my", e.g.:
my %hash;
my ($k,$v);
while (<>) {
/^KEY=(.*)/ and $k = $1 and next;
/^VALUE=(.*)/ and $v = $1;
$hash{$k} = $v;
print "$k $v\n";
}
__END__
KEY=a
VALUE=1
KEY=b
VALUE=2
Making a global $v is not really necessary in the example above, but hopefully you get the idea ($k on the other hand needs to be scoped outside the while block).
Alternatively, you can use fully qualified variable names:
$main::k="foo";
$main::v="bar";
%main::hash{$k}=$v;
$a and $b are just global variables. You can achieve similar effects by simply declaring $k and $v:
use strict;
our ($k, $v);
(In this case $k and $v are not global variables, but lexically scoped aliases for package variables. But if you don't cross the boundaries it's similarly enough.)
It sounds like you want to do the sort of magic that List::MoreUtils does:
use strict;
my #a = (1, 2);
my #b = (3, 4);
my #x = pairwise { $a + $b } #a, #b;
I'd suggest just looking at the pairwise sub in the List::MoreUtils source. It uses some clever symbol table fiddling to inject $a and $b into the caller's namespace and then localize them to just within the sub body. I think.
This worked for me:
package Special;
use base qw<Exporter>;
# use staging; -> commented out, my module for development
our $c;
our #EXPORT = qw<manip_c>;
sub import {
*{caller().'::c'} = *c;
my $import_sub = Exporter->can( 'import' );
goto &$import_sub;
}
And it passes $c through strict, too.
package main;
use feature 'say';
use strict;
use Special;
use strict;
say "In main: \$c=$c";
manip_c( 'f', sub {
say "In anon sub: \$c=$c\n"; # In anon sub: $c=f
});
say "In main: \$c=$c";
Yeah, it's kind of dumb that I bracketed my modules with "use strict", but I don't know the internals, and that takes care of potential sequencing issues.
I'm not sure if anyone's clarified this, but strict does not whitelist $a and $b just because they are really convenient variable names for you to use in your own routines. $a and $b have special meaning for the sort operator. This is good from the point of view within such a sort routine, but kind of bad design from outside. :) You shouldn't be using $a and $b in other contexts, if you are.
$a and $b aren't normal variables, though, and can't be easily replicated by either lexical declarations or explicit exports or messing about with the symbol table. For instance, using the debugger as a shell:
DB<1> #foo = sort { $b cmp $a } qw(foo bar baz wibble);
DB<2> x #foo
0 'wibble'
1 'foo'
2 'baz'
3 'bar'
DB<3> x $a
0 undef
DB<4> x $b
0 undef
$a and $b only exist within the block passed to sort(), don't exist afterwards, and have scope in such a way that any further calls to sort don't tread on them.
To replicate that, you probably need to start messing about with source filters, to turn your preferred notation
my %starts_upper_1_to_25
= skim { $k =~ m/^\p{IsUpper}/ && ( 1 <= $v && $v <= 25 ) } %my_hash
;
into effectively
my %starts_upper_1_to_25
= map { my $k = $_; my $v = $my_hash{$v};
$k =~ m/^\p{IsUpper}/ && ( 1 <= $v && $v <=> 25 ) } keys %my_hash
;
$a and $b are as special as $_ and #_, and while there's no easy way to change those names in Perl 5, Perl 6 does indeed fix this, with the given keyword. "given" is a rubbish term to search on, but http://dev.perl.org/perl6/doc/design/syn/S03.html may be a good place to start.
Is this what your after?.....
use strict;
use warnings;
use feature qw/say/;
sub hash_baz (&#) {
my $code = shift;
my $caller = caller;
my %hash = ();
use vars qw($k $v);
no strict 'refs';
local *{ $caller . '::k' } = \my $k;
local *{ $caller . '::v' } = \my $v;
while ( #_ ) {
$k = shift;
$v = shift;
$hash{ $k } = $code->() || $v;
}
return %hash;
}
my %hash = (
blue_cat => 'blue',
purple_dog => 'purple',
ginger_cat => 'ginger',
purple_cat => 'purple' );
my %new_hash = hash_baz { uc $v if $k =~ m/purple/ } %hash;
say "#{[ %new_hash ]}";
# => purple_dog PURPLE ginger_cat ginger purple_cat PURPLE blue_cat blue
The modules suggested that use export are really no different from use vars.
But the use vars would need to be done in each package that used the $a-like variable.
And our() would need to be done in each outer scope.
Note that you can avoid using $a and $b even for sort by using a $$-prototyped sub:
sub lccmp($$) { lc($_[0]) cmp lc($_[1]) }
print join ' ', sort lccmp
qw/I met this guy and he looked like he might have been a hat-check clerk/;
This is essential when using a compare routine in a different package than the sort call.
EDIT - this is actually incorrect, see the comments. Leaving it here to give other people a chance to learn from my mistake :)
Oh, you're asking if there's a way for a module to declare $k and $v in the CALLER's namespace? You can use Exporter to push up your variables to the caller:
use strict;
package Test;
use Exporter;
my #ISA = qw/Exporter/;
my $c = 3;
my #EXPORT = qw/$c/;
package main;
print $c;