Subclassing Class::MethodMaker to obtain "required" fields

rkg has asked for the wisdom of the Perl Monks concerning the following question:

Hi --

I am planning on using Class::MethodMaker like this:

package Simple;

use constant REQFIELDS => qw(a b);

use Class::MethodMaker
  get_set       => [REQFIELDS, qw(c d)],
  new_with_init => 'new',
  new_hash_init => 'hash_init';

sub init {
    my $self   = shift;
    my %values = (@_);
    foreach (REQFIELDS) {
        die "$_ doesn't exist" unless exists($values{$_});
    }
    $self->hash_init(%values);
    return;
}

1;
[download]

The idea is the object must define certain attributes at creation. Rather than start each class with this idiom, I was thinking of subclassing Class::MethodMaker as per the docs so I could specify certain get_set methods as 'required', such that the class would die if an object was created lacking these arguments.

The docs on subclassing C:MM leave me somewhat befuddled... Can anyone give me some suggestions how might I subclass C:MM to obtain this 'required' method functionality?

Thanks for any suggestions

rkg

Comment on Subclassing Class::MethodMaker to obtain "required" fields Download Code

Replies are listed 'Best First'.

Re: Subclassing Class::MethodMaker to obtain "required" fields
by rkg (Hermit) on Dec 15, 2003 at 04:27 UTC

package MakeMethod;

use strict;
use base qw( Class::MethodMaker );

sub new_hash_init_required {
    my ($class, @args) = @_;
    my %methods;
    foreach (@args) {
        $methods{$_} = sub {
            my $class = shift;
            my $self  = ref($class) ? $class : bless {}, $class;
            my %args  = (scalar @_ == 1 and ref($_[0]) eq 'HASH') ? %{
+$_[0]} : @_;
            foreach (keys %args) {
                if (my $setter = $class->can(" __CMM__ $_")) {
                    $setter->($self, $args{$_});
                } else {
                    $self->$_($args{$_});
                }
            }
            die "must specify required" unless $self->can("required");
            my @req = $self->required;
            foreach my $req (@req) {
                die "$req does not exist" unless exists($self->{$req})
+;
            }
            $self;
        };
    }
    $class->install_methods(%methods);
}

sub required {
    my ($class, @req) = @_;
    my %methods;
    $methods{required} = sub { @req };
    $class->get_set(@req);
    $class->install_methods(%methods);

}

1;
[download]

[reply]
[d/l]


Think about Loose Coupling
	PerlMonks