This is a quick sift through the main package symbol table to find subroutines, so that if you have a coderef that actually refers to a named subroutine, you can get its name. If your sub might belong to another package, you'll need to have the search recurse through the other namespaces.
#!perl -l
use strict;
use warnings;

sub routine1 {
  print "Who am I?";
}

sub routine2 {
  print "Where am I?";
}

my %all_subs =
  map  { (\&{$main::{$_}} => $_) }
  grep { defined &{$main::{$_}} }
  keys %{main::}
;

my $some_sub = \&routine1;

if ($all_subs{$some_sub}) {
   print "Found $all_subs{$some_sub}"
}
else {
   print "Sub not found";
}

[download]

Replies are listed 'Best First'.
Re: Finding the name of a code ref
by cazz (Pilgrim) on Apr 05, 2005 at 20:51 UTC
    I've done something similar before, but going through all of the packages, not must main as well. 
    #!/usr/bin/perl
use warnings;
use strict;
no strict "refs";

my %refs;

foreach my $ref (keys %{main::}) {
    if ($ref =~ /::$/) {
        next if ($ref =~ /^main::/);
        recurse($ref);
    } else {
        if (defined \&{$main::{$ref}}) {
            my $sub = \&{$main::{$ref}};
            $refs{$sub} = "main::$ref";
        }
    }
}

sub recurse {
    my ($ref) = @_;
    foreach my $subref (keys %{$ref}) {
        next if ($subref eq $ref);
        if ($subref =~ /::$/) {
            recurse("$ref$subref");
        } else {
            if (defined \&{"$ref$subref"}) {
                $refs{\&{"$ref$subref"}} = "$ref$subref";
            }
        }
    }
}

my $ref = \&Foo::bar;

if ($refs{$ref}) {
    print "ref = $refs{$ref}\n"
} else {
    print "ACK!, can't find $ref\n";
}

package Foo;

sub bar {
    print "Here I am\n";
}

    [download]
[reply]
[d/l]
Re: Finding the name of a code ref
by merlyn (Sage) on Apr 05, 2005 at 20:47 UTC
[reply]
Re: Finding the name of a code ref
by ysth (Canon) on Apr 06, 2005 at 07:20 UTC
[reply]

Back to Cool Uses for Perl