#!/usr/bin/env perl use 5.010_001; use strict; use warnings; package My::Base; use mro; our %conf; sub new { my ($class) = @_; bless {} => $class; } sub configure { my ($class, $opts) = @_; { no strict 'refs'; %{$class . '::conf'} = (%{$class . '::conf'}, %$opts); } $_->configure($opts) for @{mro::get_isarev($class)}; return; } package My::Trunk; use parent -norequire, 'My::Base'; our %conf; package My::Branch_A; use parent -norequire, 'My::Trunk'; our %conf; package My::Branch_B; use parent -norequire, 'My::Trunk'; our %conf; package main; # Everything after here is for demo purposes only. use Data::Dump; say '*** Normal instantiation'; say 'My::Base object: ', My::Base::->new(); say 'My::Trunk object: ', My::Trunk::->new(); say 'My::Branch_A object: ', My::Branch_A::->new(); say 'My::Branch_B object: ', My::Branch_B::->new(); say "\n*** My::Base::->configure({A => 1});"; My::Base::->configure({A => 1}); _show_configs(); say "\n*** My::Trunk::->configure({B => 2, C => 3});"; My::Trunk::->configure({B => 2, C => 3}); _show_configs(); say "\n*** My::Branch_A::->configure({A => 'me', D => 4});"; My::Branch_A::->configure({A => 'me', D => 4}); _show_configs(); say "\n*** My::Branch_B::->configure({B => 'me', E => 5});"; My::Branch_B::->configure({B => 'me', E => 5}); _show_configs(); sub _show_configs { say 'My::Base::conf'; dd \%My::Base::conf; say 'My::Trunk::conf'; dd \%My::Trunk::conf; say 'My::Branch_A::conf'; dd \%My::Branch_A::conf; say 'My::Branch_B::conf'; dd \%My::Branch_B::conf; }