Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

What is a reliable way to get the package of the code creating a Moose object?

by nysus (Priest)
on Jul 12, 2018 at 04:10 UTC ( #1218356=perlquestion: print w/replies, xml ) Need Help??
nysus has asked for the wisdom of the Perl Monks concerning the following question:

I want a Moose object to behave differently depending upon which package has created the object. For example, if the "Teacher" package create the "Child" object, I want the "Child" object to behave different than if the "Parent" object created the "Child" object.

To accomplish this, I have something like the following code:

1 #! /usr/bin/env perl 2 use strict; 3 use warnings; 4 5 package Child; 6 use Moose; 7 8 has 'context' => (is => 'rw'); 9 10 sub BUILD { 11 my $s = shift; 12 my ($pkg) = caller 4; 13 $s->context('Teacher') if $pkg eq 'Teacher'; 14 $s->context('Parent') if $pkg eq 'Parent'; 15 } 16 17 package Teacher; 18 my $tom = Child->new(); 19 print $tom->context . "\n"; 20 21 package Parent; 22 my $kit = Child->new(); 23 print $kit->context . "\n";

This works, but it is dependent upon line 12 guessing that the original caller being 4 (5?) levels deep.If Moose internals change at all, the code will break. So I'm wondering if there might be a more reliable and documented way of accomplishing this. Or perhaps it's best to pass in the "context" as an argument to the constructor (though this seems like a less cool approach)? It also seems like this approach could have a proper name in computer science but I'm not aware of. If you can educate me, I'd appreciate it. Thanks!

$PM = "Perl Monk's";
$MCF = "Most Clueless Friar Abbot Bishop Pontiff Deacon Curate Priest";
$nysus = $PM . ' ' . $MCF;
Click here if you love Perl Monks

  • Comment on What is a reliable way to get the package of the code creating a Moose object?
  • Download Code

Replies are listed 'Best First'.
Re: What is a reliable way to get the package of the code creating a Moose object?
by choroba (Bishop) on Jul 12, 2018 at 07:06 UTC
    Checking the caller smells of bad design. Moreover, what should happen if the Child is created in, let's say, main, or worse, a descendant of Parent?

    I'd create a role for creating children, and let each class consume the role while parameterizing its child's context:

    #!/usr/bin/perl use warnings; use strict; use feature qw{ say }; { package Child::Creator; use MooseX::Role::Parameterized; parameter context => (isa => 'Str', required => 1); role { my ($p) = @_; my $context = $p->context; has _child_context => (is => 'ro', default => $context); sub create_child { 'Child'->new(context => shift->_child_context); } }; } { package Parent; use Moose; with 'Child::Creator' => {context => 'parent'}; __PACKAGE__->meta->make_immutable; } { package Teacher; use Moose; with 'Child::Creator' => {context => 'teacher'}; __PACKAGE__->meta->make_immutable; } { package Child; use Moose; use Moose::Util::TypeConstraints qw{ enum }; has context => (is => 'ro', required => 1, isa => enum([qw[ parent teacher ]])); __PACKAGE__->meta->make_immutable; } my $p = 'Parent'->new; my $ch_p = $p->create_child; say $ch_p->context; my $t = 'Teacher'->new; my $ch_t = $t->create_child; say $ch_t->context; # Attribute (context) is required at constructor Child::new (defined a +t ./1.pl line 44) line 30 my $ch = 'Child'->new; # Attribute (context) does not pass the type constraint because: Valid +ation failed for '__ANON__' with value "unknown" at constructor Child +::new (defined at ./1.pl line 44) line 39 my $ch = 'Child'->new(context => 'unknown');

    But you haven't described what you need the context for, there might be better ways to get there.

    Update:

    The parameterized role is not needed here, it just keeps the context closer to the role consumption. You can use a plain Moose role, too (but there are cases where you can't replace a parameterized role with a plain one):

    { package Child::Creator; use Moose::Role; requires 'child_context'; sub create_child { 'Child'->new(context => shift->child_context); } } { package Parent; use Moose; with 'Child::Creator'; sub child_context { 'parent' }; __PACKAGE__->meta->make_immutable; } ...

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

      Ah, very cool. Thanks.

      What I'm trying to achieve is to have the Child object behave differently depending on what created it. So if the Child object has a method called reply, it will respond with Yes, Mommy. if the Parent package created it and Yes, Teacher if the Teacher package created it. I was going to use the context property to determine how it the object should respond with something like this:

      sub reply { my $self = shift; if ($self->context eq 'teacher') { return "Yes, Teacher"; else { return "Yes, Mommy."; } }

      But as I think about it, this could get messy. I think what I really need to do is create a parent class for Child with default methods and then override those methods for the different type of Child subclasses. It would be nice to have the calling package be able to construct the correct Child subclass automatically I think I can use your suggestions here to help me achieve that.

      $PM = "Perl Monk's";
      $MCF = "Most Clueless Friar Abbot Bishop Pontiff Deacon Curate Priest";
      $nysus = $PM . ' ' . $MCF;
      Click here if you love Perl Monks

        Would it maybe help to have the Teacher create Pupil objects, and the Parent create Child objects? The Pupil could be an object that has a Child instance and reflects most methods, or it could inherit from the Child class?

        > I think what I really need to do is create a parent class

        The role is like an abstract parent class in this case. And you can "override" the method when consuming the role.

        ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
Re: What is a reliable way to get the package of the code creating a Moose object?
by (anonymized user) (Curate) on Jul 13, 2018 at 10:38 UTC
    Is there a reason why the caller can't set the context? e.g.
    use strict; use warnings; package Child; use Moose; has 'context' => (is => 'rw'); package Teacher; my $tom = Child->new(context => 'Teacher'); print $tom->context . "\n"; package Parent; my $kit = Child->new(context => 'Parent'); print $kit->context . "\n";

    One world, one people

      Better:

      package Child; # insert usual Moose stuff has context => (is => 'ro', isa => Str, init_arg => '_context', requir +ed => 1); sub new_for_parent { my $class = shift; $class->new(@_, _context => 'parent'); } sub new_for_teacher { my $class = shift; $class->new(@_, _context => 'teacher'); }

      The parent and teacher create the child via different constructors.

      (People don't think about creating custom constructors as often as they should.)

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (9)
As of 2018-09-21 17:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Eventually, "covfefe" will come to mean:













    Results (188 votes). Check out past polls.

    Notices?
    • (Sep 10, 2018 at 22:53 UTC) Welcome new users!