1package Data::Stag::Util; 2 3use Carp; 4use strict; 5use vars qw(@EXPORT_OK %EXPORT_TAGS); 6use base qw(Exporter); 7 8use vars qw($VERSION); 9$VERSION="0.14"; 10 11@EXPORT_OK = qw(rearrange); 12%EXPORT_TAGS = (all => [@EXPORT_OK]); 13 14sub rearrange { 15 my($order,@param) = @_; 16 17 # If there are no parameters, we simply wish to return 18 # an undef array which is the size of the @{$order} array. 19 return (undef) x $#{$order} unless @param; 20 21 # If we've got parameters, we need to check to see whether 22 # they are named or simply listed. If they are listed, we 23 # can just return them. 24 return @param unless (defined($param[0]) && $param[0]=~/^-\S/); 25 26 # Now we've got to do some work on the named parameters. 27 # The next few lines strip out the '-' characters which 28 # preceed the keys, and capitalizes them. 29 my $i; 30 for ($i=0;$i<@param;$i+=2) { 31 if (!defined($param[$i])) { 32 cluck("Hmmm in $i ".CORE::join(";", @param)." == ".CORE::join(";",@$order)."\n"); 33 } 34 else { 35 $param[$i]=~s/^\-//; 36 $param[$i]=~tr/a-z/A-Z/; 37 } 38 } 39 40 # Now we'll convert the @params variable into an associative array. 41 my(%param) = @param; 42 43 my(@return_array); 44 45 # What we intend to do is loop through the @{$order} variable, 46 # and for each value, we use that as a key into our associative 47 # array, pushing the value at that key onto our return array. 48 my($key); 49 50 foreach $key (@{$order}) { 51 $key=~tr/a-z/A-Z/; 52 my($value) = $param{$key}; 53 delete $param{$key}; 54 push(@return_array,$value); 55 } 56 57 # catch user misspellings resulting in unrecognized names 58 my(@restkeys) = keys %param; 59 if (scalar(@restkeys) > 0) { 60 carp("@restkeys not processed in rearrange(), did you use a 61 non-recognized parameter name ? "); 62 } 63 return @return_array; 64} 65 66 671; 68 69