package Pod::Html::Util; use strict; use Exporter 'import'; our $VERSION = 1.35; # Please keep in synch with lib/Pod/ $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 While these functions are importable on request from F, they are specifically intended for use within (a) the F distribution (modules and test programs) shipped as part of the Perl 5 core and (b) other parts of the core such as the F 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 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 Display customary Pod::Html usage information on STDERR. =cut sub usage { my $podfile = shift; warn "$0: $podfile: @_\n" if @_; die < --htmlroot= --infile= --outfile= --podpath=:...: --podroot= --cachedir= --flush --recurse --norecurse --quiet --noquiet --verbose --noverbose --index --noindex --backlink --nobacklink --header --noheader --poderrors --nopoderrors --css= --title= --[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 Ensure that F'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 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 Make text safe for HTML. =cut sub html_escape { my $rest = $_[0]; $rest =~ s/&/&/g; $rest =~ s//>/g; $rest =~ s/"/"/g; $rest =~ s/([[:^print:]])/sprintf("&#x%x;", ord($1))/aeg; return $rest; } =head2 C 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(@heading); Similar to C, but turns non-alphanumerics into underscores. Note that C is not exported by default. =cut sub anchorify { my ($anchor) = @_; $anchor =~ s/"/_/g; # Replace double quotes with underscores $anchor =~ s/_$//; # ... but strip any final underscore $anchor =~ s/[<>&']//g; # Strip the remaining HTML special characters $anchor =~ s/^\s+//; s/\s+$//; # Strip white space. $anchor =~ s/^([^a-zA-Z]+)$/pod$1/; # Prepend "pod" if no valid chars. $anchor =~ s/^[^a-zA-Z]+//; # First char must be a letter. $anchor =~ s/[^-a-zA-Z0-9_:.]+/-/g; # All other chars must be valid. $anchor =~ s/[-:.]+$//; # Strip trailing punctuation. $anchor =~ s/\W/_/g; return $anchor; } =head2 C Remove any level of indentation (spaces or tabs) from each code block consistently. Adapted from: =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;