1# Copyright (C) 2012 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 <http://www.gnu.org/licenses/>.
15
16package Autom4te::Getopt;
17
18=head1 NAME
19
20Autom4te::Getopt - GCS conforming parser for command line options
21
22=head1 SYNOPSIS
23
24  use Autom4te::Getopt;
25
26=head1 DESCRIPTION
27
28Export a function C<parse_options>, performing parsing of command
29line options in conformance to the GNU Coding standards.
30
31=cut
32
33use 5.006;
34use strict;
35use warnings FATAL => 'all';
36use Exporter ();
37use Getopt::Long ();
38use Autom4te::ChannelDefs qw/fatal/;
39use Carp qw/croak confess/;
40
41use vars qw (@ISA @EXPORT);
42@ISA = qw (Exporter);
43@EXPORT= qw/getopt/;
44
45=item C<parse_options (%option)>
46
47Wrapper around C<Getopt::Long>, trying to conform to the GNU
48Coding Standards for error messages.
49
50=cut
51
52sub parse_options (%)
53{
54  my %option = @_;
55
56  Getopt::Long::Configure ("bundling", "pass_through");
57  # Unrecognized options are passed through, so GetOption can only fail
58  # due to internal errors or misuse of options specification.
59  Getopt::Long::GetOptions (%option)
60    or confess "error in options specification (likely)";
61
62  if (@ARGV && $ARGV[0] =~ /^-./)
63    {
64      my %argopts;
65      for my $k (keys %option)
66	{
67	  if ($k =~ /(.*)=s$/)
68	    {
69	      map { $argopts{(length ($_) == 1)
70			     ? "-$_" : "--$_" } = 1; } (split (/\|/, $1));
71	    }
72	}
73      if ($ARGV[0] eq '--')
74	{
75	  shift @ARGV;
76	}
77      elsif (exists $argopts{$ARGV[0]})
78	{
79	  fatal ("option '$ARGV[0]' requires an argument\n"
80		 . "Try '$0 --help' for more information.");
81	}
82      else
83	{
84	  fatal ("unrecognized option '$ARGV[0]'.\n"
85		 . "Try '$0 --help' for more information.");
86	}
87    }
88}
89
90=back
91
92=head1 SEE ALSO
93
94L<Getopt::Long>
95
96=cut
97
981; # for require
99
100### Setup "GNU" style for perl-mode and cperl-mode.
101## Local Variables:
102## perl-indent-level: 2
103## perl-continued-statement-offset: 2
104## perl-continued-brace-offset: 0
105## perl-brace-offset: 0
106## perl-brace-imaginary-offset: 0
107## perl-label-offset: -2
108## cperl-indent-level: 2
109## cperl-brace-offset: 0
110## cperl-continued-brace-offset: 0
111## cperl-label-offset: -2
112## cperl-extra-newline-before-brace: t
113## cperl-merge-trailing-else: nil
114## cperl-continued-statement-offset: 2
115## End:
116