📄 html.pm
字号:
if ($Title) { $Title =~ s/\s*\(.*\)//; } else { warn "$0: no title for $Podfile.\n" unless $Quiet; $Podfile =~ /^(.*)(\.[^.\/]+)?\z/s; $Title = ($Podfile eq "-" ? 'No Title' : $1); warn "using $Title" if $Verbose; } $Title = html_escape($Title); my $csslink = ''; my $bodystyle = ' style="background-color: white"'; my $tdstyle = ' style="background-color: #cccccc"'; if ($Css) { $csslink = qq(\n<link rel="stylesheet" href="$Css" type="text/css" />); $csslink =~ s,\\,/,g; $csslink =~ s,(/.):,$1|,; $bodystyle = ''; $tdstyle = ''; } my $block = $Header ? <<END_OF_BLOCK : '';<table border="0" width="100%" cellspacing="0" cellpadding="3"><tr><td class="block"$tdstyle valign="middle"><big><strong><span class="block"> $Title</span></strong></big></td></tr></table>END_OF_BLOCK print HTML <<END_OF_HEAD;<?xml version="1.0" ?><!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"><html xmlns="http://www.w3.org/1999/xhtml"><head><title>$Title</title>$csslink<meta http-equiv="content-type" content="text/html; charset=utf-8" /><link rev="made" href="mailto:$Config{perladmin}" /></head><body$bodystyle>$blockEND_OF_HEAD # load/reload/validate/cache %Pages and %Items get_cache($Dircache, $Itemcache, \@Podpath, $Podroot, $Recurse); # scan the pod for =item directives scan_items( \%Local_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; my $hr = ($Doindex and $index) ? qq(<hr name="index" />) : ""; unless ($Doindex) { $index = qq(<!--\n$index\n-->\n); } print HTML << "END_OF_INDEX";<!-- INDEX BEGIN --><div name="index"><p><a name=\"__index__\"></a></p>$index$hr</div><!-- INDEX END -->END_OF_INDEX # now convert this file my $after_item; # set to true after an =item my $need_dd = 0; warn "Converting input file $Podfile\n" if $Verbose; foreach my $i (0..$#poddata){ $_ = $poddata[$i]; $Paragraph = $i+1; if (/^(=.*)/s) { # is it a pod directive? $Ignore = 0; $after_item = 0; $need_dd = 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)/s) { # =head[1-6] heading process_head( $1, $2, $Doindex && $index ); } elsif (/^=item\s*(.*\S)?/sm) { # =item text $need_dd = process_item( $1 ); $after_item = 1; } elsif (/^=over\s*(.*)/) { # =over N process_over(); } elsif (/^=back/) { # =back process_back($need_dd); } 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" unless $Quiet; } } $Top = 0; } else { next if $Ignore; next if @Begin_Stack && $Begin_Stack[-1] ne 'html'; print HTML and next if @Begin_Stack && $Begin_Stack[-1] eq 'html'; print HTML "<dd>\n" if $need_dd; my $text = $_; if( $text =~ /\A\s+/ ){ process_pre( \$text ); print HTML "<pre>\n$text</pre>\n"; } else { process_text( \$text ); # experimental: check for a paragraph where all lines # have some ...\t...\t...\n pattern if( $text =~ /\t/ ){ my @lines = split( "\n", $text ); if( @lines > 1 ){ my $all = 2; foreach my $line ( @lines ){ if( $line =~ /\S/ && $line !~ /\t/ ){ $all--; last if $all == 0; } } if( $all > 0 ){ $text =~ s/\t+/<td>/g; $text =~ s/^/<tr><td>/gm; $text = '<table cellspacing="0" cellpadding="0">' . $text . '</table>'; } } } ## end of experimental if( $after_item ){ $After_Lpar = 1; } print HTML "<p>$text</p>\n"; } print HTML "</dd>\n" if $need_dd; $after_item = 0; } } # finish off any pending directives finish_list(); # link to page index print HTML "<p><a href=\"#__index__\"><small>$Backlink</small></a></p>\n" if $Doindex and $index and $Backlink; print HTML <<END_OF_TAIL;$block</body></html>END_OF_TAIL # close the html file close(HTML); warn "Finished\n" if $Verbose;}##############################################################################sub usage { my $podfile = shift; warn "$0: $podfile: @_\n" if @_; die <<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 --cachedir=<name> --backlink - set text for "back to top" links (default: none). --cachedir - directory for the item and directory cache files. --css - stylesheet URL --flush - flushes the item and directory caches. --[no]header - produce block header/footer (default is no headers). --help - prints this message. --hiddendirs - search hidden directories in podpath --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). --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. --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 .). --[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). --[no]netscape - deprecated, has no effect. for backwards compatibility only.END_OF_USAGE}sub parse_command_line { my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header,$opt_help, $opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods, $opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_quiet, $opt_recurse,$opt_title,$opt_verbose,$opt_hiddendirs); unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html}; my $result = GetOptions( 'backlink=s' => \$opt_backlink, 'cachedir=s' => \$opt_cachedir, 'css=s' => \$opt_css, 'flush' => \$opt_flush, 'header!' => \$opt_header, 'help' => \$opt_help, 'hiddendirs!'=> \$opt_hiddendirs, 'htmldir=s' => \$opt_htmldir, '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, 'quiet!' => \$opt_quiet, '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. @Podpath = split(":", $opt_podpath) if defined $opt_podpath; @Libpods = split(":", $opt_libpods) if defined $opt_libpods; $Backlink = $opt_backlink if defined $opt_backlink; $Cachedir = $opt_cachedir if defined $opt_cachedir; $Css = $opt_css if defined $opt_css; $Header = $opt_header if defined $opt_header; $Htmldir = $opt_htmldir if defined $opt_htmldir; $Htmlroot = $opt_htmlroot if defined $opt_htmlroot; $Doindex = $opt_index if defined $opt_index; $Podfile = $opt_infile if defined $opt_infile; $HiddenDirs = $opt_hiddendirs if defined $opt_hiddendirs; $Htmlfile = $opt_outfile if defined $opt_outfile; $Podroot = $opt_podroot if defined $opt_podroot; $Quiet = $opt_quiet if defined $opt_quiet; $Recurse = $opt_recurse if defined $opt_recurse; $Title = $opt_title if defined $opt_title; $Verbose = $opt_verbose if defined $opt_verbose; warn "Flushing item and directory caches\n" if $opt_verbose && defined $opt_flush; $Dircache = "$Cachedir/pod2htmd.tmp"; $Itemcache = "$Cachedir/pod2htmi.tmp"; if (defined $opt_flush) { 1 while unlink($Dircache, $Itemcache); }}my $Saved_Cache_Key;sub get_cache { my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_; my @cache_key_args = @_; # A first-level cache: # Don't bother reading the cache files if they still apply # and haven't changed since we last read them. my $this_cache_key = cache_key(@cache_key_args); return if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key; # load the cache of %Pages and %Items if possible. $tests will be # non-zero if successful. my $tests = 0; if (-f $dircache && -f $itemcache) { warn "scanning for item cache\n" if $Verbose; $tests = load_cache($dircache, $itemcache, $podpath, $podroot); } # if we didn't succeed in loading the cache then we must (re)build # %Pages and %Items. if (!$tests) { warn "scanning directories in pod-path\n" if $Verbose; scan_podpath($podroot, $recurse, 0); } $Saved_Cache_Key = cache_key(@cache_key_args);}sub cache_key { my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_; return join('!', $dircache, $itemcache, $recurse, @$podpath, $podroot, stat($dircache), stat($itemcache));}## load_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 load_cache { my($dircache, $itemcache, $podpath, $podroot) = @_; my($tests); local $_; $tests = 0; open(CACHE, "<$itemcache") || die "$0: error opening $itemcache for reading: $!\n"; $/ = "\n"; # is it the same podpath? $_ = <CACHE>; chomp($_); $tests++ if (join(":", @$podpath) eq $_); # is it the same podroot? $_ = <CACHE>; chomp($_); $tests++ if ($podroot eq $_); # load the cache if its good if ($tests != 2) { close(CACHE); return 0; } warn "loading item cache\n" if $Verbose; while (<CACHE>) { /(.*?) (.*)$/; $Items{$1} = $2; } close(CACHE); warn "scanning for directory cache\n" if $Verbose; open(CACHE, "<$dircache") || die "$0: error opening $dircache for reading: $!\n"; $/ = "\n"; $tests = 0; # is it the same podpath? $_ = <CACHE>; chomp($_); $tests++ if (join(":", @$podpath) eq $_); # is it the same podroot? $_ = <CACHE>; chomp($_); $tests++ if ($podroot eq $_); # load the cache if its good if ($tests != 2) { close(CACHE); return 0; } warn "loading directory cache\n" if $Verbose; while (<CACHE>) { /(.*?) (.*)$/; $Pages{$1} = $2; } close(CACHE); return 1;}## 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 { my($podroot, $recurse, $append) = @_; my($pwd, $dir); my($libpod, $dirname, $pod, @files, @poddata); unless($append) { %Items = (); %Pages = (); } # scan each directory listed in @Podpath $pwd = getcwd(); chdir($podroot) || die "$0: error changing to directory $podroot: $!\n"; foreach $dir (@Podpath) { scan_dir($dir, $recurse); } # scan the pods listed in @Libpods for =item directives foreach $libpod (@Libpods) { # if the page isn't defined then we won't know where to find it # on the system. next unless defined $Pages{$libpod} && $Pages{$libpod}; # if there is a directory then use the .pod and .pm files within it. # NOTE: Only finds the first so-named directory in the tree.# if ($Pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) { if ($Pages{$libpod} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) { # find all the .pod and .pm files within the directory $dirname = $1; opendir(DIR, $dirname) || die "$0: error opening directory $dirname: $!\n"; @files = grep(/(\.pod|\.pm)\z/ && ! -d $_, readdir(DIR)); closedir(DIR); # scan each .pod and .pm file for =item directives foreach $pod (@files) { open(POD, "<$dirname/$pod") || die "$0: error opening $dirname/$pod for input: $!\n"; @poddata = <POD>; close(POD);⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -