File Coverage

File:blib/lib/Pod/Html/Auxiliary.pm
Coverage:84.0%

linestmtbrancondsubcode
1package Pod::Html::Auxiliary;
2
14
14
14
use strict;
3require Exporter;
4
5
14
14
14
use vars qw($VERSION @ISA @EXPORT_OK);
6#$VERSION = 1.16;
7@ISA = qw(Exporter);
8@EXPORT_OK = qw(
9    parse_command_line
10    usage
11    html_escape
12    htmlify
13    anchorify
14    unixify
15    relativize_url
16);
17
18
14
14
14
use Config;
19
14
14
14
use File::Spec;
20
14
14
14
use File::Spec::Unix;
21
14
14
14
use Getopt::Long;
22
14
14
14
use locale; # make \w work right in non-ASCII lands
23
24
25sub parse_command_line {
26
7
    my %opts = ();
27
28
7
    unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
29
7
    my $result = GetOptions(\%opts,
30        'backlink!',
31        'cachedir=s',
32        'css=s',
33        'flush',
34        'help',
35        'header!',
36        'htmldir=s',
37        'htmlroot=s',
38        'index!',
39        'infile=s',
40        'libpods=s', # deprecated
41        'outfile=s',
42        'poderrors!',
43        'podpath=s',
44        'podroot=s',
45        'quiet!',
46        'recurse!',
47        'title=s',
48        'verbose!',
49    );
50
7
    usage("-", "invalid parameters") if not $result;
51
52
7
    usage("-") if defined $opts{help}; # see if the user asked for help
53
7
    $opts{help} = ''; # just to make -w shut-up.
54
7
    return \%opts;
55}
56
57sub usage {
58
2
    my $podfile = shift;
59
2
    warn "$0: $podfile: @_\n" if @_;
60
2
    die <<END_OF_USAGE;
61Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
62           --podpath=<name>:...:<name> --podroot=<name> --cachedir=<name>
63           --recurse --verbose --index --norecurse --noindex
64
65  --[no]backlink - turn =head1 directives into links pointing to the top of
66                      the page (off by default).
67  --cachedir - directory for the directory cache files.
68  --css - stylesheet URL
69  --flush - flushes the directory cache.
70  --[no]header - produce block header/footer (default is no headers).
71  --help - prints this message.
72  --htmldir - directory for resulting HTML files.
73  --htmlroot - http-server base directory from which all relative paths
74                      in podpath stem (default is /).
75  --[no]index - generate an index at the top of the resulting html
76                      (default behaviour).
77  --infile - filename for the pod to convert (input taken from stdin
78                      by default).
79  --outfile - filename for the resulting html file (output sent to
80                      stdout by default).
81  --[no]poderrors - include a POD ERRORS section in the output if there were
82                      any POD errors in the input (default behavior).
83  --podpath - colon-separated list of directories containing library
84                      pods (empty by default).
85  --podroot - filesystem base directory from which all relative paths
86                      in podpath stem (default is .).
87  --[no]quiet - suppress some benign warning messages (default is off).
88  --[no]recurse - recurse on those subdirectories listed in podpath
89                      (default behaviour).
90  --title - title that will appear in resulting html file.
91  --[no]verbose - self-explanatory (off by default).
92
93END_OF_USAGE
94
95}
96
97
98#
99# html_escape: make text safe for HTML
100#
101sub html_escape {
102
18
    my $rest = $_[0];
103
18
    $rest =~ s/&/&amp;/g;
104
18
    $rest =~ s/</&lt;/g;
105
18
    $rest =~ s/>/&gt;/g;
106
18
    $rest =~ s/"/&quot;/g;
107    # &apos; is only in XHTML, not HTML4. Be conservative
108    #$rest =~ s/'/&apos;/g;
109
18
    return $rest;
110}
111
112 - 120
=head2 htmlify

    htmlify($heading);

Converts a pod section specification to a suitable section specification
for HTML. Note that we keep spaces and special characters except
C<", ?> (Netscape problem) and the hyphen (writer's problem...).

=cut
121
122sub htmlify {
123
12
    my( $heading) = @_;
124
12
    $heading =~ s/(\s+)/ /g;
125
12
    $heading =~ s/\s+\Z//;
126
12
    $heading =~ s/\A\s+//;
127    # The hyphen is a disgrace to the English language.
128    # $heading =~ s/[-"?]//g;
129
12
    $heading =~ s/["?]//g;
130
12
    $heading = lc( $heading );
131
12
    return $heading;
132}
133
134 - 140
=head2 anchorify

    anchorify(@heading);

Similar to C<htmlify()>, but turns non-alphanumerics into underscores.

=cut
141
142sub anchorify {
143
12
    my ($anchor) = @_;
144
12
    $anchor = htmlify($anchor);
145
12
    $anchor =~ s/\W/_/g;
146
12
    return $anchor;
147}
148
149sub unixify {
150
59
    my $full_path = shift;
151
59
    return '' unless $full_path;
152
57
    return $full_path if $full_path eq '/';
153
154
54
    my ($vol, $dirs, $file) = File::Spec->splitpath($full_path);
155
54
    my @dirs = $dirs eq File::Spec->curdir()
156               ? (File::Spec::Unix->curdir())
157               : File::Spec->splitdir($dirs);
158
54
    if (defined($vol) && $vol) {
159
0
        $vol =~ s/:$// if $^O eq 'VMS';
160
0
        $vol = uc $vol if $^O eq 'MSWin32';
161
162
0
        if( $dirs[0] ) {
163
0
            unshift @dirs, $vol;
164        }
165        else {
166
0
            $dirs[0] = $vol;
167        }
168    }
169
54
    unshift @dirs, '' if File::Spec->file_name_is_absolute($full_path);
170
54
    return $file unless scalar(@dirs);
171
33
    $full_path = File::Spec::Unix->catfile(File::Spec::Unix->catdir(@dirs),
172                                           $file);
173
33
    $full_path =~ s|^\/|| if $^O eq 'MSWin32'; # C:/foo works, /C:/foo doesn't
174
33
    $full_path =~ s/\^\././g if $^O eq 'VMS'; # unescape dots
175
33
    return $full_path;
176}
177
178#
179# relativize_url - convert an absolute URL to one relative to a base URL.
180# Assumes both end in a filename.
181#
182sub relativize_url {
183
7
    my ($dest, $source) = @_;
184
185    # Remove each file from its path
186
7
    my ($dest_volume, $dest_directory, $dest_file) =
187        File::Spec::Unix->splitpath( $dest );
188
7
    $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' );
189
190
7
    my ($source_volume, $source_directory, $source_file) =
191        File::Spec::Unix->splitpath( $source );
192
7
    $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' );
193
194
7
    my $rel_path = '';
195
7
    if ($dest ne '') {
196
6
       $rel_path = File::Spec::Unix->abs2rel( $dest, $source );
197    }
198
199
7
    if ($rel_path ne '' && substr( $rel_path, -1 ) ne '/') {
200
6
        $rel_path .= "/$dest_file";
201    }
202    else {
203
1
        $rel_path .= "$dest_file";
204    }
205
206
7
    return $rel_path;
207}
208
2091;