summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Pod/Html/Util.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod/Html/Util.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Pod/Html/Util.pm282
1 files changed, 282 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Pod/Html/Util.pm b/Master/tlpkg/tlperl/lib/Pod/Html/Util.pm
new file mode 100755
index 00000000000..88452d4d4e8
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Pod/Html/Util.pm
@@ -0,0 +1,282 @@
+package Pod::Html::Util;
+use strict;
+use Exporter 'import';
+
+our $VERSION = 1.34; # Please keep in synch with lib/Pod/Html.pm
+$VERSION = eval $VERSION;
+our @EXPORT_OK = qw(
+ anchorify
+ html_escape
+ htmlify
+ process_command_line
+ relativize_url
+ trim_leading_whitespace
+ unixify
+ usage
+);
+
+use Config;
+use File::Spec;
+use File::Spec::Unix;
+use Getopt::Long;
+use Pod::Simple::XHTML;
+use Text::Tabs;
+use locale; # make \w work right in non-ASCII lands
+
+=head1 NAME
+
+Pod::Html::Util - helper functions for Pod-Html
+
+=head1 SUBROUTINES
+
+B<Note:> While these functions are importable on request from
+F<Pod::Html::Util>, they are specifically intended for use within (a) the
+F<Pod-Html> distribution (modules and test programs) shipped as part of the
+Perl 5 core and (b) other parts of the core such as the F<installhtml>
+program. These functions may be modified or relocated within the core
+distribution -- or removed entirely therefrom -- as the core's needs evolve.
+Hence, you should not rely on these functions in situations other than those
+just described.
+
+=cut
+
+=head2 C<process_command_line()>
+
+Process command-line switches (options). Returns a reference to a hash. Will
+provide usage message if C<--help> switch is present or if parameters are
+invalid.
+
+Calling this subroutine may modify C<@ARGV>.
+
+=cut
+
+sub process_command_line {
+ my %opts = map { $_ => undef } (qw|
+ backlink cachedir css flush
+ header help htmldir htmlroot
+ index infile outfile poderrors
+ podpath podroot quiet recurse
+ title verbose
+ |);
+ unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
+ my $result = GetOptions(\%opts,
+ 'backlink!',
+ 'cachedir=s',
+ 'css=s',
+ 'flush',
+ 'help',
+ 'header!',
+ 'htmldir=s',
+ 'htmlroot=s',
+ 'index!',
+ 'infile=s',
+ 'outfile=s',
+ 'poderrors!',
+ 'podpath=s',
+ 'podroot=s',
+ 'quiet!',
+ 'recurse!',
+ 'title=s',
+ 'verbose!',
+ );
+ usage("-", "invalid parameters") if not $result;
+ usage("-") if defined $opts{help}; # see if the user asked for help
+ $opts{help} = ""; # just to make -w shut-up.
+ return \%opts;
+}
+
+=head2 C<usage()>
+
+Display customary Pod::Html usage information on STDERR.
+
+=cut
+
+sub usage {
+ my $podfile = shift;
+ warn "$0: $podfile: @_\n" if @_;
+ die <<END_OF_USAGE;
+Usage: $0 --help --htmldir=<name> --htmlroot=<URL>
+ --infile=<name> --outfile=<name>
+ --podpath=<name>:...:<name> --podroot=<name>
+ --cachedir=<name> --flush --recurse --norecurse
+ --quiet --noquiet --verbose --noverbose
+ --index --noindex --backlink --nobacklink
+ --header --noheader --poderrors --nopoderrors
+ --css=<URL> --title=<name>
+
+ --[no]backlink - turn =head1 directives into links pointing to the top of
+ the page (off by default).
+ --cachedir - directory for the directory cache files.
+ --css - stylesheet URL
+ --flush - flushes the directory cache.
+ --[no]header - produce block header/footer (default is no headers).
+ --help - prints this message.
+ --htmldir - directory for resulting HTML files.
+ --htmlroot - http-server base directory from which all relative paths
+ in podpath stem (default is /).
+ --[no]index - generate an index at the top of the resulting html
+ (default behaviour).
+ --infile - filename for the pod to convert (input taken from stdin
+ by default).
+ --outfile - filename for the resulting html file (output sent to
+ stdout by default).
+ --[no]poderrors - include a POD ERRORS section in the output if there were
+ any POD errors in the input (default behavior).
+ --podpath - colon-separated list of directories containing library
+ pods (empty by default).
+ --podroot - filesystem base directory from which all relative paths
+ in podpath stem (default is .).
+ --[no]quiet - suppress some benign warning messages (default is off).
+ --[no]recurse - recurse on those subdirectories listed in podpath
+ (default behaviour).
+ --title - title that will appear in resulting html file.
+ --[no]verbose - self-explanatory (off by default).
+
+END_OF_USAGE
+
+}
+
+=head2 C<unixify()>
+
+Ensure that F<Pod::Html>'s internals and tests handle paths consistently
+across Unix, Windows and VMS.
+
+=cut
+
+sub unixify {
+ my $full_path = shift;
+ return '' unless $full_path;
+ return $full_path if $full_path eq '/';
+
+ my ($vol, $dirs, $file) = File::Spec->splitpath($full_path);
+ my @dirs = $dirs eq File::Spec->curdir()
+ ? (File::Spec::Unix->curdir())
+ : File::Spec->splitdir($dirs);
+ if (defined($vol) && $vol) {
+ $vol =~ s/:$// if $^O eq 'VMS';
+ $vol = uc $vol if $^O eq 'MSWin32';
+
+ if( $dirs[0] ) {
+ unshift @dirs, $vol;
+ }
+ else {
+ $dirs[0] = $vol;
+ }
+ }
+ unshift @dirs, '' if File::Spec->file_name_is_absolute($full_path);
+ return $file unless scalar(@dirs);
+ $full_path = File::Spec::Unix->catfile(File::Spec::Unix->catdir(@dirs),
+ $file);
+ $full_path =~ s|^\/|| if $^O eq 'MSWin32'; # C:/foo works, /C:/foo doesn't
+ $full_path =~ s/\^\././g if $^O eq 'VMS'; # unescape dots
+ return $full_path;
+}
+
+=head2 C<relativize_url()>
+
+Convert an absolute URL to one relative to a base URL.
+Assumes both end in a filename.
+
+=cut
+
+sub relativize_url {
+ my ($dest, $source) = @_;
+
+ # Remove each file from its path
+ my ($dest_volume, $dest_directory, $dest_file) =
+ File::Spec::Unix->splitpath( $dest );
+ $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' );
+
+ my ($source_volume, $source_directory, $source_file) =
+ File::Spec::Unix->splitpath( $source );
+ $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' );
+
+ my $rel_path = '';
+ if ($dest ne '') {
+ $rel_path = File::Spec::Unix->abs2rel( $dest, $source );
+ }
+
+ if ($rel_path ne '' && substr( $rel_path, -1 ) ne '/') {
+ $rel_path .= "/$dest_file";
+ } else {
+ $rel_path .= "$dest_file";
+ }
+
+ return $rel_path;
+}
+
+=head2 C<html_escape()>
+
+Make text safe for HTML.
+
+=cut
+
+sub html_escape {
+ my $rest = $_[0];
+ $rest =~ s/&/&amp;/g;
+ $rest =~ s/</&lt;/g;
+ $rest =~ s/>/&gt;/g;
+ $rest =~ s/"/&quot;/g;
+ $rest =~ s/([[:^print:]])/sprintf("&#x%x;", ord($1))/aeg;
+ return $rest;
+}
+
+=head2 C<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
+
+sub htmlify {
+ my( $heading) = @_;
+ return Pod::Simple::XHTML->can("idify")->(undef, $heading, 1);
+}
+
+=head2 C<anchorify()>
+
+ anchorify(@heading);
+
+Similar to C<htmlify()>, but turns non-alphanumerics into underscores. Note
+that C<anchorify()> is not exported by default.
+
+=cut
+
+sub anchorify {
+ my ($anchor) = @_;
+ $anchor = htmlify($anchor);
+ $anchor =~ s/\W/_/g;
+ return $anchor;
+}
+
+=head2 C<trim_leading_whitespace()>
+
+Remove any level of indentation (spaces or tabs) from each code block
+consistently. Adapted from:
+https://metacpan.org/source/HAARG/MetaCPAN-Pod-XHTML-0.002001/lib/Pod/Simple/Role/StripVerbatimIndent.pm
+
+=cut
+
+sub trim_leading_whitespace {
+ my ($para) = @_;
+
+ # Start by converting tabs to spaces
+ @$para = Text::Tabs::expand(@$para);
+
+ # Find the line with the least amount of indent, as that's our "base"
+ my @indent_levels = (sort(map { $_ =~ /^( *)./mg } @$para));
+ my $indent = $indent_levels[0] || "";
+
+ # Remove the "base" amount of indent from each line
+ foreach (@$para) {
+ $_ =~ s/^\Q$indent//mg;
+ }
+
+ return;
+}
+
+1;
+