Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

How can I do this: 
use Some::Module;

sub somecode {
   do { print "some stuff\n" }
}

my $somevar = Some::Module->new();
print $somevar->printcode(\&somecode);

[download]
and have it return: 
do { print "some stuff\n" }

[download]
?

Replies are listed 'Best First'.
Re: Printing the code of a coderef
by Trizor (Pilgrim) on Jun 26, 2007 at 05:35 UTC

    You're looking for B::Deparse. In fact, you have the usage almost correct, except instead of printcode the method is called coderef2text.

    use B::Deparse;

sub somecode {
    do { print "some stuff\n" }
}

my $somevar = B::Deparse->new();
print $somevar->coderef2text(\&somecode);

    [download]

    However you might want to read the docs, as B::Deparse is still in development and contains some caveats.

[reply]
[d/l]
[select]
      Very helpful, but I get a weird nested structure as output, though it would be equivalent to the original code: 
      {
    do {
        do {
            print "some stuff\n"
        }
    };
}

      [download]
      Is there any way I can get it to print without the excessive do's?
[reply]
[d/l]

        the new generation of data dumping does streamline this using B::Deparse 

        % steph@apexPDell2 (/home/stephan/t1) %
% date
Tue Jun 26 15:04:14     2007

% steph@apexPDell2 (/home/stephan/t1) %
% date; cat Some/Module.pm                                     
Tue Jun 26 15:04:27     2007

package Some::Module;

sub somecode {
   do { print "some stuff\n" }
}
1;

% steph@apexPDell2 (/home/stephan/t1) %
% perl -MDDS -MSome::Module -e 'Dump(\&Some::Module::somecode)'; date
$CODE1 = sub {
           package Some::Module;
           do {
             do {
               print "some stuff\n"
             }
           };
         };

Tue Jun 26 15:04:32     2007

        [download]
        cheers --stephan
[reply]
[d/l]
        I guess that's the best we can get now. I don't know what B::Deparse exactly does, but it seems to handle the do statement specially. As shown in another reply with Sub::Information, the result is the same with with Data::Dump::Streamer which in turn also uses B::Deparse. Consider and compare with the following code. 
        use Data::Dump::Streamer;

sub somecode {
    my $x = shift;
    if ($x) {
        print "x ok\n";
    } else {
        print "what do you want?\n";
    }
    return 1;
}

print Dump(\&somecode);
__END__
# result:
$CODE1 = sub {
           my $x = shift @_;
           if ($x) {
             print "x ok\n";
           } else {
             print "what do you want?\n";
           }
           return 1;
         };

        [download]

        Open source softwares? Share and enjoy. Make profit from them if you can. Yet, share and enjoy!

[reply]
[d/l]
Re: Printing the code of a coderef
by ferreira (Chaplain) on Jun 26, 2007 at 13:43 UTC

    A very recent module which can help you with this is Sub::Information. To tell the truth, it uses B::Deparse (via Data::Dump::Streamer) to get the source code, but its rationale is to bring together a bunch of modules which collect information about code and offer a nice integrated API. 

    sub somecode {
   do { print "some stuff\n" }
}

use Sub::Information as => 'inspect';
my $code_info = inspect(\&somecode);
print $code_info->code;

    [download]
[reply]
[d/l]
Re: Printing the code of a coderef
by belden (Friar) on Jun 28, 2007 at 15:08 UTC
    You can also try using Data::Dumper... just set $Data::Dumper::Deparse to true.
    use Data::Dumper;
$Data::Dumper::Deparse = 1;
my $code = sub { print "hello world\n" };
print Dumper $code;
__END__
$VAR1 = sub {
                  print "hello world\n";
              };

    [download]
    A more interesting example: 
    {
  package foo;
  use strict;
  sub get_coderef { sub { print "hello world\n" } }
}
use Data::Dumper;
$Data::Dumper::Deparse = 1;
print Dumper(foo->get_coderef);
__END__
$VAR1 = sub {
                  package foo;
                  use strict 'refs';
                  print "hello world\n";
              };

    [download]
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom