Mercurial > repos > mahtabm > ensembl
comparison variant_effect_predictor/Bio/DB/GFF/Util/Rearrange.pm @ 0:1f6dce3d34e0
Uploaded
| author | mahtabm |
|---|---|
| date | Thu, 11 Apr 2013 02:01:53 -0400 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:1f6dce3d34e0 |
|---|---|
| 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; |
