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

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,

Replies are listed 'Best First'.
Re^2: What is a reliable way to get the package of the code creating a Moose object?
by nysus (Parson) on Jul 12, 2018 at 13:32 UTC

    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?

        Yeah, it probably makes the most sense to do it like this. That would be a much more standard design pattern even if it's a little more boring.

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

      > 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,