[Summary view] [Print] [Text view]

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