While waiting for responses, I through together a small sample implementation. It assumes that you will set pass single arguments to setters:
So far, no one's commented on the obvious bug. It's fixed in the current version I'm working on.
package Class::BuildMethods;
use strict;
use warnings;
my %value_for;
sub import {
my $class = shift;
my ($callpack) = caller();
while (@_) {
my $method = shift;
my $constraints;
my $validation_sub;
if ( 'HASH' eq ref $_[0] ) {
$constraints = shift;
if ( exists $constraints->{default} ) {
$value_for{$callpack}{$method} = delete $constraints->
+{default};
}
if ( exists $constraints->{validate} ) {
$validation_sub = delete $constraints->{validate};
}
if ( my @keys = keys %$constraints ) {
require Carp;
Carp::croak(
"Unknown constraint keys (@keys) for ${callpack}::
+$method");
}
}
no strict 'refs';
if ($validation_sub) {
*{"${callpack}::$method"} = sub {
my $self = shift;
return $value_for{$callpack}{$method} unless @_;
my $new_value = shift;
$self->$validation_sub($new_value);
$value_for{$callpack}{$method} = $new_value;
return $self;
};
}
else {
*{"${callpack}::$method"} = sub {
my $self = shift;
return $value_for{$callpack}{$method} unless @_;
$value_for{$callpack}{$method} = shift;
return $self;
};
}
}
}
1;
And the tests:
#!perl
use Test::More qw/no_plan/;
BEGIN {
chdir 't' if -d 't';
unshift @INC, '../lib';
}
{
package Foo;
use Class::BuildMethods qw(name rank);
}
my $foo = bless {}, 'Foo';
can_ok $foo, 'name';
ok !defined $foo->name, '... and its default value should be undefined
+';
ok $foo->name('Ovid'), '... and we should be able to set the name';
is $foo->name, 'Ovid', '... and later retrieve it';
$foo = bless [], 'Foo';
can_ok $foo, 'rank';
ok !defined $foo->rank, '... and its default value should be undefined
+';
ok $foo->rank('private'), '... and we should be able to set the rank';
is $foo->rank, 'private', '... and later retrieve it';
{
package Foo::Bar;
use Class::BuildMethods poet => { default => 'Publius Ovidius' };
}
my $foo_bar = bless \do { my $anon_scalar }, 'Foo::Bar';
can_ok $foo_bar, 'poet';
is $foo_bar->poet, 'Publius Ovidius',
'... and we should be able to set default values';
ok $foo_bar->poet("John Davidson"),
'... and we should be able to set a new value';
is $foo_bar->poet, 'John Davidson', '... and fetch the default value';
{
package Drinking::Customer;
use Class::BuildMethods age => {
validate => sub { shift; die "Too young" unless $_[0] >= 21 }
};
}
my $customer = bless [], 'Drinking::Customer';
can_ok $customer, 'age';
eval { $customer->age(19) };
ok $@, '... and we should be able to provide validation';
like $@, qr/Too young/, '... and have any sort of error message we wan
+t';
ok $customer->age(21), '... but we should be able to set the values';
is $customer->age, 21, '... and later retrieve them';
eval <<"END_PACKAGE";
package Bogus::Package;
use Class::BuildMethods name => { no_such_key => 1 };
END_PACKAGE
ok $@, 'Trying to use unknown constraint for methods should fail';
like $@, qr/\QUnknown constraint keys (no_such_key) for Bogus::Package
+::name/,
'... with an appropriate error message';
Note that it makes no assumptions about how you implement your objects. You can use blessed anonymous scalars, hashrefs, whatever. It also makes no assumption about how you want to validate your code. It's very lightweight and thus very flexible.
