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

[nysus]

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!

[choroba]

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;
}

...

[nysus]

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.

[Corion]

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?

[choroba]

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

[anonymized user 468275]

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";

[tobyink]

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.)