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