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.
Related
I am currently trying to implement a suffix tree using Perl, however, when I attempt to set the reference for the tree function, the reference location is not set, if I pass the address via a string then check the text in the string vs the location of the hash table and they are different. Any help is appreciated!
use strict;
use warnings;
use Data::Dumper;
my $count = 0;
my $str; # holds the complete string
my %root;
# takes in all lines of code
open(IN, '<:encoding(UTF-8)', $ARGV[0]) or die "Could not open file '$ARGV[0]' $!\n";
while (<IN>) {
chomp;
# concatinates with string
$str .= $_;
}
# closes input
close(IN);
#length of input string
my $l_size = length($str) - 1;
#recursively makes
sub tree {
#recursive root
my %treeRoot;
#checking incomming data
print "1 ".Dumper(\#_)."\n";
#checking incomming data
print "2 ".Dumper(\%root)."\n";
#attempts to set tree's refrence
\%treeRoot, $count = #_;
#checking incomming data
print "3 ".Dumper(\%root)."\n";
#checking incomming data
print "4 ".$count."\n";
#leaf for each node
my %leaf;
for (my $i = 0; $i < $l_size; $i++) {
#creates alphabet tree
$treeRoot { substr($str, $i, 1) } = %leaf;
}
#checking incomming data
print "5 ".Dumper(\%root)."\n";
while ($count > 0) {
#checking incomming data
print "loop 6 ".Dumper(\%root)."\n";
$count--;
#checking incomming data
print "loop 7 ".$count."\n";
#recursion not implamented yet
#tree(\$treeRoot{'a'}, $count);
}
}
tree(\%root, 2);
#print Dumper(\%root);
You need parentheses to disambiguate. This:
\%treeRoot, $count = #_;
means this:
\%treeRoot;
$count = #_;
Because the assignment operator = has higher precedence than the comma operator ,. The warning that you got from running that code tells you this: Useless use of reference constructor in void context.
To pass the arguments correctly, you need parentheses:
(\%treeRoot, $count) = #_;
Unfortunately, this does not work, because you cannot assign to a reference this way. The following error tells you that: Can't modify reference constructor in list assignment.
So what you need is to pass the reference to a scalar:
my ($href, $count) = #_;
print $href->{'value'};
I think this method is a bit backwards, though. Passing variables by reference is likely to become a source of bugs. A more natural solution is to use the return value of the subroutine to assign values:
sub foo {
my %hash;
$hash{'value'} = ....
....
return \%hash;
}
my $hashref = foo();
print $hashref->{'value'};
Your question isn't actually how to pass a hash reference, but how to receive it, as the following will not work:
\%treeRoot, $count = #_;
Basically, you need to assign your reference to a scalar like so:
use strict;
use warnings;
sub example_sub {
my ($hashref, $count) = #_;
# Add two values to the hash:
$hashref->{newkey} = 'val';
$hashref->{newkey2} = 'val2';
}
my %root;
example_sub(\%root, 2);
use Data::Dump;
dd \%root;
Outputs:
{ newkey => "val", newkey2 => "val2" }
If you don't want to modify your original hash, you can assign the values to a new hash within the sub:
my %newhash = %$hashref;
For more info on working with references, check out: perlref - Perl references and nested data structures
I'm learning perl references, I understand the usefullness of the references to hases or arrays. But thinking about in what scenarios can be useful a reference to an scalar value.
my $x = 1;
my $sr = \$x;
where can be useful to use $$sr, instead of direct use of $x?
For example, when traversing any deep hashref structure, isn't the common practice returning a reference if the given node is hashref or arrayref, but returning directly the scalar value instead of returning a reference to the scalar?
Exists some functions or modules what uses or return references to scalars, instead of returning the scalar's value?
In a subroutine, when you want to directly modify the values being passed into it.
e.g.
sub increment_this {
my ( $inc_ref ) = #_;
${$inc_ref}++;
}
Bit of a trivial case I know, but perhaps more pertinent would be examples like chomp which removes trailing letters from a variable or $_.
If you think about it though - $_ is often effectively a reference.
If you do this:
my #array = qw ( 1 2 3 );
foreach ( #array ) {
$_++;
}
print #array;
Modifying $_ has modified the contents of the array.
I think the real answer lies in your question itself: References to scalars are not terribly useful, and you can probably just ignore that they exist when writing code. The main usefulness as hinted at by perreal is that you can point to the same memory location: Share a variable between objects.
However, for curiosity and academic purposes, one rather obscure thing comes to mind, besides the good examples left by perreal and Sobrique. You can open a file handle to print to a variable:
use strict;
use warnings;
use Data::Dumper;
my $string;
open my $fh, ">", \$string or die $!;
print $fh "Inside the string";
print Dumper $string;
# prints $VAR1 = 'Inside the string';
When you want to share a scalar between objects:
my $v = 1;
my %h1 = (a=>\$v);
my %h2 = (b=>\$v);
$v++;
print ${$h1{a}}, "\n";
print ${$h2{b}}, "\n";
prints:
2
2
It is usefull when you have to pass huge strings to a sub, and don't want to do a copy of them to make faster and don't waste the memory:
sub my_sub {
my $str = shift; #makes a copy of a reference => cheaper
#do something with $$str
}
#...
$x = ' ... large string ...';
my_sub(\$x);
#TLP mentioned file handles, which prompted another example:
Passing around file handles. Good practice for manipulating files is to use lexical file handles, to avoid namespace pollution.
sub write_header {
my ( $fh_ref ) = #_;
print ${$fh_ref} "This is a header\n";
}
open ( my $output, ">", "output_filename" );
write_header ( \$output );
write_content ( \$output );
write_footer ( \$output );
close ( $output );
I have the following question:
I want to create a perl script that reads from a text file (file with several columns of numbers) and calculate some statistics (mean, median, sd, variance). I already built one script, but as I am not in love yet with perl, I can't fix the problems of syntax on it...
Here is my perl script..
#!/usr/bin/perl -w
use strict;
open(FILEHANDLE, data.txt);
while (<FILEHANDLE>) {
shift #ARGV;
my #array = split(\t,$_);
}
close(FILEHANDLE);
###### mean, sum and size
$N = $sum = 0;
$array[$x-1];
$N++;
$sum += $array[$x-1];
###### minimum and the maximum
($min = 0, $max = 0);
$max = $array[$x-1] if ($max < $array[$x-1]), (my#sorted = sort { $a <=> $b } #samples) {
print join(" ",#sorted);
}
##### median
if ($N % 2==1) {
print "$median = $sorted[int($N/2)]\n"; ## check this out
};
else ($median = ($sorted[$N/2] + $sorted[($N/2)-1]) / 2)) {
print "$median\n"; # check this out
};
##### quantiles 1º and 3º
if $qt1 = $sorted[$r25-1] {
print "\n"; # check this out
};
else $qt1 = $fr*($sorted[$ir] - $sorted[$ir-1]) + $sorted[$ir-1] {
print "\n"; # check this out
};
##### variance
for (my $i=0;
$i<scalar(#samples);
$i++)
{
$Var += ($samples[$i]-$mean)**2;
$Var = $Var/($N-1);
};
###### standard error
($Std = sqrt($Var)/ sqrt($N));
############################################################
print "$min\n";
print "$max\n";
print "$mean\n";
print "$median\n";
print "$qt1\n";
print "$var\n";
print "$std\n";
exit(0);
I want to get it working. Please help. THANKS IN ADVANCE!
Errors in your code:
open(FILEHANDLE, data.txt);
data.txt needs to be quoted. You are not checking the return value of the open, e.g. ... or die $!. You should use a lexical filehandle and three argument open, e.g. open my $fh, '<', "data.txt" or die $!.
shift #ARGV;
This does nothing except remove the first value from you argument list, which is then promptly discarded.
my #array = split(\t,$_);
You are using \t as a bareword, it should be a regex, /\t/. Your #array is declared inside a lexical scope of the while loop, and will be undefined outside this block.
$N = $sum = 0;
Both variables are not declared, which will cause the script to die when you use strict (which is a very good idea). Use my $N to solve that. Also, $N is not a very good variable name.
$array[$x-1];
This will do nothing. $x is not declared (see above), and also undefined. The whole statement does nothing, it is like having a line 3;. I believe you will get an error such as Useless use of variable in void context.
$N++;
This increments $N to 1, which is a useless thing to do, since you only a few lines above initialized it to 0.
Well.. the list goes on. I suggest you start smaller, use strict and warnings since they are very good tools, and work out the errors one by one. A very good idea would be to make subroutines of your calculations, e.g.:
sub sum {
# code here
return $sum;
}
Go to perldoc.perl.org and read the documentation. Especially useful would be the syntax related ones and perlfunc.
Also, you should be aware that this functionality can be found in modules, which you can find at CPAN.
Your main problem is you have not declared your variables such as $N, $max, etc.
You need to introduce all new variables with my the first time you reference them. Just like you did with $array and $i. So for example
$N = $sum = 0;
Should become
my( $N, $sum ) = ( 0, 0 );
What syntax, if any, is able to take a reference of a builtin like shift?
$shift_ref = $your_magic_syntax_here;
The same way you could to a user defined sub:
sub test { ... }
$test_ref = \&test;
I've tried the following, which all don't work:
\&shift
\&CORE::shift
\&{'shift'}
\&{'CORE::shift'}
Your answer can include XS if needed, but I'd prefer not.
Clarification: I am looking for a general purpose solution that can obtain a fully functional code reference from any builtin. This coderef could then be passed to any higher order function, just like a reference to a user defined sub. It seems to be the consensus so far that this is not possible, anyone care to disagree?
No, you can't. What is the underlying problem you are trying to solve? There may be some way to do whatever that is.
Re the added part of the question "Your answer can include XS if needed, but I'd prefer not.",
calling builtins from XS is really hard, since the builtins are set up to assume they are running as part of a compiled optree and have some global variables set. Usually it's much easier to call some underlying function that the builtin itself uses, though there isn't always such a function, so you see things like:
buffer = sv_2mortal(newSVpvf("(caller(%d))[3]", (int) frame));
caller = eval_pv(SvPV_nolen(buffer), 1);
(doing a string eval from XS rather than go through the hoops required to directly call pp_caller).
I was playing around with general purpose solutions to this one, and came up with the following dirty hack using eval. It basically uses the prototype to pull apart #_ and then call the builtin. This has only been lightly tested, and uses the string form of eval, so some may say its already broken :-)
use 5.10.0;
use strict;
use warnings;
sub builtin {
my ($sub, $my, $id) = ($_[0], '');
my $proto = prototype $sub //
prototype "CORE::$sub" //
$_[1] //
($sub =~ /map|grep/ ? '&#' : '#;_');
for ($proto =~ /(\\?.)/g) { $id++;
if (/(?|(\$|&)|.(.))/) {
$my .= "my \$_$id = shift;";
$sub .= " $1\$_$id,";
} elsif (/([#%])/) {
$my .= "my $1_$id = splice \#_, 0, \#_;";
$sub .= " $1_$id,";
} elsif (/_/) {
$my .= "my \$_$id = \#_ ? shift : \$_;";
$sub .= " \$_$id,"
}
}
eval "sub ($proto) {$my $sub}"
or die "prototype ($proto) failed for '$_[0]', ".
"try passing a prototype string as \$_[1]"
}
my $shift = builtin 'shift';
my #a = 1..10;
say $shift->(\#a);
say "#a";
my $uc = builtin 'uc';
local $_ = 'goodbye';
say $uc->('hello '), &$uc;
my $time = builtin 'time';
say &$time;
my $map = builtin 'map';
my $reverse = builtin 'reverse';
say $map->(sub{"$_, "}, $reverse->(#a));
my %h = (a=>1, b=>2);
my $keys = builtin 'keys';
say $keys->(\%h);
# which prints
# 1
# 2 3 4 5 6 7 8 9 10
# HELLO GOODBYE
# 1256088298
# 10, 9, 8, 7, 6, 5, 4, 3, 2,
# ab
Revised with below and refactored.
You could do this if you patched the internal method first (which would give you the coderef of your patch):
use strict;
use warnings;
BEGIN {
*CORE::GLOBAL::die = sub { warn "patched die: '$_[0]'"; exit 3 };
}
print "ref to patched die: " . \&CORE::GLOBAL::die . "\n";
die "ack, I am slain";
gives the output:
ref to patched die: CODE(0x1801060)
patched die: 'ack, I am slain' at patch.pl line 5.
BTW: I would appreciate if anyone can explain why the override needs to be done as *CORE::GLOBAL::die rather than *CORE::die. I can't find any references for this. Additionally, why must the override be done in a BEGIN block? The die() call is done at runtime, so why can't the override be done at runtime just prior?
You can wrap shift with something that you can reference, but you have to use a prototype to use it, since shift is special.
sub my_shift (\#) { my $ll = shift; return shift #$ll }
The problem is that the prototype system can't magically figure out that when it calls some random ref-to-sub in a scalar, that it needs to take the reference before calling the subroutine.
my #list = (1,2,3,4);
sub my_shift (\#) { my $ll = shift; return shift #$ll }
my $a = shift #list;
my $my_shift_ref = \&my_shift;
my $b = (&{$my_shift_ref} (\#list) ); # see below
print "a=$a, b=$b\n";
for (my $i = 0; $i <= $#list; ++$i) { print "\$list[$i] = ",$list[$i],"\n"; }
If this is called as just #list, perl barfs, because it can't automagically make references the way shift does.
See also: [http://www.perl.com/language/misc/fmproto.html][Tom Christensen's article].
Of course, for builtins that aren't special like shift, you can always do
sub my_fork { return fork; }
and then &my_fork all you want.
As I understand you want to have coderef that will be called on some data, and it might point to some your function or to builtin.
If I'm right, just put the builtin in closure:
#!/usr/bin/perl -w
use strict;
my $coderef = \&test;
$coderef->( "Test %u\n", 1 );
$coderef = sub { printf #_ };
$coderef->( "Test %u\n", 2 );
exit;
sub test {
print join(' ', map { "[$_]" } #_) . "\n";
}
Doing it with shift is also possible, but remember that shift without explicit array to work on, works on different arrays based on where it was called.
If you want to see what it takes to fake it in production quality code, look at the code for autodie. The meat is in Fatal. Helps if you're a mad pirate Jedi Australian.
The only way I can get it to work is to make a reference to sub{shift}.
perl -e '#a=(1..3); $f=sub{shift}; print($f->(#a), "\n");'
This is functionally equivalent to:
perl -e '#a=(1..3); print(shift(#a), "\n");'
Which could be just perl -e 'print 1, "\n"' but then we wouldn't be talking about a builtin.
For your information I'm surprised that one cannot reference a builtin, and now that it's been made clear to me I can't help but think of it as a deficiency in Perl.
Update Eric correctly points out that $f=sub{shift}; $f->(#a) leaves #a unchanged. It should be more like:
perl -e '#a=(1..3); $f=sub{shift #{+shift}}; print($f->(\#a), "\n");
Thanks Eric.
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.