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