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;