package Class::MethodMaker;
#
# $Id: MethodMaker.pm,v 2.18 1996/09/28 19:53:22 seibel Exp $
#
# Copyright (c) 1996 Organic Online. All rights reserved. This program is
# free software; you can redistribute it and/or modify it under the same
# terms as Perl itself.
=head1 NAME
B<Class::MethodMaker> - a module for creating generic methods
=head1 SYNOPSIS
use Class::MethodMaker
new_with_init => 'new',
get_set => [ qw /foo bar baz / ];
=head1 DESCRIPTION
This module solves the problem of having to write a bazillion get/set
methods that are all the same. The argument to 'use' is a hash whose keys
are the names of types of generic methods generated by MethodMaker and
whose values tell method maker what methods to make. (More precisely, the
keys are the names of MethodMaker methods (methods that write methods)
and the values are the arguments to those methods.
=cut
use strict;
use Carp;
use vars '$VERSION';
$VERSION = "0.90";
# Just to point out the existence of these variables
$Class::MethodMaker::Private::current_class = "";
# Set in import_into_class so meta-methods can know what class
# they're building into without having to pass the class as an
# argument to every meta-method
%Class::MethodMaker::Private::boolean_pos = ();
# A hash of the current index into the bit vector used in boolean for
# each class.
%Class::MethodMaker::Private::boolean_fields = ();
# A hash of refs to arrays which store the names of the bit fileds
# for a given class
sub ima_method_maker { 1 };
sub get_class {
# Find the class to add the methods to. I'm assuming that it would be
# the first class in the caller() stack that's not a subsclass of
# MethodMaker. If for some reason a sub-class of MethodMaker also
# wanted to use MethodMaker it could redefine ima_method_maker to
# return a false value and then $class would be set to it.
my $class;
my $i = 0;
while (1) {
$class = (caller($i))[0];
eval { not $class->ima_method_maker and last; };
if ($@) {
$@ =~ /Can\'t locate object method/ ? last : croak $@;
}
$i++;
}
$class;
}
sub import {
my ($sub_class, @args) = @_;
my $class = &get_class;
$sub_class->import_into_class($class, @args);
}
*make = \&import; # make make() an alias for import()
sub import_into_class {
no strict 'refs';
my ($sub_class, $class, @args) = @_;
# Hmmmmm. This might work.
$Class::MethodMaker::Private::current_class = $class;
# Each class needs to have their own copy of these variables but by the
# time we get to the meta-methods we've lost track of what class we're
# building methods for. Thus this hack.
$Class::MethodMaker::Private::boolean_pos{$class} ||= 0;
$Class::MethodMaker::Private::boolean_fields{$class} ||= [];
my $package = $class . "::";
# Make generic methods. The list passed to import should alternate
# between the names of the meta-method to call to generate the methods
# and the values which are passed to that method as it's argument. Most
# methods, if passed a list ref, will iterate over the list doing the
# same thing they would have to a simple scalar. But that is not
# required as some meta-methods will require more complicated
# aguments. Since the list passed into import is a list and not a hash,
# the same meta-method name can be used more than once.
# Each meta-method should return a hash of names to code references
# which will be installed in the class determined above.
my ($type, $arg);
my %methods;
while (1) {
$type = shift @args;
$type or last;
$arg = shift @args;
$arg or croak "No arg for $type in import of $sub_class.\n";
%methods = (%methods, $sub_class->$type($arg));
}
my ($name, $code);
while (($name, $code) = each %methods) {
*{"$package$name"} = $code;
}
}
## GENERIC METHODS ##
=head1 SUPPORTED METHOD TYPES
=head2 new
Creates a basic constructor.
Takes a single string or a reference to an array of strings as its
argument. For each string creates a method of the form:
sub <string> {
my ($class, @args) = @_;
my $self = {};
bless $self, $class;
}
=cut
sub new {
shift;
my ($arg) = @_;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
map {
$_,
sub {
my ($class, @args) = @_;
my $self = {};
bless $self, $class;
}
} @list;
}
=head2 new_with_init
Creates a basic constructor which calls a method named init after
instatiating the object. The I<init>() method should be defined in the class
using MethodMaker.
Takes a single string or a reference to an array of strings as its
argument. For each string creates a method of the form listed below.
sub <string> {
my ($class, @args) = @_;
my $self = {};
bless $self, $class;
$self->init(@args);
$self;
}
=cut
sub new_with_init {
shift;
my ($arg) = @_;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
map {
$_, sub {
my ($class, @args) = @_;
my $self = {};
bless $self, $class;
$self->init(@args);
$self;
}
} @list;
}
=head2 new_hash_init
Creates a basic constructor which accepts a hash of slot-name/value pairs
with which to initialize the object. The slot-names are interpreted as
the names of methods that can be called on the object after it is created
and the values are the arguments to be passed to those methods.
Takes a single string or a reference to an array of strings as its
argument. For each string creates a method of the form listed below. Note
that this method can be called on an existing objec, which allows it to
be combined with new_with_init (see above) to provide some default
values. (Basically, declare a new_with_init method, say 'new' and a
new_hash_init method, for example, 'hash_init' and then in the init
method, you can call modify or add to the %args hash and then call
hash_init.)
sub <string> {
my ($class, %args) = @_;
my $self = {};
bless $self, $class;
foreach (keys %args) {
$self->$_($args{$_});
}
$self;
}
=cut
sub new_hash_init {
shift;
my ($arg) = @_;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
map {
$_,
sub {
my ($class, %args) = @_;
my $self;
if (ref $class) {
$self = $class;
} else {
$self = {};
bless $self, $class;
}
foreach (keys %args) {
$self->$_($args{$_});
}
$self;
}
} @list
}
=head2 get_set
Takes a single string or a reference to an array of strings as its
argument. For each string, x creates two methods:
sub x {
my ($self, $new) = @_;
defined $new and $self->{$name} = $new;
$self->{$name};
}
sub clear_x
my ($self) = @_;
$self->{$name} = undef;
}
This is your basic get/set method, and can be used for slots containing
any scalar value, including references to non-scalar data. Note, however,
that MethodMaker has meta-methods that define more useful sets of methods
for slots containing references to lists, hashes, and objects.
=cut
sub get_set {
shift;
my ($arg) = @_;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
map {
my $name = $_;
($name,
sub {
my ($self, $new) = @_;
defined $new and $self->{$name} = $new;
$self->{$name};
},
"clear_$name",
sub {
my ($self) = @_;
$self->{$name} = undef;
},
)
} @list;
}
=head2 get_concat
Like get_set except sets don't clear out the original value, but instead
concatenate the new value to the existing one. Thus these slots are only
good for plain scalars. Also, like get_set, defines clear_foo method.
=cut
sub get_concat {
shift;
my ($arg) = @_;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
map {
my $name = $_;
($name,
sub {
my ($self, $new) = @_;
$self->{$name} ||= "";
defined $new and $self->{$name} .= $new;
$self->{$name};
},
"clear_$name",
sub {
my ($self) = @_;
$self->{$name} = undef;
},
)
} @list;
}
=head2 fields
Creates get/set methods like get_set but also defines a method which
returns a list of the slots in the group.
fields => {
group => 'group_name',
slots => [ qw / slot1 slot2 / ]
}
Takes a single hash-ref or a reference to an array of hash-refs as its
argument. Each hash-ref should have have the keys group and slots. The
group value is the name of the method which returns the list of slots and
the slots value should be an acceptable argument for get_set.
=cut
sub fields {
my ($class, $arg) = @_;
my %results;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
my $rhArg;
foreach $rhArg (@list) {
my $group = $rhArg->{'group'};
my $rhSlots = $rhArg->{'slots'};
%results = $class->get_set($rhSlots);
$results{$group} = sub { @$rhSlots };
}
%results;
}
=head2 object
Creates methods for accessing a slot that contains an object of a given
class as well as methods to automatically pass method calls onto the
object stored in that slot.
object => [
'Foo' => 'phooey',
'Bar' => [ qw / bar1 bar2 bar3 / ],
'Baz' => {
slot => 'foo',
comp_mthds => [ qw / bar baz / ]
},
];
This is a hairy one. The main argument should be a reference to an
array. The array should contain pairs of class => sub-argument
pairs. The sub-argument's are further parsed thusly:
If the sub-argument is a simple string or a reference to an array of
strings (as is the case for Foo and Bar above), for each string a get/set
method is created that can store an object of that class. (The get/set
method, if called with a reference to an object of the given class as the
first argument, stores it in the slot. If the slot isn't filled yet it
creates an object by calling the given class's new method. Any arguments
passed to the get/set method are passed on to new. In all cases the
object now stored in the slot is returned.
If the sub-argument is a ref to a hash (as with Baz, above) then the
hash should have two keys: slot and comp_mthds. The value indexed by
'slot' will be interpreted as the is in (a). The value or values (ref to
an array if plural) indexed by 'comp_mthds' are the names of methods
which should be "inherited" from the object stored in the slot. That is,
using the example above, a method, foo, is created in the class that
calls MethodMaker, which can get and set the value of a slot containing
an object of class Baz. Class Baz in turn defines two methods, 'bar', and
'baz'. Two more methods are created in the class using MethodMaker, named
'bar' and 'baz' which result in a call to the 'bar' and 'baz' methods,
through the Baz object stored in slot foo.
=cut
sub object {
shift;
my ($rlArg) = @_;
my %results;
while (1) {
my $class = shift @$rlArg; $class or last;
my $list = shift @$rlArg; $list or
croak "No list of methods for $class.\n";
my $ref = ref $list;
my @list;
if ($ref eq 'HASH') {
my $name = $list->{'slot'};
my $composites = $list->{'comp_mthds'} || $list->{'forward'};
@list = ($name);
my @composites = ref($composites) eq 'ARRAY'
? @$composites : ($composites);
my $meth;
foreach $meth (@composites) {
$results{$meth} =
sub {
my ($self, @args) = @_;
$self->$name()->$meth(@args);
};
}
} else {
@list = ref($list) eq 'ARRAY' ? @$list : ($list);
}
my $name;
foreach $name (@list) {
my $type = $class; # Hmmm. We have to do this for the closure to
# work. I.e. using $class in the closure dosen't
# work. Someday I'll actually understand scoping
# in Perl.
$results{$name} =
sub {
my ($self, @args) = @_;
if (ref $args[0] eq $class) { # This is sub-optimal. We should
# really use isa from
# UNIVERSAL.pm to catch
# sub-classes too.
$self->{$name} = $args[0];
} else {
defined $self->{$name} or $self->{$name} = $type->new(@args);
}
$self->{$name};
};
$results{"delete_$name"} =
sub {
my ($self) = @_;
$self->{$name} = undef;
};
}
}
%results;
}
=head2 boolean
boolean => [ qw / foo bar baz / ]
Creates methods for setting, checking and clearing flags. All flags
created with this meta-method are stored in a single vector for space
efficiency. The argument to boolean should be a string or a reference to
an array of strings. For each string x it defines several methods: x,
set_x, and clear x. x returns the value of the x-flag. If called with an
argument, it first sets the x-flag to the truth-value of the
argument. set_x is equivalent to x(1) and clear_x is equivalent to x(0).
Additionally, boolean defines three class method: I<bits>, which returns
the vector containing all of the bit fields (remember however that a
vector containing all 0 bits is still true), I<boolean_fields>, which returns
a list of all the flags by name, and I<bit_dump>, which returns a hash of
the flag-name/flag-value pairs.
=cut
sub boolean {
shift;
my ($arg) = @_;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
my %results = ();
my $field;
my $class = $Class::MethodMaker::Private::current_class;
my $boolean_fields = $Class::MethodMaker::Private::boolean_fields{$class};
$results{'bits'} =
sub {
my ($self, $new) = @_;
defined $new and $self->{'boolean'} = $new;
$self->{'boolean'};
};
$results{'bit_fields'} = sub { @$boolean_fields; };
$results{'bit_dump'} =
sub {
my ($self) = @_;
map { ($_, $self->$_()) } @$boolean_fields;
};
foreach $field (@list) {
my $bfp = $Class::MethodMaker::Private::boolean_pos{$class}++;
# $boolean_pos a global declared at top of file. We need to make
# a local copy because it will be captured in the closure and if
# we capture the global version the changes to it will effect all
# the closures. (Note also that it's value is reset with each
# call to import_into_class.)
push @$boolean_fields, $field;
# $boolean_fields is also declared up above. It is used to store a
# list of the names of all the bit fields.
$results{$field} =
sub {
my ($self, $on_off) = @_;
defined $self->{'boolean'} or $self->{'boolean'} = "";
if (defined $on_off) {
vec($self->{'boolean'}, $bfp, 1) = $on_off ? 1 : 0;
}
vec($self->{'boolean'}, $bfp, 1);
};
$results{"set_$field"} =
sub {
my ($self) = @_;
$self->$field(1);
};
$results{"clear_$field"} =
sub {
my ($self) = @_;
$self->$field(0);
};
}
%results;
}
=head2 listed_attrib
listed_attrib => [ qw / foo bar baz / ]
Like I<boolean>, I<listed_attrib> creates x, set_x, and clear_x
methods. However, it also defines a class method x_objects which returns
a list of the objects which presently have the x-flag set to
true. N.B. listed_attrib does not use the same space efficient
implementation as boolean, so boolean should be prefered unless the
x_objects method is actually needed.
=cut
sub listed_attrib {
shift;
my ($arg) = @_;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
my %results = ();
my $field;
foreach $field (@list) {
my %list = ();
$results{$field} =
sub {
my ($self, $on_off) = @_;
if (defined $on_off) {
if ($on_off) {
$list{$self} = $self;
} else {
delete $list{$self};
}
}
$list{$self} ? 1 : 0;
};
$results{"set_$field"} =
sub {
my ($self) = @_;
$self->$field(1);
};
$results{"clear_$field"} =
sub {
my ($self) = @_;
$self->$field(0);
};
$results{$field . "_objects"} =
sub {
values %list;
};
}
%results;
}
=head2 key_attrib
key_attrib => [ qw / foo bar baz / ]
Creates get/set methods like get/set but also maintains a hash in which
each object is stored under the value of the field when the slot is
set. If an object has a slot set to a value which another object is
already set to the object currently set to that value has that slot set
to undef and the new object will be put into the hash under that
value. (I.e. only one object can have a given key. The method find_x is
defined which if called with any arguments returns a list of the objects
stored under those values in the hash. Called with no arguments, it
returns a reference to the hash.
=cut
sub key_attrib {
shift;
my ($arg) = @_;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
my %results = ();
my $field;
foreach $field (@list) {
my %list = ();
$results{$field} =
sub {
my ($self, $new) = @_;
if (defined $new) {
# We need to set the value
if (defined $self->{$field}) {
# the object must be in the hash under its old value so
# that entry needs to be deleted
delete $list{$self->{$field}};
}
my $old;
if ($old = $list{$new}) {
# There's already an object stored under that value so we
# need to unset it's value
$old->{$field} = undef;
}
# Set our value to new
$self->{$field} = $new;
# Put ourself in the list under that value
$list{$new} = $self;
}
$self->{$field};
};
$results{"clear_$field"} =
sub {
my ($self) = @_;
delete $list{$self->{$field}};
$self->{$field} = undef;
};
$results{"find_$field"} =
sub {
my ($self, @args) = @_;
if (scalar @args) {
return @list{@args};
} else {
return \%list;
}
};
}
%results;
}
=head2 key_with_create
key_with_create => [ qw / foo bar baz / ]
Just like key_attrib except the find_x method is defined to call the new
method to create an object if there is no object already stored under any of the keys you give as arguments.
=cut
sub key_with_create {
shift;
my ($arg) = @_;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
my %results = ();
my $field;
foreach $field (@list) {
my %list = ();
$results{$field} =
sub {
my ($self, $new) = @_;
if (defined $new) {
# We need to set the value
if (defined $self->{$field}) {
# the object must be in the hash under its old value so
# that entry needs to be deleted
delete $list{$self->{$field}};
}
my $old;
if ($old = $list{$new}) {
# There's already an object stored under that value so we
# need to unset it's value
$old->{$field} = undef;
}
# Set our value to new
$self->{$field} = $new;
# Put ourself in the list under that value
$list{$new} = $self;
}
$self->{$field};
};
$results{"clear_$field"} =
sub {
my ($self) = @_;
delete $list{$self->{$field}};
$self->{$field} = undef;
};
$results{"find_$field"} =
sub {
my ($class, @args) = @_;
if (scalar @args) {
foreach (@args) {
$class->new->$field($_) unless defined $list{$_};
}
return @list{@args};
} else {
return \%list;
}
};
}
%results;
}
=head2 list
Creates several methods for dealing with slots containing list
data. Takes a string or a reference to an array of strings as its
argument and for each string, x, creates the methods: x, push_x, and
pop_x. The method x returns the list of values stored in the slot. In an
array context it returns them as an array and in a scalar context as a
reference to the array. If called with arguments, x will push them onto
the list. push_x and pop_x do about what you would expect.
=cut
sub list {
shift;
my ($arg) = @_;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
my %results = ();
my $field;
foreach $field (@list) {
$results{$field} =
sub {
my ($self, @list) = @_;
defined $self->{$field} or $self->{$field} = [];
push @{$self->{$field}}, map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @list;
# wantarray ? @{$self->{$field}} : $self->{$field}; # this is soooo cool!
@{$self->{$field}}; # no it's not. That was exposing the
# implementation, plus you couldn't say
# scalar $obj->field to get the number of
# items in it.
};
$results{"pop_$field"} =
sub {
my ($self) = @_;
pop @{$self->{$field}}
};
$results{"push_$field"} =
sub {
my ($self, @values) = @_;
push @{$self->{$field}}, @values;
};
$results{"shift_$field"} =
sub {
my ($self) = @_;
shift @{$self->{$field}}
};
$results{"unshift_$field"} =
sub {
my ($self, @values) = @_;
unshift @{$self->{$field}}, @values;
};
$results{"splice_$field"} =
sub {
my ($self, $offset, $len, @list) = @_;
splice(@{$self->{$field}}, $offset, $len, @list);
};
$results{"clear_$field"} =
sub {
my ($self) = @_;
$self->{$field} = [];
};
$results{"$ {field}_ref"} =
sub {
my ($self) = @_;
$self->{$field};
};
}
%results;
}
=head2 hash
Creates a group of methods for dealing with hash data stored in a
slot. Takes a string or a reference to an array of strings and for each
string, x, creates: x, x_keys, x_values, and x_tally. Called with no
arguments x returns the hash stored in the slot, as a hash in an array
context or as a refernce in a scalar context. Called with one argument it
treats the argument as a key and returns the value stored under that key,
or as a list of keys (if it is a reference to a list) and returns the
list of values stored under those keys. Called with more than one
argument, treats them as a series of key/value pairs and adds them to the
hash. x_keys returns the keys of the hash, and x_values returns the list
of values. x_tally takes a list of arguments and for each scalar in the
list increments the value stored in the hash and returns a list of the
current (after the increment) values.
=cut
sub hash {
shift;
my ($arg) = @_;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
my %results = ();
my $field;
foreach $field (@list) {
$results{$field} =
sub {
my ($self, @list) = @_;
defined $self->{$field} or $self->{$field} = {};
if (scalar @list == 1) {
my $key = shift @list;
if (ref $key) { # had better by an array ref
return @{$self->{$field}}{@$key};
} else {
return $self->{$field}->{$key};
}
} else {
while (1) {
my $key = shift @list;
defined $key or last;
my $value = shift @list;
defined $value or carp "No value for key $key.";
$self->{$field}->{$key} = $value;
}
wantarray ? %{$self->{$field}} : $self->{$field};
}
};
$results{"$ {field}s"} = $results{$field};
$results{$field . "_keys"} =
sub {
my ($self) = @_;
keys %{$self->{$field}};
};
$results{$field . "_values"} =
sub {
my ($self) = @_;
values %{$self->{$field}};
};
$results{$field . "_tally"} =
sub {
my ($self, @list) = @_;
defined $self->{$field} or $self->{$field} = {};
map { ++$self->{$field}->{$_} } @list;
};
$results{"add_$field"} =
sub {
my ($self, $attrib, $value) = @_;
$self->{$field}->{$attrib} = $value;
};
$results{"clear_$field"} =
sub {
my ($self, $attrib) = @_;
delete $ {$self->{$field}}{$attrib};
};
$results{"add_$ {field}s"} =
sub {
my ($self, %attribs) = @_;
my ($k, $v);
while (($k, $v) = each %attribs) {
$self->{$field}->{$k} = $v;
}
};
$results{"clear_$ {field}s"} =
sub {
my ($self, @attribs) = @_;
my $attrib;
foreach $attrib (@attribs) {
delete $ {$self->{$field}}{$attrib};
}
};
}
%results;
}
sub static_hash {
shift;
my ($arg) = @_;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
my %results = ();
my $field;
foreach $field (@list) {
my %hash;
$results{$field} =
sub {
my ($self, @list) = @_;
if (scalar @list == 1) {
my $key = shift @list;
if (ref $key) { # had better by an array ref
return @hash{@$key};
} else {
return $hash{$key};
}
} else {
while (1) {
my $key = shift @list;
defined $key or last;
my $value = shift @list;
defined $value or carp "No value for key $key.";
$hash{$key} = $value;
}
%hash;
}
};
$results{"$ {field}s"} = $results{$field};
$results{$field . "_keys"} =
sub {
my ($self) = @_;
keys %hash;
};
$results{$field . "_values"} =
sub {
my ($self) = @_;
values %hash;
};
$results{$field . "_tally"} =
sub {
my ($self, @list) = @_;
defined $self->{$field} or $self->{$field} = {};
map { ++$hash{$_} } @list;
};
$results{"add_$field"} =
sub {
my ($self, $attrib, $value) = @_;
$hash{$attrib} = $value;
};
$results{"clear_$field"} =
sub {
my ($self, $attrib) = @_;
delete $hash{$attrib};
};
$results{"add_$ {field}s"} =
sub {
my ($self, %attribs) = @_;
my ($k, $v);
while (($k, $v) = each %attribs) {
$hash{$k} = $v;
}
};
$results{"clear_$ {field}s"} =
sub {
my ($self, @attribs) = @_;
my $attrib;
foreach $attrib (@attribs) {
delete $hash{$attrib};
}
};
}
%results;
}
=head2 code
code => [ qw / foo bar baz / ]
Creates a slot that holds a code reference. Takes a string or a reference
to a list of string and for each string, x, creates a method B<x> which
if called with one argument which is a CODE reference, it installs that
code in the slot. Otherwise it runs the code stored in the slot with
whatever arguments (including none) were passed in.
=cut
sub code {
shift;
my ($arg) = @_;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
map {
my $name = $_;
($name,
sub {
my ($self, @args) = @_;
if (ref($args[0]) eq 'CODE') {
# Set the function
$self->{$name} = $args[0];
} else {
# Run the function on the given arguments
&{$self->{$name}}(@args)
}
}
)
} @list;
}
=head2 method
method => [ qw / foo bar baz / ]
Just like B<code>, except the code is called like a method, with $self as
it's first argument. Basically, you're creating a method which can be
different for each object. Which is sort of weird. But perhaps useful.
=cut
sub method {
shift;
my ($arg) = @_;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
map {
my $name = $_;
($name,
sub {
my ($self, @args) = @_;
if (ref($args[0]) eq 'CODE') {
# Set the function
$self->{$name} = $args[0];
} else {
# Run the function on the given arguments
&{$self->{$name}}($self, @args)
}
}
)
} @list;
}
=head 2 interface
interface => [ qw / foo bar baz / ]
=cut
sub abstract {
shift;
my ($arg) = @_;
my $class = $Class::MethodMaker::Private::current_class;
my @list = ref($arg) eq 'ARRAY' ? @$arg : ($arg);
map {
my $name = $_;
($name,
sub {
my ($self) = @_;
my $calling_class = ref $self;
die <<DIE;
Can't locate abstract method "$name" declared in "$class" via "$calling_class".
DIE
}
)
} @list;
}
=head1 ADDDING NEW METHOD TYPES
MethodMaker is a class that can be inherited. A subclass can define new
method types by writing a method that returns a hash of
method_name/code-reference pairs.
For example a simple sub-class that defines a method type
upper_case_get_set might look like this:
package Class::MethodMakerSubclass;
use strict;
use Class::MethodMaker;
@Class::MethodMakerSubclass::ISA = qw ( Class::MethodMaker );
sub upper_case_get_set {
shift; # we don't need the class name
my ($name) = @_;
my %results;
$results{$name} =
sub {
my ($self, $new) = @_;
defined $new and $self->{$name} = uc $new;
$self->{$name};
};
%results;
}
1;
=head1 VERSION
Class::MethodMaker v0.9
=cut
1;
__END__