Beefy Boxes and Bandwidth Generously Provided by pair Networks DiBona
Think about Loose Coupling
 
PerlMonks  

How can I find the calling object?

by strider corinth (Friar)
on Nov 18, 2002 at 16:04 UTC ( #213775=perlquestion: print w/ replies, xml ) Need Help??
strider corinth has asked for the wisdom of the Perl Monks concerning the following question:

Hey, monks. In my code, I have one object calling a sub in another. I'd like the called sub to be able to find (without being told directly) a reference to the object that called it.

I've thought of a few ways to do it, but none of them are the Right Way. To filter out stuff I've thought of already (or that don't fit what I'm looking for), here are some constraints:
  1. The result must be a reference to the object which called the sub.
  2. The reference to the calling object must be obtained on the fly (no saving it anyplace first to be retrieved later).
  3. No changes may be made to the calling object (say, to have it pass $self to the receiving object).
Any takers?
--
Love justice; desire mercy.

Comment on How can I find the calling object?
Re: How can I find the calling object?
by Aristotle (Chancellor) on Nov 18, 2002 at 16:30 UTC
    You can find out who is calling you via caller but that only gives you the function, that is, method name. The problem is that the object reference is stored somewhere in that sub's lexicals.. you might be able to find it using PadWalker, but I doubt that such a solution can be generalized.

    Makeshifts last the longest.

      Perfect. Here's some proof of concept code:
      #!/usr/bin/perl package Caller; sub new { bless {}, 'Caller' } sub call { my( $self, $one ) = @_; $one->output; } sub output { "I am the Caller\n" } 1; package Called; use PadWalker 'peek_my'; sub new { bless {}, 'Called' } sub output { my $caller = peek_my( 1 )->{ '$self' }; #$h->{ '$self' }; print STDOUT $$caller->output(); } 1; package main; my $one = new Caller; my $two = new Called; $one->call( $two );
      This prints:
      I am the Caller.
      --
      Love justice; desire mercy.
        Perfect, so long as it is indeed called $self.. :)

        Makeshifts last the longest.

      I'm surprised that something like PadWalker is possible. I figured that the compiler would not retain the names at all at run-time.
Re: How can I find the calling object?
by Joost (Canon) on Nov 18, 2002 at 16:31 UTC
    You can't.

    What's wrong with:

    sub method { my ($self) = shift; my $object = Object->new; $object->method2($self,@other_args); }
    anyway?

    If you've got some special problem that needs this functionality, maybe there is another way to solve it.

    update: fixed typo.

    -- Joost downtime n. The period during which a system is error-free and immune from user input.
      It doesn't solve the problem. That's what's wrong with it. ;) The original calling object isn't made available to my receiving object.

      I'm working with a static package somebody else wrote. When a sub in my package is called, it needs to do something to the calling object. As dakkar pointed out (and you saw) it is possible. =) I think it ought to be easier, but I didn't (nor am I remotely qualified to) design the language I'm using.

      I'm wary, though, when I hear somebody say "it can't be done". It's very easy to prove something possible. It's near to impossible to prove that a thing is impossible. I do have a number of other ways to solve the problem, but they're all kludges. I want a better way, and I think it may well exist someplace. If it does, I expect the answer to come from the undocumented depths of the way Perl works, on a much lower level than I currently understand. But I do think it may be out there.
      --
      Love justice; desire mercy.
        I would probably rewrite the other package in this case, but if you really can't I would suggest using the caller/DB trick below. It's really nasty and somewhat underdocumented, but it will probably work.

        But in my view it's simple: the problem lies not in your code, it's in the other package. Fix the problem; fix the other package.

        -- Joost downtime n. The period during which a system is error-free and immune from user input.
Re: How can I find the calling object?
by dakkar (Hermit) on Nov 18, 2002 at 16:33 UTC

    This works, but is SOOOO wrong....

    It uses the debugger, and some little-documented side-effects of "caller"

    #!/usr/bin/perl -w package a; # the caller package sub new { return bless {},shift } sub call { my ($self,$other)=@_; $other->do_something; # calling the other. Notice: no $self } sub back { my $self=shift; print "I've been called back!\n"; print "And I have ",$self->{stuff},"\n"; } package b; # the called package use Data::Dumper; sub new { return bless {},shift } sub do_something { my $p=DB::get_args(); print Dumper($p); # this dumps the arguments of the caller (in this +case, a->call) $p->[0]->back() } package DB; # this MUST be called DB. It triggers magic in "caller" sub get_args { my @a=caller(2); # 2 because 0 is this, 1 is the one that called it, + 2 is the one we need. # no, you can't remove the assignment: the optimizer will kill the l +ine. return [@DB::args]; # @DB::args gets magically set to the param list +. } package main; $a=a->new;$b=b->new; $a->{stuff}='something'; $a->call(b); __END__

    Will print:

    $VAR1 = [ bless( { 'stuff' => 'something' }, 'a' ), 'b' ]; I've been called back! And I have something

    UPDATE: clarified the meaning of the DB package

      Very nice :-)

      Ok, so you can. That still doesnt mean that you should.

      In fact, I'm really curious why you would ever want this (except in the debugger ofcourse).

      -- Joost downtime n. The period during which a system is error-free and immune from user input.
Re: How can I find the calling object?
by broquaint (Abbot) on Nov 18, 2002 at 16:34 UTC
    This won't work as you're asking perl to remember the object that called a given method from another method. The only real solution to this is to pass it as argument to the given sub
    sub Foo::new { bless {bar => pop}, shift } sub Foo::call_bar { $_[0]->{bar}->some_method($_[0]); } sub Bar::new { bless [@_], shift } sub Bar::some_method { print "the object whose method called this method: $_[-1]\n"; } my $o = Foo->new( Bar->new(qw(a list of args)) ); $o->call_bar(); __output__ the object whose method called this method: Foo=HASH(0x8108174)
    I think this is about the simplest method for getting get the *same* object as that which the calling method was called with.
    HTH

    _________
    broquaint

    update: I sit corrected :)

Re: How can I find the calling object?
by demerphq (Chancellor) on Nov 19, 2002 at 12:32 UTC
    The method who_called() below will more or less do what you want. Caveats: Its not guaranteed to work. Read perlfunc::caller(). Note that there are some funky issues that mean you _cant_ reliable replace the overload::StrVal calls with plain old reference stringification.
    package NewObj; sub new { return bless {},$_[0] }; package Foo; our @ISA=qw(NewObj); sub call_bar { my ($self,$bar)=@_; $bar->who_called; } package Bar; use strict; use warnings; use overload; #VITAL! our @ISA=qw(NewObj); sub who_called { my ($self)=@_; package DB; unless (my (undef,undef,undef,$sub)=caller(1)) { print "Called from main\n"; } else { print "Called from $sub\n"; if (ref($DB::args[0]) and overload::StrVal($DB::args[0])=~/=/) { print "\tWhich is a method that was invoked on ".overload::Str +Val($DB::args[0])."\n"; } else { print "@DB::args"; } } } package main; my $obj1=Foo->new(); my $obj2=Bar->new(); print "OBJ1 (Foo) : ".overload::StrVal($obj1)."\n" $obj1->call_bar($obj2);
    HTH

    --- demerphq
    my friends call me, usually because I'm late....

      Note that there are some funky issues that mean you _cant_ reliable replace the overload::StrVal calls with plain old reference stringification.

      Do go on...

        To coin a phrase, a snippet is worth a thousand words...
        package Foo; use overload qw("" stringify fallback 1 + zero); sub stringify { "overload.pm just ruined your day!" } sub zero { 0 } package main; my $foo1=bless {},'Foo'; my $foo2=bless {},'Foo'; sub same { "'$_[0]' is ".($_[0] eq $_[1] ? "the same as" : "different +to" )." '$_[1]'\n" }; print same(0+$foo1,0+$foo2); print same($foo1,$foo2); print same("$foo1","$foo2"); print same(overload::StrVal($foo1),overload::StrVal($foo2)); __END__ '0' is the same as '0' 'overload.pm just ruined your day!' is the same as 'overload.pm just r +uined your day!' 'overload.pm just ruined your day!' is the same as 'overload.pm just r +uined your day!' 'Foo=HASH(0x1acef84)' is different to 'Foo=HASH(0x1acf038)'
        :-)

        AFAIK, the _only_ non-xs way to reliably determine the underlying variable type and class of an overloaded object is to parse the results of overload::StrVal. Even then you get nowhere with reblessed qr// objects. (Which still act as regexes at the same time.)

        Frankly the fact that perl completely lacks any reliable native perl way of doing type introspection is IMO one of its few serious failings. (And no, at least some of the problems do not go away with Scalar::Utils and List::Utils.)

        --- demerphq
        my friends call me, usually because I'm late....

Re: How can I find the calling object?
by adrianh (Chancellor) on Nov 19, 2002 at 14:18 UTC

    I'm a little curious about your constraints...

    1. The result must be a reference to the object which called the sub.
    2. The reference to the calling object must be obtained on the fly (no saving it anyplace first to be retrieved later).
    3. No changes may be made to the calling object (say, to have it pass $self to the receiving object).

    While they have provided some interesting (if somewhat baroque :-) solutions, I'd love to know what causes them in your particular instance?

    For example, why can't you use Hook::LexWrap to temporarily override the method in question to stash the object somewhere for your later use (which would violate constraint (2) and (3)?

    Just curious :-)

      Hehe. Ok. Quite a few people appear to be interested. Here goes:

      I'm writing an LDAP browser using Tk. My goal is to use ONLY the standard Tk:: modules and Net::LDAP, for reasons relating to the architectures I'm designing it for. Halfway through production, though, I designed a really cool (I think) new interface for it, which requires widgets totally unavailable in the standard Tk module set. I needed to make them myself.

      During one attempt to create such a derivative widget, I needed to teach a widget that doesn't properly support scrolling to update the scrollbar I had attached to it when it received the yview() call. But since I was doing the binding myself (and hadn't yet discovered the ConfigSpecs command) the only way to tell the widget where the scrollbar was was to set $widget->{ scrollbar } to a reference to the scrollbar widget, and use that to address it. That method was messy, and just the Wrong Way To Do It, in my mind. Since I was using the standard Tk modules, and only happened to be doing a minor adjustment to one widget, I didn't want to modify it extensively enough to use LexWrap or anything else (not that I knew about LexWrap at the time =).

      That was what got me thinking about finding the calling object. It's the sort of thing which would've been useful to me in some other places, and I figured there must be a way. Turns out there are at least three.

      I'm very new at making derivative Tk widgets. Awhile after I posted, I found out about ConfigSpecs. Being able to use that solved a lot of problems that finding the calling object would've created, so I ended up using it instead.

      In the end, I wasn't looking for an answer to the problem I have just explained. I had already thought of ways to store and retrieve the object, and didn't want to be told that that's how I should do it. That's why I posted the question I did.
      --
      Love justice; desire mercy.
        Turns out there are at least three.

        Er, i would say the three you mentioned are the same, with subtle differences, but essentially the same.

        BTW, my personal feeling is that avoiding having to do this is the best way to proceed, but i understand your constraints.

        Yves

        --- demerphq
        my friends call me, usually because I'm late....

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://213775]
Approved by broquaint
Front-paged by Aristotle
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (10)
As of 2014-04-21 12:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (494 votes), past polls