Objects encapsulate data. This can include their name/id.

package Foo;

sub new {
   my ($class, $id) = @_;
   my $self = { id => $id };
   return bless $self, $class;
}

sub method {
   my ($self) = @_;
   ...
   if (...something went wrong...) {
      warn("$self->{id} rotted into a pile of mush\n");
   }
   ...
}
[download]

use Foo;
my $one = Foo->new('one');
my $second = Foo->new('two');
[download]

( If what you want to do is possible, it'll be hard, fragile and error prone. That's why I suggested this alternative. )

You could also modify this to save information from caller and store off the filename and line number where the constructor was called from if a more meaningful name isn't provided (of course I don't know offhand how that'd behave with subclasses . . .).

Maybe you can reliably do this with some B magic or something but there's no simple solution that I know of. For instance, consider the following code...

package P; 
sub new { bless {} } 
sub print_my_var { ... } 

package main; 
my $p = P->new(); 
my $q = $p; 
*r = $p;

$p->print_my_var(); 
$q->print_my_var();
$r->print_my_var();
[download]

What I want is: I'm working on a module to allow me create objects on the fly (I know there are a bunch of cpan modules that does exactly the same and better, but I was wondering how would that be, and also considered that a good learning experience) The point is that I'm using something like this (On my main class):

sub AUTOLOAD {
    my $_call = our $AUTOLOAD;
    $_call =~ s/.*:://;
    my $self = shift;
    my $param = shift;
    ...
    $self->{$_call} = $_param || return $self->{$_call};
}
[download]

So far, so good. But the problem is, that at some point, when I initialize a 'new' object, I define for it a list of available parameters, which will be then used as that object method. So, what I want is to raise a warning when I try to do something like

my $o = Foo->new(); #create new object
$o->Available_Param_List(["one", "two"]); #methods that should be avai
+lable to $o
$o->one('this will work ok');
$o->nope('this should print a warn on saying that nope is not availabl
+e for $o');
[download]

I want to avoid things like passing the var name to the constructor function or things like that... Thats why I been thinking that *maybe* there was a way to know the name of the variable that called to a package.

The traditional message is

Can't locate object method "nope" via package "Foo" (perhaps you forgo
+t to load "Foo"?) at file.pl line 4.
[download]

Why won't the following suffice?

Can't locate object method "nope" (perhaps you forgot to specify "nope
+" to Available_Param_List) at file.pl line 4.
[download]

Chances are you won't be calling nope more than one time per line, so you'll know exactly which object is giving the error.

Use Carp's croak to make the message appear to originate from the calling line.

#!/usr/bin/perl

my $o = Foo->new();

$o->available_methods([ qw/one two/]);

$o->one("This will work\n");
$o->two("This will work as well\n");
$o->three("This won't work\n");

package Foo;
use Carp;

my %Objs;
sub new {
        my $self = {};
        $Objs{$self} = {};
        bless $self, shift;
}

sub available_methods {
        my($self,$methods_ref) = @_;
        $Objs{$self}{methods} = $methods_ref;
}

sub DESTROY {
        my $self = shift;
        delete $Objs{$self};
}

sub AUTOLOAD {
        my $_call = our $AUTOLOAD;
        $_call =~ s/.*:://;
        my $self = shift;
        my $param = shift;
        if(grep /$_call/,@{ $Objs{$self}{methods} }) {
                print $param;
        }
        else {
                carp("Couldn't execute $_call\n");
        }
}
[download]

    my $param = shift;
    ...
    $self->{$_call} = $_param || return $self->{$_call};
[download]

I assume $param and $_param were supposed to be the same. That's a little obfuscated, and doesn't allow setting parameters to false values. A more typical way to do it is:

    # (after shifting everything but param)
    if (@_) {
        return $self->{$_call} = shift;
    } else {
        return $self->{$_call};
    }
[download]

{
    package Foo;

    sub new {
        my ($class, $id) = @_;
        my $self = { id => $id };
        my ($package) = caller;

        ${$callpkg."::".$id} = bless $self, $class;

        undef;
    }

    sub method {
        my ($self, $name) = @_;
        print $self->{id}, "\n";
    }
}

Foo->new('one');
Foo->new('second');

$one->method;
$second->method;
[download]

The problem with your solution is that it is installing global package variables into the calling module (or main script). Normally - and also in ikegami's post - you use local my variables for objects!

-- Hofmator

Code written by Hofmator and posted on PerlMonks is public domain. It is provided as is with no warranties, express or implied, of any kind. Posted code may not have been tested. Use of posted code is at your own risk.

warn "Error: \$self ..\n";

warn "Error: \$_[0] ..\n";
[download]