← Back to branch summary

~percona-toolkit-dev/percona-toolkit/fix-password-comma-bug-886077

« back to all changes in this revision

Viewing changes to lib/OptionParser.pm

  • Committer: Daniel Nichter
  • Date: 2012-02-07 20:10:11 UTC
  • mfrom: (174 2.0)
  • mto: This revision was merged to the branch mainline in revision 189.
  • Revision ID: daniel@percona.com-20120207201011-sok2c1f2ay9qr3gm
Merge trunk r174.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/OptionParser.pm
62
62
use strict;
63
63
use warnings FATAL => 'all';
64
64
use English qw(-no_match_vars);
65
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
65
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
66
66
 
67
67
use List::Util qw(max);
68
68
use Getopt::Long;
179
179
   my $contents = do { local $/ = undef; <$fh> };
180
180
   close $fh;
181
181
   if ( $contents =~ m/^=head1 DSN OPTIONS/m ) {
182
 
      MKDEBUG && _d('Parsing DSN OPTIONS');
 
182
      PTDEBUG && _d('Parsing DSN OPTIONS');
183
183
      my $dsn_attribs = {
184
184
         dsn  => 1,
185
185
         copy => 1,
221
221
      $self->{DSNParser} = DSNParser->new(opts => \@dsn_opts);
222
222
   }
223
223
 
224
 
   if ( $contents =~ m/^(Percona Toolkit v.+)$/m ) {
 
224
   if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) {
225
225
      $self->{version} = $1;
226
 
      MKDEBUG && _d($self->{version});
 
226
      PTDEBUG && _d($self->{version});
227
227
   }
228
228
 
229
229
   return;
291
291
      chomp $para;
292
292
      $para =~ s/\s+/ /g;
293
293
      $para =~ s/$POD_link_re/$1/go;
294
 
      MKDEBUG && _d('Option rule:', $para);
 
294
      PTDEBUG && _d('Option rule:', $para);
295
295
      push @rules, $para;
296
296
   }
297
297
 
301
301
   do {
302
302
      if ( my ($option) = $para =~ m/^=item $self->{item}/ ) {
303
303
         chomp $para;
304
 
         MKDEBUG && _d($para);
 
304
         PTDEBUG && _d($para);
305
305
         my %attribs;
306
306
 
307
307
         $para = <$fh>; # read next paragraph, possibly attributes
320
320
            $para = <$fh>; # read next paragraph, probably short help desc
321
321
         }
322
322
         else {
323
 
            MKDEBUG && _d('Option has no attributes');
 
323
            PTDEBUG && _d('Option has no attributes');
324
324
         }
325
325
 
326
326
         # Remove extra spaces and POD formatting (L<"">).
331
331
         # Take the first period-terminated sentence as the option's short help
332
332
         # description.
333
333
         $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s;
334
 
         MKDEBUG && _d('Short help:', $para);
 
334
         PTDEBUG && _d('Short help:', $para);
335
335
 
336
336
         die "No description after option spec $option" if $para =~ m/^=item/;
337
337
 
385
385
 
386
386
   foreach my $opt ( @specs ) {
387
387
      if ( ref $opt ) { # It's an option spec, not a rule.
388
 
         MKDEBUG && _d('Parsing opt spec:',
 
388
         PTDEBUG && _d('Parsing opt spec:',
389
389
            map { ($_, '=>', $opt->{$_}) } keys %$opt);
390
390
 
391
391
         my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/;
399
399
         $self->{opts}->{$long} = $opt;
400
400
 
401
401
         if ( length $long == 1 ) {
402
 
            MKDEBUG && _d('Long opt', $long, 'looks like short opt');
 
402
            PTDEBUG && _d('Long opt', $long, 'looks like short opt');
403
403
            $self->{short_opts}->{$long} = $long;
404
404
         }
405
405
 
425
425
 
426
426
         my ( $type ) = $opt->{spec} =~ m/=(.)/;
427
427
         $opt->{type} = $type;
428
 
         MKDEBUG && _d($long, 'type:', $type);
 
428
         PTDEBUG && _d($long, 'type:', $type);
429
429
 
430
430
         # This check is no longer needed because we'll create a DSNParser
431
431
         # object for ourself if DSN OPTIONS exists in the POD.
442
442
         # to set_defaults().
443
443
         if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) {
444
444
            $self->{defaults}->{$long} = defined $def ? $def : 1;
445
 
            MKDEBUG && _d($long, 'default:', $def);
 
445
            PTDEBUG && _d($long, 'default:', $def);
446
446
         }
447
447
 
448
448
         # Handle special behavior for --config.
454
454
         if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) {
455
455
            # Defer checking till later because of possible forward references.
456
456
            $disables{$long} = $dis;
457
 
            MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis);
 
457
            PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis);
458
458
         }
459
459
 
460
460
         # Save the option.
461
461
         $self->{opts}->{$long} = $opt;
462
462
      }
463
463
      else { # It's an option rule, not a spec.
464
 
         MKDEBUG && _d('Parsing rule:', $opt); 
 
464
         PTDEBUG && _d('Parsing rule:', $opt); 
465
465
         push @{$self->{rules}}, $opt;
466
466
         my @participants = $self->_get_participants($opt);
467
467
         my $rule_ok = 0;
469
469
         if ( $opt =~ m/mutually exclusive|one and only one/ ) {
470
470
            $rule_ok = 1;
471
471
            push @{$self->{mutex}}, \@participants;
472
 
            MKDEBUG && _d(@participants, 'are mutually exclusive');
 
472
            PTDEBUG && _d(@participants, 'are mutually exclusive');
473
473
         }
474
474
         if ( $opt =~ m/at least one|one and only one/ ) {
475
475
            $rule_ok = 1;
476
476
            push @{$self->{atleast1}}, \@participants;
477
 
            MKDEBUG && _d(@participants, 'require at least one');
 
477
            PTDEBUG && _d(@participants, 'require at least one');
478
478
         }
479
479
         if ( $opt =~ m/default to/ ) {
480
480
            $rule_ok = 1;
481
481
            # Example: "DSN values in L<"--dest"> default to values
482
482
            # from L<"--source">."
483
483
            $self->{defaults_to}->{$participants[0]} = $participants[1];
484
 
            MKDEBUG && _d($participants[0], 'defaults to', $participants[1]);
 
484
            PTDEBUG && _d($participants[0], 'defaults to', $participants[1]);
485
485
         }
486
486
         if ( $opt =~ m/restricted to option groups/ ) {
487
487
            $rule_ok = 1;
498
498
            # information for details."
499
499
            $rule_ok = 1;
500
500
            $self->{strict} = 0;
501
 
            MKDEBUG && _d("Strict mode disabled by rule");
 
501
            PTDEBUG && _d("Strict mode disabled by rule");
502
502
         }
503
503
 
504
504
         die "Unrecognized option rule: $opt" unless $rule_ok;
510
510
      # _get_participants() will check that each opt exists.
511
511
      my @participants = $self->_get_participants($disables{$long});
512
512
      $self->{disables}->{$long} = \@participants;
513
 
      MKDEBUG && _d('Option', $long, 'disables', @participants);
 
513
      PTDEBUG && _d('Option', $long, 'disables', @participants);
514
514
   }
515
515
 
516
516
   return; 
535
535
         unless exists $self->{opts}->{$long};
536
536
      push @participants, $long;
537
537
   }
538
 
   MKDEBUG && _d('Participants for', $str, ':', @participants);
 
538
   PTDEBUG && _d('Participants for', $str, ':', @participants);
539
539
   return @participants;
540
540
}
541
541
 
568
568
      die "Cannot set default for nonexistent option $long"
569
569
         unless exists $self->{opts}->{$long};
570
570
      $self->{defaults}->{$long} = $defaults{$long};
571
 
      MKDEBUG && _d('Default val for', $long, ':', $defaults{$long});
 
571
      PTDEBUG && _d('Default val for', $long, ':', $defaults{$long});
572
572
   }
573
573
   return;
574
574
}
602
602
      $opt->{value} = $val;
603
603
   }
604
604
   $opt->{got} = 1;
605
 
   MKDEBUG && _d('Got option', $long, '=', $val);
 
605
   PTDEBUG && _d('Got option', $long, '=', $val);
606
606
}
607
607
 
608
608
# Sub: get_opts
644
644
            if ( $self->got('config') ) {
645
645
               die $EVAL_ERROR;
646
646
            }
647
 
            elsif ( MKDEBUG ) {
 
647
            elsif ( PTDEBUG ) {
648
648
               _d($EVAL_ERROR);
649
649
            }
650
650
         }
719
719
            if ( exists $self->{disables}->{$long} ) {
720
720
               my @disable_opts = @{$self->{disables}->{$long}};
721
721
               map { $self->{opts}->{$_}->{value} = undef; } @disable_opts;
722
 
               MKDEBUG && _d('Unset options', @disable_opts,
 
722
               PTDEBUG && _d('Unset options', @disable_opts,
723
723
                  'because', $long,'disables them');
724
724
            }
725
725
 
772
772
            delete $long[$i];
773
773
         }
774
774
         else {
775
 
            MKDEBUG && _d('Temporarily failed to parse', $long);
 
775
            PTDEBUG && _d('Temporarily failed to parse', $long);
776
776
         }
777
777
      }
778
778
 
802
802
   my $val = $opt->{value};
803
803
 
804
804
   if ( $val && $opt->{type} eq 'm' ) {  # type time
805
 
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value');
 
805
      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value');
806
806
      my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/;
807
807
      # The suffix defaults to 's' unless otherwise specified.
808
808
      if ( !$suffix ) {
809
809
         my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/;
810
810
         $suffix = $s || 's';
811
 
         MKDEBUG && _d('No suffix given; using', $suffix, 'for',
 
811
         PTDEBUG && _d('No suffix given; using', $suffix, 'for',
812
812
            $opt->{long}, '(value:', $val, ')');
813
813
      }
814
814
      if ( $suffix =~ m/[smhd]/ ) {
817
817
              : $suffix eq 'h' ? $num * 3600     # Hours
818
818
              :                  $num * 86400;   # Days
819
819
         $opt->{value} = ($prefix || '') . $val;
820
 
         MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val);
 
820
         PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val);
821
821
      }
822
822
      else {
823
823
         $self->save_error("Invalid time suffix for --$opt->{long}");
824
824
      }
825
825
   }
826
826
   elsif ( $val && $opt->{type} eq 'd' ) {  # type DSN
827
 
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN');
 
827
      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN');
828
828
      # DSN vals for this opt may come from 3 places, in order of precedence:
829
829
      # the opt itself, the defaults to/copies from opt (prev), or
830
830
      # --host, --port, etc. (defaults).
831
831
      my $prev = {};
832
832
      my $from_key = $self->{defaults_to}->{ $opt->{long} };
833
833
      if ( $from_key ) {
834
 
         MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN');
 
834
         PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN');
835
835
         if ( $self->{opts}->{$from_key}->{parsed} ) {
836
836
            $prev = $self->{opts}->{$from_key}->{value};
837
837
         }
838
838
         else {
839
 
            MKDEBUG && _d('Cannot parse', $opt->{long}, 'until',
 
839
            PTDEBUG && _d('Cannot parse', $opt->{long}, 'until',
840
840
               $from_key, 'parsed');
841
841
            return;
842
842
         }
845
845
      $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults);
846
846
   }
847
847
   elsif ( $val && $opt->{type} eq 'z' ) {  # type size
848
 
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value');
 
848
      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value');
849
849
      $self->_parse_size($opt, $val);
850
850
   }
851
851
   elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) {
855
855
      $opt->{value} = [ split(/(?<!\\),\s*/, ($val || '')) ];
856
856
   }
857
857
   else {
858
 
      MKDEBUG && _d('Nothing to validate for option',
 
858
      PTDEBUG && _d('Nothing to validate for option',
859
859
         $opt->{long}, 'type', $opt->{type}, 'value', $val);
860
860
   }
861
861
 
972
972
   # First make sure we have a description and usage, else print_usage()
973
973
   # and print_errors() will die.
974
974
   if ( !$self->{description} || !$self->{usage} ) {
975
 
      MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file);
 
975
      PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file);
976
976
      my %synop = $self->_parse_synopsis($file);
977
977
      $self->{description} ||= $synop{description};
978
978
      $self->{usage}       ||= $synop{usage};
979
 
      MKDEBUG && _d("Description:", $self->{description},
 
979
      PTDEBUG && _d("Description:", $self->{description},
980
980
         "\nUsage:", $self->{usage});
981
981
   }
982
982
 
1247
1247
 
1248
1248
   # Special case used by mk-find to do things like --datasize null.
1249
1249
   if ( lc($val || '') eq 'null' ) {
1250
 
      MKDEBUG && _d('NULL size for', $opt->{long});
 
1250
      PTDEBUG && _d('NULL size for', $opt->{long});
1251
1251
      $opt->{value} = 'null';
1252
1252
      return;
1253
1253
   }
1257
1257
   if ( defined $num ) {
1258
1258
      if ( $factor ) {
1259
1259
         $num *= $factor_for{$factor};
1260
 
         MKDEBUG && _d('Setting option', $opt->{y},
 
1260
         PTDEBUG && _d('Setting option', $opt->{y},
1261
1261
            'to num', $num, '* factor', $factor);
1262
1262
      }
1263
1263
      $opt->{value} = ($pre || '') . $num;
1264
1264
   }
1265
1265
   else {
1266
 
      $self->save_error("Invalid size for --$opt->{long}");
 
1266
      $self->save_error("Invalid size for --$opt->{long}: $val");
1267
1267
   }
1268
1268
   return;
1269
1269
}
1283
1283
sub _parse_synopsis {
1284
1284
   my ( $self, $file ) = @_;
1285
1285
   $file ||= $self->{file} || __FILE__;
1286
 
   MKDEBUG && _d("Parsing SYNOPSIS in", $file);
 
1286
   PTDEBUG && _d("Parsing SYNOPSIS in", $file);
1287
1287
 
1288
1288
   # Slurp the file.
1289
1289
   local $INPUT_RECORD_SEPARATOR = '';  # read paragraphs
1297
1297
      push @synop, $para;
1298
1298
   }
1299
1299
   close $fh;
1300
 
   MKDEBUG && _d("Raw SYNOPSIS text:", @synop);
 
1300
   PTDEBUG && _d("Raw SYNOPSIS text:", @synop);
1301
1301
   my ($usage, $desc) = @synop;
1302
1302
   die "The SYNOPSIS section in $file is not formatted properly"
1303
1303
      unless $usage && $desc;
1329
1329
# This is debug code I want to run for all tools, and this is a module I
1330
1330
# certainly include in all tools, but otherwise there's no real reason to put
1331
1331
# it here.
1332
 
if ( MKDEBUG ) {
 
1332
if ( PTDEBUG ) {
1333
1333
   print '# ', $^X, ' ', $], "\n";
1334
1334
   if ( my $uname = `uname -a` ) {
1335
1335
      $uname =~ s/\s+/ /g;