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.
Related
I recently hit a bug when use warnings FATAL ... pragma interprets mute warnings from elsewhere as a reason to die. Consider the following sample:
use strict;
# In one file:
no warnings;
my %hash;
Foo->bar( my $temp = $hash{ +undef } ); # this lives
Foo->bar( $hash{ +undef } ); # this dies
# Elsewhere
package Foo;
use warnings FATAL => qw(uninitialized);
sub bar {
my ($self, $param) = #_; # prefectly safe
$param = "(undef)"
unless defined $param; # even safer
print "Param: $param\n";
}
Now this of course can be fixed big time using the same policy regarding warnings throughout the project. Or this can be fixed every time it occurs by ruling out undefs in specific places (see # this lives line).
My question is whether there is an acceptable solution for package Foo which doesn't require changing anything that calls it, and whether this is really a bug in Perl itself.
It's not a bug. You are experiencing a side-effect of a feature that prevents needless autovification of hash elements passed to subs.
Perl passes by reference. That means that changes to the arguments within the function will change the parameters on the outside.
$ perl -E'
sub f { $_[0] = "xyz"; }
f($x);
say $x;
'
xyz
This applies to hash elements too.
$ perl -E'
sub f { $_[0] = "xyz"; }
my %h;
f($h{x});
say $h{x};
'
xyz
The sub doesn't know anything about the hash, so the hash element must be created before the sub is entered for there to be something to which to assign.
...or does it? It would be generally undesirable for f($h{x}) to always create $h{x} if the element doesn't exist. As such, Perl postpones doing the hash lookup until $_[0] is accessed, at which point it's known whether the element needs to be vivified or not. This is why the warning is coming from within the sub.
Specifically, Perl doesn't pass $h{x} to the sub when you call f($h{x}). Instead, it passes a magical scalar that contains both a reference to %h and the key value (x). This postpones doing the hash lookup until $_[0] is accessed, where it's known whether $_[0] is used somewhere assignable or not.
If $_[0] is used in a manner in which it doesn't change (i.e. if it's used as an rvalue), the hash element is looked up without vivifying it.
If $_[0] is used in a manner in which it can change (i.e. if it's used as an lvalue), the hash element is vivified and returned.
$ perl -E'
sub f { my $x = $_[0]; } # $_[0] returns undef without vivifying $h{x}
sub g { $_[0] = "xyz"; } # $_[0] vivifies and returns $h{x}
my %h;
f($h{x});
say 0+keys(%h);
g($h{x});
say 0+keys(%h);
'
0
1
Is there any way to get Perl to convert the stringified version e.g (ARRAY(0x8152c28)) of an array reference to the actual array reference?
For example
perl -e 'use Data::Dumper; $a = [1,2,3];$b = $a; $a = $a.""; warn Dumper (Then some magic happens);'
would yield
$VAR1 = [
1,
2,
3
];
Yes, you can do this (even without Inline C). An example:
use strict;
use warnings;
# make a stringified reference
my $array_ref = [ qw/foo bar baz/ ];
my $stringified_ref = "$array_ref";
use B; # core module providing introspection facilities
# extract the hex address
my ($addr) = $stringified_ref =~ /.*(0x\w+)/;
# fake up a B object of the correct class for this type of reference
# and convert it back to a real reference
my $real_ref = bless(\(0+hex $addr), "B::AV")->object_2svref;
print join(",", #$real_ref), "\n";
but don't do that. If your actual object is freed or reused, you may very well
end up getting segfaults.
Whatever you are actually trying to achieve, there is certainly a better way.
A comment to another answer reveals that the stringification is due to using a reference as a hash key. As responded to there, the better way to do that is the well-battle-tested
Tie::RefHash.
The first question is: do you really want to do this?
Where is that string coming from?
If it's coming from outside your Perl program, the pointer value (the hex digits) are going to be meaningless, and there's no way to do it.
If it's coming from inside your program, then there's no need to stringify it in the first place.
Yes, it's possible: use Devel::FindRef.
use strict;
use warnings;
use Data::Dumper;
use Devel::FindRef;
sub ref_again {
my $str = #_ ? shift : $_;
my ($addr) = map hex, ($str =~ /\((.+?)\)/);
Devel::FindRef::ptr2ref $addr;
}
my $ref = [1, 2, 3];
my $str = "$ref";
my $ref_again = ref_again($str);
print Dumper($ref_again);
The stringified version contains the memory address of the array object, so yes, you can recover it. This code works for me, anyway (Cygwin, perl 5.8):
use Inline C;
#a = (1,2,3,8,12,17);
$a = \#a . "";
print "Stringified array ref is $a\n";
($addr) = $a =~ /0x(\w+)/;
$addr = hex($addr);
$c = recover_arrayref($addr);
#c = #$c;
print join ":", #c;
__END__
__C__
AV* recover_arrayref(int av_address) { return (AV*) av_address; }
.
$ perl ref-to-av.pl
Stringified array ref is ARRAY(0x67ead8)
1:2:3:8:12:17
I'm not sure why you want to do this, but if you really need it, ignore the answers that use the tricks to look into memory. They'll only cause you problems.
Why do you want to do this? There's probably a better design. Where are you getting that stringified reference from.
Let's say you need to do it for whatever reason. First, create a registry of objects where the hash key is the stringified form, and the value is a weakened reference:
use Scalar::Util qw(weaken);
my $array = [ ... ];
$registry{ $array } = $array;
weaken( $registry{ $array } ); # doesn't count toward ref count
Now, when you have the stringified form, you just look it up in the hash, checking to see that it's still a reference:
if( ref $registry{$string} ) { ... }
You could also try Tie::RefHash and let it handle all of the details of this.
There is a longer example of this in Intermediate Perl.
In case someone finds this useful, I'm extending tobyink's answer by adding support for detecting segmentation faults. There are two approaches I discovered. The first way locally replaces $SIG{SEGV} and $SIG{BUS} before dereferencing. The second way masks the child signal and checks if a forked child can dereference successfully. The first way is significantly faster than the second.
Anyone is welcome to improve this answer.
First Approach
sub unstringify_ref($) {
use bigint qw(hex);
use Devel::FindRef;
my $str = #_ ? shift : $_;
if (defined $str and $str =~ /\((0x[a-fA-F0-9]+)\)$/) {
my $addr = (hex $1)->bstr;
local $#;
return eval {
local $SIG{SEGV} = sub { die };
local $SIG{BUS} = sub { die };
return Devel::FindRef::ptr2ref $addr;
};
}
return undef;
}
I'm not sure if any other signals can occur in an attempt to access illegal memory.
Second Approach
sub unstringify_ref($) {
use bigint qw(hex);
use Devel::FindRef;
use Signal::Mask;
my $str = #_ ? shift : $_;
if (defined $str and $str =~ /\((0x[a-fA-F0-9]+)\)$/) {
my $addr = (hex $1)->bstr;
local $!;
local $?;
local $Signal::Mask{CHLD} = 1;
if (defined(my $kid = fork)) {
# Child -- This might seg fault on invalid address.
exit(not Devel::FindRef::ptr2ref $addr) unless $kid;
# Parent
waitpid $kid, 0;
return Devel::FindRef::ptr2ref $addr if $? == 0;
} else {
warn 'Unable to fork: $!';
}
}
return undef;
}
I'm not sure if the return value of waitpid needs to be checked.
Consider the following Perl code.
#!/usr/bin/perl
use strict;
use warnings;
$b="1";
my $a="${b}";
$b="2";
print $a;
The script obviously outputs 1. I would like it to be whatever the current value of $b is.
What would be the smartest way in Perl to achieve lazy evaluation like this? I would like the ${b} to remain "unreplaced" until $a is needed.
I'm more interested in knowing why you want to do this. You could use a variety of approaches depending on what you really need to do.
You could wrap up the code in a coderef, and only evaluate it when you need it:
use strict; use warnings;
my $b = '1';
my $a = sub { $b };
$b = '2';
print $a->();
A variant of this would be to use a named function as a closure (this is probably the best approach, in the larger context of your calling code):
my $b = '1';
sub print_b
{
print $b;
}
$b = '2';
print_b();
You could use a reference to the original variable, and dereference it as needed:
my $b = '1';
my $a = \$b;
$b = '2';
print $$a;
What you want is not lazy evaluation, but late binding. To get it in Perl, you need to use eval.
my $number = 3;
my $val = "";
my $x = '$val="${number}"';
$number = 42;
eval $x;
print "val is now $val\n";
Be advised that eval is usually inefficient as well as methodically atrocious. You are almost certainly better off using a solution from one of the other answers.
Perl will interpolate a string when the code runs, and i don't know of a way to make it not do so, short of formats (which are ugly IMO). What you could do, though, is change "when the code runs" to something more convenient, by wrapping the string in a sub and calling it when you need the string interpolated...
$b = "1";
my $a = sub { "\$b is $b" };
$b = "2";
print &$a;
Or, you could do some eval magic, but it's a bit more intrusive (you'd need to do some manipulation of the string in order to achieve it).
As others have mentioned, Perl will only evaluate strings as you have written them using eval to invoke the compiler at runtime. You could use references as pointed out in some other answers, but that changes the way the code looks ($$a vs $a). However, this being Perl, there is a way to hide advanced functionality behind a simple variable, by using tie.
{package Lazy;
sub TIESCALAR {bless \$_[1]} # store a reference to $b
sub FETCH {${$_[0]}} # dereference $b
sub STORE {${$_[0]} = $_[1]} # dereference $b and assign to it
sub new {tie $_[1] => $_[0], $_[2]} # syntactic sugar
}
my $b = 1;
Lazy->new( my $a => $b ); # '=>' or ',' but not '='
print "$a\n"; # prints 1
$b = 2;
print "$a\n"; # prints 2
You can lookup the documentation for tie, but in a nutshell, it allows you to define your own implementation of a variable (for scalars, arrays, hashes, or file handles). So this code creates the new variable $a with an implementation that gets or sets the current value of $b (by storing a reference to $b internally). The new method is not strictly needed (the constructor is actually TIESCALAR) but is provided as syntactic sugar to avoid having to use tie directly in the calling code.
(which would be tie my $a, 'Lazy', $b;)
You wish to pretend that $a refers to something that is evaluated when $a is used... You can only do that if $a is not truly a scalar, it could be a function (as cHao's answer) or, in this simple case, a reference to the other variable
my $b="1";
my $a= \$b;
$b="2";
print $$a;
I would like the ${b} to remain "unreplaced" until $a is needed.
Then I'd recommend eschewing string interpolation, instead using sprintf, so that you "interpolate" when needed.
Of course, on this basis you could tie together something quick(ish) and dirty:
use strict;
use warnings;
package LazySprintf;
# oh, yuck
sub TIESCALAR { my $class = shift; bless \#_, $class; }
sub FETCH { my $self = shift; sprintf $self->[0], #$self[1..$#$self]; }
package main;
my $var = "foo";
tie my $lazy, 'LazySprintf', '%s', $var;
print "$lazy\n"; # prints "foo\n"
$var = "bar";
print "$lazy\n"; # prints "bar\n";
Works with more exotic format specifiers, too. Yuck.
With warnings enabled, perl usually prints Use of uninitialized value $foo if $foo is used in an expression and hasn't been assigned a value, but in some cases it's OK, and the variable is treated as false, 0, or '' without a warning.
What are the cases where an uninitialized/undefined variable can be used without a warning?
Summary
Boolean tests
Incrementing or decrementing an undefined value
Appending to an undefined value
Autovivification
Other mutators
Boolean tests
According to the perlsyn documentation,
The number 0, the strings '0' and '', the empty list (), and undef are all false in a boolean context. All other values are true.
Because the undefined value is false, the following program
#! /usr/bin/perl
use warnings;
my $var;
print "A\n" if $var;
$var && print "B\n";
$var and print "C\n";
print "D\n" if !$var;
print "E\n" if not $var;
$var or print "F\n";
$var || print "G\n";
outputs D through G with no warnings.
Incrementing or decrementing an undefined value
There's no need to explicitly initialize a scalar to zero if your code will increment or decrement it at least once:
#! /usr/bin/perl
use warnings;
my $i;
++$i while "aaba" =~ /a/g;
print $i, "\n";
The code above outputs 3 with no warnings.
Appending to an undefined value
Similar to the implicit zero, there's no need to explicitly initialize scalars to the empty string if you'll append to it at least once:
#! /usr/bin/perl
use warnings;
use strict;
my $str;
for (<*>) {
$str .= substr $_, 0, 1;
}
print $str, "\n";
Autovivification
One example is "autovivification." From the Wikipedia article:
Autovivification is a distinguishing feature of the Perl programming language involving the dynamic creation of data structures. Autovivification is the automatic creation of a variable reference when an undefined value is dereferenced. In other words, Perl autovivification allows a programmer to refer to a structured variable, and arbitrary sub-elements of that structured variable, without expressly declaring the existence of the variable and its complete structure beforehand.
For example:
#! /usr/bin/perl
use warnings;
my %foo;
++$foo{bar}{baz}{quux};
use Data::Dumper;
$Data::Dumper::Indent = 1;
print Dumper \%foo;
Even though we don't explicitly initialize the intermediate keys, Perl takes care of the scaffolding:
$VAR1 = {
'bar' => {
'baz' => {
'quux' => '1'
}
}
};
Without autovivification, the code would require more boilerplate:
my %foo;
$foo{bar} = {};
$foo{bar}{baz} = {};
++$foo{bar}{baz}{quux}; # finally!
Don't confuse autovivification with the undefined values it can produce. For example with
#! /usr/bin/perl
use warnings;
my %foo;
print $foo{bar}{baz}{quux}, "\n";
use Data::Dumper;
$Data::Dumper::Indent = 1;
print Dumper \%foo;
we get
Use of uninitialized value in print at ./prog.pl line 6.
$VAR1 = {
'bar' => {
'baz' => {}
}
};
Notice that the intermediate keys autovivified.
Other examples of autovivification:
reference to array
my $a;
push #$a => "foo";
reference to scalar
my $s;
++$$s;
reference to hash
my $h;
$h->{foo} = "bar";
Sadly, Perl does not (yet!) autovivify the following:
my $code;
$code->("Do what I need please!");
Other mutators
In an answer to a similar question, ysth reports
Certain operators deliberately omit the "uninitialized" warning for your convenience because they are commonly used in situations where a 0 or "" default value for the left or only operand makes sense.
These are: ++ and -- (either pre- or post-), +=, -=, .=, |=, ^=, &&=, ||=.
Being "defined-or," //= happily mutates an undefined value without warning.
So far the cases I've found are:
autovivification (gbacon's answer)
boolean context, like if $foo or $foo || $bar
with ++ or --
left side of +=, -=, or .=
Are there others?
Always fix warnings even the pesky annoying ones.
Undefined warnings can to be turned off. You can do that by creating a new scope for the operation. See perldoc perllexwarn for more info. This method works across all versions of perl.
{
no warnings 'uninitialized';
my $foo = "foo" + undef = "bar";
}
For a lot of the binary operators, you can use the new Perl 5.10 stuff, ~~ and //; See perldoc perlop for more info.
use warnings;
my $foo = undef;
my $bar = $foo // ''; ## same as $bar = defined $foo ? $foo : ''
also is the //= variant which sets the variable if it is undefined:
$foo //= '';
The Smart Matching (~~) operator is kind of cool, and permits smart comparisons, this is kind of nifty check it out in perldoc perlsyn:
use warnings;
my $foo = "string";
say $foo eq undef; # triggers warnings
say $foo ~~ undef; # no undef warnings
The real answer should be: why would you want to turn on that warning? undef is a perfectly good value for a variable (as anyone who's ever worked with a database can tell you), and it often makes sense to differentiate between true (something happened), false (nothing happened) and undef (an error occurred).
Rather than saying
use strict;
use warnings;
say
use common::sense;
and you'll get all the benefits of warnings, but with the annoying ones like undefined variables turned off.
common::sense is available from the CPAN.
Is there any way to get Perl to convert the stringified version e.g (ARRAY(0x8152c28)) of an array reference to the actual array reference?
For example
perl -e 'use Data::Dumper; $a = [1,2,3];$b = $a; $a = $a.""; warn Dumper (Then some magic happens);'
would yield
$VAR1 = [
1,
2,
3
];
Yes, you can do this (even without Inline C). An example:
use strict;
use warnings;
# make a stringified reference
my $array_ref = [ qw/foo bar baz/ ];
my $stringified_ref = "$array_ref";
use B; # core module providing introspection facilities
# extract the hex address
my ($addr) = $stringified_ref =~ /.*(0x\w+)/;
# fake up a B object of the correct class for this type of reference
# and convert it back to a real reference
my $real_ref = bless(\(0+hex $addr), "B::AV")->object_2svref;
print join(",", #$real_ref), "\n";
but don't do that. If your actual object is freed or reused, you may very well
end up getting segfaults.
Whatever you are actually trying to achieve, there is certainly a better way.
A comment to another answer reveals that the stringification is due to using a reference as a hash key. As responded to there, the better way to do that is the well-battle-tested
Tie::RefHash.
The first question is: do you really want to do this?
Where is that string coming from?
If it's coming from outside your Perl program, the pointer value (the hex digits) are going to be meaningless, and there's no way to do it.
If it's coming from inside your program, then there's no need to stringify it in the first place.
Yes, it's possible: use Devel::FindRef.
use strict;
use warnings;
use Data::Dumper;
use Devel::FindRef;
sub ref_again {
my $str = #_ ? shift : $_;
my ($addr) = map hex, ($str =~ /\((.+?)\)/);
Devel::FindRef::ptr2ref $addr;
}
my $ref = [1, 2, 3];
my $str = "$ref";
my $ref_again = ref_again($str);
print Dumper($ref_again);
The stringified version contains the memory address of the array object, so yes, you can recover it. This code works for me, anyway (Cygwin, perl 5.8):
use Inline C;
#a = (1,2,3,8,12,17);
$a = \#a . "";
print "Stringified array ref is $a\n";
($addr) = $a =~ /0x(\w+)/;
$addr = hex($addr);
$c = recover_arrayref($addr);
#c = #$c;
print join ":", #c;
__END__
__C__
AV* recover_arrayref(int av_address) { return (AV*) av_address; }
.
$ perl ref-to-av.pl
Stringified array ref is ARRAY(0x67ead8)
1:2:3:8:12:17
I'm not sure why you want to do this, but if you really need it, ignore the answers that use the tricks to look into memory. They'll only cause you problems.
Why do you want to do this? There's probably a better design. Where are you getting that stringified reference from.
Let's say you need to do it for whatever reason. First, create a registry of objects where the hash key is the stringified form, and the value is a weakened reference:
use Scalar::Util qw(weaken);
my $array = [ ... ];
$registry{ $array } = $array;
weaken( $registry{ $array } ); # doesn't count toward ref count
Now, when you have the stringified form, you just look it up in the hash, checking to see that it's still a reference:
if( ref $registry{$string} ) { ... }
You could also try Tie::RefHash and let it handle all of the details of this.
There is a longer example of this in Intermediate Perl.
In case someone finds this useful, I'm extending tobyink's answer by adding support for detecting segmentation faults. There are two approaches I discovered. The first way locally replaces $SIG{SEGV} and $SIG{BUS} before dereferencing. The second way masks the child signal and checks if a forked child can dereference successfully. The first way is significantly faster than the second.
Anyone is welcome to improve this answer.
First Approach
sub unstringify_ref($) {
use bigint qw(hex);
use Devel::FindRef;
my $str = #_ ? shift : $_;
if (defined $str and $str =~ /\((0x[a-fA-F0-9]+)\)$/) {
my $addr = (hex $1)->bstr;
local $#;
return eval {
local $SIG{SEGV} = sub { die };
local $SIG{BUS} = sub { die };
return Devel::FindRef::ptr2ref $addr;
};
}
return undef;
}
I'm not sure if any other signals can occur in an attempt to access illegal memory.
Second Approach
sub unstringify_ref($) {
use bigint qw(hex);
use Devel::FindRef;
use Signal::Mask;
my $str = #_ ? shift : $_;
if (defined $str and $str =~ /\((0x[a-fA-F0-9]+)\)$/) {
my $addr = (hex $1)->bstr;
local $!;
local $?;
local $Signal::Mask{CHLD} = 1;
if (defined(my $kid = fork)) {
# Child -- This might seg fault on invalid address.
exit(not Devel::FindRef::ptr2ref $addr) unless $kid;
# Parent
waitpid $kid, 0;
return Devel::FindRef::ptr2ref $addr if $? == 0;
} else {
warn 'Unable to fork: $!';
}
}
return undef;
}
I'm not sure if the return value of waitpid needs to be checked.