File Coverage

blib/lib/App/DocKnot/Command.pm
Criterion Covered Total %
statement 73 75 97.3
branch 24 28 85.7
condition n/a
subroutine 11 11 100.0
pod 2 2 100.0
total 110 116 94.8


line stmt bran cond sub pod time code
1             # Dispatch code for the DocKnot application.
2             #
3             # DocKnot provides various commands for generating documentation, web pages,
4             # and software releases. This module provides command-line parsing and
5             # dispatch of commands to the various App::DocKnot modules.
6             #
7             # SPDX-License-Identifier: MIT
8              
9             ##############################################################################
10             # Modules and declarations
11             ##############################################################################
12              
13             package App::DocKnot::Command 3.02;
14              
15 2     2   171004 use 5.024;
  2         14  
16 2     2   9 use autodie;
  2         3  
  2         14  
17 2     2   9011 use warnings;
  2         4  
  2         75  
18              
19 2     2   855 use App::DocKnot::Dist;
  2         6  
  2         64  
20 2     2   1050 use App::DocKnot::Generate;
  2         6  
  2         65  
21 2     2   1214 use Getopt::Long;
  2         17412  
  2         9  
22              
23             # Defines the subcommands, their options, and the module and method that
24             # implements them. The keys are the names of the commands. Each value is a
25             # hash with one or more of the following keys:
26             #
27             # code
28             # A reference to a function to call to implement this command. If set,
29             # overrides method and module. The function will be passed a reference to
30             # the hash resulting from option parsing as its first argument and any
31             # other command-line arguments as its remaining arguments.
32             #
33             # maximum
34             # The maximum number of positional arguments this command takes.
35             #
36             # method
37             # The name of the method to run to implement this command. It is passed
38             # as arguments any remaining command-line arguments after option parsing.
39             #
40             # minimum
41             # The minimum number of positional arguments this command takes.
42             #
43             # module
44             # The name of the module that implements this command. Its constructor
45             # (which must be named new) will be passed as its sole argument a
46             # reference to the hash containing the results of parsing any options.
47             #
48             # options
49             # A reference to an array of Getopt::Long option specifications defining
50             # the arguments that can be passed to this subcommand.
51             #
52             # required
53             # A reference to an array of required option names (the part before any |
54             # in the option specification for that option). If any of these options
55             # are not set, an error will be thrown.
56             our %COMMANDS = (
57             dist => {
58             method => 'make_distribution',
59             module => 'App::DocKnot::Dist',
60             options => ['distdir|d=s', 'metadata|m=s'],
61             maximum => 0,
62             required => ['distdir'],
63             },
64             generate => {
65             method => 'generate_output',
66             module => 'App::DocKnot::Generate',
67             options => ['metadata|m=s', 'width|w=i'],
68             maximum => 2,
69             minimum => 1,
70             },
71             'generate-all' => {
72             method => 'generate_all',
73             module => 'App::DocKnot::Generate',
74             options => ['metadata|m=s', 'width|w=i'],
75             maximum => 0,
76             },
77             );
78              
79             ##############################################################################
80             # Option parsing
81             ##############################################################################
82              
83             # Parse command-line options and do any required error handling.
84             #
85             # $self - The App::DocKnot::Command object
86             # $command - The command being run or undef for top-level options
87             # $options_ref - A reference to the options specification
88             # @args - The arguments to the command
89             #
90             # Returns: A list composed of a reference to a hash of options and values,
91             # followed by a reference to the remaining arguments after options
92             # have been extracted
93             # Throws: A text error message if the options are invalid
94             sub _parse_options {
95 23     23   57 my ($self, $command, $options_ref, @args) = @_;
96              
97             # Use the object-oriented syntax to isolate configuration options from the
98             # rest of the program.
99 23         87 my $parser = Getopt::Long::Parser->new;
100 23         361 $parser->configure(qw(bundling no_ignore_case require_order));
101              
102             # Parse the options and capture any errors, turning them into exceptions.
103             # The first letter of the Getopt::Long warning message will be capitalized
104             # but we want it to be lowercase to follow our error message standard.
105 23         1399 my %opts;
106             {
107 23         34 my $error = 'option parsing failed';
  23         34  
108 23     2   168 local $SIG{__WARN__} = sub { ($error) = @_ };
  2         420  
109 23 100       75 if (!$parser->getoptionsfromarray(\@args, \%opts, $options_ref->@*)) {
110 2         98 $error =~ s{ \n+ \z }{}xms;
111 2         9 $error =~ s{ \A (\w) }{ lc($1) }xmse;
  2         6  
112 2 100       6 if ($command) {
113 1         11 die "$0 $command: $error\n";
114             } else {
115 1         12 die "$0: $error\n";
116             }
117             }
118             }
119              
120             # Success. Return the options and the remaining arguments.
121 21         4078 return (\%opts, \@args);
122             }
123              
124             # Parse command-line options for a given command.
125             #
126             # $self - The App::DocKnot::Command object
127             # $command - The command being run
128             # @args - The arguments to the command
129             #
130             # Returns: A list composed of a reference to a hash of options and values,
131             # followed by a reference to the remaining arguments after options
132             # have been extracted
133             # Throws: A text error message if the options are invalid
134             sub _parse_command {
135 10     10   59 my ($self, $command, @args) = @_;
136 10         26 my $options_ref = $COMMANDS{$command}{options};
137 10         22 return $self->_parse_options($command, $options_ref, @args);
138             }
139              
140             ##############################################################################
141             # Public interface
142             ##############################################################################
143              
144             # Create a new App::DocKnot::Command object.
145             #
146             # $class - Class of object to create
147             #
148             # Returns: Newly created object
149             sub new {
150 2     2 1 237 my ($class) = @_;
151 2         7 my $self = {};
152 2         4 bless($self, $class);
153 2         6 return $self;
154             }
155              
156             # Parse command-line options to determine which command to run, and then
157             # dispatch that command.
158             #
159             # $self - The App::DocKnot::Command object
160             # @args - Command-line arguments (optional, default: @ARGV)
161             #
162             # Returns: undef
163             # Throws: A text error message for invalid arguments
164             sub run {
165 13     13 1 11784 my ($self, @args) = @_;
166 13 100       41 if (!@args) {
167 2         5 @args = @ARGV;
168             }
169              
170             # Parse the initial options and extract the subcommand to run, preserving
171             # any options after the subcommand.
172 13         29 my $spec = ['help|h'];
173 13         37 my ($opts_ref, $args_ref) = $self->_parse_options(undef, $spec, @args);
174 12 50       34 if ($opts_ref->{help}) {
175 0         0 pod2usage(0);
176             }
177 12 100       28 if (!$args_ref->@*) {
178 1         7 die "$0: no subcommand given\n";
179             }
180 11         17 my $command = shift($args_ref->@*);
181 11 100       36 if (!$COMMANDS{$command}) {
182 1         9 die "$0: unknown command $command\n";
183             }
184              
185             # Parse the arguments for the command and check for required arguments.
186 10         27 ($opts_ref, $args_ref) = $self->_parse_command($command, $args_ref->@*);
187 9 100       46 if (exists($COMMANDS{$command}{required})) {
188 1         4 for my $required ($COMMANDS{$command}{required}->@*) {
189 1 50       3 if (!exists($opts_ref->{$required})) {
190 1         8 die "$0 $command: missing required option --$required\n";
191             }
192             }
193             }
194              
195             # Check that we have the correct number of remaining arguments.
196 8 50       44 if (exists($COMMANDS{$command}{maximum})) {
197 8 100       28 if (scalar($args_ref->@*) > $COMMANDS{$command}{maximum}) {
198 2         13 die "$0 $command: too many arguments\n";
199             }
200             }
201 6 100       18 if (exists($COMMANDS{$command}{minimum})) {
202 5 100       17 if (scalar($args_ref->@*) < $COMMANDS{$command}{minimum}) {
203 1         7 die "$0 $command: too few arguments\n";
204             }
205             }
206              
207             # Dispatch the command and turn exceptions into error messages.
208 5         7 eval {
209 5 50       15 if ($COMMANDS{$command}{code}) {
210 0         0 $COMMANDS{$command}{code}->($opts_ref, $args_ref->@*);
211             } else {
212 5         42 my $object = $COMMANDS{$command}{module}->new($opts_ref);
213 4         10 my $method = $COMMANDS{$command}{method};
214 4         21 $object->$method($args_ref->@*);
215             }
216             };
217 5 100       45 if ($@) {
218 1         2 my $error = $@;
219 1         2 chomp($error);
220 1         9 $error =~ s{ \s+ at \s+ \S+ \s+ line \s+ \d+ [.]? \z }{}xms;
221 1         7 die "$0 $command: $error\n";
222             }
223 4         32 return;
224             }
225              
226             ##############################################################################
227             # Module return value and documentation
228             ##############################################################################
229              
230             1;
231             __END__