subroutine parameter validation

[Gary Stainburn]

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>