comment on

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;
[download]

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';
[download]

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.

Cheers,
Ovid

New address of my CGI Course.

In reply to Re: A Class:: module (sample implementation) by Ovid
in thread A Class:: module I don't want to write by Ovid

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Come for the quick hacks, stay for the epiphanies.
	PerlMonks