|
0
|
1 =head1 NAME
|
|
|
2
|
|
|
3 Bio::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
|
|
|
13 This is a different version of the _rearrange() method from
|
|
|
14 Bio::Root::Root. It runs as a function call, rather than as a method
|
|
|
15 call, and it handles unidentified parameters slightly differently.
|
|
|
16
|
|
|
17 It exports a single function call:
|
|
|
18
|
|
|
19 =over 4
|
|
|
20
|
|
|
21 =item @rearranged_args = rearrange(\@parameter_names,@parameters);
|
|
|
22
|
|
|
23 The first argument is an array reference containing list of parameter
|
|
|
24 names in the desired order. The second and subsequent arguments are a
|
|
|
25 list of parameters in the format:
|
|
|
26
|
|
|
27 (-arg1=>$arg1,-arg2=>$arg2,-arg3=>$arg3...)
|
|
|
28
|
|
|
29 The function calls returns the parameter values in the order in which
|
|
|
30 they were specified in @parameter_names. Any parameters that were not
|
|
|
31 found in @parameter_names are returned in the form of a hash reference
|
|
|
32 in which the keys are the uppercased forms of the parameter names, and
|
|
|
33 the values are the parameter values.
|
|
|
34
|
|
|
35 =back
|
|
|
36
|
|
|
37 =head1 BUGS
|
|
|
38
|
|
|
39 None known yet.
|
|
|
40
|
|
|
41 =head1 SEE ALSO
|
|
|
42
|
|
|
43 L<Bio::DB::GFF>,
|
|
|
44
|
|
|
45 =head1 AUTHOR
|
|
|
46
|
|
|
47 Lincoln Stein E<lt>lstein@cshl.orgE<gt>.
|
|
|
48
|
|
|
49 Copyright (c) 2001 Cold Spring Harbor Laboratory.
|
|
|
50
|
|
|
51 This library is free software; you can redistribute it and/or modify
|
|
|
52 it under the same terms as Perl itself.
|
|
|
53
|
|
|
54 =cut
|
|
|
55
|
|
|
56 package Bio::DB::GFF::Util::Rearrange;
|
|
|
57
|
|
|
58 use strict;
|
|
|
59 require Exporter;
|
|
|
60 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
|
|
|
61 @ISA = 'Exporter';
|
|
|
62 @EXPORT_OK = qw(rearrange);
|
|
|
63 @EXPORT = qw(rearrange);
|
|
|
64
|
|
|
65 # default export
|
|
|
66 sub 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
|
|
|
107 1;
|
