Bio/DB/GFF/Util/Rearrange.pm

   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(@EXPORT @EXPORT_OK);
  61 use base qw(Exporter);
  62 @EXPORT_OK = qw(rearrange);
  63 @EXPORT = qw(rearrange);
  64 use Bio::Root::Version;
  65
  66 # default export
  67 sub rearrange {
  68     my($order,@param) = @_;
  69     return unless @param;
  70     my %param;
  71
  72     if (ref $param[0] eq 'HASH') {
  73       %param = %{$param[0]};
  74     } else {
  75       return @param unless (defined($param[0]) && substr($param[0],0,1) eq '-');
  76
  77       my $i;
  78       for ($i=0;$i<@param;$i+=2) {
  79         $param[$i]=~s/^\-//;     # get rid of initial - if present
  80         $param[$i]=~tr/a-z/A-Z/; # parameters are upper case
  81       }
  82
  83       %param = @param;                # convert into associative array
  84     }
  85
  86     my(@return_array);
  87
  88     local($^W) = 0;
  89     my($key)='';
  90     foreach $key (@$order) {
  91         my($value);
  92         if (ref($key) eq 'ARRAY') {
  93             foreach (@$key) {
  94                 last if defined($value);
  95                 $value = $param{$_};
  96                 delete $param{$_};
  97             }
  98         } else {
  99             $value = $param{$key};
 100             delete $param{$key};
 101         }
 102         push(@return_array,$value);
 103     }
 104     push (@return_array,\%param) if %param;
 105     return @return_array;
 106 }
 107
 108 1;