Do any of you know of a way for a function to get at the name it was actually called by in the code as opposed to the name of the original function definition?

Short answer - you can't :-) Coderefs have a pointer back to the glob (if any) that defined them. So only one name.

If it were me, I'd probably use closures... something like:

sub make_sub {
    my $name = shift;
    return sub { print "My name is $name\n" };
};

*sub1 = make_sub( 'sub1' );
*sub2 = make_sub( 'sub2' );
*sub3 = make_sub( 'sub3' );
[download]

One reason you may want to have three different subs is that MainSub may do wildly different things, depending on the value of the first parameter. In which case it would probably be better to split MainSub into three smaller subs, each doing only a single task:

sub MainSub
{
    my $name = shift;

    if ($name eq 'Bob') {
        sub1(@_);
    }
    elsif ($name eq 'Ted') {
        sub2(@_);
    }
    elsif ($name eq 'Alice') {
        sub3(@_);
    }
    else {
        die "First parm $name should be Bob, Ted, or Alice\n";
    } 
}
[download]

But any of the methods above is better that trying to use an alias to in effect pass a parameter. Aliases would be more indirect, more confusing, and harder to debug.

Maybe you could play with AUTOLOAD() instead of aliases and caller. AUTOLOAD is made to do this sort of thing.

use strict;
use warnings;

sub AUTOLOAD {
    my $called = ( split /::/, $main::AUTOLOAD )[-1];
    my %recognized;
    @recognized{'this', 'that', 'those'} = ();
    exists $recognized{$called}
        or die "I don't know how to $called.\n";
    print "I was called as $called\n";
}

this();
that();
those();
woops();
[download]

One subroutine with 3 names and 3 different behaviours, sounds an aweful lot like it ought to be 3 subroutines with their own names, that call a 4th subroutine for their common behaviour--at least to me.

Is there a good reason for avoiding the obvious solution?

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#define SI_NOT  0x01
#define SI_REV  0x02


MODULE = String::Index          PACKAGE = String::Index


int
cindex(SV *str, SV *cc, ...)
PROTOTYPE: $$;$
ALIAS:
  ncindex = 1
  crindex = 2
  ncrindex = 3
CODE:
{
  /* you use the 'ix' variable in here to
     determine which alias of the function
     was called.  ix = 0 means 'cindex',
     1 means ncindex, and so on */
}
[download]

sub sub_alias (\&;$) {
  my ($func, $ix) = (@_, 0);
  sub { $func->($ix, @_) };  # that's sub { ... }'s @_, not sub_alias'
+s @_
}

*foo = sub_alias &bar, 1;
*blat = sub_alias &bar, 2;
*gunk = sub_alias &bar, 3;
[download]

sub SubAliasIndex::new { my ($class, $ix) = @_; bless \$ix, $class; }
sub SubAliasIndex::ix { ${ $_[0] } }

sub sub_alias (\&;$) {
  my ($func, $ix) = (@_, 0);
  sub { $func->(SubAliasIndex->new($ix), @_) };
}

sub bar {
  my $ix = (@_ and UNIVERSAL::isa($_[0], 'SubAliasIndex')) ? shift->ix
+ : 0;
  # ...
}

*foo = sub_alias &bar, 1;
*blat = sub_alias &bar, 2;
*gunk = sub_alias &bar, 3;
[download]

DrWhy, if you tell us why you want to do this, we may be able to give you some alternative ideas.

I have a set of related[*] modules that all have very similar accessor/mutator methods for their object's instance variables. Instead of typing virtually the same code over and over, I wrote a private _get_set() method in the ultimate base class. I first tried to use aliasing the get the actual method name called, but that didn't work and lead to the OP. I endded up writing another private method that defined all the public accessor/mutators using closures much like adrianh suggests above. Although my closures only call the ultimate _get_set method whereas you are putting the full code in the closure itself (I'll probably make that change since it will increase efficiency slightly and prevent users from calling _get_set directly -- with unpredictable results)

BTW - I thought about an AUTOLOAD for this purpose, but:

1. I don't believe AUTOLOADs do inheritance (correct me if I'm wrong) and I didn't want to have to create a separate AUTOLOAD for each class.
2. I wanted a similar mechanism for handling calls to abstract methods (i.e., if you manage to instantiate an abstract base class and then call one of it's abstract methods you should get feedback that is more helpful than "subroutine not found") and didn't want to confound the two functions into a single AUTOLOAD.
3. AUTOLOADs are messy.

[*] Related in the OO-sense, super-/sub-class relationships

--DrWhy

"If God had meant for us to think for ourselves he would have given us brains. Oh, wait..."

If I understand you right, the typical idiom to deal with the situation you describe is something like (untested):

package Foo;
# ...
my @fields = qw( eenie meenie minie moe );
make_accessor( $_ ) for @fields;
# ...
sub make_accessor {
  my $method = shift;
  my $sub = sub {
    # your accessor here;
  };
  my $class = caller;
  {
    no strict 'refs';
    *{ "$class\::$method" } = $sub;
  }
  return;
}
[download]

...which does not require the methods to know their names.

the lowliest monk

In addition to all the great ways described above, you can also use Sub::Uplevel with an extra function call. (Technically, Sub::Uplevel replaces caller with code that knows how to skip frames in the stack on request.)

use Sub::Uplevel;

sub MainSub {
    my $name = (caller 0)[3];
    print "My name is $name\n";
}

sub sub1 { uplevel 1, \&MainSub };
sub sub2 { uplevel 1, \&MainSub };
sub sub3 { uplevel 1, \&MainSub };

sub1();
sub2();
sub3();
[download]

Prints:

My name is main::sub1
My name is main::sub2
My name is main::sub3
[download]

One way could be to use closures. Here's an example snippet (untested):

for my $name (qw(sub1 sub2 sub3)) {
    my $n = $name; # it is important to declare a new scalar for each 
+subroutine you create
    *{$name} = sub { MainSub("sub1"); };
}
[download]