lib/Pod/Usage.pm

   1 #############################################################################
   2 # Pod/Usage.pm -- print usage messages for the running script.
   3 #
   4 # Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
   5 # This file is part of "PodParser". PodParser is free software;
   6 # you can redistribute it and/or modify it under the same terms
   7 # as Perl itself.
   8 #############################################################################
   9
  10 package Pod::Usage;
  11 use strict;
  12
  13 use vars qw($VERSION @ISA @EXPORT);
  14 $VERSION = '1.36';  ## Current version of this package
  15 require  5.005;    ## requires this Perl version or later
  16
  17 =head1 NAME
  18
  19 Pod::Usage, pod2usage() - print a usage message from embedded pod documentation
  20
  21 =head1 SYNOPSIS
  22
  23   use Pod::Usage
  24
  25   my $message_text  = "This text precedes the usage message.";
  26   my $exit_status   = 2;          ## The exit status to use
  27   my $verbose_level = 0;          ## The verbose level to use
  28   my $filehandle    = \*STDERR;   ## The filehandle to write to
  29
  30   pod2usage($message_text);
  31
  32   pod2usage($exit_status);
  33
  34   pod2usage( { -message => $message_text ,
  35                -exitval => $exit_status  ,
  36                -verbose => $verbose_level,
  37                -output  => $filehandle } );
  38
  39   pod2usage(   -msg     => $message_text ,
  40                -exitval => $exit_status  ,
  41                -verbose => $verbose_level,
  42                -output  => $filehandle   );
  43
  44   pod2usage(   -verbose => 2,
  45                -noperldoc => 1  )
  46
  47 =head1 ARGUMENTS
  48
  49 B<pod2usage> should be given either a single argument, or a list of
  50 arguments corresponding to an associative array (a "hash"). When a single
  51 argument is given, it should correspond to exactly one of the following:
  52
  53 =over 4
  54
  55 =item *
  56
  57 A string containing the text of a message to print I<before> printing
  58 the usage message
  59
  60 =item *
  61
  62 A numeric value corresponding to the desired exit status
  63
  64 =item *
  65
  66 A reference to a hash
  67
  68 =back
  69
  70 If more than one argument is given then the entire argument list is
  71 assumed to be a hash.  If a hash is supplied (either as a reference or
  72 as a list) it should contain one or more elements with the following
  73 keys:
  74
  75 =over 4
  76
  77 =item C<-message>
  78
  79 =item C<-msg>
  80
  81 The text of a message to print immediately prior to printing the
  82 program's usage message.
  83
  84 =item C<-exitval>
  85
  86 The desired exit status to pass to the B<exit()> function.
  87 This should be an integer, or else the string "NOEXIT" to
  88 indicate that control should simply be returned without
  89 terminating the invoking process.
  90
  91 =item C<-verbose>
  92
  93 The desired level of "verboseness" to use when printing the usage
  94 message. If the corresponding value is 0, then only the "SYNOPSIS"
  95 section of the pod documentation is printed. If the corresponding value
  96 is 1, then the "SYNOPSIS" section, along with any section entitled
  97 "OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is printed.  If the
  98 corresponding value is 2 or more then the entire manpage is printed.
  99
 100 The special verbosity level 99 requires to also specify the -sections
 101 parameter; then these sections are extracted (see L<Pod::Select>)
 102 and printed.
 103
 104 =item C<-sections>
 105
 106 A string representing a selection list for sections to be printed
 107 when -verbose is set to 99, e.g. C<"NAME|SYNOPSIS|DESCRIPTION|VERSION">.
 108
 109 Alternatively, an array reference of section specifications can be used:
 110
 111   pod2usage(-verbose => 99,
 112             -sections => [ qw(fred fred/subsection) ] );
 113
 114 =item C<-output>
 115
 116 A reference to a filehandle, or the pathname of a file to which the
 117 usage message should be written. The default is C<\*STDERR> unless the
 118 exit value is less than 2 (in which case the default is C<\*STDOUT>).
 119
 120 =item C<-input>
 121
 122 A reference to a filehandle, or the pathname of a file from which the
 123 invoking script's pod documentation should be read.  It defaults to the
 124 file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
 125
 126 If you are calling B<pod2usage()> from a module and want to display
 127 that module's POD, you can use this:
 128
 129   use Pod::Find qw(pod_where);
 130   pod2usage( -input => pod_where({-inc => 1}, __PACKAGE__) );
 131
 132 =item C<-pathlist>
 133
 134 A list of directory paths. If the input file does not exist, then it
 135 will be searched for in the given directory list (in the order the
 136 directories appear in the list). It defaults to the list of directories
 137 implied by C<$ENV{PATH}>. The list may be specified either by a reference
 138 to an array, or by a string of directory paths which use the same path
 139 separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
 140 MSWin32 and DOS).
 141
 142 =item C<-noperldoc>
 143
 144 By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
 145 specified. This does not work well e.g. if the script was packed
 146 with L<PAR>. The -noperldoc option suppresses the external call to
 147 L<perldoc> and uses the simple text formatter (L<Pod::Text>) to
 148 output the POD.
 149
 150 =back
 151
 152 =head1 DESCRIPTION
 153
 154 B<pod2usage> will print a usage message for the invoking script (using
 155 its embedded pod documentation) and then exit the script with the
 156 desired exit status. The usage message printed may have any one of three
 157 levels of "verboseness": If the verbose level is 0, then only a synopsis
 158 is printed. If the verbose level is 1, then the synopsis is printed
 159 along with a description (if present) of the command line options and
 160 arguments. If the verbose level is 2, then the entire manual page is
 161 printed.
 162
 163 Unless they are explicitly specified, the default values for the exit
 164 status, verbose level, and output stream to use are determined as
 165 follows:
 166
 167 =over 4
 168
 169 =item *
 170
 171 If neither the exit status nor the verbose level is specified, then the
 172 default is to use an exit status of 2 with a verbose level of 0.
 173
 174 =item *
 175
 176 If an exit status I<is> specified but the verbose level is I<not>, then the
 177 verbose level will default to 1 if the exit status is less than 2 and
 178 will default to 0 otherwise.
 179
 180 =item *
 181
 182 If an exit status is I<not> specified but verbose level I<is> given, then
 183 the exit status will default to 2 if the verbose level is 0 and will
 184 default to 1 otherwise.
 185
 186 =item *
 187
 188 If the exit status used is less than 2, then output is printed on
 189 C<STDOUT>.  Otherwise output is printed on C<STDERR>.
 190
 191 =back
 192
 193 Although the above may seem a bit confusing at first, it generally does
 194 "the right thing" in most situations.  This determination of the default
 195 values to use is based upon the following typical Unix conventions:
 196
 197 =over 4
 198
 199 =item *
 200
 201 An exit status of 0 implies "success". For example, B<diff(1)> exits
 202 with a status of 0 if the two files have the same contents.
 203
 204 =item *
 205
 206 An exit status of 1 implies possibly abnormal, but non-defective, program
 207 termination.  For example, B<grep(1)> exits with a status of 1 if
 208 it did I<not> find a matching line for the given regular expression.
 209
 210 =item *
 211
 212 An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
 213 exits with a status of 2 if you specify an illegal (unknown) option on
 214 the command line.
 215
 216 =item *
 217
 218 Usage messages issued as a result of bad command-line syntax should go
 219 to C<STDERR>.  However, usage messages issued due to an explicit request
 220 to print usage (like specifying B<-help> on the command line) should go
 221 to C<STDOUT>, just in case the user wants to pipe the output to a pager
 222 (such as B<more(1)>).
 223
 224 =item *
 225
 226 If program usage has been explicitly requested by the user, it is often
 227 desirable to exit with a status of 1 (as opposed to 0) after issuing
 228 the user-requested usage message.  It is also desirable to give a
 229 more verbose description of program usage in this case.
 230
 231 =back
 232
 233 B<pod2usage> doesn't force the above conventions upon you, but it will
 234 use them by default if you don't expressly tell it to do otherwise.  The
 235 ability of B<pod2usage()> to accept a single number or a string makes it
 236 convenient to use as an innocent looking error message handling function:
 237
 238     use Pod::Usage;
 239     use Getopt::Long;
 240
 241     ## Parse options
 242     GetOptions("help", "man", "flag1")  ||  pod2usage(2);
 243     pod2usage(1)  if ($opt_help);
 244     pod2usage(-verbose => 2)  if ($opt_man);
 245
 246     ## Check for too many filenames
 247     pod2usage("$0: Too many files given.\n")  if (@ARGV > 1);
 248
 249 Some user's however may feel that the above "economy of expression" is
 250 not particularly readable nor consistent and may instead choose to do
 251 something more like the following:
 252
 253     use Pod::Usage;
 254     use Getopt::Long;
 255
 256     ## Parse options
 257     GetOptions("help", "man", "flag1")  ||  pod2usage(-verbose => 0);
 258     pod2usage(-verbose => 1)  if ($opt_help);
 259     pod2usage(-verbose => 2)  if ($opt_man);
 260
 261     ## Check for too many filenames
 262     pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
 263         if (@ARGV > 1);
 264
 265 As with all things in Perl, I<there's more than one way to do it>, and
 266 B<pod2usage()> adheres to this philosophy.  If you are interested in
 267 seeing a number of different ways to invoke B<pod2usage> (although by no
 268 means exhaustive), please refer to L<"EXAMPLES">.
 269
 270 =head1 EXAMPLES
 271
 272 Each of the following invocations of C<pod2usage()> will print just the
 273 "SYNOPSIS" section to C<STDERR> and will exit with a status of 2:
 274
 275     pod2usage();
 276
 277     pod2usage(2);
 278
 279     pod2usage(-verbose => 0);
 280
 281     pod2usage(-exitval => 2);
 282
 283     pod2usage({-exitval => 2, -output => \*STDERR});
 284
 285     pod2usage({-verbose => 0, -output  => \*STDERR});
 286
 287     pod2usage(-exitval => 2, -verbose => 0);
 288
 289     pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);
 290
 291 Each of the following invocations of C<pod2usage()> will print a message
 292 of "Syntax error." (followed by a newline) to C<STDERR>, immediately
 293 followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
 294 will exit with a status of 2:
 295
 296     pod2usage("Syntax error.");
 297
 298     pod2usage(-message => "Syntax error.", -verbose => 0);
 299
 300     pod2usage(-msg  => "Syntax error.", -exitval => 2);
 301
 302     pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});
 303
 304     pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});
 305
 306     pod2usage(-msg  => "Syntax error.", -exitval => 2, -verbose => 0);
 307
 308     pod2usage(-message => "Syntax error.",
 309               -exitval => 2,
 310               -verbose => 0,
 311               -output  => \*STDERR);
 312
 313 Each of the following invocations of C<pod2usage()> will print the
 314 "SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
 315 C<STDOUT> and will exit with a status of 1:
 316
 317     pod2usage(1);
 318
 319     pod2usage(-verbose => 1);
 320
 321     pod2usage(-exitval => 1);
 322
 323     pod2usage({-exitval => 1, -output => \*STDOUT});
 324
 325     pod2usage({-verbose => 1, -output => \*STDOUT});
 326
 327     pod2usage(-exitval => 1, -verbose => 1);
 328
 329     pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});
 330
 331 Each of the following invocations of C<pod2usage()> will print the
 332 entire manual page to C<STDOUT> and will exit with a status of 1:
 333
 334     pod2usage(-verbose  => 2);
 335
 336     pod2usage({-verbose => 2, -output => \*STDOUT});
 337
 338     pod2usage(-exitval  => 1, -verbose => 2);
 339
 340     pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});
 341
 342 =head2 Recommended Use
 343
 344 Most scripts should print some type of usage message to C<STDERR> when a
 345 command line syntax error is detected. They should also provide an
 346 option (usually C<-H> or C<-help>) to print a (possibly more verbose)
 347 usage message to C<STDOUT>. Some scripts may even wish to go so far as to
 348 provide a means of printing their complete documentation to C<STDOUT>
 349 (perhaps by allowing a C<-man> option). The following complete example
 350 uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
 351 things:
 352
 353     use Getopt::Long;
 354     use Pod::Usage;
 355
 356     my $man = 0;
 357     my $help = 0;
 358     ## Parse options and print usage if there is a syntax error,
 359     ## or if usage was explicitly requested.
 360     GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
 361     pod2usage(1) if $help;
 362     pod2usage(-verbose => 2) if $man;
 363
 364     ## If no arguments were given, then allow STDIN to be used only
 365     ## if it's not connected to a terminal (otherwise print usage)
 366     pod2usage("$0: No files given.")  if ((@ARGV == 0) && (-t STDIN));
 367     __END__
 368
 369     =head1 NAME
 370
 371     sample - Using GetOpt::Long and Pod::Usage
 372
 373     =head1 SYNOPSIS
 374
 375     sample [options] [file ...]
 376
 377      Options:
 378        -help            brief help message
 379        -man             full documentation
 380
 381     =head1 OPTIONS
 382
 383     =over 8
 384
 385     =item B<-help>
 386
 387     Print a brief help message and exits.
 388
 389     =item B<-man>
 390
 391     Prints the manual page and exits.
 392
 393     =back
 394
 395     =head1 DESCRIPTION
 396
 397     B<This program> will read the given input file(s) and do something
 398     useful with the contents thereof.
 399
 400     =cut
 401
 402 =head1 CAVEATS
 403
 404 By default, B<pod2usage()> will use C<$0> as the path to the pod input
 405 file.  Unfortunately, not all systems on which Perl runs will set C<$0>
 406 properly (although if C<$0> isn't found, B<pod2usage()> will search
 407 C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
 408 If this is the case for your system, you may need to explicitly specify
 409 the path to the pod docs for the invoking script using something
 410 similar to the following:
 411
 412     pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
 413
 414 In the pathological case that a script is called via a relative path
 415 I<and> the script itself changes the current working directory
 416 (see L<perlfunc/chdir>) I<before> calling pod2usage, Pod::Usage will
 417 fail even on robust platforms. Don't do that.
 418
 419 =head1 AUTHOR
 420
 421 Please report bugs using L<http://rt.cpan.org>.
 422
 423 Marek Rouchal E<lt>marekr@cpan.orgE<gt>
 424
 425 Brad Appleton E<lt>bradapp@enteract.comE<gt>
 426
 427 Based on code for B<Pod::Text::pod2text()> written by
 428 Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
 429
 430 =head1 ACKNOWLEDGMENTS
 431
 432 Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
 433 with re-writing this manpage.
 434
 435 =head1 SEE ALSO
 436
 437 L<Pod::Parser>, L<Getopt::Long>, L<Pod::Find>
 438
 439 =cut
 440
 441 #############################################################################
 442
 443 #use diagnostics;
 444 use Carp;
 445 use Config;
 446 use Exporter;
 447 use File::Spec;
 448
 449 @EXPORT = qw(&pod2usage);
 450 BEGIN {
 451     if ( $] >= 5.005_58 ) {
 452        require Pod::Text;
 453        @ISA = qw( Pod::Text );
 454     }
 455     else {
 456        require Pod::PlainText;
 457        @ISA = qw( Pod::PlainText );
 458     }
 459 }
 460
 461 require Pod::Select;
 462
 463 ##---------------------------------------------------------------------------
 464
 465 ##---------------------------------
 466 ## Function definitions begin here
 467 ##---------------------------------
 468
 469 sub pod2usage {
 470     local($_) = shift;
 471     my %opts;
 472     ## Collect arguments
 473     if (@_ > 0) {
 474         ## Too many arguments - assume that this is a hash and
 475         ## the user forgot to pass a reference to it.
 476         %opts = ($_, @_);
 477     }
 478     elsif (!defined $_) {
 479       $_ = '';
 480     }
 481     elsif (ref $_) {
 482         ## User passed a ref to a hash
 483         %opts = %{$_}  if (ref($_) eq 'HASH');
 484     }
 485     elsif (/^[-+]?\d+$/) {
 486         ## User passed in the exit value to use
 487         $opts{'-exitval'} =  $_;
 488     }
 489     else {
 490         ## User passed in a message to print before issuing usage.
 491         $_  and  $opts{'-message'} = $_;
 492     }
 493
 494     ## Need this for backward compatibility since we formerly used
 495     ## options that were all uppercase words rather than ones that
 496     ## looked like Unix command-line options.
 497     ## to be uppercase keywords)
 498     %opts = map {
 499         my ($key, $val) = ($_, $opts{$_});
 500         $key =~ s/^(?=\w)/-/;
 501         $key =~ /^-msg/i   and  $key = '-message';
 502         $key =~ /^-exit/i  and  $key = '-exitval';
 503         lc($key) => $val;
 504     } (keys %opts);
 505
 506     ## Now determine default -exitval and -verbose values to use
 507     if ((! defined $opts{'-exitval'}) && (! defined $opts{'-verbose'})) {
 508         $opts{'-exitval'} = 2;
 509         $opts{'-verbose'} = 0;
 510     }
 511     elsif (! defined $opts{'-exitval'}) {
 512         $opts{'-exitval'} = ($opts{'-verbose'} > 0) ? 1 : 2;
 513     }
 514     elsif (! defined $opts{'-verbose'}) {
 515         $opts{'-verbose'} = (lc($opts{'-exitval'}) eq 'noexit' ||
 516                              $opts{'-exitval'} < 2);
 517     }
 518
 519     ## Default the output file
 520     $opts{'-output'} = (lc($opts{'-exitval'}) eq 'noexit' ||
 521                         $opts{'-exitval'} < 2) ? \*STDOUT : \*STDERR
 522             unless (defined $opts{'-output'});
 523     ## Default the input file
 524     $opts{'-input'} = $0  unless (defined $opts{'-input'});
 525
 526     ## Look up input file in path if it doesnt exist.
 527     unless ((ref $opts{'-input'}) || (-e $opts{'-input'})) {
 528         my $basename = $opts{'-input'};
 529         my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/i) ? ';'
 530                             : (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' :  ':');
 531         my $pathspec = $opts{'-pathlist'} || $ENV{PATH} || $ENV{PERL5LIB};
 532
 533         my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
 534         for my $dirname (@paths) {
 535             $_ = File::Spec->catfile($dirname, $basename)  if length;
 536             last if (-e $_) && ($opts{'-input'} = $_);
 537         }
 538     }
 539
 540     ## Now create a pod reader and constrain it to the desired sections.
 541     my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts);
 542     if ($opts{'-verbose'} == 0) {
 543         $parser->select('(?:SYNOPSIS|USAGE)\s*');
 544     }
 545     elsif ($opts{'-verbose'} == 1) {
 546         my $opt_re = '(?i)' .
 547                      '(?:OPTIONS|ARGUMENTS)' .
 548                      '(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
 549         $parser->select( '(?:SYNOPSIS|USAGE)\s*', $opt_re, "DESCRIPTION/$opt_re" );
 550     }
 551     elsif ($opts{'-verbose'} >= 2 && $opts{'-verbose'} != 99) {
 552         $parser->select('.*');
 553     }
 554     elsif ($opts{'-verbose'} == 99) {
 555         my $sections = $opts{'-sections'};
 556         $parser->select( (ref $sections) ? @$sections : $sections );
 557         $opts{'-verbose'} = 1;
 558     }
 559
 560     ## Now translate the pod document and then exit with the desired status
 561     if (      !$opts{'-noperldoc'}
 562          and  $opts{'-verbose'} >= 2
 563          and  !ref($opts{'-input'})
 564          and  $opts{'-output'} == \*STDOUT )
 565     {
 566        ## spit out the entire PODs. Might as well invoke perldoc
 567        my $progpath = File::Spec->catfile($Config{scriptdir}, 'perldoc');
 568        print { $opts{'-output'} } ($opts{'-message'}, "\n") if($opts{'-message'});
 569        if(defined $opts{-input} && $opts{-input} =~ /^\s*(\S.*?)\s*$/) {
 570          # the perldocs back to 5.005 should all have -F
 571          # without -F there are warnings in -T scripts
 572          system($progpath, '-F', $1);
 573          if($?) {
 574            # RT16091: fall back to more if perldoc failed
 575            system(($Config{pager} || $ENV{PAGER} || '/bin/more'), $1);
 576          }
 577        } else {
 578          croak "Unspecified input file or insecure argument.\n";
 579        }
 580     }
 581     else {
 582        $parser->parse_from_file($opts{'-input'}, $opts{'-output'});
 583     }
 584
 585     exit($opts{'-exitval'})  unless (lc($opts{'-exitval'}) eq 'noexit');
 586 }
 587
 588 ##---------------------------------------------------------------------------
 589
 590 ##-------------------------------
 591 ## Method definitions begin here
 592 ##-------------------------------
 593
 594 sub new {
 595     my $this = shift;
 596     my $class = ref($this) || $this;
 597     my %params = @_;
 598     my $self = {%params};
 599     bless $self, $class;
 600     if ($self->can('initialize')) {
 601         $self->initialize();
 602     } else {
 603         $self = $self->SUPER::new();
 604         %$self = (%$self, %params);
 605     }
 606     return $self;
 607 }
 608
 609 sub select {
 610     my ($self, @sections) = @_;
 611     if ($ISA[0]->can('select')) {
 612         $self->SUPER::select(@sections);
 613     } else {
 614         # we're using Pod::Simple - need to mimic the behavior of Pod::Select
 615         my $add = ($sections[0] eq '+') ? shift(@sections) : '';
 616         ## Reset the set of sections to use
 617         unless (@sections) {
 618           delete $self->{USAGE_SELECT} unless ($add);
 619           return;
 620         }
 621         $self->{USAGE_SELECT} = []
 622           unless ($add && $self->{USAGE_SELECT});
 623         my $sref = $self->{USAGE_SELECT};
 624         ## Compile each spec
 625         for my $spec (@sections) {
 626           my $cs = Pod::Select::_compile_section_spec($spec);
 627           if ( defined $cs ) {
 628             ## Store them in our sections array
 629             push(@$sref, $cs);
 630           } else {
 631             carp qq{Ignoring section spec "$spec"!\n};
 632           }
 633         }
 634     }
 635 }
 636
 637 # Override Pod::Text->seq_i to return just "arg", not "*arg*".
 638 sub seq_i { return $_[1] }
 639
 640 # This overrides the Pod::Text method to do something very akin to what
 641 # Pod::Select did as well as the work done below by preprocess_paragraph.
 642 # Note that the below is very, very specific to Pod::Text.
 643 sub _handle_element_end {
 644     my ($self, $element) = @_;
 645     if ($element eq 'head1') {
 646         $self->{USAGE_HEADINGS} = [ $$self{PENDING}[-1][1] ];
 647         if ($self->{USAGE_OPTIONS}->{-verbose} < 2) {
 648             $$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/;
 649         }
 650     } elsif ($element =~ /^head(\d+)$/ && $1) { # avoid 0
 651         my $idx = $1 - 1;
 652         $self->{USAGE_HEADINGS} = [] unless($self->{USAGE_HEADINGS});
 653         $self->{USAGE_HEADINGS}->[$idx] = $$self{PENDING}[-1][1];
 654     }
 655     if ($element =~ /^head\d+$/) {
 656         $$self{USAGE_SKIPPING} = 1;
 657         if (!$$self{USAGE_SELECT} || !@{ $$self{USAGE_SELECT} }) {
 658             $$self{USAGE_SKIPPING} = 0;
 659         } else {
 660             my @headings = @{$$self{USAGE_HEADINGS}};
 661             for my $section_spec ( @{$$self{USAGE_SELECT}} ) {
 662                 my $match = 1;
 663                 for (my $i = 0; $i < $Pod::Select::MAX_HEADING_LEVEL; ++$i) {
 664                     $headings[$i] = '' unless defined $headings[$i];
 665                     my $regex   = $section_spec->[$i];
 666                     my $negated = ($regex =~ s/^\!//);
 667                     $match  &= ($negated ? ($headings[$i] !~ /${regex}/)
 668                                          : ($headings[$i] =~ /${regex}/));
 669                     last unless ($match);
 670                 } # end heading levels
 671                 if ($match) {
 672                   $$self{USAGE_SKIPPING} = 0;
 673                   last;
 674                 }
 675             } # end sections
 676         }
 677
 678         # Try to do some lowercasing instead of all-caps in headings, and use
 679         # a colon to end all headings.
 680         if($self->{USAGE_OPTIONS}->{-verbose} < 2) {
 681             local $_ = $$self{PENDING}[-1][1];
 682             s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
 683             s/\s*$/:/  unless (/:\s*$/);
 684             $_ .= "\n";
 685             $$self{PENDING}[-1][1] = $_;
 686         }
 687     }
 688     if ($$self{USAGE_SKIPPING} && $element !~ m/^over-/) {
 689         pop @{ $$self{PENDING} };
 690     } else {
 691         $self->SUPER::_handle_element_end($element);
 692     }
 693 }
 694
 695 # required for Pod::Simple API
 696 sub start_document {
 697     my $self = shift;
 698     $self->SUPER::start_document();
 699     my $msg = $self->{USAGE_OPTIONS}->{-message}  or  return 1;
 700     my $out_fh = $self->output_fh();
 701     print $out_fh "$msg\n";
 702 }
 703
 704 # required for old Pod::Parser API
 705 sub begin_pod {
 706     my $self = shift;
 707     $self->SUPER::begin_pod();  ## Have to call superclass
 708     my $msg = $self->{USAGE_OPTIONS}->{-message}  or  return 1;
 709     my $out_fh = $self->output_handle();
 710     print $out_fh "$msg\n";
 711 }
 712
 713 sub preprocess_paragraph {
 714     my $self = shift;
 715     local $_ = shift;
 716     my $line = shift;
 717     ## See if this is a heading and we arent printing the entire manpage.
 718     if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
 719         ## Change the title of the SYNOPSIS section to USAGE
 720         s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
 721         ## Try to do some lowercasing instead of all-caps in headings
 722         s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
 723         ## Use a colon to end all headings
 724         s/\s*$/:/  unless (/:\s*$/);
 725         $_ .= "\n";
 726     }
 727     return  $self->SUPER::preprocess_paragraph($_);
 728 }
 729
 730 1; # keep require happy