1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
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.14";
@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;
|
