|
|
- package MethodSpit;
-
- use strict;
- use warnings;
- no warnings 'uninitialized';
-
- sub methodspit {
- my ($class, @names) = @_;
-
- # These are simple accessors.
- foreach my $name (@names) {
- makemethod($class, $name);
- }
-
- return;
- }
-
- # Handy-dandy basic closure:
- sub makemethod {
- my ($class, $name) = @_;
-
- no strict 'refs';
-
- # Install a generated sub:
- *{ "${class}::${name}" } =
- sub {
- my ($self, $param) = @_;
- $self->{$name} = $param if defined $param;
- return $self->{$name};
- }
- }
-
- sub methodspit_depend {
- my ($class, $dependency, $names) = @_;
-
- my %names = %{ $names };
-
- foreach my $name (keys %names) {
- my $default = $names{$name};
- makemethod_depend($class, $dependency, $name, $default);
- }
- }
-
-
- # A more complicated closure. Makes a return value dependent on another
- # method, if not already explicitly defined.
-
- sub makemethod_depend {
- my ($class, $dependency, $name, $default) = @_;
-
- no strict 'refs';
-
- *{ "${class}::${name}" } =
- sub {
- my ($self, $param) = @_;
-
- if (defined $param) {
- $self->{$name} = $param;
- }
-
- if (defined $self->{$name}) {
- return $self->{$name};
- } else {
- return $self->$dependency . $default;
- }
- }
-
- # return;
- }
-
- 1;
-
- =pod
-
- =head1 NAME
-
- MethodSpit - quickie method generation
-
- =head1 SYNOPSIS
-
- =head1 DESCRIPTION
-
- The following bits are cheap method generation, in place of using
- Class::Accessor or Object::Tiny.
-
- =cut
|