Identify the package a subroutine is being called from

[Herkum]

I have a base module that I want to auto-generate information depending on the package that is originating the call. However, I cannot think of anything that provides that context. Here is my non-working example:

#!/usr/bin/perl

use strict;
use warnings;

print "Calling: " . Calling::package_name() . "\n"; # Displays 'main' 
+and needs to be 'Calling'
print "Calling2: " . Calling2::package_name() . "\n"; # Displays 'main
+' and needs to be 'Calling2'

package Test;

sub package_name { return (caller)[0] } # What to replace caller with?

package Calling;

use base 'Test';

package Calling2;

use base 'Test';

Suggestions?

Update: kyle pointed out, that it complains about an undefined subroutine. It appears that you cannot inherit a subroutine and try to call it without passing either a blessed reference or the package name to it.

[pc88mxer]

You can get more information by calling caller in list context:

package Test:

sub package_name {
  my @c = caller(0);
  $c[3];
}

Although, the way you have set things up, this will return Test::package_name for both Calling->package_name and Calling2->package_name. Technically this is correct so you could add information about $_[0] in the result.

sub package_name {
  my @c = caller(0);
  "$c[3] (with self = $_[0])"
}

[moritz]

You can get more information by calling caller in list context

Actually (caller)[0] does call it in list context. The number of arguments to caller matters, though:

$ perl -wle 'sub foo { my @l = caller(); return scalar @l }; print foo
+()'
3
$ perl -wle 'sub foo { my @l = caller(0); return scalar @l }; print fo
+o()'
10

[pc88mxer]

You're right. How may we invoke caller? Let us count the ways:

  $package = caller;
  @info = caller;
    # -> ($package, $file, $line)
  $package = caller($i);
  @extra_info = caller($i);
    # -> ($pack, $file, $line, $sub, $hasargs, ...)

[moritz]

If you need that kind of information, you have to use the Package->subroutine() syntax (at least I think so). Then the package name is passed as the first argument, just like the object is in method calls.

[Herkum]

Well, I am adding code onto an existing module, and I cannot guarantee thats how they call the subroutine. It is driving me nuts because of it too! Otherwise that would have been the easy way to fix it.

[kyle]

The code snippet you posted does not execute for me.

Undefined subroutine &Calling::package_name called

It runs if I change Blah::package_name() to Blah->package_name(). The former will look for package_name only in the package you specify. The latter will look for it in the inheritance tree in the way you're talking about.

That being the case, moritz is correct. The package name you're looking for is the first thing in @_. If it's not there, then maybe you want __PACKAGE__.

If there's something I'm missing, please post some working code that shows the problem.

[Herkum]

No, you are correct, I made a bad assumption evidently. You HAVE to call the subroutine with a package name( or blessed reference) or it will blow up(at least when you are using inheritance).

It was not the answer I expected, but it is an answer.

[jettero]

Corollary, anyone have any idea how to get the calling object instance? I've always wanted that in perl. I don't think you can get it. It's called previous_object() in pike/lpc...

[pc88mxer]

The debugger certain can get the calling arguments, even if @_ has been modified (i.e. shifted).

Here's a solution using Devel::StackTrace:

use Devel::StackTrace;

sub calling_object {
  my $t = Devel::StackTrace->new;
  my $f;
  $f = $t->next_frame for (1..4);
  ($f->args)[0]
}

sub e {
  my $x = shift;
  print "x = $x\n";
  d('humma');
}

sub d {
  print "I was called by object ", calling_object(), "\n";
}

e('a', 'b', 'c');

[jettero]

Holy crap. That's exactly what I wanted. I should have asked years ago.

[chromatic]

This may work, depending on what happened to @_:

package DB;

sub get_calling_object
{
    my @foo = caller(2);
    return $DB::args[0]
}

Update: This needs the package declaration.

[jettero]

I do not understand what $DB::args[0] is, but I suspect this is intended to return the package name of the caller, not the instance of the caller object.