diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod/Html/Util.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Pod/Html/Util.pm | 282 |
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/&/&/g; + $rest =~ s/</</g; + $rest =~ s/>/>/g; + $rest =~ s/"/"/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; + |