lib/perl5/5.6.1/auto/Getopt/Long/Configure.al

   1 # NOTE: Derived from lib/Getopt/Long.pm.
   2 # Changes made here will be lost when autosplit again.
   3 # See AutoSplit.pm.
   4 package Getopt::Long;
   5
   6 #line 921 "lib/Getopt/Long.pm (autosplit into lib/auto/Getopt/Long/Configure.al)"
   7 # Getopt::Long Configuration.
   8 sub Configure (@) {
   9     my (@options) = @_;
  10
  11     my $prevconfig =
  12       [ $error, $debug, $major_version, $minor_version,
  13         $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
  14         $gnu_compat, $passthrough, $genprefix ];
  15
  16     if ( ref($options[0]) eq 'ARRAY' ) {
  17         ( $error, $debug, $major_version, $minor_version,
  18           $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
  19           $gnu_compat, $passthrough, $genprefix ) = @{shift(@options)};
  20     }
  21
  22     my $opt;
  23     foreach $opt ( @options ) {
  24         my $try = lc ($opt);
  25         my $action = 1;
  26         if ( $try =~ /^no_?(.*)$/s ) {
  27             $action = 0;
  28             $try = $+;
  29         }
  30         if ( ($try eq 'default' or $try eq 'defaults') && $action ) {
  31             ConfigDefaults ();
  32         }
  33         elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) {
  34             local $ENV{POSIXLY_CORRECT};
  35             $ENV{POSIXLY_CORRECT} = 1 if $action;
  36             ConfigDefaults ();
  37         }
  38         elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
  39             $autoabbrev = $action;
  40         }
  41         elsif ( $try eq 'getopt_compat' ) {
  42             $getopt_compat = $action;
  43         }
  44         elsif ( $try eq 'gnu_getopt' ) {
  45             if ( $action ) {
  46                 $gnu_compat = 1;
  47                 $bundling = 1;
  48                 $getopt_compat = 0;
  49                 $permute = 1;
  50             }
  51         }
  52         elsif ( $try eq 'gnu_compat' ) {
  53             $gnu_compat = $action;
  54         }
  55         elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
  56             $ignorecase = $action;
  57         }
  58         elsif ( $try eq 'ignore_case_always' ) {
  59             $ignorecase = $action ? 2 : 0;
  60         }
  61         elsif ( $try eq 'bundling' ) {
  62             $bundling = $action;
  63         }
  64         elsif ( $try eq 'bundling_override' ) {
  65             $bundling = $action ? 2 : 0;
  66         }
  67         elsif ( $try eq 'require_order' ) {
  68             $order = $action ? $REQUIRE_ORDER : $PERMUTE;
  69         }
  70         elsif ( $try eq 'permute' ) {
  71             $order = $action ? $PERMUTE : $REQUIRE_ORDER;
  72         }
  73         elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
  74             $passthrough = $action;
  75         }
  76         elsif ( $try =~ /^prefix=(.+)$/ && $action ) {
  77             $genprefix = $1;
  78             # Turn into regexp. Needs to be parenthesized!
  79             $genprefix = "(" . quotemeta($genprefix) . ")";
  80             eval { '' =~ /$genprefix/; };
  81             Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
  82         }
  83         elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) {
  84             $genprefix = $1;
  85             # Parenthesize if needed.
  86             $genprefix = "(" . $genprefix . ")"
  87               unless $genprefix =~ /^\(.*\)$/;
  88             eval { '' =~ /$genprefix/; };
  89             Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
  90         }
  91         elsif ( $try eq 'debug' ) {
  92             $debug = $action;
  93         }
  94         else {
  95             Croak ("Getopt::Long: unknown config parameter \"$opt\"")
  96         }
  97     }
  98     $prevconfig;
  99 }
 100
 101 # end of Getopt::Long::Configure
 102 1;