File Coverage

blib/lib/App/DocKnot.pm

Criterion	Covered	Total	%
statement	67	72	93.0
branch	22	28	78.5
condition			n/a
subroutine	10	10	100.0
pod	2	2	100.0
total	101	112	90.1

# Dispatch code for the DocKnot application.
#
# DocKnot provides various commands for generating documentation, web pages,
# and software releases.  This module provides command-line parsing and
# dispatch of commands to the various App::DocKnot modules.
#
# SPDX-License-Identifier: MIT

##############################################################################
# Modules and declarations
##############################################################################

package App::DocKnot 2.00;

use 5.024;
use autodie;
use warnings;

use App::DocKnot::Generate;
use Getopt::Long;

# Defines the subcommands, their options, and the module and method that
# implements them.  The keys are the names of the commands.  Each value is a
# hash with one or more of the following keys:
#
# code
#     A reference to a function to call to implement this command.  If set,
#     overrides method and module.  The function will be passed a reference to
#     the hash resulting from option parsing as its first argument and any
#     other command-line arguments as its remaining arguments.
#
# maximum
#     The maximum number of positional arguments this command takes.
#
# method
#     The name of the method to run to implement this command.  It is passed
#     as arguments any remaining command-line arguments after option parsing.
#
# minimum
#     The minimum number of positional arguments this command takes.
#
# module
#     The name of the module that implements this command.  Its constructor
#     (which must be named new) will be passed as its sole argument a
#     reference to the hash containing the results of parsing any options.
#
# options
#     A reference to an array of Getopt::Long option specifications defining
#     the arguments that can be passed to this subcommand.
#
# required
#     A reference to an array of required option names (the part before any |
#     in the option specification for that option).  If any of these options
#     are not set, an error will be thrown.
our %COMMANDS = (
    generate => {
        method  => 'generate_output',
        module  => 'App::DocKnot::Generate',
        options => ['metadata|m=s', 'width|w=i'],
        maximum => 2,
        minimum => 1,
    },
    'generate-all' => {
        method  => 'generate_all',
        module  => 'App::DocKnot::Generate',
        options => ['metadata|m=s', 'width|w=i'],
        maximum => 0,
    },
);

##############################################################################
# Option parsing
##############################################################################

# Parse command-line options and do any required error handling.
#
# $self        - The App::DocKnot object
# $command     - The command being run or undef for top-level options
# $options_ref - A reference to the options specification
# @args        - The arguments to the command
#
# Returns: A list composed of a reference to a hash of options and values,
#          followed by a reference to the remaining arguments after options
#          have been extracted
#  Throws: A text error message if the options are invalid
sub _parse_options {
    my ($self, $command, $options_ref, @args) = @_;

    # Use the object-oriented syntax to isolate configuration options from the
    # rest of the program.
    my $parser = Getopt::Long::Parser->new;
    $parser->configure(qw(bundling no_ignore_case require_order));

    # Parse the options and capture any errors, turning them into exceptions.
    # The first letter of the Getopt::Long warning message will be capitalized
    # but we want it to be lowercase to follow our error message standard.
    my %opts;
    {
        my $error = 'option parsing failed';
        local $SIG{__WARN__} = sub { ($error) = @_ };
        if (!$parser->getoptionsfromarray(\@args, \%opts, $options_ref->@*)) {
            $error =~ s{ \n+ \z }{}xms;
            $error =~ s{ \A (\w) }{ lc($1) }xmse;
            if ($command) {
                die "$0 $command: $error\n";
            } else {
                die "$0: $error\n";
            }
        }
    }

    # Success.  Return the options and the remaining arguments.
    return (\%opts, \@args);
}

# Parse command-line options for a given command.
#
# $self    - The App::DocKnot object
# $command - The command being run
# @args    - The arguments to the command
#
# Returns: A list composed of a reference to a hash of options and values,
#          followed by a reference to the remaining arguments after options
#          have been extracted
#  Throws: A text error message if the options are invalid
sub _parse_command {
    my ($self, $command, @args) = @_;
    my $options_ref = $COMMANDS{$command}{options};
    return $self->_parse_options($command, $options_ref, @args);
}

##############################################################################
# Public interface
##############################################################################

# Create a new App::DocKnot object.
#
# $class - Class of object to create
#
# Returns: Newly created object
sub new {
    my ($class) = @_;
    my $self = {};
    bless($self, $class);
    return $self;
}

# Parse command-line options to determine which command to run, and then
# dispatch that command.
#
# $self - The App::DocKnot object
# @args - Command-line arguments (optional, default: @ARGV)
#
# Returns: undef
#  Throws: A text error message for invalid arguments
sub run {
    my ($self, @args) = @_;
    if (!@args) {
        @args = @ARGV;
    }

    # Parse the initial options and extract the subcommand to run, preserving
    # any options after the subcommand.
    my $spec = ['help|h'];
    my ($opts_ref, $args_ref) = $self->_parse_options(undef, $spec, @args);
    if ($opts_ref->{help}) {
        pod2usage(0);
    }
    if (!$args_ref->@*) {
        die "$0: no subcommand given\n";
    }
    my $command = shift($args_ref->@*);
    if (!$COMMANDS{$command}) {
        die "$0: unknown command $command\n";
    }

    # Parse the arguments for the command and check for required arguments.
    ($opts_ref, $args_ref) = $self->_parse_command($command, $args_ref->@*);
    if (exists($COMMANDS{$command}{required})) {
        for my $required ($COMMANDS{$command}{required}->@*) {
            if (!exists($opts_ref->{$required})) {
                die "$0 $command: missing required option --$required\n";
            }
        }
    }

    # Check that we have the correct number of remaining arguments.
    if (exists($COMMANDS{$command}{maximum})) {
        if (scalar($args_ref->@*) > $COMMANDS{$command}{maximum}) {
            die "$0 $command: too many arguments\n";
        }
    }
    if (exists($COMMANDS{$command}{minimum})) {
        if (scalar($args_ref->@*) < $COMMANDS{$command}{minimum}) {
            die "$0 $command: too few arguments\n";
        }
    }

    # Dispatch the command and turn exceptions into error messages.
    eval {
        if ($COMMANDS{$command}{code}) {
            $COMMANDS{$command}{code}->($opts_ref, $args_ref->@*);
        } else {
            my $object = $COMMANDS{$command}{module}->new($opts_ref);
            my $method = $COMMANDS{$command}{method};
            $object->$method($args_ref->@*);
        }
    };
    if ($@) {
        my $error = $@;
        chomp($error);
        $error =~ s{ \s+ at \s+ \S+ \s+ line \s+ \d+ [.]? \z }{}xms;
        die "$0 $command: $error\n";
    }
    return;
}

1;
__END__