package NameProto; use strict; use base qw(Base::Decorator); sub new { my $self = shift->SUPER::new(@_); $self->{age} = 0; no strict 'refs'; my $package = ref($self->{base}); *{$package . '::name'} = sub { my ($self, $name) = @_; $self->{name} = $name if defined $name; return $self->{name}; }; return bless $self, $package; } sub name { return shift->{base}->name(@_); } 1;