[6585] in Perl-Users-Digest
Perl-Users Digest, Issue: 210 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Mar 31 18:37:40 1997
Date: Mon, 31 Mar 97 15:01:35 -0800
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Mon, 31 Mar 1997 Volume: 8 Number: 210
Today's topics:
Re: Why doesn't pod2html send its default output to STD <tchrist@mox.perl.com>
Re: Why is no subscripting allowed in custom sort routi <merlyn@stonehenge.com>
Win 32 problems <agavurin@ix.netcom.com>
Win32 Problems <agavurin@ix.netcom.com>
Re: Writing a routine the works like 'open' (Daniel Lipton)
Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 31 Mar 1997 21:49:37 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Why doesn't pod2html send its default output to STDOUT?
Message-Id: <5hpbhh$j7e$1@csnews.cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
Because it just does that (annoys me too). Put this in your pod directory
and play with it. There are some outstanding issues. Check the
perl-porters mailing-list gateway for my posting about them.
--tom
#!/bin/sh
# This is a shell archive (produced by GNU sharutils 4.2).
# To extract the files from this archive, save it to some FILE, remove
# everything before the `!/bin/sh' line above, then type `sh FILE'.
#
# Made on 1997-03-30 08:26 MST by <tchrist@jhereg.perl.com>.
# Source directory was `/usr/local/src/perl5.003_95'.
#
# Existing files will *not* be overwritten unless `-c' is specified.
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 595 -rwxr-xr-x pod/htall
# 16709 -rwxr-xr-x pod/installhtml
# 2375 -rw-r--r-- pod/pod2html
# 39829 -rw-r--r-- lib/Pod/Html.pm
#
save_IFS="${IFS}"
IFS="${IFS}:"
gettext_dir=FAILED
locale_dir=FAILED
first_param="$1"
for dir in $PATH
do
if test "$gettext_dir" = FAILED && test -f $dir/gettext \
&& ($dir/gettext --version >/dev/null 2>&1)
then
set `$dir/gettext --version 2>&1`
if test "$3" = GNU
then
gettext_dir=$dir
fi
fi
if test "$locale_dir" = FAILED && test -f $dir/shar \
&& ($dir/shar --print-text-domain-dir >/dev/null 2>&1)
then
locale_dir=`$dir/shar --print-text-domain-dir`
fi
done
IFS="$save_IFS"
if test "$locale_dir" = FAILED || test "$gettext_dir" = FAILED
then
echo=echo
else
TEXTDOMAINDIR=$locale_dir
export TEXTDOMAINDIR
TEXTDOMAIN=sharutils
export TEXTDOMAIN
echo="$gettext_dir/gettext -s"
fi
touch -am 1231235999 $$.touch >/dev/null 2>&1
if test ! -f 1231235999 && test -f $$.touch; then
shar_touch=touch
else
shar_touch=:
echo
$echo 'WARNING: not restoring timestamps. Consider getting and'
$echo "installing GNU \`touch', distributed in GNU File Utilities..."
echo
fi
rm -f 1231235999 $$.touch
#
if mkdir _sh12213; then
$echo 'x -' 'creating lock directory'
else
$echo 'failed to create lock directory'
exit 1
fi
# ============= pod/htall ==============
if test ! -d 'pod'; then
$echo 'x -' 'creating directory' 'pod'
mkdir 'pod'
fi
if test -f 'pod/htall' && test "$first_param" != -c; then
$echo 'x -' SKIPPING 'pod/htall' '(file already exists)'
else
$echo 'x -' extracting 'pod/htall' '(binary)'
sed 's/^X//' << 'SHAR_EOF' | uudecode &&
begin 600 pod/htall
M("`@("XN+W!E<FP@+4DN+B]L:6(@:6YS=&%L;&AT;6P@"0E<"@D@("`@+2UP
M;V1P871H/6QI8CIE>'0Z<&]D.G9M<R`@(`D)7`H)("`@("TM<&]D<F]O=#TN
M+B`@("`@"5P*("`@("`@("`@("`@+2UP;V1P871H/7!O9#IL:6(Z97AT.G9M
M<SIP;&%N.3IV;7,Z;W,R.G=I;C,R(%P*("`@("`@("`@("`@+2UH=&UL9&ER
M/6!P=V1@+VAT;6P@("`@(`E<"B`@("`@("`@("`@("TM:'1M;')O;W0]8'!W
M9&`O:'1M;"`@("`)7`H@("`@("`@("`@("`M+6QI8G!O9',]<&5R;&9U;F,Z
M<&5R;&=U=',Z<&5R;'9A<CIP97)L<G5N.G!E<FQO<#IP97)L<G5N(%P*("`@
M("`@("`@("`@+2UR96-U<G-E(`D)"5P*"B`@("`C("TM=F5R8F]S90H*("`@
M(",M+7-P;&ET:&5A9#UP;V0O<&5R;&EP8RYP;V0L<&]D+W!E<FQT;V]T+G!O
M9"QP;V0O<&5R;&9A<3$N<&]D+'!O9"]P97)L9F%Q,BYP;V0L<&]D+W!E<FQF
M87$S+G!O9"QP;V0O<&5R;&9A<30N<&]D+'!O9"]P97)L9F%Q-2YP;V0L<&]D
M+W!E<FQF87$V+G!O9"QP;V0O<&5R;&9A<3<N<&]D+'!O9"]P97)L9F%Q."YP
M;V0L<&]D+W!E<FQF87$Y+G!O9"!<"@H@("`@(RTM<W!L:71I=&5M/7!O9"]P
*97)L9G5N8R!<"FQF
`
end
SHAR_EOF
$shar_touch -am 0330082697 'pod/htall' &&
chmod 0755 'pod/htall' ||
$echo 'restore of' 'pod/htall' 'failed'
if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
&& ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
md5sum -c << SHAR_EOF >/dev/null 2>&1 \
|| $echo 'pod/htall:' 'MD5 check failed'
3494eb2898a08d7452c6cc73ba57dcb0 pod/htall
SHAR_EOF
else
shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'pod/htall'`"
test 595 -eq "$shar_count" ||
$echo 'pod/htall:' 'original size' '595,' 'current size' "$shar_count!"
fi
fi
# ============= pod/installhtml ==============
if test -f 'pod/installhtml' && test "$first_param" != -c; then
$echo 'x -' SKIPPING 'pod/installhtml' '(file already exists)'
else
$echo 'x -' extracting 'pod/installhtml' '(text)'
sed 's/^X//' << 'SHAR_EOF' > 'pod/installhtml' &&
#!/usr/bin/perl -w
X
use Config; # for config options in the makefile
use Getopt::Long; # for command-line parsing
use Cwd;
use Pod::Html;
X
umask 022;
X
=head1 NAME
X
installhtml - converts a collection of POD pages to HTML format.
X
=head1 SYNOPSIS
X
X installhtml [--help] [--podpath=<name>:...:<name>] [--podroot=<name>]
X [--htmldir=<name>] [--htmlroot=<name>] [--norecurse] [--recurse]
X [--splithead=<name>,...,<name>] [--splititem=<name>,...,<name>]
X [--libpods=<name>,...,<name>] [--verbose]
X
=head1 DESCRIPTION
X
I<installhtml> converts a collection of POD pages to a corresponding
collection of HTML pages. This is primarily used to convert the pod
pages found in the perl distribution.
X
=head1 OPTIONS
X
=over 4
X
=item B<--help> help
X
Displays the usage.
X
=item B<--podpath> POD search path
X
The list of diretories to search for .pod and .pm files to be converted.
Default is `podroot/.'.
X
=item B<--podroot> POD search path base directory
X
The base directory to search for all .pod and .pm files to be converted.
Default is current directory.
X
=item B<--htmldir> HTML destination directory
X
The base directory which all HTML files will be written to. This should
be a path relative to the filesystem, not the resulting URL.
X
=item B<--htmlroot> URL base directory
X
The base directory which all resulting HTML files will be visible at in
a URL. The default is `/'.
X
=item B<--recurse> recurse on subdirectories
X
Whether or not to convert all .pm and .pod files found in subdirectories
too. Default is to not recurse.
X
=item B<--splithead> POD files to split on =head directive
X
Colon-seperated list of pod files to split by the =head directive. These
files should have names specified relative to podroot.
X
=item B<--splititem> POD files to split on =item directive
X
Colon-seperated list of all pod files to split by the =item directive.
I<installhtml> does not do the actual split, rather it invokes I<splitpod>
to do the dirty work. As with --splithead, these files should have names
specified relative to podroot.
X
=item B<--libpods> library PODs for LE<lt>E<gt> links
X
Colon-seperated list of "library" pod files. This is the same list that
will be passed to pod2html when any pod is converted.
X
=item B<--verbose> verbose output
X
Self-explanatory.
X
=back
X
=head1 EXAMPLE
X
The following command-line is an example of the one we use to convert
perl documentation:
X
X ./installhtml --podpath=lib:ext:pod:vms \
X --podroot=/usr/src/perl \
X --htmldir=/perl/nmanual \
X --htmlroot=/perl/nmanual \
X --splithead=pod/perlipc.pod \
X --splititem=pod/perlfunc \
X --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \
X --recurse \
X --verbose
X
=head1 AUTHOR
X
Chris Hall E<lt>hallc@cs.colorado.eduE<gt>
X
=head1 TODO
X
=cut
X
$usage =<<END_OF_USAGE;
Usage: $0 --help --podpath=<name>:...:<name> --podroot=<name>
X --htmldir=<name> --htmlroot=<name> --norecurse --recurse
X --splithead=<name>,...,<name> --splititem=<name>,...,<name>
X --libpods=<name>,...,<name> --verbose
X
X --help - this message
X --podpath - colon-separated list of directories containing .pod and
X .pm files to be converted (. by default).
X --podroot - filesystem base directory from which all relative paths in
X podpath stem (default is .).
X --htmldir - directory to store resulting html files in relative
X to the filesystem (\$podroot/html by default).
X --htmlroot - http-server base directory from which all relative paths
X in podpath stem (default is /).
X --libpods - comma-separated list of files to search for =item pod
X directives in as targets of C<> and implicit links (empty
X by default).
X --norecurse - don't recurse on those subdirectories listed in podpath.
X (default behavior).
X --recurse - recurse on those subdirectories listed in podpath
X --splithead - comma-separated list of .pod or .pm files to split. will
X split each file into several smaller files at every occurance
X of a pod =head[1-6] directive.
X --splititem - comma-separated list of .pod or .pm files to split using
X splitpod.
X --splitpod - where the program splitpod can be found (\$podroot/pod by
X default).
X --verbose - self-explanatory.
X
END_OF_USAGE
X
@libpods = ();
@podpath = ( "." ); # colon-separated list of directories containing .pod
X # and .pm files to be converted.
$podroot = "."; # assume the pods we want are here
$htmldir = ""; # nothing for now...
$htmlroot = "/"; # default value
$recurse = 0; # default behavior
@splithead = (); # don't split any files by default
@splititem = (); # don't split any files by default
$splitpod = ""; # nothing for now.
X
$verbose = 0; # whether or not to print debugging info
X
$pod2html = "pod/pod2html";
X
X
# parse the command-line
$result = GetOptions( qw(
X help
X podpath=s
X podroot=s
X htmldir=s
X htmlroot=s
X libpods=s
X recurse!
X splithead=s
X splititem=s
X splitpod=s
X verbose
));
usage("invalid parameters") unless $result;
parse_command_line();
X
X
# set these variables to appropriate values if the user didn't specify
# values for them.
$htmldir = "$htmlroot/html" unless $htmldir;
$splitpod = "$htmlroot/pod" unless $splitpod;
X
X
# make sure that the destination directory exists
(mkdir($htmldir, 0755) ||
X die "$0: cannot make directory $htmldir: $!\n") if ! -d $htmldir;
X
X
# the following array will eventually contain files that are to be
# ignored in the conversion process. these are files that have been
# process by splititem or splithead and should not be converted as a
# result.
@ignore = ();
X
X
# split pods. its important to do this before convert ANY pods because
# it may effect some of the links
@splitdirs = (); # files in these directories won't get an index
split_on_head($podroot, $htmldir, \@splitdirs, \@ignore, @splithead);
split_on_item($podroot, \@splitdirs, \@ignore, @splititem);
X
X
# convert the pod pages found in @poddirs
#warn "converting files\n" if $verbose;
#warn "\@ignore\t= @ignore\n" if $verbose;
foreach $dir (@podpath) {
X installdir($dir, $recurse, $podroot, \@splitdirs, \@ignore);
}
X
X
# now go through and create master indices for each pod we split
foreach $dir (@splititem) {
X print "creating index $htmldir/$dir.html\n" if $verbose;
X create_index("$htmldir/$dir.html", "$htmldir/$dir");
}
X
foreach $dir (@splithead) {
X $dir .= ".pod" unless $dir =~ /(\.pod|\.pm)$/;
X # let pod2html create the file
X runpod2html($dir, 1);
X
X # now go through and truncate after the index
X $dir =~ /^(.*?)(\.pod|\.pm)?$/sm;
X $file = "$htmldir/$1";
X print "creating index $file.html\n" if $verbose;
X
X # read in everything until what would have been the first =head
X # directive, patching the index as we go.
X open(H, "<$file.html") ||
X die "$0: error opening $file.html for input: $!\n";
X $/ = "";
X @data = ();
X while (<H>) {
X last if /NAME=/;
X s,HREF="#(.*)">,HREF="$file/$1.html">,g;
X push @data, $_;
X }
X close(H);
X
X # now rewrite the file
X open(H, ">$file.html") ||
X die "$0: error opening $file.html for output: $!\n";
X print H "@data\n";
X close(H);
}
X
##############################################################################
X
X
sub usage {
X warn "$0: @_\n" if @_;
X die $usage;
}
X
X
sub parse_command_line {
X usage() if defined $opt_help;
X $opt_help = ""; # make -w shut up
X
X # list of directories
X @podpath = split(":", $opt_podpath) if defined $opt_podpath;
X
X # lists of files
X @splithead = split(",", $opt_splithead) if defined $opt_splithead;
X @splititem = split(",", $opt_splititem) if defined $opt_splititem;
X @libpods = split(",", $opt_libpods) if defined $opt_libpods;
X
X $htmldir = $opt_htmldir if defined $opt_htmldir;
X $htmlroot = $opt_htmlroot if defined $opt_htmlroot;
X $podroot = $opt_podroot if defined $opt_podroot;
X $splitpod = $opt_splitpod if defined $opt_splitpod;
X
X $recurse = $opt_recurse if defined $opt_recurse;
X $verbose = $opt_verbose if defined $opt_verbose;
}
X
X
sub create_index {
X my($html, $dir) = @_;
X my(@files, @filedata, @index, $file);
X
X # get the list of .html files in this directory
X opendir(DIR, $dir) ||
X die "$0: error opening directory $dir for reading: $!\n";
X @files = sort(grep(/\.html$/, readdir(DIR)));
X closedir(DIR);
X
X open(HTML, ">$html") ||
X die "$0: error opening $html for output: $!\n";
X
X # for each .html file in the directory, extract the index
X # embedded in the file and throw it into the big index.
X print HTML "<DL COMPACT>\n";
X foreach $file (@files) {
X $/ = "";
X
X open(IN, "<$dir/$file") ||
X die "$0: error opening $dir/$file for input: $!\n";
X @filedata = <IN>;
X close(IN);
X
X # pull out the NAME section
X ($name) = grep(/NAME=/, @filedata);
X $name =~ m,/H1>\s(\S+)\s[\s-]*(.*?)\s*$,sm;
X print HTML qq(<A HREF="$dir/$file">);
X print HTML "<DT>$1</A><DD>$2\n" if defined $1;
# print HTML qq(<A HREF="$dir/$file">$1</A><BR>\n") if defined $1;
X
X next;
X
X @index = grep(/<!-- INDEX BEGIN -->.*<!-- INDEX END -->/s,
X @filedata);
X for (@index) {
X s/<!-- INDEX BEGIN -->(\s*<!--)(.*)(-->\s*)<!-- INDEX END -->/$2/s;
X s,#,$dir/$file#,g;
X # print HTML "$_\n";
X print HTML "$_\n<P><HR><P>\n";
X }
X }
X print HTML "</DL>\n";
X
X close(HTML);
}
X
X
sub split_on_head {
X my($podroot, $htmldir, $splitdirs, $ignore, @splithead) = @_;
X my($pod, $dirname, $filename);
X
X # split the files specified in @splithead on =head[1-6] pod directives
X print "splitting files by head.\n" if $verbose && $#splithead >= 0;
X foreach $pod (@splithead) {
X # figure out the directory name and filename
X $pod =~ s,^([^/]*)$,/$1,;
X $pod =~ m,(.*?)/(.*?)(\.pod)?$,;
X $dirname = $1;
X $filename = "$2.pod";
X
X # since we are splitting this file it shouldn't be converted.
X push(@$ignore, "$podroot/$dirname/$filename");
X
X # split the pod
X splitpod("$podroot/$dirname/$filename", "$podroot/$dirname", $htmldir,
X $splitdirs);
X }
}
X
X
sub split_on_item {
X my($podroot, $splitdirs, $ignore, @splititem) = @_;
X my($pwd, $dirname, $filename);
X
X print "splitting files by item.\n" if $verbose && $#splititem >= 0;
X $pwd = getcwd();
X foreach $pod (@splititem) {
X # figure out the directory to split into
X $pod =~ s,^([^/]*)$,/$1,;
X $pod =~ m,(.*?)/(.*?)(\.pod)?$,;
X $dirname = "$1/$2";
X $filename = "$2.pod";
X
X # since we are splitting this file it shouldn't be converted.
X push(@$ignore, "$podroot/$dirname.pod");
X
X # split the pod
X push(@$splitdirs, "$podroot/$dirname");
X if (! -d "$podroot/$dirname") {
X mkdir("$podroot/$dirname", 0755) ||
X die "$0: error creating directory $podroot/$dirname: $!\n";
X }
X chdir("$podroot/$dirname") ||
X die "$0: error changing to directory $podroot/$dirname: $!\n";
X system("splitpod", "../$filename");
X }
X chdir($pwd);
}
X
X
#
# splitpod - splits a .pod file into several smaller .pod files
# where a new file is started each time a =head[1-6] pod directive
# is encountered in the input file.
#
sub splitpod {
X my($pod, $poddir, $htmldir, $splitdirs) = @_;
X my(@poddata, @filedata, @heads);
X my($file, $i, $j, $prevsec, $section, $nextsec);
X
X print "splitting $pod\n" if $verbose;
X
X # read the file in paragraphs
X $/ = "";
X open(SPLITIN, "<$pod") ||
X die "$0: error opening $pod for input: $!\n";
X @filedata = <SPLITIN>;
X close(SPLITIN) ||
X die "$0: error closing $pod: $!\n";
X
X # restore the file internally by =head[1-6] sections
X @poddata = ();
X for ($i = 0, $j = -1; $i <= $#filedata; $i++) {
X $j++ if ($filedata[$i] =~ /^\s*=head[1-6]/);
X if ($j >= 0) {
X $poddata[$j] = "" unless defined $poddata[$j];
X $poddata[$j] .= "\n$filedata[$i]" if $j >= 0;
X }
X }
X
X # create list of =head[1-6] sections so that we can rewrite
X # L<> links as necessary.
X %heads = ();
X foreach $i (0..$#poddata) {
X $heads{htmlize($1)} = 1 if $poddata[$i] =~ /=head[1-6]\s+(.*)/;
X }
X
X # create a directory of a similar name and store all the
X # files in there
X $pod =~ s,.*/(.*),$1,; # get the last part of the name
X $dir = $pod;
X $dir =~ s/\.pod//g;
X push(@$splitdirs, "$poddir/$dir");
X mkdir("$poddir/$dir", 0755) ||
X die "$0: could not create directory $poddir/$dir: $!\n"
X unless -d "$poddir/$dir";
X
X $poddata[0] =~ /^\s*=head[1-6]\s+(.*)/;
X $section = "";
X $nextsec = $1;
X
X # for each section of the file create a separate pod file
X for ($i = 0; $i <= $#poddata; $i++) {
X # determine the "prev" and "next" links
X $prevsec = $section;
X $section = $nextsec;
X if ($i < $#poddata) {
X $poddata[$i+1] =~ /^\s*=head[1-6]\s+(.*)/;
X $nextsec = $1;
X } else {
X $nextsec = "";
X }
X
X # determine an appropriate filename (this must correspond with
X # what pod2html will try and guess)
X # $poddata[$i] =~ /^\s*=head[1-6]\s+(.*)/;
X $file = "$dir/" . htmlize($section) . ".pod";
X
X # create the new .pod file
X print "\tcreating $poddir/$file\n" if $verbose;
X open(SPLITOUT, ">$poddir/$file") ||
X die "$0: error opening $poddir/$file for output: $!\n";
X $poddata[$i] =~ s,L<([^<>]*)>,
X defined $heads{htmlize($1)} ? "L<$dir/$1>" : "L<$1>"
X ,ge;
X print SPLITOUT $poddata[$i]."\n\n";
X print SPLITOUT "=over 4\n\n";
X print SPLITOUT "=item *\n\nBack to L<$dir/\"$prevsec\">\n\n" if $prevsec;
X print SPLITOUT "=item *\n\nForward to L<$dir/\"$nextsec\">\n\n" if $nextsec;
X print SPLITOUT "=item *\n\nUp to L<$dir>\n\n";
X print SPLITOUT "=back\n\n";
X close(SPLITOUT) ||
X die "$0: error closing $poddir/$file: $!\n";
X }
}
X
X
#
# installdir - takes care of converting the .pod and .pm files in the
# current directory to .html files and then installing those.
#
sub installdir {
X my($dir, $recurse, $podroot, $splitdirs, $ignore) = @_;
X my(@dirlist, @podlist, @pmlist, $doindex);
X
X @dirlist = (); # directories to recurse on
X @podlist = (); # .pod files to install
X @pmlist = (); # .pm files to install
X
X # should files in this directory get an index?
X $doindex = (grep($_ eq "$podroot/$dir", @$splitdirs) ? 0 : 1);
X
X opendir(DIR, "$podroot/$dir")
X || die "$0: error opening directory $podroot/$dir: $!\n";
X
X # find the directories to recurse on
X @dirlist = map { "$dir/$_" }
X grep(-d "$podroot/$dir/$_" && !/^\.{1,2}/, readdir(DIR)) if $recurse;
X rewinddir(DIR);
X
X # find all the .pod files within the directory
X @podlist = map { /^(.*)\.pod$/; "$dir/$1" }
X grep(! -d "$podroot/$dir/$_" && /\.pod$/, readdir(DIR));
X rewinddir(DIR);
X
X # find all the .pm files within the directory
X @pmlist = map { /^(.*)\.pm$/; "$dir/$1" }
X grep(! -d "$podroot/$dir/$_" && /\.pm$/, readdir(DIR));
X
X closedir(DIR);
X
X # recurse on all subdirectories we kept track of
X foreach $dir (@dirlist) {
X installdir($dir, $recurse, $podroot, $splitdirs, $ignore);
X }
X
X # install all the pods we found
X foreach $pod (@podlist) {
X # check if we should ignore it.
X next if grep($_ eq "$podroot/$pod.pod", @$ignore);
X
X # check if a .pm files exists too
X if (grep($_ eq "$pod.pm", @pmlist)) {
X print "$0: Warning both `$podroot/$pod.pod' and "
X . "`$podroot/$pod.pm' exist, using pod\n";
X push(@ignore, "$pod.pm");
X }
X runpod2html("$pod.pod", $doindex);
X }
X
X # install all the .pm files we found
X foreach $pm (@pmlist) {
X # check if we should ignore it.
X next if grep($_ eq "$pm.pm", @ignore);
X
X runpod2html("$pm.pm", $doindex);
X }
}
X
X
#
# runpod2html - invokes pod2html to convert a .pod or .pm file to a .html
# file.
#
sub runpod2html {
X my($pod, $doindex) = @_;
X my($html, $i, $dir, @dirs);
X
X $html = $pod;
X $html =~ s/\.(pod|pm)$/.html/g;
X
X # make sure the destination directories exist
X @dirs = split("/", $html);
X $dir = "$htmldir/";
X for ($i = 0; $i < $#dirs; $i++) {
X if (! -d "$dir$dirs[$i]") {
X mkdir("$dir$dirs[$i]", 0755) ||
X die "$0: error creating directory $dir$dirs[$i]: $!\n";
X }
X $dir .= "$dirs[$i]/";
X }
X
X # invoke pod2html
X print "$podroot/$pod => $htmldir/$html\n" if $verbose;
#system("./pod2html",
X Pod::Html'pod2html(
X #Pod::Html'pod2html($pod2html,
X "--htmlroot=$htmlroot",
X "--podpath=".join(":", @podpath),
X "--podroot=$podroot", "--netscape",
X ($doindex ? "--index" : "--noindex"),
X "--" . ($recurse ? "" : "no") . "recurse",
X ($#libpods >= 0) ? "--libpods=" . join(":", @libpods) : "",
X "--infile=$podroot/$pod", "--outfile=$htmldir/$html");
X die "$0: error running $pod2html: $!\n" if $?;
}
X
sub htmlize { htmlify(0, @_) }
SHAR_EOF
$shar_touch -am 0330073697 'pod/installhtml' &&
chmod 0755 'pod/installhtml' ||
$echo 'restore of' 'pod/installhtml' 'failed'
if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
&& ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
md5sum -c << SHAR_EOF >/dev/null 2>&1 \
|| $echo 'pod/installhtml:' 'MD5 check failed'
55c784bcd9b289d5113165bfe7f22ebb pod/installhtml
SHAR_EOF
else
shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'pod/installhtml'`"
test 16709 -eq "$shar_count" ||
$echo 'pod/installhtml:' 'original size' '16709,' 'current size' "$shar_count!"
fi
fi
# ============= pod/pod2html ==============
if test -f 'pod/pod2html' && test "$first_param" != -c; then
$echo 'x -' SKIPPING 'pod/pod2html' '(file already exists)'
else
$echo 'x -' extracting 'pod/pod2html' '(text)'
sed 's/^X//' << 'SHAR_EOF' > 'pod/pod2html' &&
#!/usr/bin/perl -w
X eval 'exec perl -S $0 "$@"'
X if 0;
X
=pod
X
=head1 NAME
X
pod2html - convert .pod files to .html files
X
=head1 SYNOPSIS
X
X pod2html --help --htmlroot=<name> --infile=<name> --outfile=<name>
X --podpath=<name>:...:<name> --podroot=<name>
X --libpods=<name>:...:<name> --recurse --norecurse --verbose
X --index --noindex --title=<name>
X
=head1 DESCRIPTION
X
Converts files from pod format (see L<perlpod>) to HTML format.
X
=head1 ARGUMENTS
X
pod2html takes the following arguments:
X
=over 4
X
=item help
X
X --help
X
Displays the usage message.
X
=item htmlroot
X
X --htmlroot=name
X
Sets the base URL for the HTML files. When cross-references are made,
the HTML root is prepended to the URL.
X
=item infile
X
X --infile=name
X
Specify the pod file to convert. Input is taken from STDIN if no
infile is specified.
X
=item outfile
X
X --outfile=name
X
Specify the HTML file to create. Output goes to STDOUT if no outfile
is specified.
X
=item podroot
X
X --podroot=name
X
Specify the base directory for finding library pods.
X
=item podpath
X
X --podpath=name:...:name
X
Specify which subdirectories of the podroot contain pod files whose
HTML converted forms can be linked-to in cross-references.
X
=item libpods
X
X --libpods=name:...:name
X
List of page names (eg, "perlfunc") which contain linkable C<=item>s.
X
=item netscape
X
X --netscape
X
Use Netscape HTML directives when applicable.
X
=item nonetscape
X
X --nonetscape
X
Do not use Netscape HTML directives (default).
X
=item index
X
X --index
X
Generate an index at the top of the HTML file (default behaviour).
X
=item noindex
X
X --noindex
X
Do not generate an index at the top of the HTML file.
X
X
=item recurse
X
X --recurse
X
Recurse into subdirectories specified in podpath (default behaviour).
X
=item norecurse
X
X --norecurse
X
Do not recurse into subdirectories specified in podpath.
X
=item title
X
X --title=title
X
Specify the title of the resulting HTML file.
X
=item verbose
X
X --verbose
X
Display progress messages.
X
=back
X
=head1 AUTHOR
X
Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
X
=head1 BUGS
X
See L<Pod::Html> for a list of known bugs in the translator.
X
=head1 SEE ALSO
X
L<perlpod>, L<Pod::HTML>
X
=head1 COPYRIGHT
X
This program is distributed under the Artistic License.
X
=cut
X
use Pod::Html;
X
if(@ARGV) {
X Pod::Html'pod2html(@ARGV);
} else {
X Pod::Html'pod2html();
}
SHAR_EOF
$shar_touch -am 0330071497 'pod/pod2html' &&
chmod 0644 'pod/pod2html' ||
$echo 'restore of' 'pod/pod2html' 'failed'
if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
&& ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
md5sum -c << SHAR_EOF >/dev/null 2>&1 \
|| $echo 'pod/pod2html:' 'MD5 check failed'
b9f8b98973a4e77f0cb94bdcc7c23e21 pod/pod2html
SHAR_EOF
else
shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'pod/pod2html'`"
test 2375 -eq "$shar_count" ||
$echo 'pod/pod2html:' 'original size' '2375,' 'current size' "$shar_count!"
fi
fi
# ============= lib/Pod/Html.pm ==============
if test ! -d 'lib'; then
$echo 'x -' 'creating directory' 'lib'
mkdir 'lib'
fi
if test ! -d 'lib/Pod'; then
$echo 'x -' 'creating directory' 'lib/Pod'
mkdir 'lib/Pod'
fi
if test -f 'lib/Pod/Html.pm' && test "$first_param" != -c; then
$echo 'x -' SKIPPING 'lib/Pod/Html.pm' '(file already exists)'
else
$echo 'x -' extracting 'lib/Pod/Html.pm' '(text)'
sed 's/^X//' << 'SHAR_EOF' > 'lib/Pod/Html.pm' &&
package Pod::Html;
X
use Pod::Functions;
use Getopt::Long; # package for handling command-line parameters
require Exporter;
@ISA = Exporter;
@EXPORT = qw(pod2html htmlify);
use Cwd;
X
use Carp;
X
use strict;
X
=head1 NAME
X
Pod::HTML - module to convert pod files to HTML
X
=head1 SYNOPSIS
X
X use Pod::HTML;
X pod2html([options]);
X
=head1 DESCRIPTION
X
Converts files from pod format (see L<perlpod>) to HTML format. It
can automatically generate indexes and cross-references, and it keeps
a cache of things it knows how to cross-reference.
X
=head1 ARGUMENTS
X
Pod::Html takes the following arguments:
X
=over 4
X
=item help
X
X --help
X
Displays the usage message.
X
=item htmlroot
X
X --htmlroot=name
X
Sets the base URL for the HTML files. When cross-references are made,
the HTML root is prepended to the URL.
X
=item infile
X
X --infile=name
X
Specify the pod file to convert. Input is taken from STDIN if no
infile is specified.
X
=item outfile
X
X --outfile=name
X
Specify the HTML file to create. Output goes to STDOUT if no outfile
is specified.
X
=item podroot
X
X --podroot=name
X
Specify the base directory for finding library pods.
X
=item podpath
X
X --podpath=name:...:name
X
Specify which subdirectories of the podroot contain pod files whose
HTML converted forms can be linked-to in cross-references.
X
=item libpods
X
X --libpods=name:...:name
X
List of page names (eg, "perlfunc") which contain linkable C<=item>s.
X
=item netscape
X
X --netscape
X
Use Netscape HTML directives when applicable.
X
=item nonetscape
X
X --nonetscape
X
Do not use Netscape HTML directives (default).
X
=item index
X
X --index
X
Generate an index at the top of the HTML file (default behaviour).
X
=item noindex
X
X --noindex
X
Do not generate an index at the top of the HTML file.
X
X
=item recurse
X
X --recurse
X
Recurse into subdirectories specified in podpath (default behaviour).
X
=item norecurse
X
X --norecurse
X
Do not recurse into subdirectories specified in podpath.
X
=item title
X
X --title=title
X
Specify the title of the resulting HTML file.
X
=item verbose
X
X --verbose
X
Display progress messages.
X
=back
X
=head1 EXAMPLE
X
X pod2html("pod2html",
X "--podpath=lib:ext:pod:vms",
X "--podroot=/usr/src/perl",
X "--htmlroot=/perl/nmanual",
X "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop",
X "--recurse",
X "--infile=foo.pod",
X "--outfile=/perl/nmanual/foo.html");
X
=head1 AUTHOR
X
Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
X
=head1 BUGS
X
Has trouble with C<> etc in = commands.
X
=head1 SEE ALSO
X
L<perlpod>
X
=head1 COPYRIGHT
X
This program is distributed under the Artistic License.
X
=cut
X
my $dircache = "pod2html-dircache";
my $itemcache = "pod2html-itemcache";
X
my @begin_stack = (); # begin/end stack
X
my @libpods = (); # files to search for links from C<> directives
my $htmlroot = "/"; # http-server base directory from which all
X # relative paths in $podpath stem.
my $htmlfile = ""; # write to stdout by default
my $podfile = ""; # read from stdin by default
my @podpath = (); # list of directories containing library pods.
my $podroot = "."; # filesystem base directory from which all
X # relative paths in $podpath stem.
my $recurse = 1; # recurse on subdirectories in $podpath.
my $verbose = 0; # not verbose by default
my $doindex = 1; # non-zero if we should generate an index
my $listlevel = 0; # current list depth
my @listitem = (); # stack of HTML commands to use when a =item is
X # encountered. the top of the stack is the
X # current list.
my @listdata = (); # similar to @listitem, but for the text after
X # an =item
my @listend = (); # similar to @listitem, but the text to use to
X # end the list.
my $ignore = 1; # whether or not to format text. we don't
X # format text until we hit our first pod
X # directive.
X
my %items_named = (); # for the multiples of the same item in perlfunc
my @items_seen = ();
my $netscape = 0; # whether or not to use netscape directives.
my $title; # title to give the pod(s)
my $top = 1; # true if we are at the top of the doc. used
X # to prevent the first <HR> directive.
my $paragraph; # which paragraph we're processing (used
X # for error messages)
my %pages = (); # associative array used to find the location
X # of pages referenced by L<> links.
my %sections = (); # sections within this page
my %items = (); # associative array used to find the location
X # of =item directives referenced by C<> links
sub init_globals {
$dircache = "pod2html-dircache";
$itemcache = "pod2html-itemcache";
X
@begin_stack = (); # begin/end stack
X
@libpods = (); # files to search for links from C<> directives
$htmlroot = "/"; # http-server base directory from which all
X # relative paths in $podpath stem.
$htmlfile = ""; # write to stdout by default
$podfile = ""; # read from stdin by default
@podpath = (); # list of directories containing library pods.
$podroot = "."; # filesystem base directory from which all
X # relative paths in $podpath stem.
$recurse = 1; # recurse on subdirectories in $podpath.
$verbose = 0; # not verbose by default
$doindex = 1; # non-zero if we should generate an index
$listlevel = 0; # current list depth
@listitem = (); # stack of HTML commands to use when a =item is
X # encountered. the top of the stack is the
X # current list.
@listdata = (); # similar to @listitem, but for the text after
X # an =item
@listend = (); # similar to @listitem, but the text to use to
X # end the list.
$ignore = 1; # whether or not to format text. we don't
X # format text until we hit our first pod
X # directive.
X
@items_seen = ();
%items_named = ();
$netscape = 0; # whether or not to use netscape directives.
$title = ''; # title to give the pod(s)
$top = 1; # true if we are at the top of the doc. used
X # to prevent the first <HR> directive.
$paragraph = ''; # which paragraph we're processing (used
X # for error messages)
%pages = (); # associative array used to find the location
X # of pages referenced by L<> links.
%sections = (); # sections within this page
%items = (); # associative array used to find the location
X # of =item directives referenced by C<> links
X
}
X
sub pod2html {
X local(@ARGV) = @_;
X local($/);
X local $_;
X
X init_globals();
X
X # cache of %pages and %items from last time we ran pod2html
X my $podpath = '';
X
X #undef $opt_help if defined $opt_help;
X
X # parse the command-line parameters
X parse_command_line();
X
X # set some variables to their default values if necessary
X local *POD;
X unless (@ARGV && $ARGV[0]) {
X $podfile = "-" unless $podfile; # stdin
X open(POD, "<$podfile")
X || die "$0: cannot open $podfile file for input: $!\n";
X } else {
X $podfile = $ARGV[0]; # XXX: might be more filenames
X *POD = *ARGV;
X }
X $htmlfile = "-" unless $htmlfile; # stdout
X $htmlroot = "" if $htmlroot eq "/"; # so we don't get a //
X
X # read the pod a paragraph at a time
X warn "Scanning for sections in input file(s)\n" if $verbose;
X $/ = "";
X my @poddata = <POD>;
X close(POD);
X
X # scan the pod for =head[1-6] directives and build an index
X my $index = scan_headings(\%sections, @poddata);
X
X # open the output file
X open(HTML, ">$htmlfile")
X || die "$0: cannot open $htmlfile file for output: $!\n";
X
X # put a title in the HTML file
X $title = '';
X TITLE_SEARCH: {
X for (my $i = 0; $i < @poddata; $i++) {
X if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
X for my $para ( @poddata[$i, $i+1] ) {
X last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+\s*.*)/s;
X }
X }
X
X }
X }
X unless ($title) {
X $podfile =~ /^(.*)(\.[^.\/]+)?$/;
X $title = ($podfile eq "-" ? 'No Title' : $1);
X warn "found $title" if $verbose;
X }
X if ($title =~ /\.pm/) {
X warn "$0: no title for $podfile";
X $title = $podfile;
X }
X print HTML <<END_OF_HEAD;
X <HTML>
X <HEAD>
X <TITLE>$title</TITLE>
X </HEAD>
X
X <BODY>
X
END_OF_HEAD
X
X # load a cache of %pages and %items if possible. $tests will be
X # non-zero if successful.
X my $tests = 0;
X if (-f $dircache && -f $itemcache) {
X warn "scanning for item cache\n" if $verbose;
X $tests = find_cache($dircache, $itemcache, $podpath, $podroot);
X }
X
X # if we didn't succeed in loading the cache then we must (re)build
X # %pages and %items.
X if (!$tests) {
X warn "scanning directories in pod-path\n" if $verbose;
X scan_podpath($podroot, $recurse);
X }
X
X # scan the pod for =item directives
X scan_items("", \%items, @poddata);
X
X # put an index at the top of the file. note, if $doindex is 0 we
X # still generate an index, but surround it with an html comment.
X # that way some other program can extract it if desired.
X $index =~ s/--+/-/g;
X print HTML "<!-- INDEX BEGIN -->\n";
X print HTML "<!--\n" unless $doindex;
X print HTML $index;
X print HTML "-->\n" unless $doindex;
X print HTML "<!-- INDEX END -->\n\n";
X print HTML "<HR>\n" if $doindex;
X
X # now convert this file
X warn "Converting input file\n" if $verbose;
X foreach my $i (0..$#poddata) {
X $_ = $poddata[$i];
X $paragraph = $i+1;
X if (/^(=.*)/s) { # is it a pod directive?
X $ignore = 0;
X $_ = $1;
X if (/^=begin\s+(\S+)\s*(.*)/si) {# =begin
X process_begin($1, $2);
X } elsif (/^=end\s+(\S+)\s*(.*)/si) {# =end
X process_end($1, $2);
X } elsif (/^=cut/) { # =cut
X process_cut();
X } elsif (/^=pod/) { # =pod
X process_pod();
X } else {
X next if @begin_stack && $begin_stack[-1] ne 'html';
X
X if (/^=(head[1-6])\s+(.*)/s) { # =head[1-6] heading
X process_head($1, $2);
X } elsif (/^=item\s*(.*)/sm) { # =item text
X process_item($1);
X } elsif (/^=over\s*(.*)/) { # =over N
X process_over();
X } elsif (/^=back/) { # =back
X process_back();
X } elsif (/^=for\s+(\S+)\s+(.*)/si) {# =for
X process_for($1,$2);
X } else {
X /^=(\S*)\s*/;
X warn "$0: $podfile: unknown pod directive '$1' in "
X . "paragraph $paragraph. ignoring.\n";
X }
X }
X $top = 0;
X }
X else {
X next if $ignore;
X next if @begin_stack && $begin_stack[-1] ne 'html';
X my $text = $_;
X process_text(\$text, 1);
X print HTML "$text\n<P>\n\n";
X }
X }
X
X # finish off any pending directives
X finish_list();
X print HTML <<END_OF_TAIL;
X </BODY>
X
X </HTML>
END_OF_TAIL
X
X # close the html file
X close(HTML);
X
X warn "Finished\n" if $verbose;
}
X
##############################################################################
X
my $usage; # see below
sub usage {
X my $podfile = shift;
X warn "$0: $podfile: @_\n" if @_;
X die $usage;
}
X
$usage =<<END_OF_USAGE;
Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
X --podpath=<name>:...:<name> --podroot=<name>
X --libpods=<name>:...:<name> --recurse --verbose --index
X --netscape --norecurse --noindex
X
X --flush - flushes the item and directory caches.
X --help - prints this message.
X --htmlroot - http-server base directory from which all relative paths
X in podpath stem (default is /).
X --index - generate an index at the top of the resulting html
X (default).
X --infile - filename for the pod to convert (input taken from stdin
X by default).
X --libpods - colon-separated list of pages to search for =item pod
X directives in as targets of C<> and implicit links (empty
X by default). note, these are not filenames, but rather
X page names like those that appear in L<> links.
X --netscape - will use netscape html directives when applicable.
X --nonetscape - will not use netscape directives (default).
X --outfile - filename for the resulting html file (output sent to
X stdout by default).
X --podpath - colon-separated list of directories containing library
X pods. empty by default.
X --podroot - filesystem base directory from which all relative paths
X in podpath stem (default is .).
X --noindex - don't generate an index at the top of the resulting html.
X --norecurse - don't recurse on those subdirectories listed in podpath.
X --recurse - recurse on those subdirectories listed in podpath
X (default behavior).
X --title - title that will appear in resulting html file.
X --verbose - self-explanatory
X
END_OF_USAGE
X
sub parse_command_line {
X my ($opt_flush,$opt_help,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,$opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_norecurse,$opt_recurse,$opt_title,$opt_verbose);
X my $result = GetOptions(
X 'flush' => \$opt_flush,
X 'help' => \$opt_help,
X 'htmlroot=s' => \$opt_htmlroot,
X 'index!' => \$opt_index,
X 'infile=s' => \$opt_infile,
X 'libpods=s' => \$opt_libpods,
X 'netscape!' => \$opt_netscape,
X 'outfile=s' => \$opt_outfile,
X 'podpath=s' => \$opt_podpath,
X 'podroot=s' => \$opt_podroot,
X 'norecurse' => \$opt_norecurse,
X 'recurse!' => \$opt_recurse,
X 'title=s' => \$opt_title,
X 'verbose' => \$opt_verbose,
X );
X usage("-", "invalid parameters") if not $result;
X
X usage("-") if defined $opt_help; # see if the user asked for help
X $opt_help = ""; # just to make -w shut-up.
X
X $podfile = $opt_infile if defined $opt_infile;
X $htmlfile = $opt_outfile if defined $opt_outfile;
X
X @podpath = split(":", $opt_podpath) if defined $opt_podpath;
X @libpods = split(":", $opt_libpods) if defined $opt_libpods;
X
X warn "Flushing item and directory caches\n"
X if $opt_verbose && defined $opt_flush;
X unlink($dircache, $itemcache) if defined $opt_flush;
X
X $htmlroot = $opt_htmlroot if defined $opt_htmlroot;
X $podroot = $opt_podroot if defined $opt_podroot;
X
X $doindex = $opt_index if defined $opt_index;
X $recurse = $opt_recurse if defined $opt_recurse;
X $title = $opt_title if defined $opt_title;
X $verbose = defined $opt_verbose ? 1 : 0;
X $netscape = $opt_netscape if defined $opt_netscape;
}
X
#
# find_cache - tries to find if the caches stored in $dircache and $itemcache
# are valid caches of %pages and %items. if they are valid then it loads
# them and returns a non-zero value.
#
sub find_cache {
X my($dircache, $itemcache, $podpath, $podroot) = @_;
X my($tests);
X local $_;
X
X $tests = 0;
X
X open(CACHE, "<$itemcache") ||
X die "$0: error opening $itemcache for reading: $!\n";
X $/ = "\n";
X
X # is it the same podpath?
X $_ = <CACHE>;
X chomp($_);
X $tests++ if (join(":", @podpath) eq $_);
X
X # is it the same podroot?
X $_ = <CACHE>;
X chomp($_);
X $tests++ if ($podroot eq $_);
X
X # load the cache if its good
X if ($tests != 2) {
X close(CACHE);
X
X %items = ();
X return 0;
X }
X
X warn "loading item cache\n" if $verbose;
X while (<CACHE>) {
X /(.*?) (.*)$/;
X $items{$1} = $2;
X }
X close(CACHE);
X
X warn "scanning for directory cache\n" if $verbose;
X open(CACHE, "<$dircache") ||
X die "$0: error opening $dircache for reading: $!\n";
X $/ = "\n";
X $tests = 0;
X
X # is it the same podpath?
X $_ = <CACHE>;
X chomp($_);
X $tests++ if (join(":", @podpath) eq $_);
X
X # is it the same podroot?
X $_ = <CACHE>;
X chomp($_);
X $tests++ if ($podroot eq $_);
X
X # load the cache if its good
X if ($tests != 2) {
X close(CACHE);
X
X %pages = ();
X %items = ();
X return 0;
X }
X
X warn "loading directory cache\n" if $verbose;
X while (<CACHE>) {
X /(.*?) (.*)$/;
X $pages{$1} = $2;
X }
X
X close(CACHE);
X
X return 1;
}
X
#
# scan_podpath - scans the directories specified in @podpath for directories,
# .pod files, and .pm files. it also scans the pod files specified in
# @libpods for =item directives.
#
sub scan_podpath {
X my($podroot, $recurse) = @_;
X my($pwd, $dir);
X my($libpod, $dirname, $pod, @files, @poddata);
X
X # scan each directory listed in @podpath
X $pwd = getcwd();
X chdir($podroot)
X || die "$0: error changing to directory $podroot: $!\n";
X foreach $dir (@podpath) {
X scan_dir($dir, $recurse);
X }
X
X # scan the pods listed in @libpods for =item directives
X foreach $libpod (@libpods) {
X # if the page isn't defined then we won't know where to find it
X # on the system.
X next unless defined $pages{$libpod} && $pages{$libpod};
X
X # if there is a directory then use the .pod and .pm files within it.
X if ($pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) {
X # find all the .pod and .pm files within the directory
X $dirname = $1;
X opendir(DIR, $dirname) ||
X die "$0: error opening directory $dirname: $!\n";
X @files = grep(/(\.pod|\.pm)$/ && ! -d $_, readdir(DIR));
X closedir(DIR);
X
X # scan each .pod and .pm file for =item directives
X foreach $pod (@files) {
X open(POD, "<$dirname/$pod") ||
X die "$0: error opening $dirname/$pod for input: $!\n";
X @poddata = <POD>;
X close(POD);
X
X scan_items("$dirname/$pod", @poddata);
X }
X
X # use the names of files as =item directives too.
X foreach $pod (@files) {
X $pod =~ /^(.*)(\.pod|\.pm)$/;
X $items{$1} = "$dirname/$1.html" if $1;
X }
X } elsif ($pages{$libpod} =~ /([^:]*\.pod):/ ||
X $pages{$libpod} =~ /([^:]*\.pm):/) {
X # scan the .pod or .pm file for =item directives
X $pod = $1;
X open(POD, "<$pod") ||
X die "$0: error opening $pod for input: $!\n";
X @poddata = <POD>;
X close(POD);
X
X scan_items("$pod", @poddata);
X } else {
X warn "$0: shouldn't be here (line ".__LINE__."\n";
X }
X }
X @poddata = (); # clean-up a bit
X
X chdir($pwd)
X || die "$0: error changing to directory $pwd: $!\n";
X
X # cache the item list for later use
X warn "caching items for later use\n" if $verbose;
X open(CACHE, ">$itemcache") ||
X die "$0: error open $itemcache for writing: $!\n";
X
X print CACHE join(":", @podpath) . "\n$podroot\n";
X foreach my $key (keys %items) {
X print CACHE "$key $items{$key}\n";
X }
X
X close(CACHE);
X
X # cache the directory list for later use
X warn "caching directories for later use\n" if $verbose;
X open(CACHE, ">$dircache") ||
X die "$0: error open $dircache for writing: $!\n";
X
X print CACHE join(":", @podpath) . "\n$podroot\n";
X foreach my $key (keys %pages) {
X print CACHE "$key $pages{$key}\n";
X }
X
X close(CACHE);
}
X
#
# scan_dir - scans the directory specified in $dir for subdirectories, .pod
# files, and .pm files. notes those that it finds. this information will
# be used later in order to figure out where the pages specified in L<>
# links are on the filesystem.
#
sub scan_dir {
X my($dir, $recurse) = @_;
X my($t, @subdirs, @pods, $pod, $dirname, @dirs);
X local $_;
X
X @subdirs = ();
X @pods = ();
X
X opendir(DIR, $dir) ||
X die "$0: error opening directory $dir: $!\n";
X while (defined($_ = readdir(DIR))) {
X if (-d "$dir/$_" && $_ ne "." && $_ ne "..") { # directory
X $pages{$_} = "" unless defined $pages{$_};
X $pages{$_} .= "$dir/$_:";
X push(@subdirs, $_);
X } elsif (/\.pod$/) { # .pod
X s/\.pod$//;
X $pages{$_} = "" unless defined $pages{$_};
X $pages{$_} .= "$dir/$_.pod:";
X push(@pods, "$dir/$_.pod");
X } elsif (/\.pm$/) { # .pm
X s/\.pm$//;
X $pages{$_} = "" unless defined $pages{$_};
X $pages{$_} .= "$dir/$_.pm:";
X push(@pods, "$dir/$_.pm");
X }
X }
X closedir(DIR);
X
X # recurse on the subdirectories if necessary
X if ($recurse) {
X foreach my $subdir (@subdirs) {
X scan_dir("$dir/$subdir", $recurse);
X }
X }
}
X
#
# scan_headings - scan a pod file for head[1-6] tags, note the tags, and
# build an index.
#
sub scan_headings {
X my($sections, @data) = @_;
X my($tag, $which_head, $title, $listdepth, $index);
X
X $listdepth = 0;
X $index = "";
X
X # scan for =head directives, note their name, and build an index
X # pointing to each of them.
X foreach my $line (@data) {
X if ($line =~ /^\s*=(head)([1-6])\s+(.*)/) {
X ($tag,$which_head, $title) = ($1,$2,$3);
X chomp($title);
X $$sections{htmlify(0,$title)} = 1;
X
X if ($which_head > $listdepth) {
X $index .= "\n" . ("\t" x $listdepth) . "<UL>\n";
X } elsif ($which_head < $listdepth) {
X $listdepth--;
X $index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
X }
X $listdepth = $which_head;
X
X $index .= "\n" . ("\t" x $listdepth) . "<LI>" .
X "<A HREF=\"#" . htmlify(0,$title) . "\">$title</A>";
X }
X }
X
X # finish off the lists
X while ($listdepth--) {
X $index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
X }
X
X # get rid of bogus lists
X $index =~ s,\t*<UL>\s*</UL>\n,,g;
X
X return $index;
}
X
#
# scan_items - scans the pod specified by $pod for =item directives. we
# will use this information later on in resolving C<> links.
#
sub scan_items {
X my($pod, @poddata) = @_;
X my($i, $item);
X local $_;
X
X $pod =~ s/\.pod$//;
X $pod .= ".html" if $pod;
X
X foreach $i (0..$#poddata) {
X $_ = $poddata[$i];
X
X # remove any formatting instructions
X s,[A-Z]<([^<>]*)>,$1,g;
X
X # figure out what kind of item it is and get the first word of
X # it's name.
X if (/^=item\s+(\w*)\s*.*$/s) {
X if ($1 eq "*") { # bullet list
X /\A=item\s+\*\s*(.*?)\s*\Z/s;
X $item = $1;
X } elsif ($1 =~ /^[0-9]+/) { # numbered list
X /\A=item\s+[0-9]+\.?(.*?)\s*\Z/s;
X $item = $1;
X } else {
# /\A=item\s+(.*?)\s*\Z/s;
X /\A=item\s+(\w*)/s;
X $item = $1;
X }
X
X $items{$item} = "$pod" if $item;
X }
X }
}
X
#
# process_head - convert a pod head[1-6] tag and convert it to HTML format.
#
sub process_head {
X my($tag, $heading) = @_;
X my $firstword;
X
X # figure out the level of the =head
X $tag =~ /head([1-6])/;
X my $level = $1;
X
X # can't have a heading full of spaces and speechmarks and so on
X $firstword = $heading; $firstword =~ s/\s*(\w+)\s.*/$1/;
X
X print HTML "<P>\n" unless $listlevel;
X print HTML "<HR>\n" unless $listlevel || $top;
X print HTML "<H$level>"; # unless $listlevel;
X #print HTML "<H$level>" unless $listlevel;
X my $convert = $heading; process_text(\$convert);
X print HTML '<A NAME="' . htmlify(0,$heading) . "\">$convert</A>";
X print HTML "</H$level>"; # unless $listlevel;
X print HTML "\n";
}
X
#
# process_item - convert a pod item tag and convert it to HTML format.
#
sub process_item {
X my $text = $_[0];
X my($i, $quote, $name);
X
X my $need_preamble = 0;
X my $this_entry;
X
X
X # lots of documents start a list without doing an =over. this is
X # bad! but, the proper thing to do seems to be to just assume
X # they did do an =over. so warn them once and then continue.
X warn "$0: $podfile: unexpected =item directive in paragraph $paragraph. ignoring.\n"
X unless $listlevel;
X process_over() unless $listlevel;
X
X return unless $listlevel;
X
X # remove formatting instructions from the text
X 1 while $text =~ s/[A-Z]<([^<>]*)>/$1/g;
X pre_escape(\$text);
X
X $need_preamble = $items_seen[$listlevel]++ == 0;
X
X # check if this is the first =item after an =over
X $i = $listlevel - 1;
X my $need_new = $listlevel >= @listitem;
X
X if ($text =~ /\A\*/) { # bullet
X
X if ($need_preamble) {
X push(@listend, "</UL>");
X print HTML "<UL>\n";
X }
X
X print HTML "<LI><STRONG>";
X $text =~ /\A\*\s*(.*)\Z/s;
X print HTML "<A NAME=\"item_" . htmlify(1,$1) . "\">" if $1 && !$items_named{$1}++;
X $quote = 1;
X #print HTML process_puretext($1, \$quote);
X print HTML $1;
X print HTML "</A>" if $1;
X print HTML "</STRONG>";
X
X } elsif ($text =~ /\A[0-9#]+/) { # numbered list
X
X if ($need_preamble) {
X push(@listend, "</OL>");
X print HTML "<OL>\n";
X }
X
X print HTML "<LI><STRONG>";
X $text =~ /\A[0-9]+\.?(.*)\Z/s;
X print HTML "<A NAME=\"item_" . htmlify(0,$1) . "\">" if $1;
X $quote = 1;
X #print HTML process_puretext($1, \$quote);
X print HTML $1 if $1;
X print HTML "</A>" if $1;
X print HTML "</STRONG>";
X
X } else { # all others
X
X if ($need_preamble) {
X push(@listend, '</DL>');
X print HTML "<DL>\n";
X }
X
X print HTML "<DT><STRONG>";
X print HTML "<A NAME=\"item_" . htmlify(1,$text) . "\">"
X if $text && !$items_named{($text =~ /(\S+)/)[0]}++;
X # preceding craziness so that the duplicate leading bits in
X # perlfunc work to find just the first one. otherwise
X # open etc would have many names
X $quote = 1;
X #print HTML process_puretext($text, \$quote);
X print HTML $text;
X print HTML "</A>" if $text;
X print HTML "</STRONG>";
X
X print HTML '<DD>';
X }
X
X print HTML "\n";
}
X
#
# process_over - process a pod over tag and start a corresponding HTML
# list.
#
sub process_over {
X # start a new list
X $listlevel++;
}
X
#
# process_back - process a pod back tag and convert it to HTML format.
#
sub process_back {
X warn "$0: $podfile: unexpected =back directive in paragraph $paragraph. ignorning.\n"
X unless $listlevel;
X return unless $listlevel;
X
X # close off the list. note, I check to see if $listend[$listlevel] is
X # defined because an =item directive may have never appeared and thus
X # $listend[$listlevel] may have never been initialized.
X $listlevel--;
X print HTML $listend[$listlevel] if defined $listend[$listlevel];
X print HTML "\n";
X
X # don't need the corresponding perl code anymore
X pop(@listitem);
X pop(@listdata);
X pop(@listend);
X
X pop(@items_seen);
}
X
#
# process_cut - process a pod cut tag, thus stop ignoring pod directives.
#
sub process_cut {
X $ignore = 1;
}
X
#
# process_pod - process a pod pod tag, thus ignore pod directives until we see a
# corresponding cut.
#
sub process_pod {
X # no need to set $ignore to 0 cause the main loop did it
}
X
#
# process_for - process a =for pod tag. if it's for html, split
# it out verbatim, otherwise ignore it.
#
sub process_for {
X my($whom, $text) = @_;
X if ( $whom =~ /^(pod2)?html$/i) {
X print HTML $text;
X }
}
X
#
# process_begin - process a =begin pod tag. this pushes
# whom we're beginning on the begin stack. if there's a
# begin stack, we only print if it us.
#
sub process_begin {
X my($whom, $text) = @_;
X $whom = lc($whom);
X push (@begin_stack, $whom);
X if ( $whom =~ /^(pod2)?html$/) {
X print HTML $text if $text;
X }
}
X
#
# process_end - process a =end pod tag. pop the
# begin stack. die if we're mismatched.
#
sub process_end {
X my($whom, $text) = @_;
X $whom = lc($whom);
X if ($begin_stack[-1] ne $whom ) {
X die "Unmatched begin/end at chunk $paragraph\n"
X }
X pop @begin_stack;
}
X
#
# process_text - handles plaintext that appears in the input pod file.
# there may be pod commands embedded within the text so those must be
# converted to html commands.
#
sub process_text {
X my($text, $escapeQuotes) = @_;
X my($result, $rest, $s1, $s2, $s3, $s4, $match, $bf);
X my($podcommand, $params, $tag, $quote);
X
X return if $ignore;
X
X $quote = 0; # status of double-quote conversion
X $result = "";
X $rest = $$text;
X
X if ($rest =~ /^\s+/) { # preformatted text, no pod directives
X $rest =~ s/\n+\Z//;
X
X $rest =~ s/&/&/g;
X $rest =~ s/</</g;
X $rest =~ s/>/>/g;
X $rest =~ s/"/"/g;
X
X # try and create links for all occurrences of perl.* within
X # the preformatted text.
X $rest =~ s{
X (\s*)(perl\w+)
X }{
X if (defined $pages{$2}) { # is a link
X qq($1<A HREF="$htmlroot/$pages{$2}">$2</A>);
X } else {
X "$1$2";
X }
X }xeg;
X $rest =~ s/(<A HREF=)([^>:]*:)?([^>:]*)\.pod:([^>:]*:)?/$1$3.html/g;
X
X my $urls = '(' . join ('|', qw{
X http
X telnet
X mailto
X news
X gopher
X file
X wais
X ftp
X } )
X . ')';
X
X my $ltrs = '\w';
X my $gunk = '/#~:.?+=&%@!\-';
X my $punc = '.:?\-';
X my $any = "${ltrs}${gunk}${punc}";
X
X $rest =~ s{
X \b # start at word boundary
X ( # begin $1 {
X $urls : # need resource and a colon
X [$any] +? # followed by on or more
X # of any valid character, but
X # be conservative and take only
X # what you need to....
X ) # end $1 }
X (?= # look-ahead non-consumptive assertion
X [$punc]* # either 0 or more puntuation
X [^$any] # followed by a non-url char
X | # or else
X $ # then end of the string
X )
X }{<A HREF="$1">$1</A>}igox;
X
X $result = "<PRE>" # text should be as it is (verbatim)
X . "$rest\n"
X . "</PRE>\n";
X } else { # formatted text
X # parse through the string, stopping each time we find a
X # pod-escape. once the string has been throughly processed
X # we can output it.
X while ($rest) {
X # check to see if there are any possible pod directives in
X # the remaining part of the text.
X if ($rest =~ m/[BCEIFLSZ]</) {
X warn "\$rest\t= $rest\n" unless
X $rest =~ /\A
X ([^<]*?)
X ([BCEIFLSZ]?)
X <
X (.*)\Z/xs;
X
X $s1 = $1; # pure text
X $s2 = $2; # the type of pod-escape that follows
X $s3 = '<'; # '<'
X $s4 = $3; # the rest of the string
X } else {
X $s1 = $rest;
X $s2 = "";
X $s3 = "";
X $s4 = "";
X }
X
X if ($s3 eq '<' && $s2) { # a pod-escape
X $result .= ($escapeQuotes ? process_puretext($s1, \$quote) : $s1);
X $podcommand = "$s2<";
X $rest = $s4;
X
X # find the matching '>'
X $match = 1;
X $bf = 0;
X while ($match && !$bf) {
X $bf = 1;
X if ($rest =~ /\A([^<>]*[BCEIFLSZ]<)(.*)\Z/s) {
X $bf = 0;
X $match++;
X $podcommand .= $1;
X $rest = $2;
X } elsif ($rest =~ /\A([^>]*>)(.*)\Z/s) {
X $bf = 0;
X $match--;
X $podcommand .= $1;
X $rest = $2;
X }
X }
X
X if ($match != 0) {
X warn <<WARN;
$0: $podfile: cannot find matching > for $s2 in paragraph $paragraph.
WARN
X $result .= substr $podcommand, 0, 2;
X $rest = substr($podcommand, 2) . $rest;
X next;
X }
X
X # pull out the parameters to the pod-escape
X $podcommand =~ /^([BCFEILSZ]?)<(.*)>$/s;
X $tag = $1;
X $params = $2;
X
X # process the text within the pod-escape so that any escapes
X # which must occur do.
X process_text(\$params, 0) unless $tag eq 'L';
X
X $s1 = $params;
X if (!$tag || $tag eq " ") { # <> : no tag
X $s1 = "<$params>";
X } elsif ($tag eq "L") { # L<> : link
X $s1 = process_L($params);
X } elsif ($tag eq "I" || # I<> : italicize text
X $tag eq "B" || # B<> : bold text
X $tag eq "F") { # F<> : file specification
X $s1 = process_BFI($tag, $params);
X } elsif ($tag eq "C") { # C<> : literal code
X $s1 = process_C($params, 1);
X } elsif ($tag eq "E") { # E<> : escape
X $s1 = process_E($params);
X } elsif ($tag eq "Z") { # Z<> : zero-width character
X $s1 = process_Z($params);
X } elsif ($tag eq "S") { # S<> : non-breaking space
X $s1 = process_S($params);
X } elsif ($tag eq "X") { # S<> : non-breaking space
X $s1 = process_X($params);
X } else {
X warn "$0: $podfile: unhandled tag '$tag' in paragraph $paragraph\n";
X }
X
X $result .= "$s1";
X } else {
X # for pure text we must deal with implicit links and
X # double-quotes among other things.
X $result .= ($escapeQuotes ? process_puretext("$s1$s2$s3", \$quote) : "$s1$s2$s3");
X $rest = $s4;
X }
X }
X }
X $$text = $result;
}
X
sub html_escape {
X my $rest = $_[0];
X $rest =~ s/&/&/g;
X $rest =~ s/</</g;
X $rest =~ s/>/>/g;
X $rest =~ s/"/"/g;
X return $rest;
}
X
#
# process_puretext - process pure text (without pod-escapes) converting
# double-quotes and handling implicit C<> links.
#
sub process_puretext {
X my($text, $quote) = @_;
X my(@words, $result, $rest, $lead, $trail);
X
X # convert double-quotes to single-quotes
X $text =~ s/\A([^"]*)"/$1''/s if $$quote;
X while ($text =~ s/\A([^"]*)["]([^"]*)["]/$1``$2''/sg) {}
X
X $$quote = ($text =~ m/"/ ? 1 : 0);
X $text =~ s/\A([^"]*)"/$1``/s if $$quote;
X
X # keep track of leading and trailing white-space
X $lead = ($text =~ /\A(\s*)/s ? $1 : "");
X $trail = ($text =~ /(\s*)\Z/s ? $1 : "");
X
X # collapse all white space into a single space
X $text =~ s/\s+/ /g;
X @words = split(" ", $text);
X
X # process each word individually
X foreach my $word (@words) {
X # see if we can infer a link
X if ($word =~ /^\w+\(/) {
X # has parenthesis so should have been a C<> ref
X $word = process_C($word);
# $word =~ /^[^()]*]\(/;
# if (defined $items{$1} && $items{$1}) {
# $word = "\n<CODE><A HREF=\"$htmlroot/$items{$1}#item_"
# . htmlify(0,$word)
# . "\">$word</A></CODE>";
# } elsif (defined $items{$word} && $items{$word}) {
# $word = "\n<CODE><A HREF=\"$htmlroot/$items{$word}#item_"
# . htmlify(0,$word)
# . "\">$word</A></CODE>";
# } else {
# $word = "\n<CODE><A HREF=\"#item_"
# . htmlify(0,$word)
# . "\">$word</A></CODE>";
# }
X } elsif ($word =~ /^[\$\@%&*]+\w+$/) {
X # perl variables, should be a C<> ref
X $word = process_C($word, 1);
X } elsif ($word =~ m,^\w+://\w,) {
X # looks like a URL
X $word = qq(<A HREF="$word">$word</A>);
X } elsif ($word =~ /[\w.-]+\@\w+\.\w/) {
X # looks like an e-mail address
X $word = qq(<A HREF="MAILTO:$word">$word</A>);
X } elsif ($word !~ /[a-z]/ && $word =~ /[A-Z]/) { # all uppercase?
X $word = html_escape($word) if $word =~ /[&<>]/;
X $word = "\n<FONT SIZE=-1>$word</FONT>" if $netscape;
X } else {
X $word = html_escape($word) if $word =~ /[&<>]/;
X }
X }
X
X # build a new string based upon our conversion
X $result = "";
X $rest = join(" ", @words);
X while (length($rest) > 75) {
X if ( $rest =~ m/^(.{0,75})\s(.*?)$/o ||
X $rest =~ m/^(\S*)\s(.*?)$/o) {
X
X $result .= "$1\n";
X $rest = $2;
X } else {
X $result .= "$rest\n";
X $rest = "";
X }
X }
X $result .= $rest if $rest;
X
X # restore the leading and trailing white-space
X $result = "$lead$result$trail";
X
X return $result;
}
X
#
# pre_escape - convert & in text to $amp;
#
sub pre_escape {
X my($str) = @_;
X
X $$str =~ s,&,&,g;
}
X
#
# process_L - convert a pod L<> directive to a corresponding HTML link.
# most of the links made are inferred rather than known about directly
# (i.e it's not known whether the =head\d section exists in the target file,
# or whether a .pod file exists in the case of split files). however, the
# guessing usually works.
#
# Unlike the other directives, this should be called with an unprocessed
# string, else tags in the link won't be matched.
#
sub process_L {
X my($str) = @_;
X my($s1, $s2, $linktext, $page, $section, $link); # work strings
X
X $str =~ s/\n/ /g; # undo word-wrapped tags
X $s1 = $str;
X for ($s1) {
X # a :: acts like a /
X s,::,/,;
X
X # make sure sections start with a /
X s,^",/",g;
X s,^,/,g if (!m,/, && / /);
X
X # check if there's a section specified
X if (m,^(.*?)/"?(.*?)"?$,) { # yes
X ($page, $section) = ($1, $2);
X } else { # no
X ($page, $section) = ($str, "");
X }
X
X # check if we know that this is a section in this page
X if (!defined $pages{$page} && defined $sections{$page}) {
X $section = $page;
X $page = "";
X }
X }
X
X if ($page eq "") {
X $link = "#" . htmlify(0,$section);
X $linktext = $section;
X } elsif (!defined $pages{$page}) {
X warn "$0: $podfile: cannot resolve L<$str> in paragraph $paragraph: no such page '$page'\n";
X $link = "";
X $linktext = $page;
X } else {
X $linktext = ($section ? "$section" : "the $page manpage");
X $section = htmlify(0,$section) if $section ne "";
X
X # if there is a directory by the name of the page, then assume that an
X # appropriate section will exist in the subdirectory
X if ($section ne "" && $pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) {
X $link = "$htmlroot/$1/$section.html";
X
X # since there is no directory by the name of the page, the section will
X # have to exist within a .html of the same name. thus, make sure there
X # is a .pod or .pm that might become that .html
X } else {
X $section = "#$section";
X # check if there is a .pod with the page name
X if ($pages{$page} =~ /([^:]*)\.pod:/) {
X $link = "$htmlroot/$1.html$section";
X } elsif ($pages{$page} =~ /([^:]*)\.pm:/) {
X $link = "$htmlroot/$1.html$section";
X } else {
X warn "$0: $podfile: cannot resolve L$str in paragraph $paragraph: ".
X "no .pod or .pm found\n";
X $link = "";
X $linktext = $section;
X }
X }
X }
X
X process_text(\$linktext, 0);
X if ($link) {
X $s1 = "<A HREF=\"$link\">$linktext</A>";
X } else {
X $s1 = "<EM>$linktext</EM>";
X }
X return $s1;
}
X
#
# process_BFI - process any of the B<>, F<>, or I<> pod-escapes and
# convert them to corresponding HTML directives.
#
sub process_BFI {
X my($tag, $str) = @_;
X my($s1); # work string
X my(%repltext) = ( 'B' => 'STRONG',
X 'F' => 'EM',
X 'I' => 'EM');
X
X # extract the modified text and convert to HTML
X $s1 = "<$repltext{$tag}>$str</$repltext{$tag}>";
X return $s1;
}
X
#
# process_C - process the C<> pod-escape.
#
sub process_C {
X my($str, $doref) = @_;
X my($s1, $s2);
X
X $s1 = $str;
X $s1 =~ s/\([^()]*\)//g; # delete parentheses
X $str = $s2 = $s1;
X $s1 =~ s/\W//g; # delete bogus characters
X
X # if there was a pod file that we found earlier with an appropriate
X # =item directive, then create a link to that page.
X if ($doref && defined $items{$s1}) {
X $s1 = ($items{$s1} ?
X "<A HREF=\"$htmlroot/$items{$s1}#item_" . htmlify(0,$s2) . "\">$str</A>" :
X "<A HREF=\"#item_" . htmlify(0,$s2) . "\">$str</A>");
X $s1 =~ s,(perl\w+/(\S+)\.html)#item_\2\b,$1,;
X confess "s1 has space: $s1" if $s1 =~ /HREF="[^"]*\s[^"]*"/;
X } else {
X $s1 = "<CODE>$str</CODE>";
X # warn "$0: $podfile: cannot resolve C<$str> in paragraph $paragraph\n" if $verbose
X }
X
X
X return $s1;
}
X
#
# process_E - process the E<> pod directive which seems to escape a character.
#
sub process_E {
X my($str) = @_;
X
X for ($str) {
X s,([^/].*),\&$1\;,g;
X }
X
X return $str;
}
X
#
# process_Z - process the Z<> pod directive which really just amounts to
# ignoring it. this allows someone to start a paragraph with an =
#
sub process_Z {
X my($str) = @_;
X
X # there is no equivalent in HTML for this so just ignore it.
X $str = "";
X return $str;
}
X
#
# process_S - process the S<> pod directive which means to convert all
# spaces in the string to non-breaking spaces (in HTML-eze).
#
sub process_S {
X my($str) = @_;
X
X # convert all spaces in the text to non-breaking spaces in HTML.
X $str =~ s/ / /g;
X return $str;
}
X
#
# process_X - this is supposed to make an index entry. we'll just
# ignore it.
#
sub process_X {
X return '';
}
X
X
#
# finish_list - finish off any pending HTML lists. this should be called
# after the entire pod file has been read and converted.
#
sub finish_list {
X while ($listlevel >= 0) {
X print HTML "</DL>\n";
X $listlevel--;
X }
}
X
#
# htmlify - converts a pod section specification to a suitable section
# specification for HTML. if first arg is 1, only takes 1st word.
#
sub htmlify {
X my($compact, $heading) = @_;
X
X if ($compact) {
X $heading =~ /^(\w+)/;
X $heading = $1;
X }
X
X # $heading = lc($heading);
X $heading =~ s/[^\w\s]/_/g;
X $heading =~ s/(\s+)/ /g;
X $heading =~ s/^\s*(.*?)\s*$/$1/s;
X $heading =~ s/ /_/g;
X $heading =~ s/\A(.{32}).*\Z/$1/s;
X $heading =~ s/\s+\Z//;
X $heading =~ s/_{2,}/_/g;
X
X return $heading;
}
X
BEGIN {
}
X
1;
X
SHAR_EOF
$shar_touch -am 0330081597 'lib/Pod/Html.pm' &&
chmod 0644 'lib/Pod/Html.pm' ||
$echo 'restore of' 'lib/Pod/Html.pm' 'failed'
if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
&& ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
md5sum -c << SHAR_EOF >/dev/null 2>&1 \
|| $echo 'lib/Pod/Html.pm:' 'MD5 check failed'
35115925e3aede888c7ad26558623f3a lib/Pod/Html.pm
SHAR_EOF
else
shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'lib/Pod/Html.pm'`"
test 39829 -eq "$shar_count" ||
$echo 'lib/Pod/Html.pm:' 'original size' '39829,' 'current size' "$shar_count!"
fi
fi
rm -fr _sh12213
exit 0
--
Tom Christiansen tchrist@jhereg.perl.com
"Since when did you hear people talk about writing LISP or BASIC *scripts*?
JCL and shell make command *scripts*; perl and LISP make *programs*." --me
------------------------------
Date: 31 Mar 1997 14:51:10 -0700
From: Randal Schwartz <merlyn@stonehenge.com>
To: mconst@soda.CSUA.Berkeley.EDU (Michael Constant)
Subject: Re: Why is no subscripting allowed in custom sort routines?
Message-Id: <8civ27pw6p.fsf@gadget.cscaper.com>
>>>>> "Michael" == Michael Constant <mconst@soda.CSUA.Berkeley.EDU> writes:
Michael> Give your anonymous subroutine a name, for a while:
Michael> local *anonymous = $routine;
Michael> sort anonymous @foo;
Or (cooler :-),
{ local(*it_this_way) = $routine;
sort it_this_way @foo;
}
print "Just another Perl hacker," # but not what the media calls "hacker!" :-)
## legal fund: $20,495.69 collected, $182,159.85 spent; just 518 more days
## before I go to *prison* for 90 days; email fund@stonehenge.com for details
--
Name: Randal L. Schwartz / Stonehenge Consulting Services (503)777-0095
Keywords: Perl training, UNIX[tm] consulting, video production, skiing, flying
Email: <merlyn@stonehenge.com> Snail: (Call) PGP-Key: (finger merlyn@ora.com)
Web: <A HREF="http://www.stonehenge.com/merlyn/">My Home Page!</A>
Quote: "I'm telling you, if I could have five lines in my .sig, I would!" -- me
------------------------------
Date: Mon, 31 Mar 1997 15:51:19 -0500
From: Arnold Gavurin <agavurin@ix.netcom.com>
Subject: Win 32 problems
Message-Id: <334023C7.7104@ix.netcom.com>
Enclosed is a slightly modified example taken from the Win32
documentation:
------------------------------------------------------------------------
#
# Launch a Windows process from Win32 module.
# See online docs for more on this subject.
#
use Win32;
use Win32::Process;
#Create the process object.
Win32::Process::Create($ProcessObj,
"D:\\WINNT35\\NOTEPAD.EXE",
"NOTEPAD",
0, # Don't inherit.
DETACHED_PROCESS,
".") || # current dir.
die &print_error;
#Wait for the process to end. No timeout.
$ProcessObj->Wait(INFINITE) ||
warn &print_error;
$ProcessObj->GetExitCode($ExitCode) ||
warn &print_error;
print "Notepad exited with $ExitCode\n";
sub print_error {
print Win32::FormatMessage( Win32::GetLastError() );
}
# winapp.pl
---------------------------------------------------------------------
This example starts the notepad. (I am using windows nt 3.51). Note the
statement:
$ProcessObj->Wait(INFINITE) ||
warn &print_error;
The comment seems to tell me that I have change the "INFINITE" to some
value in
milliseconds that the process (notepad) should terminate after that time
elapses
I have tried different times and notepad never terminates.
Questions:
1) Has anyone used this?
2) Does it work on your workstation?
3) I have a copy of "Cross Platform PERL". It covers NT albiet
breifly. Any books were there is more detail and EXAMPLES?
Arnold Gavurin
------------------------------
Date: Mon, 31 Mar 1997 15:58:36 -0500
From: Arnold Gavurin <agavurin@ix.netcom.com>
Subject: Win32 Problems
Message-Id: <3340257C.41F3@ix.netcom.com>
Enclosed is a slightly modified example taken from the Win32
documentation:
------------------------------------------------------------------------
#
# Launch a Windows process from Win32 module.
# See online docs for more on this subject.
#
use Win32;
use Win32::Process;
#Create the process object.
Win32::Process::Create($ProcessObj,
"D:\\WINNT35\\NOTEPAD.EXE",
"NOTEPAD",
0, # Don't inherit.
DETACHED_PROCESS,
".") || # current dir.
die &print_error;
#Wait for the process to end. No timeout.
$ProcessObj->Wait(INFINITE) ||
warn &print_error;
$ProcessObj->GetExitCode($ExitCode) ||
warn &print_error;
print "Notepad exited with $ExitCode\n";
sub print_error {
print Win32::FormatMessage( Win32::GetLastError() );
}
# winapp.pl
---------------------------------------------------------------------
This example starts the notepad. (I am using windows nt 3.51). Note the
statement:
$ProcessObj->Wait(INFINITE) ||
warn &print_error;
The comment seems to tell me that I have change the "INFINITE" to some
value in
milliseconds that the process (notepad) should terminate after that time
elapses
I have tried different times and notepad never terminates.
Questions:
1) Has anyone used this?
2) Does it work on your workstation?
3) I have a copy of "Cross Platform PERL". It covers NT albiet
breifly. Any books were there is more detail and EXAMPLES?
Arnold Gavurin
------------------------------
Date: 31 Mar 1997 21:53:41 GMT
From: dlipton@bbnplanet.com (Daniel Lipton)
Subject: Re: Writing a routine the works like 'open'
Message-Id: <5hpbp5$9jh$1@daily.bbnplanet.com>
It's not exactly like "open()", but how about using references?
for example:
#!/usr/local/bin/perl
#
flopen( \*FILENAME, ">tmp.txt" ) ;
print FILENAME "hello world!\n" ;
flclose( \*FILENAME ) ;
sub flopen
{
( $filehandle, $expr ) = @_ ;
flock $filehandle, 1 ;
open( $filehandle, $expr ) ;
}
sub flclose
{
( $filehandle ) = @_ ;
flock $filehandle, 8 ;
close $filehandle ;
}
------------------------------
Date: 8 Mar 97 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 8 Mar 97)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.misc (and this Digest), send your
article to perl-users@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.
The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V8 Issue 210
*************************************
