use v5.14; use warnings;

package Horse {
	# A little bit of metadata about the class. The constructor
	# uses this to find out what attributes the class supports.
	sub _attributes {
		my $class = shift;
		return ( qw( name colour ) );
	}
	
	# A fairly standard constructor, similar to MooseX::StrictConstructor
	sub new {
		my $class  = shift;
		my $self   = bless {}, $class;
		
		my %params = @_==1 ? %{$_[0]} : @_;
		$self->{$_} = delete($params{$_}) for $class->_attributes;
		
		die "Unknown parameter(s)... @{[ sort keys %params ]}"
			if keys %params;
		
		return $self;
	}
	
	# Accessors for our attributes, with lazy defaults
	sub name   { $_[0]->{name}   //= $_[0]->_build_name }
	sub colour { $_[0]->{colour} //= $_[0]->_build_colour }
	
	# Here are the default values for the attributes
	sub _build_name   { "Cloppity" }
	sub _build_colour { "brown" }
	
	# This is for debugging
	use JSON::PP;
	sub dump {
		my $self  = shift;
		my $class = ref $self;
		print JSON::PP->new->pretty(1)->canonical(1)->encode({
			__CLASS__ => $class,
			map(+($_ => $self->$_), $class->_attributes),
		});
	}
}

my $ed = Horse->new( name => "Mr Ed" );
$ed->dump;

package Unicorn {
	use parent -norequire, "Horse";
	
	# Add "horn" to the list of supported attributes.
	sub _attributes {
		my $class = shift;
		return (
			$class->SUPER::_attributes(@_),
			qw( horn ),
		);
	}
	
	# Accessor and default value for "horn" attribute.
	sub horn { $_[0]->{horn} //= $_[0]->_build_horn }
	sub _build_horn { "medium" }
	
	# override the default colour from Horse
	sub _build_colour { "lavender" }
}

my $ts = Unicorn->new( name => "Twilight Sparkle" );
$ts->dump;

# Note that this dies because of the typo!
my $pp = Unicorn->new( naem => "Pinkie Pie" );