Mercurial > repos > mahtabm > ensembl
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 |