0
|
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
|