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