116 lines
2.7 KiB
Perl
116 lines
2.7 KiB
Perl
# Copyright (C) 2012 Free Software Foundation, Inc.
|
|
|
|
# This program is free software: you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation, either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
package Autom4te::Getopt;
|
|
|
|
=head1 NAME
|
|
|
|
Autom4te::Getopt - GCS conforming parser for command line options
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Autom4te::Getopt;
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Export a function C<parse_options>, performing parsing of command
|
|
line options in conformance to the GNU Coding standards.
|
|
|
|
=cut
|
|
|
|
use 5.006;
|
|
use strict;
|
|
use warnings FATAL => 'all';
|
|
use Exporter ();
|
|
use Getopt::Long ();
|
|
use Autom4te::ChannelDefs qw/fatal/;
|
|
use Carp qw/croak confess/;
|
|
|
|
use vars qw (@ISA @EXPORT);
|
|
@ISA = qw (Exporter);
|
|
@EXPORT= qw/getopt/;
|
|
|
|
=item C<parse_options (%option)>
|
|
|
|
Wrapper around C<Getopt::Long>, trying to conform to the GNU
|
|
Coding Standards for error messages.
|
|
|
|
=cut
|
|
|
|
sub parse_options (%)
|
|
{
|
|
my %option = @_;
|
|
|
|
Getopt::Long::Configure ("bundling", "pass_through");
|
|
# Unrecognized options are passed through, so GetOption can only fail
|
|
# due to internal errors or misuse of options specification.
|
|
Getopt::Long::GetOptions (%option)
|
|
or confess "error in options specification (likely)";
|
|
|
|
if (@ARGV && $ARGV[0] =~ /^-./)
|
|
{
|
|
my %argopts;
|
|
for my $k (keys %option)
|
|
{
|
|
if ($k =~ /(.*)=s$/)
|
|
{
|
|
map { $argopts{(length ($_) == 1)
|
|
? "-$_" : "--$_" } = 1; } (split (/\|/, $1));
|
|
}
|
|
}
|
|
if ($ARGV[0] eq '--')
|
|
{
|
|
shift @ARGV;
|
|
}
|
|
elsif (exists $argopts{$ARGV[0]})
|
|
{
|
|
fatal ("option '$ARGV[0]' requires an argument\n"
|
|
. "Try '$0 --help' for more information.");
|
|
}
|
|
else
|
|
{
|
|
fatal ("unrecognized option '$ARGV[0]'.\n"
|
|
. "Try '$0 --help' for more information.");
|
|
}
|
|
}
|
|
}
|
|
|
|
=back
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Getopt::Long>
|
|
|
|
=cut
|
|
|
|
1; # for require
|
|
|
|
### Setup "GNU" style for perl-mode and cperl-mode.
|
|
## Local Variables:
|
|
## perl-indent-level: 2
|
|
## perl-continued-statement-offset: 2
|
|
## perl-continued-brace-offset: 0
|
|
## perl-brace-offset: 0
|
|
## perl-brace-imaginary-offset: 0
|
|
## perl-label-offset: -2
|
|
## cperl-indent-level: 2
|
|
## cperl-brace-offset: 0
|
|
## cperl-continued-brace-offset: 0
|
|
## cperl-label-offset: -2
|
|
## cperl-extra-newline-before-brace: t
|
|
## cperl-merge-trailing-else: nil
|
|
## cperl-continued-statement-offset: 2
|
|
## End:
|