File Coverage

blib/lib/Bio/Das/Util.pm
Criterion Covered Total %
statement 33 35 94.2
branch 10 12 83.3
condition 2 3 66.6
subroutine 4 4 100.0
pod 0 1 0.0
total 49 55 89.0


line stmt bran cond sub pod time code
1             package Bio::Das::Util;
2              
3 1     1   4 use strict;
  1         2  
  1         34  
4             require Exporter;
5 1     1   4 use Carp 'croak';
  1         2  
  1         39  
6 1     1   4 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  1         2  
  1         318  
7              
8             @ISA = qw(Exporter);
9             @EXPORT = qw(rearrange);
10             @EXPORT_OK = qw(rearrange);
11             $VERSION = '0.01';
12              
13             # utility routine
14             sub rearrange {
15 292     292 0 815 my($order,@param) = @_;
16 292 100       635 return unless @param;
17 290         327 my %param;
18              
19 290 50       636 if (ref $param[0] eq 'HASH') {
20 0         0 %param = %{$param[0]};
  0         0  
21             } else {
22 290 100 66     1335 return @param unless (defined($param[0]) && substr($param[0],0,1) eq '-');
23              
24 85         93 my $i;
25 85         189 for ($i=0;$i<@param;$i+=2) {
26 330         1169 $param[$i] =~ s/^\-//; # get rid of initial - if present
27             }
28              
29 85         336 %param = @param; # convert into associative array
30             }
31              
32 85         104 my(@return_array);
33              
34 85         1023 local($^W) = 0;
35 85         99 my($key)='';
36 85         129 foreach $key (@$order) {
37 376         345 my($value);
38 376 100       562 if (ref($key) eq 'ARRAY') {
39 35         52 foreach (@$key) {
40 70 100       121 last if defined($value);
41 56         69 $value = $param{$_};
42 56         85 delete $param{$_};
43             }
44             } else {
45 341         465 $value = $param{$key};
46 341         472 delete $param{$key};
47             }
48 376         592 push(@return_array,$value);
49             }
50 85 50       199 push (@return_array,{%param}) if %param;
51 85         486 return @return_array;
52             }
53              
54             1;
55              
56             __END__
57              
58             =head1 NAME
59              
60             Bio::Das::Util - Das Utilities
61              
62             =head1 SYNOPSIS
63              
64             none
65              
66             =head1 DESCRIPTION
67              
68             This module contains yet another implementation of the rearrange()
69             call, which is used to convert -name=>argument style argument passing
70             into positional arguments.
71              
72             =head1 AUTHOR
73              
74             Lincoln Stein <lstein@cshl.org>.
75              
76             Copyright (c) 2004 Cold Spring Harbor Laboratory
77              
78             This library is free software; you can redistribute it and/or modify
79             it under the same terms as Perl itself. See DISCLAIMER.txt for
80             disclaimers of warranty.
81              
82             =head1 SEE ALSO
83              
84             L<Bio::Das::Request>, L<Bio::Das::HTTP::Fetch>,
85             L<Bio::Das::Segment>, L<Bio::Das::Type>, L<Bio::Das::Stylesheet>,
86             L<Bio::Das::Source>, L<Bio::RangeI>
87