1package Pod::Html::Util;
2use strict;
3use Exporter 'import';
4
5our $VERSION = 1.33; # Please keep in synch with lib/Pod/Html.pm
6$VERSION = eval $VERSION;
7our @EXPORT_OK = qw(
8    anchorify
9    html_escape
10    htmlify
11    process_command_line
12    relativize_url
13    trim_leading_whitespace
14    unixify
15    usage
16);
17
18use Config;
19use File::Spec;
20use File::Spec::Unix;
21use Getopt::Long;
22use Pod::Simple::XHTML;
23use Text::Tabs;
24use locale; # make \w work right in non-ASCII lands
25
26=head1 NAME
27
28Pod::Html::Util - helper functions for Pod-Html
29
30=head1 SUBROUTINES
31
32B<Note:> While these functions are importable on request from
33F<Pod::Html::Util>, they are specifically intended for use within (a) the
34F<Pod-Html> distribution (modules and test programs) shipped as part of the
35Perl 5 core and (b) other parts of the core such as the F<installhtml>
36program.  These functions may be modified or relocated within the core
37distribution -- or removed entirely therefrom -- as the core's needs evolve.
38Hence, you should not rely on these functions in situations other than those
39just described.
40
41=cut
42
43=head2 C<process_command_line()>
44
45Process command-line switches (options).  Returns a reference to a hash.  Will
46provide usage message if C<--help> switch is present or if parameters are
47invalid.
48
49Calling this subroutine may modify C<@ARGV>.
50
51=cut
52
53sub process_command_line {
54    my %opts = map { $_ => undef } (qw|
55        backlink cachedir css flush
56        header help htmldir htmlroot
57        index infile outfile poderrors
58        podpath podroot quiet recurse
59        title verbose
60    |);
61    unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
62    my $result = GetOptions(\%opts,
63        'backlink!',
64        'cachedir=s',
65        'css=s',
66        'flush',
67        'help',
68        'header!',
69        'htmldir=s',
70        'htmlroot=s',
71        'index!',
72        'infile=s',
73        'outfile=s',
74        'poderrors!',
75        'podpath=s',
76        'podroot=s',
77        'quiet!',
78        'recurse!',
79        'title=s',
80        'verbose!',
81    );
82    usage("-", "invalid parameters") if not $result;
83    usage("-") if defined $opts{help};  # see if the user asked for help
84    $opts{help} = "";                   # just to make -w shut-up.
85    return \%opts;
86}
87
88=head2 C<usage()>
89
90Display customary Pod::Html usage information on STDERR.
91
92=cut
93
94sub usage {
95    my $podfile = shift;
96    warn "$0: $podfile: @_\n" if @_;
97    die <<END_OF_USAGE;
98Usage:  $0 --help --htmldir=<name> --htmlroot=<URL>
99           --infile=<name> --outfile=<name>
100           --podpath=<name>:...:<name> --podroot=<name>
101           --cachedir=<name> --flush --recurse --norecurse
102           --quiet --noquiet --verbose --noverbose
103           --index --noindex --backlink --nobacklink
104           --header --noheader --poderrors --nopoderrors
105           --css=<URL> --title=<name>
106
107  --[no]backlink  - turn =head1 directives into links pointing to the top of
108                      the page (off by default).
109  --cachedir      - directory for the directory cache files.
110  --css           - stylesheet URL
111  --flush         - flushes the directory cache.
112  --[no]header    - produce block header/footer (default is no headers).
113  --help          - prints this message.
114  --htmldir       - directory for resulting HTML files.
115  --htmlroot      - http-server base directory from which all relative paths
116                      in podpath stem (default is /).
117  --[no]index     - generate an index at the top of the resulting html
118                      (default behaviour).
119  --infile        - filename for the pod to convert (input taken from stdin
120                      by default).
121  --outfile       - filename for the resulting html file (output sent to
122                      stdout by default).
123  --[no]poderrors - include a POD ERRORS section in the output if there were
124                      any POD errors in the input (default behavior).
125  --podpath       - colon-separated list of directories containing library
126                      pods (empty by default).
127  --podroot       - filesystem base directory from which all relative paths
128                      in podpath stem (default is .).
129  --[no]quiet     - suppress some benign warning messages (default is off).
130  --[no]recurse   - recurse on those subdirectories listed in podpath
131                      (default behaviour).
132  --title         - title that will appear in resulting html file.
133  --[no]verbose   - self-explanatory (off by default).
134
135END_OF_USAGE
136
137}
138
139=head2 C<unixify()>
140
141Ensure that F<Pod::Html>'s internals and tests handle paths consistently
142across Unix, Windows and VMS.
143
144=cut
145
146sub unixify {
147    my $full_path = shift;
148    return '' unless $full_path;
149    return $full_path if $full_path eq '/';
150
151    my ($vol, $dirs, $file) = File::Spec->splitpath($full_path);
152    my @dirs = $dirs eq File::Spec->curdir()
153               ? (File::Spec::Unix->curdir())
154               : File::Spec->splitdir($dirs);
155    if (defined($vol) && $vol) {
156        $vol =~ s/:$// if $^O eq 'VMS';
157        $vol = uc $vol if $^O eq 'MSWin32';
158
159        if( $dirs[0] ) {
160            unshift @dirs, $vol;
161        }
162        else {
163            $dirs[0] = $vol;
164        }
165    }
166    unshift @dirs, '' if File::Spec->file_name_is_absolute($full_path);
167    return $file unless scalar(@dirs);
168    $full_path = File::Spec::Unix->catfile(File::Spec::Unix->catdir(@dirs),
169                                           $file);
170    $full_path =~ s|^\/|| if $^O eq 'MSWin32'; # C:/foo works, /C:/foo doesn't
171    $full_path =~ s/\^\././g if $^O eq 'VMS'; # unescape dots
172    return $full_path;
173}
174
175=head2 C<relativize_url()>
176
177Convert an absolute URL to one relative to a base URL.
178Assumes both end in a filename.
179
180=cut
181
182sub relativize_url {
183    my ($dest, $source) = @_;
184
185    # Remove each file from its path
186    my ($dest_volume, $dest_directory, $dest_file) =
187        File::Spec::Unix->splitpath( $dest );
188    $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' );
189
190    my ($source_volume, $source_directory, $source_file) =
191        File::Spec::Unix->splitpath( $source );
192    $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' );
193
194    my $rel_path = '';
195    if ($dest ne '') {
196       $rel_path = File::Spec::Unix->abs2rel( $dest, $source );
197    }
198
199    if ($rel_path ne '' && substr( $rel_path, -1 ) ne '/') {
200        $rel_path .= "/$dest_file";
201    } else {
202        $rel_path .= "$dest_file";
203    }
204
205    return $rel_path;
206}
207
208=head2 C<html_escape()>
209
210Make text safe for HTML.
211
212=cut
213
214sub html_escape {
215    my $rest = $_[0];
216    $rest   =~ s/&/&amp;/g;
217    $rest   =~ s/</&lt;/g;
218    $rest   =~ s/>/&gt;/g;
219    $rest   =~ s/"/&quot;/g;
220    $rest =~ s/([[:^print:]])/sprintf("&#x%x;", ord($1))/aeg;
221    return $rest;
222}
223
224=head2 C<htmlify()>
225
226    htmlify($heading);
227
228Converts a pod section specification to a suitable section specification
229for HTML. Note that we keep spaces and special characters except
230C<", ?> (Netscape problem) and the hyphen (writer's problem...).
231
232=cut
233
234sub htmlify {
235    my( $heading) = @_;
236    return Pod::Simple::XHTML->can("idify")->(undef, $heading, 1);
237}
238
239=head2 C<anchorify()>
240
241    anchorify(@heading);
242
243Similar to C<htmlify()>, but turns non-alphanumerics into underscores.  Note
244that C<anchorify()> is not exported by default.
245
246=cut
247
248sub anchorify {
249    my ($anchor) = @_;
250    $anchor = htmlify($anchor);
251    $anchor =~ s/\W/_/g;
252    return $anchor;
253}
254
255=head2 C<trim_leading_whitespace()>
256
257Remove any level of indentation (spaces or tabs) from each code block
258consistently.  Adapted from:
259https://metacpan.org/source/HAARG/MetaCPAN-Pod-XHTML-0.002001/lib/Pod/Simple/Role/StripVerbatimIndent.pm
260
261=cut
262
263sub trim_leading_whitespace {
264    my ($para) = @_;
265
266    # Start by converting tabs to spaces
267    @$para = Text::Tabs::expand(@$para);
268
269    # Find the line with the least amount of indent, as that's our "base"
270    my @indent_levels = (sort(map { $_ =~ /^( *)./mg } @$para));
271    my $indent        = $indent_levels[0] || "";
272
273    # Remove the "base" amount of indent from each line
274    foreach (@$para) {
275        $_ =~ s/^\Q$indent//mg;
276    }
277
278    return;
279}
280
2811;
282
283