in reply to Point me in the right direction with OO inheritance and static variables

Generally speaking your best bet is to use something like Moose's concept of defaults/builders. Here's an example of how you can implement something very similar using only core modules:

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::StrictConstruc
+tor
    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" );

[download]
toby döt ink
  • Comment on Re: Point me in the right direction with OO inheritance and static variables
  • Download Code

Replies are listed 'Best First'.
Re^2: Point me in the right direction with OO inheritance and static variables
by AppleFritter (Vicar) on Sep 02, 2014 at 10:54 UTC 
    # ...

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

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

    [download]

    I wholeheartedly approve.

[reply]
[d/l]
Re^2: Point me in the right direction with OO inheritance and static variables
by Amblikai (Scribe) on Sep 02, 2014 at 11:41 UTC

    Wow! Thanks! This is pretty much exactly what i'm thinking of with some minor modification (i wish my program was about Unicorns called Twilight Sparkle!!

    I'm having trouble following your subs "name", "colour" etc though.

    Could you explain those? I'm guessing that if i attempt to get the value of "name" before i've assigned it a value, it'll call the _build_X sub and so return a default value. But i'm not entirely sure how it does it? Also i've never seen the "//=" operator before.

    Thanks!

[reply]

      I've written them in quite a terse fashion. This is because when you're doing OO without any OO frameworks, you end up having to write a lot of these sort of little accessor subs, and making them as abbreviated as possible keeps you sane. Writing out the name sub in full might be:

      sub name {
   my $self = shift;
   if (not defined $self->{name}) {
      $self->{name} = $self->_build_name();
   }
   return $self->{name};
}

      [download]

      But if you're writing similar accessors for dozens of different attributes, it's nice to abbreviate them so they fit on a line each:

      sub name   { $_[0]->{name}   //= $_[0]->_build_name }
sub colour { $_[0]->{colour} //= $_[0]->_build_colour }
sub owner  { $_[0]->{owner} }           # this one has no default
sub height { $_[0]->{height} //= 2.5 }  # another way to provide a def
+ault
...;

      [download]

      Slight diversion...

      The disadvantage of the second way of doing defaults (shown above) is it makes the default harder to override when you create a subclass. If the height had been defaulted via $_[0]->_build_height then when we decided to write a Pony::Shetland class, we could simply override _build_height to return a different default value (maybe 1.2?). But with the default 2.5 hard-coded into the height sub itself, we need to override height in Pony::Shetland.

      Obviously, overriding the height sub in Pony::Shetland is perfectly possible. It's technically no more difficult than overriding _build_height. However, overriding _build_height rather than height seems preferable because OO code tends to be more maintainable when you're only overriding very small targeted bits of functionality.

      As an example, let's assume that Pony::Shetland overrides height from Horse. Now somebody goes and releases a new version of Horse with a brand new feature. It allows:

      my $aj      = Horse->new(name => "Applejack");
my $metres  = $aj->height( in => "metres" );
my $inches  = $aj->height( in => "inches" );
my $hands   = $aj->height( in => "hands" );
my $silly   = $aj->height( in => "lightyears" );

      [download]

      Nice piece of new functionality, eh? However, Pony::Shetland overrides height, so the new functionality doesn't work there! There's something called the Liskov substitution principle that says anything that works with the base class should work with subclasses. So we've broken that principle.

      If Pony::Shetland was just overriding _build_height, we would never have gotten ourselves into this quandary. The new height would still work in Pony::Shetland.

      End of slight diversion!

      Regarding //=... the // and //= operators were introduced in Perl 5.10. // is much the same as || but rather than testing the truthiness of the left hand value, it tests the definedness. The number 0 and the empty string are defined but false, so if you wanted to be able to have horses with a name "0", this distinction could be important.

      $foo //= $bar is shorthand for $foo = ($foo // $bar), so it means the same as if (not defined $foo) { $foo = $bar }.

      toby döt ink
[reply]
[d/l]
[select]

        Thanks again, it all makes sense now!

        I've since found that i have another problem though. I was running with an older version of perl(5.8.8) and it didn't like some of the code. I've since upgraded locally to 5.20 and i've had to recompile my local modules but i think i have it working now.

        The problem that i'm having is that my script can't find the parent class file.

        In my main script i have the following:

        use ChildObjects;
use ParentObjects;

        [download]

        I then have the 2 files: ChildObjects.pm and ParentObjects.pm

        Inside the ParentObjects.pm file i have:

        package ParentObjects;

        Inside the ChildObjects.pm file i have:

        package ChildObjects;
use parent -norequire, "ParentObjects";

        [download]

        When i then try in my script:  my $obj=ChildObjects->new(); But i get the following error from my script: Can't locate package ParentObjects for @ChildObjects::ISA at ./script.pl line 54

        Can you help? Am i naming/calling my package files wrong?

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom