lib/Automake/Getopt.pm

   1 # Copyright (C) 2012-2024 Free Software Foundation, Inc.
   2
   3 # This program is free software: you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation, either version 3 of the License, or
   6 # (at your option) any later version.
   7
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  15
  16 ##################################################################
  17 # The master copy of this file is in Automake's source repository.
  18 # Please send updates to automake-patches@gnu.org.
  19 ##################################################################
  20
  21 package Automake::Getopt;
  22
  23 =head1 NAME
  24
  25 Automake::Getopt - GCS conforming parser for command line options
  26
  27 =head1 SYNOPSIS
  28
  29   use Automake::Getopt;
  30
  31 =head1 DESCRIPTION
  32
  33 Export a function C<parse_options>, performing parsing of command
  34 line options in conformance to the GNU Coding standards.
  35
  36 =cut
  37
  38 use 5.006;
  39 use strict;
  40 use warnings FATAL => 'all';
  41
  42 use Carp qw (confess croak);
  43 use Exporter ();
  44 use Getopt::Long ();
  45
  46 use Automake::ChannelDefs qw (fatal);
  47
  48 our @ISA = qw (Exporter);
  49 our @EXPORT = qw (getopt);
  50
  51 =item C<parse_options (%option)>
  52
  53 Wrapper around C<Getopt::Long>, trying to conform to the GNU
  54 Coding Standards for error messages.
  55
  56 =cut
  57
  58 sub parse_options (%)
  59 {
  60   my %option = @_;
  61
  62   Getopt::Long::Configure ("bundling", "pass_through");
  63   # Unrecognized options are passed through, so GetOption can only fail
  64   # due to internal errors or misuse of options specification.
  65   Getopt::Long::GetOptions (%option)
  66     or confess "error in options specification (likely)";
  67
  68   if (@ARGV && $ARGV[0] =~ /^-./)
  69     {
  70       my %argopts;
  71       for my $k (keys %option)
  72         {
  73           if ($k =~ /(.*)=s$/)
  74             {
  75               map { $argopts{(length ($_) == 1)
  76                              ? "-$_" : "--$_" } = 1; } (split (/\|/, $1));
  77             }
  78         }
  79       if ($ARGV[0] eq '--')
  80         {
  81           shift @ARGV;
  82         }
  83       elsif (exists $argopts{$ARGV[0]})
  84         {
  85           fatal ("option '$ARGV[0]' requires an argument\n"
  86                  . "Try '$0 --help' for more information.");
  87         }
  88       else
  89         {
  90           fatal ("unrecognized option '$ARGV[0]'.\n"
  91                  . "Try '$0 --help' for more information.");
  92         }
  93     }
  94 }
  95
  96 =back
  97
  98 =head1 SEE ALSO
  99
 100 L<Getopt::Long>
 101
 102 =cut
 103
 104 1; # for require