1 # This module is part of debbugs, and is released under the terms of
2 # the GPL version 3, or any later version (at your option). See the
3 # file README and COPYING for more information.
4 # Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
6 package Debbugs::Command;
10 Debbugs::Command -- Handle multiple subcommand-style commands
27 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
28 use base qw(Exporter);
32 $DEBUG = 0 unless defined $DEBUG;
35 %EXPORT_TAGS = (commands => [qw(handle_main_arguments),
36 qw(handle_subcommand_arguments)
40 Exporter::export_ok_tags(keys %EXPORT_TAGS);
41 $EXPORT_TAGS{all} = [@EXPORT_OK];
45 use Getopt::Long qw(:config no_ignore_case);
46 use Pod::Usage qw(pod2usage);
48 =head1 Command processing (:commands)
50 Functions which parse arguments for commands (exportable with
55 =item handle_main_arguments(
59 sub handle_main_arguments {
60 my ($options,@args) = @_;
61 Getopt::Long::Configure('pass_through');
62 GetOptions($options,@args);
63 Getopt::Long::Configure('default');
69 sub handle_subcommand_arguments {
70 my ($argv,$args,$subopt) = @_;
72 Getopt::Long::GetOptionsFromArray($argv,
77 for my $arg (keys %{$args}) {
78 next unless $args->{$arg};
79 my $r_arg = $arg; # real argument name
80 $r_arg =~ s/[=\|].+//g;
81 if (not defined $subopt->{$r_arg}) {
82 push @usage_errors, "You must give a $r_arg option";
85 pod2usage(join("\n",@usage_errors)) if @usage_errors;
99 # indent-tabs-mode: nil
100 # cperl-indent-level: 4