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