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

  • Comment on Re: Inheritable configuration options.... but with default values?
  • Download Code

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
    I'm confused, in my book is new() reserved for object constructors not classes.

    Inheritance for classes should be easier done by

    use strict; use warnings; use Data::Dump qw/pp dd/; package Class1 { our %cfg = (a => 1, b=>2); sub cfg { %cfg } }; package Class2 { use parent -norequire, 'Class1'; our %cfg = ( %Class1::cfg, a=>11,c=>33 ); }; package Class3 { use parent -norequire, 'Class2'; our %cfg = ( %Class2::cfg, b=> 222 ); }; pp \%Class1::cfg, \%Class2::cfg, \%Class3::cfg; # **** THIS DOESN'T WORK package Class2b { use parent -norequire, 'Class1'; our %cfg = ( SUPER->cfg(), a=>11,c=>33 ); }; pp {Class1->cfg()}, \%Class2b::cfg;

    Please note that I couldn't make it work with SUPER, ( but I'm no SUPER expert anyway ;-)

    (
      { a => 1, b => 2 },
      { a => 11, b => 2, c => 33 },
      { a => 11, b => 222, c => 33 },
    )
    Can't locate object method "cfg" via package "SUPER" (perhaps you forgot to load "SUPER"?) at d:/tmp/pm/class_cfg.pl line 32.
    
    Compilation exited abnormally with code 255 at Fri Feb 21 00:04:51
    

    edit

    ah I misread perlobj

    > The SUPER modifier can only be used for method calls. You can't use it for regular subroutine calls or class methods:

    update

    This works, albeit with ugly syntax.

    ... package Class2b { use parent -norequire, 'Class1'; our %cfg = ( __PACKAGE__->SUPER::cfg(), a=>11,c=>33,n=>'2b' ); }; pp \%Class2b::cfg;

    { a => 11, b => 2, c => 33, n => "2b" }
    

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery

      You are using package variables (what other languages call static) and in your update you have the right syntax. If you had an object, the way to access its parent's package variable is stated in perlobj, at the place you quoted it: for a static method: $self->SUPER::save(); and for a package variable %{$self->SUPER::cfg};

      But package variables are not "object variables" or member variables (?whatever?). It would be better to store %cfg into $self's hash for at least one reason: inheritance is taken care by Perl for free. Whereas in your case, Perl takes care of the inheritance of Class1 into Class2 and YOU MUST (not forget to) take care of the inheritance of Class1's package variables. That's a lot of boiler work (for me ;) ).

      related: https://stackoverflow.com/questions/3109672/how-to-make-a-hash-available-in-another-module and Perl Inheritance & module variables . The latter in particular is similar to what you have shown.

        > But package variables are not "object variables" or member variables (?whatever?)

        yeah, but I tought that's what the OP asked for !?!

        > > > Basically i have a series of classes and subclasses, each level adding a bit more functionality to its parent and in each class i have behaviour which can be modified by configuration options which are specific to that class

        see? Class not Object.

        > That's a lot of boiler work (for me ;) ).

        Well my code was shorter than yours. ;)

        (...and I'm sure this could be even shortened further with some sugar)

        > and for a package variable %{$self->SUPER::cfg};

        I doubt it, according to the docs cfg here - i.e. the part after SUPER:: - must be a sub in the super class.

        Cheers Rolf
        (addicted to the Perl Programming Language :)
        Wikisyntax for the Monastery

      TIMTOWTDI

      use strict; use warnings; use Data::Dump qw/pp dd/; package Class1 { use constant cfg => { a => 1 }; }; package Class2 { use parent -norequire, 'Class1'; use constant cfg => { %{__PACKAGE__->SUPER::cfg}, b => 2 }; }; package Class3 { use parent -norequire, 'Class2'; use constant cfg => { %{__PACKAGE__->SUPER::cfg}, c => 3 }; sub meth { warn "a is ",cfg->{a} } }; pp Class1::cfg, Class2::cfg, Class3::cfg ; Class3->meth();
      ({ a => 1 }, { a => 1, b => 2 }, { a => 1, b => 2, c => 3 })
      a is 1 at d:/tmp/pm/class_cfg.pl line 18.
      

      Cheers Rolf
      (addicted to the Perl Programming Language :)
      Wikisyntax for the Monastery