This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
All tests pass (legitimately) on ithreads
[perl5.git] / pod / pod2usage.PL
CommitLineData
360aca43
GS
1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename qw(&basename &dirname);
933fea7f 5use Cwd;
360aca43
GS
6
7# List explicitly here the variables you want Configure to
8# generate. Metaconfig only looks for shell variables, so you
9# have to mention them as if they were shell variables, not
10# %Config entries. Thus you write
11# $startperl
12# to ensure Configure will look for $Config{startperl}.
13
3b5ca523
GS
14# This forces PL files to create target in same directory as PL file.
15# This is so that make depend always knows where to find PL derivatives.
933fea7f 16$origdir = cwd;
3b5ca523
GS
17chdir(dirname($0));
18($file = basename($0)) =~ s/\.PL$//;
c93fa817
GS
19$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving"
20$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving"
360aca43
GS
21
22open OUT,">$file" or die "Can't create $file: $!";
23
24print "Extracting $file (with variable substitutions)\n";
25
26# In this section, perl variables will be expanded during extraction.
27# You can use $Config{...} to use Configure variables.
28
29print OUT <<"!GROK!THIS!";
30$Config{'startperl'}
31 eval 'exec perl -S \$0 "\$@"'
32 if 0;
33!GROK!THIS!
34
35# In the following, perl variables are not expanded during extraction.
36
37print OUT <<'!NO!SUBS!';
38
39#############################################################################
40# pod2usage -- command to print usage messages from embedded pod docs
41#
92e3d63a 42# Copyright (c) 1996-2000 by Bradford Appleton. All rights reserved.
360aca43
GS
43# This file is part of "PodParser". PodParser is free software;
44# you can redistribute it and/or modify it under the same terms
45# as Perl itself.
46#############################################################################
47
48use strict;
49use diagnostics;
50
51=head1 NAME
52
53pod2usage - print usage messages from embedded pod docs in files
54
55=head1 SYNOPSIS
56
57=over 12
58
59=item B<pod2usage>
60
61[B<-help>]
62[B<-man>]
63[B<-exit>S< >I<exitval>]
64[B<-output>S< >I<outfile>]
65[B<-verbose> I<level>]
66[B<-pathlist> I<dirlist>]
67I<file>
68
69=back
70
71=head1 OPTIONS AND ARGUMENTS
72
73=over 8
74
75=item B<-help>
76
77Print a brief help message and exit.
78
79=item B<-man>
80
81Print this command's manual page and exit.
82
83=item B<-exit> I<exitval>
84
85The exit status value to return.
86
87=item B<-output> I<outfile>
88
89The output file to print to. If the special names "-" or ">&1" or ">&STDOUT"
90are used then standard output is used. If ">&2" or ">&STDERR" is used then
91standard error is used.
92
93=item B<-verbose> I<level>
94
95The desired level of verbosity to use:
96
97 1 : print SYNOPSIS only
98 2 : print SYNOPSIS sections and any OPTIONS/ARGUMENTS sections
99 3 : print the entire manpage (similar to running pod2text)
100
101=item B<-pathlist> I<dirlist>
102
103Specifies one or more directories to search for the input file if it
104was not supplied with an absolute path. Each directory path in the given
105list should be separated by a ':' on Unix (';' on MSWin32 and DOS).
106
107=item I<file>
108
109The pathname of a file containing pod documentation to be output in
110usage mesage format (defaults to standard input).
111
112=back
113
114=head1 DESCRIPTION
115
116B<pod2usage> will read the given input file looking for pod
117documentation and will print the corresponding usage message.
118If no input file is specifed than standard input is read.
119
120B<pod2usage> invokes the B<pod2usage()> function in the B<Pod::Usage>
121module. Please see L<Pod::Usage/pod2usage()>.
122
123=head1 SEE ALSO
124
125L<Pod::Usage>, L<pod2text(1)>
126
127=head1 AUTHOR
128
129Brad Appleton E<lt>bradapp@enteract.comE<gt>
130
131Based on code for B<pod2text(1)> written by
132Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
133
134=cut
135
136use Pod::Usage;
137use Getopt::Long;
138
139## Define options
140my %options = ();
141my @opt_specs = (
142 "help",
143 "man",
144 "exit=i",
145 "output=s",
146 "pathlist=s",
147 "verbose=i",
148);
149
150## Parse options
151GetOptions(\%options, @opt_specs) || pod2usage(2);
152pod2usage(1) if ($options{help});
153pod2usage(VERBOSE => 2) if ($options{man});
154
155## Dont default to STDIN if connected to a terminal
156pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
157
158@ARGV = ("-") unless (@ARGV > 0);
159if (@ARGV > 1) {
160 print STDERR "pod2usage: Too many filenames given\n\n";
161 pod2usage(2);
162}
163
164my %usage = ();
165$usage{-input} = shift(@ARGV);
166$usage{-exitval} = $options{"exit"} if (defined $options{"exit"});
167$usage{-output} = $options{"output"} if (defined $options{"output"});
168$usage{-verbose} = $options{"verbose"} if (defined $options{"verbose"});
169$usage{-pathlist} = $options{"pathlist"} if (defined $options{"pathlist"});
170
171pod2usage(\%usage);
172
173
174!NO!SUBS!
175
176close OUT or die "Can't close $file: $!";
177chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
178exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
933fea7f 179chdir $origdir;