
hwnd
User
Jul 22, 2013, 6:08 PM
Post #12 of 14
(4582 views)
|
Re: [BillKSmith] Delete unwanted hash keys
[In reply to]
|
Can't Post
|
|
BillKSmith, FishMonger.. I have looked into hash validation and code correction and this is how I corrected and completely understand my code. I have prepared many cases for validation pass. First I store my required/allowed/default hash values into $opts. Next I check @_, testing whether the passed argument is a hash ref or even-valued list or croak if neither one are passed. If not @_ then croak on no passed arguments. Next I check if 'file' key is passed because its required, if not then croak on it. I then use grep with an @array to check for invalid arguments passed. Finally I loop through $opts keys and check if $args exist first then checking whether the value is allowed or not, or set the default values and return $args.
use strict; use warnings; foo->dump(file => 'file.txt'); # ok! sets the defaults ( type => 'aoh', head => 1 ) foo->dump(file => 'file.txt', type => 'hoa', head => 1); # ok! sets these values foo->dump(file => 'file.txt', type => 'abc', head => 1); # croaks, not an allowed value in type foo->dump(file => 'file.txt', type => 'hoa', head => 2); # croaks, not an allowed value in head foo->dump(type => 'hoa', head => 1); # croaks, file does not exists foo->dump(file => 'file.txt', id => 1, data => 1); # croaks, (id,data) invalid arguments
package foo; use Carp; sub dump { my $self = shift; my $args; my $opts = { file => 1, head => { default => 1, allowed => [0,1], }, type => { default => 'aoh', allowed => [qw(aoh hoa hoh aoa)] }, }; if (@_) { if (ref $_[0] eq 'HASH') { $args = $_[0]; } elsif (@_ % 2 == 0) { %$args = @_; } else { croak("Illegal arg: pass a hashref, or even-valued list!"); } } else { croak("No arguments specified!"); } croak("Argument 'file' is required!") unless exists $args->{file}; if ( my @junk = grep { not exists $opts->{$_} } keys %$args ) { croak("Unknown arguments (" . (join ", ", @junk) . ")") if @junk; } for my $k ( keys %$opts ) { if ( exists $args->{$k} ) { if (my $allow = $opts->{$k}->{allowed}) { croak("Value '$k': '$args->{$k}' not allowed!") unless grep { $args->{$k} eq $_ } @$allow; } } else { $args->{$k} = $opts->{$k}->{default}; } } use Data::Dumper; print Dumper $args; }
|