Home | History | Annotate | Line # | Download | only in Autom4te 
      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 
     16 package Autom4te::Getopt;
     17 
     18 =head1 NAME
     19 
     20 Autom4te::Getopt - GCS conforming parser for command line options
     21 
     22 =head1 SYNOPSIS
     23 
     24   use Autom4te::Getopt;
     25 
     26 =head1 DESCRIPTION
     27 
     28 Export a function C<parse_options>, performing parsing of command
     29 line options in conformance to the GNU Coding standards.
     30 
     31 =cut
     32 
     33 use 5.006;
     34 use strict;
     35 use warnings FATAL => 'all';
     36 use Exporter ();
     37 use Getopt::Long ();
     38 use Autom4te::ChannelDefs qw/fatal/;
     39 use Carp qw/croak confess/;
     40 
     41 use vars qw (@ISA @EXPORT);
     42 @ISA = qw (Exporter);
     43 @EXPORT= qw/getopt/;
     44 
     45 =item C<parse_options (%option)>
     46 
     47 Wrapper around C<Getopt::Long>, trying to conform to the GNU
     48 Coding Standards for error messages.
     49 
     50 =cut
     51 
     52 sub 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 
     94 L<Getopt::Long>
     95 
     96 =cut
     97 
     98 1; # 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