comparison variant_effect_predictor/Bio/EnsEMBL/Utils/Argument.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 LICENSE
2
3 Copyright (c) 1999-2012 The European Bioinformatics Institute and
4 Genome Research Limited. All rights reserved.
5
6 This software is distributed under a modified Apache license.
7 For license details, please see
8
9 http://www.ensembl.org/info/about/code_licence.html
10
11 =head1 CONTACT
12
13 Please email comments or questions to the public Ensembl
14 developers list at <dev@ensembl.org>.
15
16 Questions may also be sent to the Ensembl help desk at
17 <helpdesk@ensembl.org>.
18
19 =cut
20
21 =head1 NAME
22
23 Bio::EnsEMBL::Utils::Argument - Utility functions for argument handling
24
25 =head1 SYNOPSIS
26
27 use Bio::EnsEMBL::Utils::Argument qw(rearrange)
28
29 package Feature;
30
31 sub new {
32 my $class = shift;
33 my ( $start, $end, $strand ) =
34 rearrange( [ 'START', 'END', 'STRAND' ], @_ );
35
36 return
37 bless( { 'start' => $start, 'end' => $end, 'strand' => $strand },
38 $class );
39 }
40
41 =head1 DESCRIPTION
42
43 This is derived from the Bio::Root module in BioPerl. The _rearrange
44 object method taken from BioPerl has been renamed rearrange and is now
45 a static class method. This method was originally written by Lincoln
46 Stein, and has since been refactored several times by various people (as
47 described below).
48
49 It is recommended that this package be used instead of inheriting
50 unnecessarily from the Bio::EnsEMBL::Root or Bio::Root object.
51
52 =head1 METHODS
53
54 =cut
55
56 package Bio::EnsEMBL::Utils::Argument;
57
58 use strict;
59 use warnings;
60
61 use Exporter;
62
63 use vars qw(@ISA @EXPORT);
64
65 @ISA = qw(Exporter);
66 @EXPORT = qw(rearrange);
67
68
69
70 =head2 rearrange
71
72 Usage : rearrange( array_ref, list_of_arguments)
73 Purpose : Rearranges named parameters to requested order.
74 Example : use Bio::EnsEMBL::Utils::Argument qw(rearrange);
75 : rearrange([qw(SEQUENCE ID DESC)],@param);
76 : Where @param = (-sequence => $s,
77 : -id => $i,
78 : -desc => $d);
79 Returns : @params - an array of parameters in the requested order.
80 : The above example would return ($s, $i, $d)
81 Argument : $order : a reference to an array which describes the desired
82 : order of the named parameters.
83 : @param : an array of parameters, either as a list (in
84 : which case the function simply returns the list),
85 : or as an associative array with hyphenated tags
86 : (in which case the function sorts the values
87 : according to @{$order} and returns that new array.)
88 : The tags can be upper, lower, or mixed case
89 : but they must start with a hyphen (at least the
90 : first one should be hyphenated.)
91 Source : This function was taken from CGI.pm, written by Dr. Lincoln
92 : Stein, and adapted for use in Bio::Seq by Richard Resnick and
93 : then adapted for use in Bio::Root::Object.pm by Steve A. Chervitz.
94 : This has since been adapted as an exported static method in this
95 class Bio::EnsEMBL::Utils::Argument
96 Comments : (SAC)
97 : This method may not be appropriate for method calls that are
98 : within in an inner loop if efficiency is a concern.
99 :
100 : Parameters can be specified using any of these formats:
101 : @param = (-name=>'me', -color=>'blue');
102 : @param = (-NAME=>'me', -COLOR=>'blue');
103 : @param = (-Name=>'me', -Color=>'blue');
104 : A leading hyphenated argument is used by this function to
105 : indicate that named parameters are being used.
106 : Therefore, a ('me', 'blue') list will be returned as-is.
107 :
108 : Note that Perl will confuse unquoted, hyphenated tags as
109 : function calls if there is a function of the same name
110 : in the current namespace:
111 : -name => 'foo' is interpreted as -&name => 'foo'
112 :
113 : For ultimate safety, put single quotes around the tag:
114 : ('-name'=>'me', '-color' =>'blue');
115 : This can be a bit cumbersome and I find not as readable
116 : as using all uppercase, which is also fairly safe:
117 : (-NAME=>'me', -COLOR =>'blue');
118 :
119 : Personal note (SAC): I have found all uppercase tags to
120 : be more managable: it involves less single-quoting,
121 : the code is more readable, and there are no method naming
122 : conlicts.
123 : Regardless of the style, it greatly helps to line
124 : the parameters up vertically for long/complex lists.
125
126 =cut
127
128
129 sub rearrange {
130 my $order = shift;
131
132 if ( $order eq "Bio::EnsEMBL::Utils::Argument" ) {
133 # skip object if one provided
134 $order = shift;
135 }
136
137 # If we've got parameters, we need to check to see whether
138 # they are named or simply listed. If they are listed, we
139 # can just return them.
140 unless ( @_ && $_[0] && substr( $_[0], 0, 1 ) eq '-' ) {
141 return @_;
142 }
143
144 # Push undef onto the end if % 2 != 0 to stop warnings
145 push @_,undef unless $#_ %2;
146 my %param;
147 while( @_ ) {
148 #deletes all dashes & uppercases at the same time
149 (my $key = shift) =~ tr/a-z\055/A-Z/d;
150 $param{$key} = shift;
151 }
152
153 # What we intend to do is loop through the @{$order} variable,
154 # and for each value, we use that as a key into our associative
155 # array, pushing the value at that key onto our return array.
156 return map { $param{uc($_)} } @$order;
157 }
158
159 1;
160
161