I've hacked up a class to be inherited from allowing me to parse an input hash, verify that each key value pair passes a regex for that key, and access keys by method name.
The third capability (accessing keys by method name) is giving my mind fits right now (possibly because it's almost 5:00 A.M). I'd like to be able to call
$o->parameters->user, and access the user attribute held in the object $o (Note: not $o->parameters).
$self->{'params'}->{$_} would access it inside a subroutine. How would I 'fake' an object, so as to have
$o->parameters->user return
$o->{'params'}->{'user'}, and have
$o->parameters->user('Jeffory') change
$o->{'params'}->{'user'} to Jeffory, after validating it with a subroutine in my class (so, in fact
$o->{'params'}->{'user'} = $o->validate('Jeffory'); ) In other words, the parameters method has to return an object that has access to the class it's currently in, parses the method called on it, and executes the code (the object could be self, but I'd prefer not to do that, as I'd like to allow people to use _anything_, even new or validate, as a parameter--it's probably what I'll end up doing, though):
return $o->{'param'}->{$method};
The easiest way ( I guess?) to do that would be to create a 'false' object, that captures the method call, but is actually in the class that $o is in, and therefore can call its methods...? Any ideas if that's available?
Obviously, there's a major design flaw in this class, but humor me (or give me advice on the code, which I've posted below--the code probably doesn't work, I've been freewriting it, which means there are probably spelling errors, and important logic errors ) :)
package Input::SignUp;
our @ISA = qw/Input/;
use strict;
use warnings;
sub _init {
$_[0]->make_methods(
'user' => [ qr/^[a-zA-Z0-9]+$/, 'Username may only contain alphanu
+meric characters' ],
'password' => [ qr/^[a-zA-Z0-9]+$/, 'Password may only contain alp
+hanumeric characters' ],
'key' => [ qr/^[a-fA-F0-9]+$/, 'Key may only contain A-F alphanume
+ric characters' ],
);
}
1;
package Input;
use strict;
use warnings;
use Want;
sub new {
my $self = bless {}, shift;
$self->{'params'} = Parameters->new;
$self->_init;
$self;
}
sub make_methods {
$self = shift;
my %methods = @_;
for (keys %methods) {
my($p,$re,$error) = $methods{$_};
$self->{'regex'}->{$p} = $re;
$self->{'error'}->{$p} = $error;
}
}
sub validate {
$self = shift;
my %input = @_;
$self->{'params'}->{$_} = $self->_validate($input{$_},$_}) for keys
+%input;
}
sub _validate {
$_[1] =~ $_[0]->{'regex'}->{$_[2]} or $_[0]->error($_[2],$_[0]->{'er
+ror'}->{$_[2]});
$1;
}
sub error {
my $self = shift;
push @{$self->{'errors'}}, [ @_ ] and return 1 if scalar @_ == 2;
return scalar @{$self->{'errors'}};
}
sub error_hash {
my @loop_data;
for (@{$self->{'errors'}}) {
push(@loop_data, { 'ERROR' => ucfirst $_->[0].' Error: '.$_->[1] }
+ )
for @{$self->{'errors'} };
}
return ( 'ERRORS' => \@loop_data );
}
sub parameters {
my $self = shift;
return bless [], if want('OBJECT'); # Single Param.
# This is where I'm stuck. Ideally, the object would be called
# as $o->parameters->user('Bob'), or something like that. Then
# We'd validate the parameter, using the key 'user'. It's rather
# simple to do, by just changing parameters->user to parameters->('u
+ser','bob'),
# but I don't want that!
}
1;
|
Re: Capturing Method Call, And Relaying.
by tachyon (Chancellor) on Jan 03, 2004 at 11:26 UTC
|
As you say it is bad design. Why not just call a user method on the object - this method just needs to know where to go for its data? But as (almost) always Perl will accomodate you.
package Bad::Design;
use Data::Dumper;
my $o = Bad::Design->new();
print Dumper $o;
print $o->parameters->user, $/;
$o->parameters->user('Matt Wright');
print $o->parameters->user, $/;
sub new { bless { 'params' => { user => 'Randal Schwartz' } }, shift }
sub parameters { bless $_[0]->{'params'}, ref($_[0]) }
sub user{ $_[0]->{'user'} = $_[1] if defined $_[1]; $_[0]->{'user'} }
__DATA__
$VAR1 = bless( {
'params' => {
'user' => 'Randal Schwartz'
}
}, 'Bad::Design' );
Randal Schwartz
Matt Wright
| [reply]
[d/l] |
Re: Capturing Method Call, And Relaying.
by tachyon (Chancellor) on Jan 04, 2004 at 05:20 UTC
|
Have a look at this, it may be the sort of thing you are looking for:
package OO;
my $properties = {
'user' => [ qr/^[a-zA-Z0-9]+$/, 'Username may only contain alphanu
+meric characters' ],
'password' => [ qr/^[a-zA-Z0-9]+$/, 'Password may only contain alp
+hanumeric characters' ],
'key' => [ qr/^[a-fA-F0-9]+$/, 'Key may only contain A-F alphanume
+ric characters' ],
};
$o = OO->new( user => 'username' );
$o->password( 'secret' );
$o->key( '***Invalid' );
$o->no_exist( 'foo' );
print "Password: ", $o->password(), $/;
print "Input errors:\n" . $o->error() if $o->error();
use Data::Dumper;
print Dumper $o;
sub new {
my $class = shift;
my $self = { error => '' };
bless $self, $class;
$self->init(@_) if @_;
return $self;
}
sub init {
my ( $self, %props ) = @_;
for my $prop ( keys %props ) {
my $value = $props{$prop};
$self->$prop( $value );
}
}
sub AUTOLOAD {
my ( $self, $value ) = @_;
my ( $method ) = $AUTOLOAD =~ m/::([^:]+)$/;
if ( $properties->{$method} ) {
if ( defined $value ) {
# its a set method
if ( $value =~ m/$properties->{$method}->[0]/ ) {
$self->{$method} = $value;
}
else {
$self->error( $properties->{$method}->[1] . "\n" );
}
}
else {
# we have a get method
return $self->{$method};
}
}
else {
$self->error("Unknown method $method called from " . (join ' '
+, caller()) . "\n" );
}
}
sub error {
my ( $self, $error ) = @_;
$self->{error} .= $error if $error;
return $self->{error};
}
__DATA__
Password: secret
$VAR1 = bless( {
'error' => 'Key may only contain A-F alphanumeric cha
+racters
Unknown method no_exist called from OO C:\\PROGRA~1\\PERLBU~1\\debug\\
+oo 15
',
'password' => 'secret',
'user' => 'username'
}, 'OO' );
Input errors:
Key may only contain A-F alphanumeric characters
Unknown method no_exist called from OO C:\PROGRA~1\PERLBU~1\debug\oo 1
+5
| [reply]
[d/l] |
