lib/newgetopt.pl

   1 warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
   2
   3 # $Id: newgetopt.pl,v 1.18 2001/09/21 13:34:59 jv Exp $
   4
   5 # This library is no longer being maintained, and is included for backward
   6 # compatibility with Perl 4 programs which may require it.
   7 # It is now just a wrapper around the Getopt::Long module.
   8 # This legacy library is deprecated and will be removed in a future
   9 # release of perl.
  10 #
  11 # In particular, this should not be used as an example of modern Perl
  12 # programming techniques.
  13 #
  14 # Suggested alternative: Getopt::Long
  15
  16 {   package newgetopt;
  17
  18     # Values for $order. See GNU getopt.c for details.
  19     $REQUIRE_ORDER = 0;
  20     $PERMUTE = 1;
  21     $RETURN_IN_ORDER = 2;
  22
  23     # Handle POSIX compliancy.
  24     if ( defined $ENV{"POSIXLY_CORRECT"} ) {
  25         $autoabbrev = 0;        # no automatic abbrev of options (???)
  26         $getopt_compat = 0;     # disallow '+' to start options
  27         $option_start = "(--|-)";
  28         $order = $REQUIRE_ORDER;
  29         $bundling = 0;
  30         $passthrough = 0;
  31     }
  32     else {
  33         $autoabbrev = 1;        # automatic abbrev of options
  34         $getopt_compat = 1;     # allow '+' to start options
  35         $option_start = "(--|-|\\+)";
  36         $order = $PERMUTE;
  37         $bundling = 0;
  38         $passthrough = 0;
  39     }
  40
  41     # Other configurable settings.
  42     $debug = 0;                 # for debugging
  43     $ignorecase = 1;            # ignore case when matching options
  44     $argv_end = "--";           # don't change this!
  45 }
  46
  47 use Getopt::Long;
  48
  49 ################ Subroutines ################
  50
  51 sub NGetOpt {
  52
  53     $Getopt::Long::debug = $newgetopt::debug
  54         if defined $newgetopt::debug;
  55     $Getopt::Long::autoabbrev = $newgetopt::autoabbrev
  56         if defined $newgetopt::autoabbrev;
  57     $Getopt::Long::getopt_compat = $newgetopt::getopt_compat
  58         if defined $newgetopt::getopt_compat;
  59     $Getopt::Long::option_start = $newgetopt::option_start
  60         if defined $newgetopt::option_start;
  61     $Getopt::Long::order = $newgetopt::order
  62         if defined $newgetopt::order;
  63     $Getopt::Long::bundling = $newgetopt::bundling
  64         if defined $newgetopt::bundling;
  65     $Getopt::Long::ignorecase = $newgetopt::ignorecase
  66         if defined $newgetopt::ignorecase;
  67     $Getopt::Long::ignorecase = $newgetopt::ignorecase
  68         if defined $newgetopt::ignorecase;
  69     $Getopt::Long::passthrough = $newgetopt::passthrough
  70         if defined $newgetopt::passthrough;
  71
  72     &GetOptions;
  73 }
  74
  75 ################ Package return ################
  76
  77 1;
  78
  79 ################ End of newgetopt.pl ################