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