File Coverage

blib/lib/Class/AutoClass/Args.pm
Criterion Covered Total %
statement 56 63 88.9
branch 25 40 62.5
condition 11 18 61.1
subroutine 11 14 78.6
pod 0 8 0.0
total 103 143 72.0


line stmt bran cond sub pod time code
1             package Class::AutoClass::Args;
2 13     13   201 use strict;
  13         146  
  13         242  
3 13     13   301 use Carp;
  13         120  
  13         289  
4              
5             sub new {
6 183     183 0 7590   my($class,@args)=@_;
7 183   33     4224   $class=(ref $class)||$class;
8 183         3575   my $self=bless _fix_args(@args), $class;
9             }
10             sub get_args {
11 2     2 0 34   my($self,@args)=@_;
12 2 50 33     26   @args=@{$args[0]} if @args==1 && 'ARRAY' eq ref $args[0];
  0         0  
13 2         20   @args=fix_keyword(@args);
14 2         21   my @results=map {$self->{$_}} @args;
  6         61  
15 2 50       32   wantarray? @results: $results[0];
16             }
17             sub getall_args {
18 0     0 0 0   my $self = shift;
19 0 0       0   wantarray? %$self: {%$self};
20             }
21             sub set_args {
22 1     1 0 5600   my($self,@args)=@_;
23 1         14   my $args=_fix_args(@args);
24 1         15   while(my($key,$value)=each %$args) {
25 3         53     $self->$key($value);
26               }
27             }
28             sub fix_keyword {
29 563     563 0 6510   my @keywords=@_; # copies input, so update-in-place doesn't munge it
30 563         6387   for my $keyword (@keywords) {
31 998 50       14314     next unless defined $keyword;
32 998 50       25804     $keyword=~s/^-*(.*)$/\L$1/ unless ref $keyword; # updates in place
33               }
34 563 100       11820   wantarray? @keywords: $keywords[0];
35             }
36 41     41 0 2744 sub fix_keywords {fix_keyword(@_);}
37 0 0   0 0 0 sub is_keyword {!(@_%2) && $_[0]=~/^-/;}
38 0 0   0 0 0 sub is_positional {@_%2 || $_[0]!~/^-/;}
39              
40             sub _fix_args {
41 13     13   296   no warnings;
  13         155  
  13         561  
42 184     184   3404   my(@args)=@_;
43 184 100 100     2667   @args=@{$args[0]} if @args==1 && 'ARRAY' eq ref $args[0];
  1         12  
44 184 100 66     2520   @args=%{$args[0]} if @args==1 && 'HASH' eq ref $args[0];
  3         51  
45 184 50 33     2446   @args=%{$args[0]} if @args==1 && $args[0]=~/HASH/; # treat object like HASH
  0         0  
46 184 50       2240   confess("Malformed keyword argument list (odd number of elements): @args") if @args%2;
47 184         1864   my $args={};
48 184         1911   my %counts;
49 184         2114   while(@args) {
50 239         2573     my($keyword,$value)=(fix_keyword(shift @args),shift @args);
51 239 100       6285     $args->{$keyword}=$value if $counts{$keyword}==0;
52 239 100       4652     $args->{$keyword}=[$args->{$keyword},$value] if $counts{$keyword}==1;
53 239 100       2556     push(@{$args->{$keyword}},$value) if $counts{$keyword}>1;
  2         23  
54 239         2713     $counts{$keyword}++;
55               }
56 184         3508   $args;
57             }
58 13     13   227 use vars qw($AUTOLOAD);
  13         118  
  13         217  
59             sub AUTOLOAD {
60 223     223   2808   my $self=shift;
61 223         3664   $AUTOLOAD=~s/^.*:://; # strip class qualification
62 223 100       2446   return if $AUTOLOAD eq 'DESTROY'; # the books say you should do this
63 80         780   my $keyword=fix_keyword($AUTOLOAD);
64 80 100 100     1801   return if @_==0 && !exists $self->{$keyword};
65 13         104   my $result;
66 13 100       183   return $self->{$keyword} if @_==0;
67 3 50       115   return $self->{$keyword}=$_[0] if @_==1;
68 0 0           return $self->{$keyword}=[@_] if @_>1;
69             }
70              
71             1;
72              
73             __END__
74             =head1 NAME
75            
76             AutoArgs - Argument list processing
77            
78             =head1 SYNOPSIS
79            
80             use Class::AutoClass::Args;
81             my $args=new Class::AutoClass::Args(name=>'Joe',-sex=>'male',
82             HOBBIES=>'hiking',hobbies=>'cooking');
83            
84             # access argument values as HASH slots
85             my $name=$args->{name};
86             my $sex=$args->{sex};
87             my $hobbies=$args->{hobbies};
88            
89             # access argument values via methods
90             my $name=$args->name;
91             my $sex=$args->sex;
92             my $hobbies=$args->hobbies;
93            
94             # set local variables from argument values -- two equivalent ways
95             my($name,$sex,$hobbies)=$args->get_args(qw(name sex hobbies));
96             my($name,$sex,$hobbies)=@$args{qw(name sex hobbies)}
97            
98             =head1 DESCRIPTION
99            
100             This class simplifies the handling of keyword argument lists.
101            
102             The 'new' method accepts an array, ARRAY, or HASH of keyword=>value
103             pairs. It normalizes the keywords to ignore case and leading dashes
104             ('-'). In other words, the following keywords are all equivalent:
105            
106             first_name, -first_name, -FIRST_NAME, --FIRST_NAME, First_Name,
107             -First_Name
108            
109             Internally we convert keywords to lowercase with no leading dash.
110            
111             Repeated keyword arguments are converted into an ARRAY of the values.
112             Thus
113            
114             new Class::AutoClass::Args(first_name=>'Joe', first_name=>'Joseph')
115            
116             is equivalent to
117            
118             new Class::AutoClass::Args(first_name=>['Joe', 'Joseph'])
119            
120             Since argument lists can be provided as ARRAYs or HASHes, the following
121            
122             new Class::AutoClass::Args([first_name=>'John', last_name=>'Doe'])
123             new Class::AutoClass::Args({first_name=>'John', last_name=>'Doe'})
124            
125             are both equivalent to
126            
127             new Class::AutoClass::Args(first_name=>'John', last_name=>'Doe')
128            
129             =head1 KNOWN BUGS AND CAVEATS
130            
131             This is still a work in progress.
132            
133             =head2 Bugs, Caveats, and ToDos
134            
135             See caveats about accessing arguments via AUTOLOADed methods.
136            
137             =head1 AUTHOR - Nat Goodman, Chris Cavnor
138            
139             Email natg@shore.net
140            
141             =head1 COPYRIGHT
142            
143             Copyright (c) 2004 Institute for Systems Biology (ISB). All Rights Reserved.
144            
145             This module is free software; you can redistribute it and/or modify
146             it under the same terms as Perl itself.
147            
148             =head1 APPENDIX
149            
150             The rest of the documentation describes the methods. Note that
151             internal methods are preceded with _
152            
153             =head2 Constructors
154            
155             Title : new
156             Usage : $args=new Class::AutoClass::Args
157             (name=>'Joe',-sex=>'male',HOBBIES=>'hiking',hobbies=>'cooking')
158             -- OR --
159             $args=new Class::AutoClass::Args
160             ([name=>'Joe',-sex=>'male',HOBBIES=>'hiking',hobbies=>'cooking'])
161             -- OR --
162             $args=new Class::AutoClass::Args
163             ({name=>'Joe',-sex=>'male',HOBBIES=>'hiking',hobbies=>'cooking'})
164             Function: Create a normalized argument list
165             Returns : Class::AutoClass::Args object that represents the given arguments
166             Args : Argument list in keyword=>value form
167             This can be an array (as in form 1 above). This is the ususal case.
168             Or it can be a single ARRAY or HASH as in forms 2 and 3
169            
170             =head2 Getting and setting argument values from object
171            
172             One simple way to get and set argument values is to treat the object
173             as a HASH and access the argument as a hash entry, eg,
174            
175             $name=$args->{name};
176             $args->{name}='Joseph'.
177            
178             While this approach is generally frowned upon in object-oriented
179             programming (because it breaks object encapsulation), we deem it to be
180             acceptable here since AutoArgs is such a lightweight class and its
181             very purpose is to _simplify_ access to argument lists. Bear in mind
182             that the hash key you use must be normalized per our rules: lowercase
183             with no leading dashes. The fix_keyword method is provided to
184             accomplish this if you need it.
185            
186             A second simple approach is to invoke a method with the name of the
187             keyword. Eg,
188            
189             $args->name;
190             $args->name('Joseph'); # sets name to 'Joseph'
191            
192             The method name is normalized exactly as in 'new'.
193            
194             CAVEAT: The second approach uses AUTOLOAD to simulate the existence of
195             a method with the same name as the keyword. This will not work if
196             AutoArgs contains a method with that name. For example 'new'. One
197             solution is to use uppercase names for methods. Or you can use the
198             first approach and just access the data directly.
199            
200             The class also provides two methods for wholesale manipulation of arguments.
201            
202             Title : get_args
203             Usage : ($first,$last)=$args->get_args(qw(-first_name last_name))
204             Function: Get values for multiple keywords
205             Args : array or ARRAY of keywords. These are normalized exactly as in 'new'
206             Returns : array or ARRAY of attribute values
207            
208             Title : set_args
209             Usage : $args->set_args(-first_name=>'John',-last_name=>'Doe')
210             Function: Set multiple attributes in existing object
211             Args : Parameter list in same format as for 'new'
212             Returns : nothing
213            
214             Title : getall_args
215             Usage : %args=$args->get_args;
216             Function: Get a list of all key,values
217             Args : none
218             Returns : hash or HASH of key, value pairs.
219            
220             Title : set_args
221             Usage : $args->set_args(-first_name=>'John',-last_name=>'Doe')
222             Function: Set multiple attributes in existing object
223             Args : Parameter list in same format as for 'new'
224             Returns : nothing
225            
226             =head2 Methods to normalize keywords. These are class methods
227            
228             These methods normalize keywords as explained in the DESCRIPTION.
229            
230             Title : fix_keyword
231             Usage : $keyword=Class::AutoClass::Args::fix_keyword('-NaMe')
232             -- OR --
233             @keywords=Class::AutoClass::Args::fix_keyword('-NaMe','---sex');
234             Function: Normalizes each keyword to lowercase with no leading dashes.
235             Args : array of one or more strings
236             Returns : array of normalized strings
237            
238             Title : fix_keywords
239             Usage : $keyword=Class::AutoClass::Args::fix_keywords('-NaMe')
240             -- OR --
241             @keywords=Class::AutoClass::Args::fix_keywords('-NaMe','---sex');
242             Function: Synonym for fix_keyword
243             Args : array of one or more strings
244             Returns : array of normalized strings
245            
246             =head2 Methods to check format of argument list. These are class methods.
247            
248             These following methods can be used in a class (typically it's 'new'
249             method) that wishes to support both keyword and positional argument
250             lists. We strongly discourage this for the reasons discussed below.
251            
252             Title : is_keyword
253             Usage : if (Class::AutoClass::Args::is_keyword(@args)) {
254             $args=new Class::AutoClass::Args::is_keyword(@args);
255             }
256             Function: Checks whether an argument list looks like it is in keyword form.
257             The function returns true if
258             (1) the argument list has an even number of elements, and
259             (2) the first argument starts with a dash ('-').
260             Obviously, this is not fully general.
261             Returns : boolean
262             Args : argument list as given
263            
264             Title : is_positional
265             Usage : if (Class::AutoClass::Argsis_positional(@args)) {
266             ($arg1,$arg2,$arg3)=@args;
267             }
268             Function: Checks whether an argument list looks like it is in positional form.
269             The function returns true if
270             (1) the argument list has an odd number of elements, or
271             (2) the first argument starts with a dash ('-').
272             Obviously, this is not fully general.
273             Returns : boolean
274             Args : argument list as given
275            
276             =head2 Why the Combination of Positional and Keyword Forms is Ambiguous
277            
278             The keyword => value notation is just a Perl shorthand for stating two
279             list members with the first one quoted. Thus,
280            
281             @list=(first_name=>'John', last_name=>'Doe')
282            
283             is completely equivalent to
284            
285             @list=('first_name', 'John', 'last_name', 'Doe')
286            
287             The ambiguity of allowing both positional and keyword forms should now
288             be apparent. In this example,
289            
290             new Class::AutoClass::Args ('first_name', 'John')
291            
292             there is s no way to tell whether the program is specifying a keyword
293             argument list with the parameter 'first_name' set to the value "John'
294             or a positional argument list with the values ''first_name' and 'John'
295             being passed to the first two parameters.
296            
297             If a program wishes to permit both forms, we suggest the convention
298             used in BioPerl that keywords be required to start with '-' (and that
299             values do not start with '-'). Obviously, this is not fully general.
300            
301             The methods 'is_keyword' and 'is_positional' check this convention.
302            
303             =cut
304