File Coverage

blib/lib/AppConfig/Getopt.pm
Criterion Covered Total %
statement 53 61 86.9
branch 18 24 75.0
condition 3 3 100.0
subroutine 9 10 90.0
pod 0 2 0.0
total 83 100 83.0


line stmt bran cond sub pod time code
1             package AppConfig::Getopt;
2              
3             #============================================================================
4             #
5             # AppConfig::Getopt.pm
6             #
7             # Perl5 module to interface AppConfig::* to Johan Vromans' Getopt::Long
8             # module. Getopt::Long implements the POSIX standard for command line
9             # options, with GNU extensions, and also traditional one-letter options.
10             # AppConfig::Getopt constructs the necessary Getopt:::Long configuration
11             # from the internal AppConfig::State and delegates the parsing of command
12             # line arguments to it. Internal variable values are updated by callback
13             # from GetOptions().
14             #
15             # Written by Andy Wardley <abw@wardley.org>
16             #
17             # Copyright (C) 1997-2003 Andy Wardley. All Rights Reserved.
18             # Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
19             #
20             # $Id: Getopt.pm,v 1.60 2003/04/29 10:43:21 abw Exp $
21             #
22             #============================================================================
23              
24             require 5.005;
25 2     2   29 use AppConfig::State;
  2         19  
  2         38  
26 2     2   110 use Getopt::Long 2.17;
  2         37  
  2         45  
27 2     2   38 use strict;
  2         19  
  2         30  
28              
29 2     2   31 use vars qw( $VERSION );
  2         19  
  2         29  
30             BEGIN {
31 2     2   26 $VERSION = '1.64';
32             }
33              
34             #------------------------------------------------------------------------
35             # new($state, \@args)
36             #
37             # Module constructor. The first, mandatory parameter should be a
38             # reference to an AppConfig::State object to which all actions should
39             # be applied. The second parameter may be a reference to a list of
40             # command line arguments. This list reference is passed to parse() for
41             # processing.
42             #
43             # Returns a reference to a newly created AppConfig::Getopt object.
44             #------------------------------------------------------------------------
45              
46             sub new {
47 2     2 0 24     my $class = shift;
48 2         20     my $state = shift;
49              
50                 
51 2         26     my $self = {
52                     STATE => $state,
53                };
54              
55 2         45     bless $self, $class;
56            
57             # call parse() to parse any arg list passed
58 2 50       26     $self->parse(@_)
59             if @_;
60              
61 2         30     return $self;
62             }
63              
64              
65             #------------------------------------------------------------------------
66             # parse(@$config, \@args)
67             #
68             # Constructs the appropriate configuration information and then delegates
69             # the task of processing command line options to Getopt::Long.
70             #
71             # Returns 1 on success or 0 if one or more warnings were raised.
72             #------------------------------------------------------------------------
73              
74             sub parse {
75 4     4 0 37     my $self = shift;
76 4         38     my $state = $self->{ STATE };
77 4         36     my (@config, $args, $getopt);
78                 
79 4         39     local $" = ', ';
80              
81             # we trap $SIG{__WARN__} errors and patch them into AppConfig::State
82                 local $SIG{__WARN__} = sub {
83 0     0   0 my $msg = shift;
84              
85             # AppConfig::State doesn't expect CR terminated error messages
86             # and it uses printf, so we protect any embedded '%' chars
87 0         0 chomp($msg);
88 0         0 $state->_error("%s", $msg);
89 4         123     };
90                 
91             # slurp all config items into @config
92 4   100     82     push(@config, shift) while defined $_[0] && ! ref($_[0]);
93              
94             # add debug status if appropriate (hmm...can't decide about this)
95             # push(@config, 'debug') if $state->_debug();
96              
97             # next parameter may be a reference to a list of args
98 4         37     $args = shift;
99              
100             # copy any args explicitly specified into @ARGV
101 4 100       66     @ARGV = @$args if defined $args;
102              
103             # we enclose in an eval block because constructor may die()
104 4         39     eval {
105             # configure Getopt::Long
106 4         54 Getopt::Long::Configure(@config);
107              
108             # construct options list from AppConfig::State variables
109 4         70 my @opts = $self->{ STATE }->_getopt_state();
110              
111             # DEBUG
112 4 50       58 if ($state->_debug()) {
113 0         0 print STDERR "Calling GetOptions(@opts)\n";
114 0         0 print STDERR "\@ARGV = (@ARGV)\n";
115             };
116              
117             # call GetOptions() with specifications constructed from the state
118 4         51 $getopt = GetOptions(@opts);
119                 };
120 4 50       44     if ($@) {
121 0         0 chomp($@);
122 0         0 $state->_error("%s", $@);
123 0         0 return 0;
124                 }
125              
126             # udpdate any args reference passed to include only that which is left
127             # in @ARGV
128 4 100       53     @$args = @ARGV if defined $args;
129              
130 4         92     return $getopt;
131             }
132              
133              
134             #========================================================================
135             # AppConfig::State
136             #========================================================================
137              
138             package AppConfig::State;
139              
140             #------------------------------------------------------------------------
141             # _getopt_state()
142             #
143             # Constructs option specs in the Getopt::Long format for each variable
144             # definition.
145             #
146             # Returns a list of specification strings.
147             #------------------------------------------------------------------------
148              
149             sub _getopt_state {
150 4     4   72     my $self = shift;
151 4         36     my ($var, $spec, $args, $argcount, @specs);
152              
153 4     16   81     my $linkage = sub { $self->set(@_) };
  16         198  
154              
155 4         37     foreach $var (keys %{ $self->{ VARIABLE } }) {
  4         58  
156 18 100       149 $spec  = join('|', $var, @{ $self->{ ALIASES }->{ $var } || [ ] });
  18         232  
157              
158             # an ARGS value is used, if specified
159 18 100       199 unless (defined ($args = $self->{ ARGS }->{ $var })) {
160             # otherwise, construct a basic one from ARGCOUNT
161             ARGCOUNT: {
162 8         65 last ARGCOUNT unless
163 8 50       86 defined ($argcount = $self->{ ARGCOUNT }->{ $var });
164              
165 8 100       142 $args = "=s", last ARGCOUNT if $argcount eq ARGCOUNT_ONE;
166 4 100       49 $args = "=s@", last ARGCOUNT if $argcount eq ARGCOUNT_LIST;
167 2 50       61 $args = "=s%", last ARGCOUNT if $argcount eq ARGCOUNT_HASH;
168 2         20 $args = "!";
169             }
170             }
171 18 50       171 $spec .= $args if defined $args;
172              
173 18         179 push(@specs, $spec, $linkage);
174                 }
175              
176 4         99     return @specs;
177             }
178              
179              
180              
181             1;
182              
183             __END__
184            
185             =head1 NAME
186            
187             AppConfig::Getopt - Perl5 module for processing command line arguments via delegation to Getopt::Long.
188            
189             =head1 SYNOPSIS
190            
191             use AppConfig::Getopt;
192            
193             my $state = AppConfig::State->new(\%cfg);
194             my $getopt = AppConfig::Getopt->new($state);
195            
196             $getopt->parse(\@args); # read args
197            
198             =head1 OVERVIEW
199            
200             AppConfig::Getopt is a Perl5 module which delegates to Johan Vroman's
201             Getopt::Long module to parse command line arguments and update values
202             in an AppConfig::State object accordingly.
203            
204             AppConfig::Getopt is distributed as part of the AppConfig bundle.
205            
206             =head1 DESCRIPTION
207            
208             =head2 USING THE AppConfig::Getopt MODULE
209            
210             To import and use the AppConfig::Getopt module the following line should appear
211             in your Perl script:
212            
213             use AppConfig::Getopt;
214            
215             AppConfig::Getopt is used automatically if you use the AppConfig module
216             and create an AppConfig::Getopt object through the getopt() method.
217            
218             AppConfig::Getopt is implemented using object-oriented methods. A new
219             AppConfig::Getopt object is created and initialised using the new() method.
220             This returns a reference to a new AppConfig::Getopt object. A reference to
221             an AppConfig::State object should be passed in as the first parameter:
222            
223             my $state = AppConfig::State->new();
224             my $getopt = AppConfig::Getopt->new($state);
225            
226             This will create and return a reference to a new AppConfig::Getopt object.
227            
228             =head2 PARSING COMMAND LINE ARGUMENTS
229            
230             The C<parse()> method is used to read a list of command line arguments and
231             update the state accordingly.
232            
233             The first (non-list reference) parameters may contain a number of
234             configuration strings to pass to Getopt::Long::Configure. A reference
235             to a list of arguments may additionally be passed or @ARGV is used by
236             default.
237            
238             $getopt->parse(); # uses @ARGV
239             $getopt->parse(\@myargs);
240             $getopt->parse(qw(auto_abbrev debug)); # uses @ARGV
241             $getopt->parse(qw(debug), \@myargs);
242            
243             See Getopt::Long for details of the configuartion options available.
244            
245             A Getopt::Long specification string is constructed for each variable
246             defined in the AppConfig::State. This consists of the name, any aliases
247             and the ARGS value for the variable.
248            
249             These specification string are then passed to Getopt::Long, the arguments
250             are parsed and the values in the AppConfig::State updated.
251            
252             See AppConfig for information about using the AppConfig::Getopt
253             module via the getopt() method.
254            
255             =head1 AUTHOR
256            
257             Andy Wardley, E<lt>abw@wardley.orgE<gt>
258            
259             =head1 REVISION
260            
261             $Revision: 1.60 $
262            
263             =head1 COPYRIGHT
264            
265             Copyright (C) 1997-2003 Andy Wardley. All Rights Reserved.
266            
267             Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
268            
269             This module is free software; you can redistribute it and/or modify it
270             under the same terms as Perl itself.
271            
272             =head1 ACKNOWLEDGMENTS
273            
274             Many thanks are due to Johan Vromans for the Getopt::Long module. He was
275             kind enough to offer assistance and access to early releases of his code to
276             enable this module to be written.
277            
278             =head1 SEE ALSO
279            
280             AppConfig, AppConfig::State, AppConfig::Args, Getopt::Long
281            
282             =cut
283