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; #### #!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 want'; 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';