in reply to Inheritable configuration options.... but with default values?
Fellow monks showed you how to do it with Moo. I will show you how to do it without any OO system.
# Simple OO example with inheritance # author: bliako # for https://perlmonks.org/?node_id=11113260 # 02-20-2020 package Class1 { use warnings; use strict; sub new { my ($class, $config) = @_; print "Class1 called.\n"; my $self = { # set an error handler to be used by error(). # NOTE: anonymous subs are not member subs, so you +can't access $self... on_error => sub { print "on_error() : exiting with msg '$_[ +0]'\n"; exit(1); }, name => "<no-name-set>", }; bless $self => $class; # my idiomatic way to remember bless or +der, i.e. bless $self, $class $self->_init_from_config($config); return $self; } sub _init_from_config { my $self = shift; my $config = shift; # a hashref of config params return unless defined $config; for (keys %$config){ $self->{$_} = $config->{$_}, print "config: set '".$_."'.\ +n" if exists $self->{$_} } } sub myname { return $_[0]->{name} } sub error { my $self = shift; print "error() : called with $self, my name is ".$self->myname +()."\n"; $self->{on_error}->(@_); } } package Class2 { use warnings; use strict; use parent -norequire, 'Class1'; sub new { my ($class,$config) = @_; print "Class2 called.\n"; my $self = $class->SUPER::new($config); $self->{name} = "my name is Class2"; return $self; } } package Class3 { use warnings; use strict; use parent -norequire, 'Class2'; sub new { my ($class,$config) = @_; print "Class3 called.\n"; my $self = $class->SUPER::new($config); $self->{on_error} = sub { print "on_error() : warning with msg '$_[0]'\n"; }; return $self; } } package main; use warnings; use strict; use Data::Dumper; my $c2 = Class2->new(); my $c3 = Class3->new({ name => 'my name is Jack' }); print "here is c2:\n".Dumper($c2); $c3->error("oops for c3"); $c2->error("oops for c2"); print "you will not see this (because c2's error handler inherits c1's + which will exit()).\n";
bw, bliako
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^2: Inheritable configuration options.... but with default values?
by LanX (Saint) on Feb 20, 2020 at 23:06 UTC | |
by bliako (Abbot) on Feb 21, 2020 at 00:03 UTC | |
by LanX (Saint) on Feb 21, 2020 at 00:24 UTC | |
by LanX (Saint) on Feb 21, 2020 at 00:45 UTC |