package Data::Stag::Util; use Carp; use strict; use vars qw(@EXPORT_OK %EXPORT_TAGS); use base qw(Exporter); use vars qw($VERSION); $VERSION="0.09"; @EXPORT_OK = qw(rearrange); %EXPORT_TAGS = (all => [@EXPORT_OK]); sub rearrange { my($order,@param) = @_; # If there are no parameters, we simply wish to return # an undef array which is the size of the @{$order} array. return (undef) x $#{$order} unless @param; # If we've got parameters, we need to check to see whether # they are named or simply listed. If they are listed, we # can just return them. return @param unless (defined($param[0]) && $param[0]=~/^-\S/); # Now we've got to do some work on the named parameters. # The next few lines strip out the '-' characters which # preceed the keys, and capitalizes them. my $i; for ($i=0;$i<@param;$i+=2) { if (!defined($param[$i])) { cluck("Hmmm in $i ".CORE::join(";", @param)." == ".CORE::join(";",@$order)."\n"); } else { $param[$i]=~s/^\-//; $param[$i]=~tr/a-z/A-Z/; } } # Now we'll convert the @params variable into an associative array. my(%param) = @param; my(@return_array); # What we intend to do is loop through the @{$order} variable, # and for each value, we use that as a key into our associative # array, pushing the value at that key onto our return array. my($key); foreach $key (@{$order}) { $key=~tr/a-z/A-Z/; my($value) = $param{$key}; delete $param{$key}; push(@return_array,$value); } # catch user misspellings resulting in unrecognized names my(@restkeys) = keys %param; if (scalar(@restkeys) > 0) { carp("@restkeys not processed in rearrange(), did you use a non-recognized parameter name ? "); } return @return_array; } 1;