Hi folks,
I've had a go a rolling my own subroutine validation code, and would welcome
any constructive comments on it.
My aim was to allow existing code to continue working using positional params,
as well as allowing varieties of -key=>value style arguments.
Gary
#!/usr/bin/perl -w
use strict;
my %_DEBUG=('new'=>0,'mysub'=>1);
my %_PARAMS=('mysub'=>'fred:s:others:a:');
# return debug info
sub debug {
my $caller=(caller(1))[3];
$caller=~s/^.*:://;
return (defined $_DEBUG{$caller}) ? $_DEBUG{$caller} : 0;
};
sub validate {
# work our who we are and what we want
my $caller=(caller(1))[3];
$caller=~s/^.*:://;
unless (defined $_PARAMS{$caller}) {
warn "validate: unknown routine $caller\n";
return undef;
}
my %resp=(); # hash to return
# now validate parameters
my $type=ref $_[0];
if ($type) { # hashref or arrayref
%resp=%{$_[0]};
} elsif ($_[0]=~/^-/) { # standard comma or arrow syntax
[EMAIL PROTECTED];
} else { # positional array passing
my @params=split(/:/,$_PARAMS{$caller});
while (@_) {
my $key=shift @params; # param name
my $type=shift @params; # string or array
if ($type eq 's') { # single value
$resp{$key}=shift @_;
} else { # handle array
if (ref $_[0]) { # hashref or arrayref
$resp{$key}=shift;
} else { # array
@[EMAIL PROTECTED]; # copy array to arrayref
$#_=-1; # then emty original array
}
}
} # while @_
}
foreach my $key (keys %resp) {
if ($key=~/^-(.*)$/) { # remove dash
$resp{$1}=$resp{$key}; # create correct key
delete $resp{$key}; # delete wrong one
}
}
return %resp;
};
sub mysub {
print "starting 'mysub'.\n" if (&debug);
my %resp=validate(@_);
return 0 unless (%resp);
foreach my $key (keys %resp) {
print "$key=$resp{$key}\n";
}
return 1;
}
print "1\n";
print "returned okay\n" if mysub(-fred=>'Ginger',-others=>{-ginger=>'Fred'});
print "2\n";
print "returned okay\n" if mysub(-fred,'Ginger',-others,'Fred');
print "3\n";
print "returned okay\n" if
mysub({-fred=>'Ginger',-others=>{-ginger=>'Fred'}});
print "4\n";
print "returned okay\n" if mysub(-fred=>'Ginger',-others=>{-ginger=>'Fred'});
--
Gary Stainburn
This email does not contain private or confidential material as it
may be snooped on by interested government parties for unknown
and undisclosed purposes - Regulation of Investigatory Powers Act, 2000
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
