home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _d8bdcf686b16e0cb001fd07fcecbf3e1 < prev    next >
Text File  |  2000-03-24  |  3KB  |  87 lines
  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 792 "../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.     $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.       $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' ) {
  31.         ConfigDefaults () if $action;
  32.     }
  33.     elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
  34.         $autoabbrev = $action;
  35.     }
  36.     elsif ( $try eq 'getopt_compat' ) {
  37.         $getopt_compat = $action;
  38.     }
  39.     elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
  40.         $ignorecase = $action;
  41.     }
  42.     elsif ( $try eq 'ignore_case_always' ) {
  43.         $ignorecase = $action ? 2 : 0;
  44.     }
  45.     elsif ( $try eq 'bundling' ) {
  46.         $bundling = $action;
  47.     }
  48.     elsif ( $try eq 'bundling_override' ) {
  49.         $bundling = $action ? 2 : 0;
  50.     }
  51.     elsif ( $try eq 'require_order' ) {
  52.         $order = $action ? $REQUIRE_ORDER : $PERMUTE;
  53.     }
  54.     elsif ( $try eq 'permute' ) {
  55.         $order = $action ? $PERMUTE : $REQUIRE_ORDER;
  56.     }
  57.     elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
  58.         $passthrough = $action;
  59.     }
  60.     elsif ( $try =~ /^prefix=(.+)$/ ) {
  61.         $genprefix = $1;
  62.         # Turn into regexp. Needs to be parenthesized!
  63.         $genprefix = "(" . quotemeta($genprefix) . ")";
  64.         eval { '' =~ /$genprefix/; };
  65.         Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
  66.     }
  67.     elsif ( $try =~ /^prefix_pattern=(.+)$/ ) {
  68.         $genprefix = $1;
  69.         # Parenthesize if needed.
  70.         $genprefix = "(" . $genprefix . ")"
  71.           unless $genprefix =~ /^\(.*\)$/;
  72.         eval { '' =~ /$genprefix/; };
  73.         Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
  74.     }
  75.     elsif ( $try eq 'debug' ) {
  76.         $debug = $action;
  77.     }
  78.     else {
  79.         Croak ("Getopt::Long: unknown config parameter \"$opt\"")
  80.     }
  81.     }
  82.     $prevconfig;
  83. }
  84.  
  85. # end of Getopt::Long::Configure
  86. 1;
  87.