Usage.pm
上传用户:shbosideng
上传日期:2013-05-04
资源大小:1555k
文件大小:17k
源码类别:

SNMP编程

开发平台:

C/C++

  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. package Pod::Usage;
  10. use vars qw($VERSION);
  11. $VERSION = 1.13;  ## Current version of this package
  12. require  5.005;    ## requires this Perl version or later
  13. =head1 NAME
  14. Pod::Usage, pod2usage() - print a usage message from embedded pod documentation
  15. =head1 SYNOPSIS
  16.   use Pod::Usage
  17.   my $message_text  = "This text precedes the usage message.";
  18.   my $exit_status   = 2;          ## The exit status to use
  19.   my $verbose_level = 0;          ## The verbose level to use
  20.   my $filehandle    = *STDERR;   ## The filehandle to write to
  21.   pod2usage($message_text);
  22.   pod2usage($exit_status);
  23.   pod2usage( { -message => $message_text ,
  24.                -exitval => $exit_status  ,  
  25.                -verbose => $verbose_level,  
  26.                -output  => $filehandle } );
  27.   pod2usage(   -msg     => $message_text ,
  28.                -exitval => $exit_status  ,  
  29.                -verbose => $verbose_level,  
  30.                -output  => $filehandle   );
  31. =head1 ARGUMENTS
  32. B<pod2usage> should be given either a single argument, or a list of
  33. arguments corresponding to an associative array (a "hash"). When a single
  34. argument is given, it should correspond to exactly one of the following:
  35. =over 4
  36. =item *
  37. A string containing the text of a message to print I<before> printing
  38. the usage message
  39. =item *
  40. A numeric value corresponding to the desired exit status
  41. =item *
  42. A reference to a hash
  43. =back
  44. If more than one argument is given then the entire argument list is
  45. assumed to be a hash.  If a hash is supplied (either as a reference or
  46. as a list) it should contain one or more elements with the following
  47. keys:
  48. =over 4
  49. =item C<-message>
  50. =item C<-msg>
  51. The text of a message to print immediately prior to printing the
  52. program's usage message. 
  53. =item C<-exitval>
  54. The desired exit status to pass to the B<exit()> function.
  55. =item C<-verbose>
  56. The desired level of "verboseness" to use when printing the usage
  57. message. If the corresponding value is 0, then only the "SYNOPSIS"
  58. section of the pod documentation is printed. If the corresponding value
  59. is 1, then the "SYNOPSIS" section, along with any section entitled
  60. "OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is printed.  If the
  61. corresponding value is 2 or more then the entire manpage is printed.
  62. =item C<-output>
  63. A reference to a filehandle, or the pathname of a file to which the
  64. usage message should be written. The default is C<*STDERR> unless the
  65. exit value is less than 2 (in which case the default is C<*STDOUT>).
  66. =item C<-input>
  67. A reference to a filehandle, or the pathname of a file from which the
  68. invoking script's pod documentation should be read.  It defaults to the
  69. file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
  70. =item C<-pathlist>
  71. A list of directory paths. If the input file does not exist, then it
  72. will be searched for in the given directory list (in the order the
  73. directories appear in the list). It defaults to the list of directories
  74. implied by C<$ENV{PATH}>. The list may be specified either by a reference
  75. to an array, or by a string of directory paths which use the same path
  76. separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
  77. MSWin32 and DOS).
  78. =back
  79. =head1 DESCRIPTION
  80. B<pod2usage> will print a usage message for the invoking script (using
  81. its embedded pod documentation) and then exit the script with the
  82. desired exit status. The usage message printed may have any one of three
  83. levels of "verboseness": If the verbose level is 0, then only a synopsis
  84. is printed. If the verbose level is 1, then the synopsis is printed
  85. along with a description (if present) of the command line options and
  86. arguments. If the verbose level is 2, then the entire manual page is
  87. printed.
  88. Unless they are explicitly specified, the default values for the exit
  89. status, verbose level, and output stream to use are determined as
  90. follows:
  91. =over 4
  92. =item *
  93. If neither the exit status nor the verbose level is specified, then the
  94. default is to use an exit status of 2 with a verbose level of 0.
  95. =item *
  96. If an exit status I<is> specified but the verbose level is I<not>, then the
  97. verbose level will default to 1 if the exit status is less than 2 and
  98. will default to 0 otherwise.
  99. =item *
  100. If an exit status is I<not> specified but verbose level I<is> given, then
  101. the exit status will default to 2 if the verbose level is 0 and will
  102. default to 1 otherwise.
  103. =item *
  104. If the exit status used is less than 2, then output is printed on
  105. C<STDOUT>.  Otherwise output is printed on C<STDERR>.
  106. =back
  107. Although the above may seem a bit confusing at first, it generally does
  108. "the right thing" in most situations.  This determination of the default
  109. values to use is based upon the following typical Unix conventions:
  110. =over 4
  111. =item *
  112. An exit status of 0 implies "success". For example, B<diff(1)> exits
  113. with a status of 0 if the two files have the same contents.
  114. =item *
  115. An exit status of 1 implies possibly abnormal, but non-defective, program
  116. termination.  For example, B<grep(1)> exits with a status of 1 if
  117. it did I<not> find a matching line for the given regular expression.
  118. =item *
  119. An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
  120. exits with a status of 2 if you specify an illegal (unknown) option on
  121. the command line.
  122. =item *
  123. Usage messages issued as a result of bad command-line syntax should go
  124. to C<STDERR>.  However, usage messages issued due to an explicit request
  125. to print usage (like specifying B<-help> on the command line) should go
  126. to C<STDOUT>, just in case the user wants to pipe the output to a pager
  127. (such as B<more(1)>).
  128. =item *
  129. If program usage has been explicitly requested by the user, it is often
  130. desireable to exit with a status of 1 (as opposed to 0) after issuing
  131. the user-requested usage message.  It is also desireable to give a
  132. more verbose description of program usage in this case.
  133. =back
  134. B<pod2usage> doesn't force the above conventions upon you, but it will
  135. use them by default if you don't expressly tell it to do otherwise.  The
  136. ability of B<pod2usage()> to accept a single number or a string makes it
  137. convenient to use as an innocent looking error message handling function:
  138.     use Pod::Usage;
  139.     use Getopt::Long;
  140.     ## Parse options
  141.     GetOptions("help", "man", "flag1")  ||  pod2usage(2);
  142.     pod2usage(1)  if ($opt_help);
  143.     pod2usage(-verbose => 2)  if ($opt_man);
  144.     ## Check for too many filenames
  145.     pod2usage("$0: Too many files given.n")  if (@ARGV > 1);
  146. Some user's however may feel that the above "economy of expression" is
  147. not particularly readable nor consistent and may instead choose to do
  148. something more like the following:
  149.     use Pod::Usage;
  150.     use Getopt::Long;
  151.     ## Parse options
  152.     GetOptions("help", "man", "flag1")  ||  pod2usage(-verbose => 0);
  153.     pod2usage(-verbose => 1)  if ($opt_help);
  154.     pod2usage(-verbose => 2)  if ($opt_man);
  155.     ## Check for too many filenames
  156.     pod2usage(-verbose => 2, -message => "$0: Too many files given.n")
  157.         if (@ARGV > 1);
  158. As with all things in Perl, I<there's more than one way to do it>, and
  159. B<pod2usage()> adheres to this philosophy.  If you are interested in
  160. seeing a number of different ways to invoke B<pod2usage> (although by no
  161. means exhaustive), please refer to L<"EXAMPLES">.
  162. =head1 EXAMPLES
  163. Each of the following invocations of C<pod2usage()> will print just the
  164. "SYNOPSIS" section to C<STDERR> and will exit with a status of 2:
  165.     pod2usage();
  166.     pod2usage(2);
  167.     pod2usage(-verbose => 0);
  168.     pod2usage(-exitval => 2);
  169.     pod2usage({-exitval => 2, -output => *STDERR});
  170.     pod2usage({-verbose => 0, -output  => *STDERR});
  171.     pod2usage(-exitval => 2, -verbose => 0);
  172.     pod2usage(-exitval => 2, -verbose => 0, -output => *STDERR);
  173. Each of the following invocations of C<pod2usage()> will print a message
  174. of "Syntax error." (followed by a newline) to C<STDERR>, immediately
  175. followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
  176. will exit with a status of 2:
  177.     pod2usage("Syntax error.");
  178.     pod2usage(-message => "Syntax error.", -verbose => 0);
  179.     pod2usage(-msg  => "Syntax error.", -exitval => 2);
  180.     pod2usage({-msg => "Syntax error.", -exitval => 2, -output => *STDERR});
  181.     pod2usage({-msg => "Syntax error.", -verbose => 0, -output => *STDERR});
  182.     pod2usage(-msg  => "Syntax error.", -exitval => 2, -verbose => 0);
  183.     pod2usage(-message => "Syntax error.",
  184.               -exitval => 2,
  185.               -verbose => 0,
  186.               -output  => *STDERR);
  187. Each of the following invocations of C<pod2usage()> will print the
  188. "SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
  189. C<STDOUT> and will exit with a status of 1:
  190.     pod2usage(1);
  191.     pod2usage(-verbose => 1);
  192.     pod2usage(-exitval => 1);
  193.     pod2usage({-exitval => 1, -output => *STDOUT});
  194.     pod2usage({-verbose => 1, -output => *STDOUT});
  195.     pod2usage(-exitval => 1, -verbose => 1);
  196.     pod2usage(-exitval => 1, -verbose => 1, -output => *STDOUT});
  197. Each of the following invocations of C<pod2usage()> will print the
  198. entire manual page to C<STDOUT> and will exit with a status of 1:
  199.     pod2usage(-verbose  => 2);
  200.     pod2usage({-verbose => 2, -output => *STDOUT});
  201.     pod2usage(-exitval  => 1, -verbose => 2);
  202.     pod2usage({-exitval => 1, -verbose => 2, -output => *STDOUT});
  203. =head2 Recommended Use
  204. Most scripts should print some type of usage message to C<STDERR> when a
  205. command line syntax error is detected. They should also provide an
  206. option (usually C<-H> or C<-help>) to print a (possibly more verbose)
  207. usage message to C<STDOUT>. Some scripts may even wish to go so far as to
  208. provide a means of printing their complete documentation to C<STDOUT>
  209. (perhaps by allowing a C<-man> option). The following complete example
  210. uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
  211. things:
  212.     use Getopt::Long;
  213.     use Pod::Usage;
  214.     my $man = 0;
  215.     my $help = 0;
  216.     ## Parse options and print usage if there is a syntax error,
  217.     ## or if usage was explicitly requested.
  218.     GetOptions('help|?' => $help, man => $man) or pod2usage(2);
  219.     pod2usage(1) if $help;
  220.     pod2usage(-verbose => 2) if $man;
  221.     ## If no arguments were given, then allow STDIN to be used only
  222.     ## if it's not connected to a terminal (otherwise print usage)
  223.     pod2usage("$0: No files given.")  if ((@ARGV == 0) && (-t STDIN));
  224.     __END__
  225.     =head1 NAME
  226.     sample - Using GetOpt::Long and Pod::Usage
  227.     =head1 SYNOPSIS
  228.     sample [options] [file ...]
  229.      Options:
  230.        -help            brief help message
  231.        -man             full documentation
  232.     =head1 OPTIONS
  233.     =over 8
  234.     =item B<-help>
  235.     Print a brief help message and exits.
  236.     =item B<-man>
  237.     Prints the manual page and exits.
  238.     =back
  239.     =head1 DESCRIPTION
  240.     B<This program> will read the given input file(s) and do something
  241.     useful with the contents thereof.
  242.     =cut
  243. =head1 CAVEATS
  244. By default, B<pod2usage()> will use C<$0> as the path to the pod input
  245. file.  Unfortunately, not all systems on which Perl runs will set C<$0>
  246. properly (although if C<$0> isn't found, B<pod2usage()> will search
  247. C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
  248. If this is the case for your system, you may need to explicitly specify
  249. the path to the pod docs for the invoking script using something
  250. similar to the following:
  251.     pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
  252. =head1 AUTHOR
  253. Brad Appleton E<lt>bradapp@enteract.comE<gt>
  254. Based on code for B<Pod::Text::pod2text()> written by
  255. Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
  256. =head1 ACKNOWLEDGEMENTS
  257. Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
  258. with re-writing this manpage.
  259. =cut
  260. #############################################################################
  261. use strict;
  262. #use diagnostics;
  263. use Carp;
  264. use Exporter;
  265. use File::Spec;
  266. use vars qw(@ISA @EXPORT);
  267. @EXPORT = qw(&pod2usage);
  268. BEGIN {
  269.     if ( $] >= 5.005_58 ) {
  270.        require Pod::Text;
  271.        @ISA = qw( Pod::Text );
  272.     }
  273.     else {
  274.        require Pod::PlainText;
  275.        @ISA = qw( Pod::PlainText );
  276.     }
  277. }
  278. ##---------------------------------------------------------------------------
  279. ##---------------------------------
  280. ## Function definitions begin here
  281. ##---------------------------------
  282. sub pod2usage {
  283.     local($_) = shift || "";
  284.     my %opts;
  285.     ## Collect arguments
  286.     if (@_ > 0) {
  287.         ## Too many arguments - assume that this is a hash and
  288.         ## the user forgot to pass a reference to it.
  289.         %opts = ($_, @_);
  290.     }
  291.     elsif (ref $_) {
  292.         ## User passed a ref to a hash
  293.         %opts = %{$_}  if (ref($_) eq 'HASH');
  294.     }
  295.     elsif (/^[-+]?d+$/) {
  296.         ## User passed in the exit value to use
  297.         $opts{"-exitval"} =  $_;
  298.     }
  299.     else {
  300.         ## User passed in a message to print before issuing usage.
  301.         $_  and  $opts{"-message"} = $_;
  302.     }
  303.     ## Need this for backward compatibility since we formerly used
  304.     ## options that were all uppercase words rather than ones that
  305.     ## looked like Unix command-line options.
  306.     ## to be uppercase keywords)
  307.     %opts = map {
  308.         my $val = $opts{$_};
  309.         s/^(?=w)/-/;
  310.         /^-msg/i   and  $_ = '-message';
  311.         /^-exit/i  and  $_ = '-exitval';
  312.         lc($_) => $val;    
  313.     } (keys %opts);
  314.     ## Now determine default -exitval and -verbose values to use
  315.     if ((! defined $opts{"-exitval"}) && (! defined $opts{"-verbose"})) {
  316.         $opts{"-exitval"} = 2;
  317.         $opts{"-verbose"} = 0;
  318.     }
  319.     elsif (! defined $opts{"-exitval"}) {
  320.         $opts{"-exitval"} = ($opts{"-verbose"} > 0) ? 1 : 2;
  321.     }
  322.     elsif (! defined $opts{"-verbose"}) {
  323.         $opts{"-verbose"} = ($opts{"-exitval"} < 2);
  324.     }
  325.     ## Default the output file
  326.     $opts{"-output"} = ($opts{"-exitval"} < 2) ? *STDOUT : *STDERR
  327.             unless (defined $opts{"-output"});
  328.     ## Default the input file
  329.     $opts{"-input"} = $0  unless (defined $opts{"-input"});
  330.     ## Look up input file in path if it doesnt exist.
  331.     unless ((ref $opts{"-input"}) || (-e $opts{"-input"})) {
  332.         my ($dirname, $basename) = ('', $opts{"-input"});
  333.         my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/) ? ";"
  334.                             : (($^O eq 'MacOS') ? ',' :  ":");
  335.         my $pathspec = $opts{"-pathlist"} || $ENV{PATH} || $ENV{PERL5LIB};
  336.         my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
  337.         for $dirname (@paths) {
  338.             $_ = File::Spec->catfile($dirname, $basename)  if length;
  339.             last if (-e $_) && ($opts{"-input"} = $_);
  340.         }
  341.     }
  342.     ## Now create a pod reader and constrain it to the desired sections.
  343.     my $parser = new Pod::Usage(USAGE_OPTIONS => %opts);
  344.     if ($opts{"-verbose"} == 0) {
  345.         $parser->select("SYNOPSIS");
  346.     }
  347.     elsif ($opts{"-verbose"} == 1) {
  348.         my $opt_re = '(?i)' .
  349.                      '(?:OPTIONS|ARGUMENTS)' .
  350.                      '(?:s*(?:AND|/)s*(?:OPTIONS|ARGUMENTS))?';
  351.         $parser->select( 'SYNOPSIS', $opt_re, "DESCRIPTION/$opt_re" );
  352.     }
  353.     ## Now translate the pod document and then exit with the desired status
  354.     $parser->parse_from_file($opts{"-input"}, $opts{"-output"});
  355.     exit($opts{"-exitval"});
  356. }
  357. ##---------------------------------------------------------------------------
  358. ##-------------------------------
  359. ## Method definitions begin here
  360. ##-------------------------------
  361. sub new {
  362.     my $this = shift;
  363.     my $class = ref($this) || $this;
  364.     my %params = @_;
  365.     my $self = {%params};
  366.     bless $self, $class;
  367.     $self->initialize();
  368.     return $self;
  369. }
  370. sub begin_pod {
  371.     my $self = shift;
  372.     $self->SUPER::begin_pod();  ## Have to call superclass
  373.     my $msg = $self->{USAGE_OPTIONS}->{-message}  or  return 1;
  374.     my $out_fh = $self->output_handle();
  375.     print $out_fh "$msgn";
  376. }
  377. sub preprocess_paragraph {
  378.     my $self = shift;
  379.     local $_ = shift;
  380.     my $line = shift;
  381.     ## See if this is a heading and we arent printing the entire manpage.
  382.     if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
  383.         ## Change the title of the SYNOPSIS section to USAGE
  384.         s/^=head1s+SYNOPSISs*$/=head1 USAGE/;
  385.         ## Try to do some lowercasing instead of all-caps in headings
  386.         s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
  387.         ## Use a colon to end all headings
  388.         s/s*$/:/  unless (/:s*$/);
  389.         $_ .= "n";
  390.     }
  391.     return  $self->SUPER::preprocess_paragraph($_);
  392. }