view release on metacpan or  search on metacpan

ARS/nparm.pm  view on Meta::CPAN

    }
    return @att;
}

# rearrange(order, params)
#  order will be an array reference (might contain other array refs)
#  that lists the order we want the params returned in.
# 
#  param is the actual params, probably as (-key, value) pairs.

sub rearrange {
  my($order,@param) = @_;
  return () unless @param;
  my($param, @possibilities);

  foreach (@$order) {
    if(ref($_) && (ref($_) eq "ARRAY")) {
      foreach my $P (@{$_}) {
	push @possibilities, $P;
      }
    } else {
      push @possibilities, $_;
    }
  }

  #print "possibilities=".join(',', @possibilities)."\n";

  unless (ref($param[0]) eq 'HASH') {
    return @param unless (defined($param[0]) && substr($param[0],0,1) eq '-');
    $param = {@param};                # convert into associative array
  } else {
    $param = $param[0];
  }

  my($key)='';
  
  foreach (keys %{$param}) {
    my $old = $_;
    s/^\-//;     # get rid of initial - if present
    tr/a-z/A-Z/; # parameters are upper case
    next if $_ eq $old;
    $param->{$_} = $param->{$old};
    delete $param->{$old};
  }

  # scan the keys in param and make sure they are valid. 

  foreach my $key (keys %$param) {
    #print "validating: $key\n";
    my (@t) = grep(/^$key$/, @possibilities);
    Carp::confess( "invalid named parameter \"$key\"" ) if $#t == -1;
  }  

  my(@return_array);

  foreach $key (@$order) {
    #print "key=$key\n";

    my($value);
    # this is an awful hack to fix spurious warnings when the
    # -w switch is set.
    if (ref($key) && ref($key) eq 'ARRAY') {
      foreach (@$key) {
	last if defined($value);
	$value = $param->{$_};
	delete $param->{$_};
      }
    } else {
      $value = $param->{$key};
      delete $param->{$key};
    }
    push(@return_array,$value);
  }
  push (@return_array,make_attributes($param)) if %{$param};
  return (@return_array);
}

1;