winhtml.pm

ARM上的如果你对底层感兴趣

package Pod::WinHtml;

use Pod::Functions;
use Getopt::Long;	# package for handling command-line parameters
require Exporter;
@ISA = Exporter;
@EXPORT = qw(pod2html htmlify);

use Cwd;
use Carp;
use strict;
use Config;

=head1 NAME

Pod::WinHtml - module to convert pod files to HTML

Taken from Pod::Html to correct some things for Win32.

=head1 SYNOPSIS

    use Pod::WinHtml;
    pod2html([options]);

=head1 DESCRIPTION

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.

=head1 ARGUMENTS

Pod::Html takes the following arguments:

=over 4

=item help

    --help

Displays the usage message.

=item htmlroot

    --htmlroot=name

Sets the base URL for the HTML files.  When cross-references are made,
the HTML root is prepended to the URL.

=item infile

    --infile=name

Specify the pod file to convert.  Input is taken from STDIN if no
infile is specified.

=item outfile

    --outfile=name

Specify the HTML file to create.  Output goes to STDOUT if no outfile
is specified.

=item podroot

    --podroot=name

Specify the base directory for finding library pods.

=item podpath

    --podpath=name:...:name

Specify which subdirectories of the podroot contain pod files whose
HTML converted forms can be linked-to in cross-references.

=item libpods

    --libpods=name:...:name

List of page names (eg, "perlfunc") which contain linkable C<=item>s.

=item netscape

    --netscape

Use Netscape HTML directives when applicable.

=item nonetscape

    --nonetscape

Do not use Netscape HTML directives (default).

=item index

    --index

Generate an index at the top of the HTML file (default behaviour).

=item noindex

    --noindex

Do not generate an index at the top of the HTML file.


=item recurse

    --recurse

Recurse into subdirectories specified in podpath (default behaviour).

=item norecurse

    --norecurse

Do not recurse into subdirectories specified in podpath.

=item title

    --title=title

Specify the title of the resulting HTML file.

=item verbose

    --verbose

Display progress messages.

=item css

	--css=stylesheet

Style sheet to use for the page.

=back

=head1 EXAMPLE

    pod2html("pod2html",
	     "--podpath=lib:ext:pod:vms", 
	     "--podroot=/usr/src/perl",
	     "--htmlroot=/perl/nmanual",
	     "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop",
	     "--recurse",
	     "--infile=foo.pod",
	     "--outfile=/perl/nmanual/foo.html");

=head1 AUTHOR

Tom Christiansen, E<lt>[e-mail]<gt>.
Hacked for ActiveState Online Help by David Grove, E<lt>[e-mail]<gt>.

=head1 BUGS

Has trouble with C<> etc in = commands.

=head1 SEE ALSO

L<perlpod>

=head1 COPYRIGHT

This program is distributed under the Artistic License.

=cut

my $dircache = "pod2html-dircache";
my $itemcache = "pod2html-itemcache";

my @begin_stack = ();		# begin/end stack

my @libpods = ();	    	# files to search for links from C<> directives
my $htmlroot = "/";	    	# http-server base directory from which all
				#   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
				#   relative paths in $podpath stem.
my $csslink = "<link rel=\"stylesheet\" href=\"file://$Config{prefix}/html/win32prk.css\" type=\"text/css\">";
   $csslink =~ s{\\}{/}g;
   $csslink =~ s{(/.):}{$1|};
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
						#   encountered.  the top of the stack is the
						#   current list.
my @listdata = ();		# similar to @listitem, but for the text after
						#   an =item
my @listend = ();		# similar to @listitem, but the text to use to
						#   end the list.
my $ignore = 1;			# whether or not to format text.  we don't
						#   format text until we hit our first pod
						#   directive.

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
						#   to prevent the first <HR> directive.
my $paragraph;			# which paragraph we're processing (used
						#   for error messages)
my %pages = ();			# associative array used to find the location
						#   of pages referenced by L<> links.
my %sections = ();		# sections within this page
my %items = ();			# associative array used to find the location
						#   of =item directives referenced by C<> links
sub init_globals {
$dircache = "pod2html.dir";
$itemcache = "pod2html.itm";

@begin_stack = ();		# begin/end stack

@libpods = ();	    	# files to search for links from C<> directives
$htmlroot = "/";    	# http-server base directory from which all
						#   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
						#   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
						#   encountered.  the top of the stack is the
						#   current list.
@listdata = ();			# similar to @listitem, but for the text after
						#   an =item
@listend = ();			# similar to @listitem, but the text to use to
						#   end the list.
$ignore = 1;			# whether or not to format text.  we don't
						#   format text until we hit our first pod
						#   directive.

@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
						#   to prevent the first <HR> directive.
$paragraph = '';		# which paragraph we're processing (used
						#   for error messages)
%sections = ();			# sections within this page

# These are not reinitialised here but are kept as a cache.
# See get_cache and related cache management code.
#%pages = ();			# associative array used to find the location
						#   of pages referenced by L<> links.
#%items = ();			# associative array used to find the location
						#   of =item directives referenced by C<> links

}

sub pod2html {
    local(@ARGV) = @_;
    local($/);
    local $_;

    init_globals();

    # cache of %pages and %items from last time we ran pod2html

    #undef $opt_help if defined $opt_help;

    # parse the command-line parameters
    parse_command_line();

    # set some variables to their default values if necessary
    local *POD;
    unless (@ARGV && $ARGV[0]) { 
		$podfile  = "-" unless $podfile;	# stdin
		open(POD, "<$podfile")
			|| die "$0: cannot open $podfile file for input: $!\n";
    } else {
		$podfile = $ARGV[0];  # XXX: might be more filenames
		*POD = *ARGV;
    } 

    $htmlfile = "-" unless $htmlfile;	# stdout
    $htmlroot = "" if $htmlroot eq "/";	# so we don't get a //

    # read the pod a paragraph at a time
    warn "Scanning for sections in input file(s)\n" if $verbose;
    $/ = "";
    my @poddata  = <POD>;
    close(POD);

    # scan the pod for =head[1-6] directives and build an index
    my $index = scan_headings(\%sections, @poddata);

    unless($index) {
		warn "No pod in $podfile\n" if $verbose;
		return;
    }

    # open the output file
    open(HTML, ">$htmlfile")
	    || die "$0: cannot open $htmlfile file for output: $!\n";

    # put a title in the HTML file
    $title = '';
    TITLE_SEARCH: {
		for (my $i = 0; $i < @poddata; $i++) { 
		    if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
				for my $para ( @poddata[$i, $i+1] ) { 
				    last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+\s*.*)/s;
				}
		    } 
		} 
    } 

    if (!$title and $podfile =~ /\.pod$/) {
		# probably a split pod so take first =head[12] as title
		for (my $i = 0; $i < @poddata; $i++) { 
		    last if ($title) = $poddata[$i] =~ /^=head[12]\s*(.*)/;
		} 
		warn "adopted '$title' as title for $podfile\n"
		    if $verbose and $title;
    } 

    unless ($title) { 
#		warn "$0: no title for $podfile";
		$podfile =~ /^(.*)(\.[^.\/]+)?$/;
		$title = ($podfile eq "-" ? 'No Title' : $1);
		warn "using $title" if $verbose;
    }

    print HTML <<"END_OF_HEAD";
    <HTML> 
	<HEAD> 
	    <TITLE>$title</TITLE>
		$csslink
	</HEAD>
	<BODY BGCOLOR=\"FFFFFF\">
	<!-- beginning of leaf header-->

	<TABLE border=0  cellpadding=0 cellspacing=0 width=100%>
	<TR>
		<TD valign=middle width=\"100%\"
		bgcolor=\"#cc0066\"> <font face=\"sans-serif\" size=\"+1\"
		color=\"#ff99cc\">&nbsp;&nbsp;&nbsp;$title</font>
		</TD>
	</TR>
	<tr>
	<td>
	<p>&nbsp</p>
	<!-- end of leaf content-->
END_OF_HEAD

    # load/reload/validate/cache %pages and %items
    get_cache($dircache, $itemcache, \@podpath, $podroot, $recurse);

    # scan the pod for =item directives
    scan_items("", \%items, @poddata);

    # put an index at the top of the file.  note, if $doindex is 0 we
    # still generate an index, but surround it with an html comment.
    # that way some other program can extract it if desired.
    $index =~ s/--+/-/g;
    print HTML "<!-- INDEX BEGIN -->\n";
    print HTML "<!--\n" unless $doindex;
    print HTML $index;
    print HTML "-->\n" unless $doindex;
    print HTML "<!-- INDEX END -->\n\n";
    print HTML "<HR>\n" if $doindex;

    # now convert this file
    warn "Converting input file\n" if $verbose;
    foreach my $i (0..$#poddata) {
		$_ = $poddata[$i];
		$paragraph = $i+1;
		if (/^(=.*)/s) {	# is it a pod directive?
		    $ignore = 0;
		    $_ = $1;
		    if (/^=begin\s+(\S+)\s*(.*)/si) {# =begin
				process_begin($1, $2);
		    } elsif (/^=end\s+(\S+)\s*(.*)/si) {# =end
				process_end($1, $2);
		    } elsif (/^=cut/) {			# =cut
				process_cut();
		    } elsif (/^=pod/) {			# =pod
				process_pod();
		    } else {
				next if @begin_stack && $begin_stack[-1] ne 'html';

			if (/^=(head[1-6])\s+(.*)/s) {	# =head[1-6] heading
			    process_head($1, $2);
			} elsif (/^=item\s*(.*)/sm) {	# =item text
			    process_item($1);
			} elsif (/^=over\s*(.*)/) {		# =over N
			    process_over();
			} elsif (/^=back/) {		# =back
			    process_back();
			} elsif (/^=for\s+(\S+)\s+(.*)/si) {# =for
			    process_for($1,$2);
			} else {
			    /^=(\S*)\s*/;
			    warn "$0: $podfile: unknown pod directive '$1' in "
			       . "paragraph $paragraph.  ignoring.\n";
			}
	    }
	    $top = 0;
	}
	else {
	    next if $ignore;
	    next if @begin_stack && $begin_stack[-1] ne 'html';
	    my $text = $_;
	    process_text(\$text, 1);
	    print HTML "<P>$text\n</P>\n\n";
	}
    }

    # finish off any pending directives
    finish_list();
    print HTML <<"END_OF_TAIL";
		<!-- beginning of leaf footer-->
		<p>&nbsp;</p>
		</TD>
		<TR>
			<TD valign=middle
				bgcolor=\"#cc0066\"> <font face=\"sans-serif\" size=\"+1\"
				color=\"#ff99cc\">&nbsp;&nbsp;&nbsp;$title</font>
			</TD>
		</TR>
		</table>
		<!-- end of leaf footer-->
		</BODY>
		</HTML>
END_OF_TAIL

    # close the html file
    close(HTML);

    warn "Finished\n" if $verbose;
}

##############################################################################

my $usage;			# see below
sub usage {
    my $podfile = shift;
    warn "$0: $podfile: @_\n" if @_;
    die $usage;
}

$usage =<<END_OF_USAGE;
Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
           --podpath=<name>:...:<name> --podroot=<name>
           --libpods=<name>:...:<name> --recurse --verbose --index
           --netscape --norecurse --noindex

  --flush      - flushes the item and directory caches.
  --help       - prints this message.
  --htmlroot   - http-server base directory from which all relative paths
                 in podpath stem (default is /).
  --index      - generate an index at the top of the resulting html
                 (default).
  --infile     - filename for the pod to convert (input taken from stdin
                 by default).
  --libpods    - colon-separated list of pages to search for =item pod
                 directives in as targets of C<> and implicit links (empty
                 by default).  note, these are not filenames, but rather
                 page names like those that appear in L<> links.
  --netscape   - will use netscape html directives when applicable.
  --nonetscape - will not use netscape directives (default).
  --outfile    - filename for the resulting html file (output sent to
                 stdout by default).
  --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 .).
  --noindex    - don't generate an index at the top of the resulting html.
  --norecurse  - don't recurse on those subdirectories listed in podpath.
  --recurse    - recurse on those subdirectories listed in podpath
                 (default behavior).
  --title      - title that will appear in resulting html file.
  --verbose    - self-explanatory

END_OF_USAGE

sub parse_command_line {
    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,$opt_css,$opt_embedcss);
    my $result = GetOptions(
			    'flush'      => \$opt_flush,
			    'help'       => \$opt_help,
			    'htmlroot=s' => \$opt_htmlroot,
			    'index!'     => \$opt_index,
			    'infile=s'   => \$opt_infile,
			    'libpods=s'  => \$opt_libpods,
			    'netscape!'  => \$opt_netscape,
			    'outfile=s'  => \$opt_outfile,
			    'podpath=s'  => \$opt_podpath,
			    'podroot=s'  => \$opt_podroot,
			    'norecurse'  => \$opt_norecurse,
			    'recurse!'   => \$opt_recurse,
			    'title=s'    => \$opt_title,
			    'verbose'    => \$opt_verbose
			   );
    usage("-", "invalid parameters") if not $result;

    usage("-") if defined $opt_help;	# see if the user asked for help
    $opt_help = "";			# just to make -w shut-up.

    $podfile  = $opt_infile if defined $opt_infile;
    $htmlfile = $opt_outfile if defined $opt_outfile;

    @podpath  = split(":", $opt_podpath) if defined $opt_podpath;
    @libpods  = split(":", $opt_libpods) if defined $opt_libpods;

    warn "Flushing item and directory caches\n"
	if $opt_verbose && defined $opt_flush;
    unlink($dircache, $itemcache) if defined $opt_flush;