Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW

Re^2: dereferencing a stringfied referent

by clueless newbie (Chaplain)
on Jun 12, 2010 at 16:33 UTC ( #844358=note: print w/replies, xml ) Need Help??

in reply to Re: dereferencing a stringfied referent
in thread dereferencing a stringfied referent

This kind of gets me what I'm after without actually dereferencing the stringified referent. The replacement format_arg is "stashing" the stringified data structure while returning its stringified referent
#! use Carp::Heavy; use Data::Dumper; use Scalar::Util; use strict; use warnings; my @stash; BEGIN { # Now redefine Carp::format_arg so we can dump refs too! no warnings qw(once redefine); *Carp::format_arg = sub { # shameless stolen from b. d foy package Carp; my $arg_s=shift; my $return_s; if (not defined $arg_s) { $return_s='undef'; } elsif (Scalar::Util::blessed($arg_s)) { # an object $return_s="'".ref($arg_s)."(object/class)'"; } elsif (ref($arg_s)) { # a ref require Data::Dumper; local $Data::Dumper::Indent=0; local $Data::Dumper::Terse=0; # deparse CodeRefs local $Data::Dumper::Deparse=ref($arg_s) eq 'CODE'; $return_s=Data::Dumper::Dumper($arg_s); $return_s=~ s/^\$VAR\d+\s*=\s*//; $return_s=~ s/;\s*$//; $return_s=~ s/ */ /g if (ref($arg_s) eq 'CODE'); push(@stash,$return_s); $return_s="'$arg_s($#stash)'"; } else { $return_s=$arg_s; $return_s=~ s/'/\\'/g; $return_s=str_len_trim($arg_s,$Carp::Heavy::MaxArgLen); $return_s="'$arg_s'" unless $arg_s =~ /^-?[\d.]+\z/; } $return_s=~ s/([[:cntrl:]]|[[:^ascii:]])/sprintf("\\x{%x}",ord +($1))/eg; return $return_s; }; }; # BEGIN: $SIG{__WARN__}=sub { my $buffer=Carp::longmess(); print STDOUT "$buffer\n"; print STDOUT "$_: $stash[$_]\n" for (0..$#stash); @stash=(); }; # Just some code to test use CGI; my $q=CGI->new(); main(1,[2],{3=>$q},sub { return "huh" },$q); sub main { warn "main"; shift; shift; subroutine(@_); }; sub subroutine { warn "sub"; die "just for fun!"; };
It yields:
at line 62 main::main(1, 'ARRAY(0x1bba4ec)(0)', 'HASH(0x1b58b5c)(1)', 'CO +DE(0x1a6d4a4)(2)', 'CGI(object/class)') called at line 59 0: [2] 1: {'3' => bless( {'.parameters' => [],'use_tempfile' => 1,'.charset' +=> 'ISO-8859-1','.fieldnames' => {},'param' => {},'escape' => 1}, 'CG +I' )} 2: sub { use warnings; use strict 'refs'; return 'huh';} at line 68 main::subroutine('HASH(0x1b58b5c)(0)', 'CODE(0x1a6d4a4)(1)', ' +CGI(object/class)') called at line 64 main::main(1, 'ARRAY(0x1bba4ec)(2)', 'HASH(0x1b58b5c)(3)', 'CO +DE(0x1a6d4a4)(4)', 'CGI(object/class)') called at line 59 0: {'3' => bless( {'.parameters' => [],'use_tempfile' => 1,'.charset' +=> 'ISO-8859-1','.fieldnames' => {},'param' => {},'escape' => 1}, 'CG +I' )} 1: sub { use warnings; use strict 'refs'; return 'huh';} 2: [2] 3: {'3' => bless( {'.parameters' => [],'use_tempfile' => 1,'.charset' +=> 'ISO-8859-1','.fieldnames' => {},'param' => {},'escape' => 1}, 'CG +I' )} 4: sub { use warnings; use strict 'refs'; return 'huh';} just for fun! at line 69.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://844358]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (12)
As of 2016-12-06 20:45 GMT
Find Nodes?
    Voting Booth?
    On a regular basis, I'm most likely to spy upon:

    Results (117 votes). Check out past polls.