1=head1 NAME
2
3Bio::DB::GFF::Util::Rearrange - rearrange utility
4
5=head1 SYNOPSIS
6
7 use Bio::DB::GFF::Util::Rearrange 'rearrange';
8
9 my ($arg1,$arg2,$arg3,$others) = rearrange(['ARG1','ARG2','ARG3'],@args);
10
11=head1 DESCRIPTION
12
13This is a different version of the _rearrange() method from
14Bio::Root::Root.  It runs as a function call, rather than as a method
15call, and it handles unidentified parameters slightly differently.
16
17It exports a single function call:
18
19=over 4
20
21=item @rearranged_args = rearrange(\@parameter_names,@parameters);
22
23The first argument is an array reference containing list of parameter
24names in the desired order.  The second and subsequent arguments are a
25list of parameters in the format:
26
27  (-arg1=>$arg1,-arg2=>$arg2,-arg3=>$arg3...)
28
29The function calls returns the parameter values in the order in which
30they were specified in @parameter_names.  Any parameters that were not
31found in @parameter_names are returned in the form of a hash reference
32in which the keys are the uppercased forms of the parameter names, and
33the values are the parameter values.
34
35=back
36
37=head1 BUGS
38
39None known yet.
40
41=head1 SEE ALSO
42
43L<Bio::DB::GFF>,
44
45=head1 AUTHOR
46
47Lincoln Stein E<lt>lstein@cshl.orgE<gt>.
48
49Copyright (c) 2001 Cold Spring Harbor Laboratory.
50
51This library is free software; you can redistribute it and/or modify
52it under the same terms as Perl itself.
53
54=cut
55
56package Bio::DB::GFF::Util::Rearrange;
57$Bio::DB::GFF::Util::Rearrange::VERSION = '1.7.7';
58use strict;
59require Exporter;
60use vars qw(@EXPORT @EXPORT_OK);
61use base qw(Exporter);
62@EXPORT_OK = qw(rearrange);
63@EXPORT = qw(rearrange);
64
65# default export
66sub rearrange {
67    my($order,@param) = @_;
68    return unless @param;
69    my %param;
70
71    if (ref $param[0] eq 'HASH') {
72      %param = %{$param[0]};
73    } else {
74      return @param unless (defined($param[0]) && substr($param[0],0,1) eq '-');
75
76      my $i;
77      for ($i=0;$i<@param;$i+=2) {
78        $param[$i]=~s/^\-//;     # get rid of initial - if present
79        $param[$i]=~tr/a-z/A-Z/; # parameters are upper case
80      }
81
82      %param = @param;                # convert into associative array
83    }
84
85    my(@return_array);
86
87    local($^W) = 0;
88    my($key)='';
89    foreach $key (@$order) {
90        my($value);
91        if (ref($key) eq 'ARRAY') {
92            foreach (@$key) {
93                last if defined($value);
94                $value = $param{$_};
95                delete $param{$_};
96            }
97        } else {
98            $value = $param{$key};
99            delete $param{$key};
100        }
101        push(@return_array,$value);
102    }
103    push (@return_array,\%param) if %param;
104    return @return_array;
105}
106
1071;
108