I like the idea of having Objects as accessors. It struck me that traits could be of use here.
Here are two traits:
The Getter:
package Class::Trait::TGetter;
use strict;
use warnings;
use Class::Trait 'base';
sub get
{
my $self = shift;
return $self->{object}->{$self->{property}};
}
1;
and the Setter:
package Class::Trait::TSetter;
use strict;
use warnings;
use Carp;
our $VERSION = '0.03';
use Class::Trait 'base';
#this doesnt work as expected
#our %OVERLOADS = ( '=' => "set" );
sub set
{
my $self = shift;
my $value = shift;
if ( my $sub = $self->{validate} )
{
if ( &$sub ($value) )
{
#print "assign $value to $self->{property}\n";
$self->{object}->{$self->{property}} = $value;
}
else
{
croak "Illegal value assigned for property $self->{propert
+y}";
}
}
else
{
#print "assign $value to $self->{property}\n";
$self->{object}->{$self->{property}} = $value;
}
}
1;
These are be "consumed" by a GetterSetter (There could also be a pure Getter and a pure Setter) class:
package GetterSetter;
use strict;
use warnings;
use Class::Trait
(
'Class::Trait::TGetter' => {},
"Class::Trait::TSetter" => {}
);
sub new
{
my $class = shift;
my $self = {object=>shift, property=>shift, validate=>shift};
return bless $self, $class;
}
1;
This class can be used by other classes as accessor:
package Person;
use warnings;
use strict;
use GetterSetter;
sub new
{
my $class = shift;
my %args = @_;
my $self = bless {}, $class;
$self->age->set ( $args{age} || 0 );
$self->name->set ( $args{name} || "" );
return $self;
}
sub age
{
my $self = shift;
# return GetterSetter with validation
return GetterSetter->new($self, "age", sub { return $_[0] =~ /^[0-
+9]+$/ });
}
sub name
{
my $self = shift;
# return GetterSetter without validation
return GetterSetter->new($self, "name");;
}
Now the Person class can be used
use Person;
eval
{
my $p = Person->new(name => "holli", age => "30");
print $p->name->get, ", ", $p->age->get, "\n";
};
eval
{
my $p = Person->new();
$p->name->set("holli");
$p->age->set(30);
print $p->name->get, ", ", $p->age->get, "\n";
};
#this croaks "Can't modify non-lvalue subroutine call at..."
#but shouldn't because the setter should be overloaded
#Can you jump in [Ovid]?
eval
{
my $p = Person->new();
$p->name = "holli";
$p->age = 30;
print $p->name->get, ", ", $p->age->get, "\n";
};
print $@;
#croaks "Illegal value assigned for property age..."
eval
{
my $p = Person->new(name => "Santa Claus", age => "unknown");
print $p->name->get, ", ", $p->age->get, "\n";
};
print $@;
#croaks "Illegal value assigned for property age..."
eval
{
my $p = Person->new();
$p->name->set("Santa Claus");
$p->age->set ("unknown");
print $p->name->get, ", ", $p->age->get, "\n";
};
print $@;
Thoughts?