Note that there are some explanatory texts on larger screens.

plurals
  1. PO
    text
    copied!<p>First, one best practice for writing objects based on hashrefs is to prefix all fields with the package name, e.g.</p> <pre><code>package Parent; sub new { my ($class, $x, $y) = @_; bless { "Parent::x" =&gt; $x, "Parent::y" =&gt; $y } =&gt; $class; } sub x { shift()-&gt;{"Parent::x"} } sub y { shift()-&gt;{"Parent::y"} } </code></pre> <p>In that case, the issue doesn't arise, as every class has its own attribute namespace. But who writes his classes that way?</p> <p>There are two ways I can think of to circumvent any problems: Proxying the original object via Autoload, or using inside-out object patterns. The third solution is to use prefixed attributes in your class, and hope that the parent never ever uses these names.</p> <h3>Inside-Out Objects</h3> <p>An inside-out object uses the blessed reference as an ID, and stores the attributes in lexical variables inside your class:</p> <pre><code>package Child; use Scalar::Util qw/refaddr/; use parent 'Parent'; my %foo; sub new { my ($class, $foo, @args) = @_; my $self = $class-&gt;SUPER::new(@args); $foo{refaddr $self} = $foo; return $self; } sub foo { my ($self) = @_; $foo{refaddr $self}; } sub set_foo { my ($self, $val) = @_; $foo{refaddr $self} = $val; } sub DESTROY { my ($self) = @_; # remove entries for this object delete $foo{refaddr $self}; $self-&gt;SUPER::DESTROY if $self-&gt;SUPER::can('DESTROY'); } </code></pre> <p>This is a slightly dated pattern, but it works extremely well for your use case.</p> <h3>Proxy objects</h3> <p>We can contain a parent instance in a field of our class (i.e. both has-a and is-a relationship). Whenever we encounter unknown methods, we delegate to that object:</p> <pre><code>package Child; use Parent (); our $SUPER = 'Parent'; use Carp; sub new { my ($class, $foo, @args) = @_; bless { parent =&gt; $SUPER-&gt;new(@args), foo =&gt; $foo, } =&gt; $class; } sub foo { my ($self) = @_; $self-&gt;{foo}; } sub set_foo { my ($self, $val) = @_; $self-&gt;{foo} = $val; } # manually establish pseudo-inheritance # return true if our class inherits a given package sub isa { my ($self, $class) = @_; return !!1 if $class eq __PACKAGE__; return +(ref $self ? $self-&gt;{parent} : $SUPER)-&gt;isa($class); } # return a coderef to that method, or false sub can { my ($self, $meth) = @_; my %methods = (new =&gt; \&amp;new, foo =&gt; \&amp;foo, set_foo =&gt; \&amp;set_foo, DESTROY =&gt; \&amp;DESTROY); if (my $code = $methods{$meth}) { return $code; } # check parent my $code = ( ref $self ? $self-&gt;{parent} : $SUPER)-&gt;can($meth); return undef unless $code; return sub { my $self = shift; unshift @_, ref $self ? $self-&gt;{parent} : $self; goto &amp;$code; }; } # write explicit destroy to satisfy autoload sub DESTROY { my ($self) = @_; $self-&gt;{parent}-&gt;DESTROY if ref $self and $SUPER-&gt;can('DESTROY'); } sub AUTOLOAD { # fetch appropriate method coderef my $meth = our $AUTOLOAD; $meth =~ s/.*:://; # clean package name from name my $code = $_[0]-&gt;can($meth); $code or croak qq(Can't locate object method "$meth" via package "@{[__PACKAGE__]}"); goto &amp;$code; } </code></pre> <p>The ugly part is to fake methods defined in superclasses in the <code>can</code> code: We have to wrap the actual method inside a anonymous sub that unpacks our object to call the method on the proxied object. The <code>goto</code>s make our extra levels invisible to the called code, which is neccessary when somebody uses <code>caller</code>.</p> <p>Most of this boilerplate proxying code can be abstracted into another module (and probably is, somewhere on CPAN).</p>
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload