# 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 => "", }; bless $self => $class; # my idiomatic way to remember bless order, 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";