The following code is a package I wrote to logically (in my mind) handle default args, initialization, and most especially inheritance with regards to perl's OO. It assumes use of Class:MethodMaker 1.12 but the ideas should work regardless.

Class::MethodMaker defines your new and invokes 'init' on your subclass. My package _Inheritable defined 'init' and instead requires '_init' to be defined by inheriting subclasses. _Inheritable calls the _init method from baseclase up and makes sure an _init method isn't called twice (the 'diamond' class inheritance problem).

Default args are stored in our @DEFAULT_ARGS = ( ARG1 => "TEST"); The _init method builds up and caches the list of default args per package. The Args are built as a hierarchy as well, and thus if you inherit and override a default arg, it is handled.

hash_init is the Class::MethodMaker provided function that adds the args into $self so Class->new(-Arg1 => "Test"); works.

For the multiple args in the same format, you may want to think about writing a special Tie overtop a hash that adds a missing '-' and then converts the key to lower case. The Perl Cookbook has a case insensitive tied has example in 13.15.

In the code below, you could change the call $self->hash_init( @{$defaultCache{$class}}, @_ ); to be $self->hash_init( @{$defaultCache{$class}}, fixArgs(@_) ); where the fixArgs function implements your for loop functionality.

Few other notes:

• $self->{__init}{$package} stops init from being run twice on the same class instance.
• InitDebug is to let you see how your package hierarchy is being walked for debugging
• _init has no params beyond the OO $self
• Parents are computed once, so don't dynamically fiddle with @ISA
• Default args are determined once per package, so don't fiddle with @DEFAULT_ARGS at runtime.

package _Inheritable;
use strict;
use warnings;

BEGIN {
    use Exporter;
    our ( $VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS );

    $VERSION = sprintf "%d.%03d", q$Revision: 1.3 $ =~ /(\d+)/g;
    @ISA     = qw( Exporter );
    @EXPORT  = qw();
    %EXPORT_TAGS = ();     #eg: TAG => [ qw!name1 name2! ];
    @EXPORT_OK   = qw();
} ## end BEGIN


######################################################################
+###

use Class::MethodMaker 1.12;


our @DEFAULT_ARGS = ();

use Class::MethodMaker
  new_with_init => 'new',
  new_hash_init => 'hash_init',
  get_set       => [qw/ -java -static InitDebug /];


######################################################################
+###

{
    my %cache;
    my %defaultCache;

    sub init
    {
        my $self = shift;
        my $class = ref($self) || $self;
        my $package = __PACKAGE__;
        return $self if $self->{__init}{$package}++;
        $defaultCache{$class} = $self->_getDefaultArgs
          unless $defaultCache{$class};
        $self->hash_init( @{$defaultCache{$class}}, @_ );
        $cache{$class} = [grep { defined *{$_ . "::_init"} }
                            reverse( $class, $self->getParents )]
          unless exists $cache{$class};

        no strict 'refs';
        for ( @{$cache{$class}} ) {
            print "_Init($_)\n" if $self->getInitDebug;
            &{$_ . "::_init"}($self);
        }

        return $self;
    } ## end sub init
}


{

    sub _getParents
    {
        my $self = shift;
        my $class = ref($self) || $self;
        no strict 'refs';
        my @parents = @{$class . "::ISA"};
        my @acc;
        push @acc, @parents;
        for (@parents) {
            push @acc, _getParents($_);
        }
        return @acc;
    } ## end sub _getParents
}

{
    my %cache;

    sub getParents
    {
        my $self = shift;
        my $class = ref($self) || $self;
        my %seen;
        $cache{$class} = [grep { !$seen{$_}++ } _getParents($class)]
          unless exists $cache{$class};
        return @{$cache{$class}};
    } ## end sub getParents
}

{
    my %cache;

    sub _getDefaultArgs
    {
        my $self = shift;
        my $class = ref($self) || $self;
        return @{$cache{$class}} if exists $cache{$class};
        my @args;
        no strict 'refs';
        for ( $class, $self->getParents ) {
            next if /^Exporter$/;
            push @args, @{$_ . "::DEFAULT_ARGS"};
        }
        $cache{$class} = \@args;
        return \@args;
    } ## end sub _getDefaultArgs
}


1;
[download]