sub one {
my ($self, $value) = @_;
$self->{one} = $value if defined $value;
return $self->{one} // 1;
}
sub two {
my ($self, $value) = @_;
$self->{two} = $value if defined $value;
return $self->{two} // 2;
}
# and so on...
####
package Dynamic;
use warnings;
use strict;
BEGIN {
my %sub_info = (
one => 1,
two => 2,
three => 3,
four => 4,
five => 5,
);
no strict 'refs';
for (keys %sub_info) {
my $sub_name = $_; # Take a copy of the key, which is the sub name
*$_ = sub {
my ($self, $value) = @_;
$self->{$sub_name} = $value if defined $value;
return $self->{$sub_name} // $sub_info{$sub_name};
};
}
}
sub new {
return bless {}, $_[0];
}
1;
__END__
##
##
use warnings;
use strict;
use feature 'say';
use lib '.';
use Dynamic;
my $dyn = Dynamic->new;
say "Manual calls";
say $dyn->one;
say $dyn->two;
# Or even
say "Stringified calls";
for (qw(one two three four five)) {
if ($_ eq 'three') {
# Update the value of the 'three' method
$dyn->three(99);
}
printf "sub $_: %d\n", $dyn->$_();
}
##
##
spek@scelia ~/repos/scripts/perl/dynamically_auto_generate_subs $ perl dyn.pl
Manual calls
1
2
Stringified calls
sub one: 1
sub two: 2
sub three: 99
sub four: 4
sub five: 5
##
##
BEGIN {
# Auto generate the stdout() and stderr() methods, and their private
# helper counterparts
no strict 'refs';
for ('stdout', 'stderr') {
my $sub_name = $_;
# Public
*$_ = sub {
my ($self) = @_;
if (! wantarray) {
warn "Calling $sub_name() in non-list context is deprecated!\n";
}
return defined $self->{$sub_name}{data}
? split /\n/, $self->{$sub_name}{data}
: @{[ () ]}; # Empty list
};
# Private
my $private_sub_name = "_$sub_name";
*$private_sub_name = sub {
my ($self) = @_;
my $HANDLE = uc $sub_name;
open $self->{$sub_name}{handle}, ">&$HANDLE"
or die "can't hook " . uc $sub_name . ": $!";
close $HANDLE;
open $HANDLE, '>>', \$self->{$sub_name}{data} or die $!;
};
}
}