📄 htmlbatch.pm
字号:
require 5;package Pod::Simple::HTMLBatch;use strict;use vars qw( $VERSION $HTML_RENDER_CLASS $HTML_EXTENSION $CSS $JAVASCRIPT $SLEEPY $SEARCH_CLASS @ISA);$VERSION = '3.02';@ISA = (); # Yup, we're NOT a subclass of Pod::Simple::HTML!# TODO: nocontents stylesheets. Strike some of the color variations?use Pod::Simple::HTML ();BEGIN {*esc = \&Pod::Simple::HTML::esc }use File::Spec ();use UNIVERSAL (); # "Isn't the Universe an amazing place? I wouldn't live anywhere else!"use Pod::Simple::Search;$SEARCH_CLASS ||= 'Pod::Simple::Search';BEGIN { if(defined &DEBUG) { } # no-op elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG } else { *DEBUG = sub () {0}; }}$SLEEPY = 1 if !defined $SLEEPY and $^O =~ /mswin|mac/i;# flag to occasionally sleep for $SLEEPY - 1 seconds.$HTML_RENDER_CLASS ||= "Pod::Simple::HTML";## Methods beginning with "_" are particularly internal and possibly ugly.#Pod::Simple::_accessorize( __PACKAGE__, 'verbose', # how verbose to be during batch conversion 'html_render_class', # what class to use to render 'contents_file', # If set, should be the name of a file (in current directory) # to write the list of all modules to 'index', # will set $htmlpage->index(...) to this (true or false) 'progress', # progress object 'contents_page_start', 'contents_page_end', 'css_flurry', '_css_wad', 'javascript_flurry', '_javascript_wad', 'no_contents_links', # set to true to suppress automatic adding of << links. '_contents',);# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -# Just so we can run from the command line more easilysub go { @ARGV == 2 or die sprintf( "Usage: perl -M%s -e %s:go indirs outdir\n (or use \"\@INC\" for indirs)\n", __PACKAGE__, __PACKAGE__, ); if(defined($ARGV[1]) and length($ARGV[1])) { my $d = $ARGV[1]; -e $d or die "I see no output directory named \"$d\"\nAborting"; -d $d or die "But \"$d\" isn't a directory!\nAborting"; -w $d or die "Directory \"$d\" isn't writeable!\nAborting"; } __PACKAGE__->batch_convert(@ARGV);}# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub new { my $new = bless {}, ref($_[0]) || $_[0]; $new->html_render_class($HTML_RENDER_CLASS); $new->verbose(1 + DEBUG); $new->_contents([]); $new->index(1); $new-> _css_wad([]); $new->css_flurry(1); $new->_javascript_wad([]); $new->javascript_flurry(1); $new->contents_file( 'index' . ($HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION) ); $new->contents_page_start( join "\n", grep $_, $Pod::Simple::HTML::Doctype_decl, "<html><head>", "<title>Perl Documentation</title>", $Pod::Simple::HTML::Content_decl, "</head>", "\n<body class='contentspage'>\n<h1>Perl Documentation</h1>\n" ); # override if you need a different title $new->contents_page_end( sprintf( "\n\n<p class='contentsfooty'>Generated by %s v%s under Perl v%s\n<br >At %s GMT, which is %s local time.</p>\n\n</body></html>\n", esc( ref($new), eval {$new->VERSION} || $VERSION, $], scalar(gmtime), scalar(localtime), ))); return $new;}# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub muse { my $self = shift; if($self->verbose) { print 'T+', int(time() - $self->{'_batch_start_time'}), "s: ", @_, "\n"; } return 1;}# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub batch_convert { my($self, $dirs, $outdir) = @_; $self ||= __PACKAGE__; # tolerate being called as an optionless function $self = $self->new unless ref $self; # tolerate being used as a class method if(!defined($dirs) or $dirs eq '' or $dirs eq '@INC' ) { $dirs = ''; } elsif(ref $dirs) { # OK, it's an explicit set of dirs to scan, specified as an arrayref. } else { # OK, it's an explicit set of dirs to scan, specified as a # string like "/thing:/also:/whatever/perl" (":"-delim, as usual) # or, under MSWin, like "c:/thing;d:/also;c:/whatever/perl" (";"-delim!) require Config; my $ps = quotemeta( $Config::Config{'path_sep'} || ":" ); $dirs = [ grep length($_), split qr/$ps/, $dirs ]; } $outdir = $self->filespecsys->curdir unless defined $outdir and length $outdir; $self->_batch_convert_main($dirs, $outdir);}# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _batch_convert_main { my($self, $dirs, $outdir) = @_; # $dirs is either false, or an arrayref. # $outdir is a pathspec. $self->{'_batch_start_time'} ||= time(); $self->muse( "= ", scalar(localtime) ); $self->muse( "Starting batch conversion to \"$outdir\"" ); my $progress = $self->progress; if(!$progress and $self->verbose > 0 and $self->verbose() <= 5) { require Pod::Simple::Progress; $progress = Pod::Simple::Progress->new( ($self->verbose < 2) ? () # Default omission-delay : ($self->verbose == 2) ? 1 # Reduce the omission-delay : 0 # Eliminate the omission-delay ); $self->progress($progress); } if($dirs) { $self->muse(scalar(@$dirs), " dirs to scan: @$dirs"); } else { $self->muse("Scanning \@INC. This could take a minute or two."); } my $mod2path = $self->find_all_pods($dirs ? $dirs : ()); $self->muse("Done scanning."); my $total = keys %$mod2path; unless($total) { $self->muse("No pod found. Aborting batch conversion.\n"); return $self; } $progress and $progress->goal($total); $self->muse("Now converting pod files to HTML.", ($total > 25) ? " This will take a while more." : () ); $self->_spray_css( $outdir ); $self->_spray_javascript( $outdir ); $self->_do_all_batch_conversions($mod2path, $outdir); $progress and $progress->done(sprintf ( "Done converting %d files.", $self->{"__batch_conv_page_count"} )); return $self->_batch_convert_finish($outdir); return $self;}sub _do_all_batch_conversions { my($self, $mod2path, $outdir) = @_; $self->{"__batch_conv_page_count"} = 0; foreach my $module (sort {lc($a) cmp lc($b)} keys %$mod2path) { $self->_do_one_batch_conversion($module, $mod2path, $outdir); sleep($SLEEPY - 1) if $SLEEPY; } return;}sub _batch_convert_finish { my($self, $outdir) = @_; $self->write_contents_file($outdir); $self->muse("Done with batch conversion. $$self{'__batch_conv_page_count'} files done."); $self->muse( "= ", scalar(localtime) ); $self->progress and $self->progress->done("All done!"); return;}# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _do_one_batch_conversion { my($self, $module, $mod2path, $outdir, $outfile) = @_; my $retval; my $total = scalar keys %$mod2path; my $infile = $mod2path->{$module}; my @namelets = grep m/\S/, split "::", $module; # this can stick around in the contents LoL my $depth = scalar @namelets; die "Contentless thingie?! $module $infile" unless @namelets; #sanity $outfile ||= do { my @n = @namelets; $n[-1] .= $HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION; $self->filespecsys->catfile( $outdir, @n ); }; my $progress = $self->progress; my $page = $self->html_render_class->new; if(DEBUG > 5) { $self->muse($self->{"__batch_conv_page_count"} + 1, "/$total: ", ref($page), " render ($depth) $module => $outfile"); } elsif(DEBUG > 2) { $self->muse($self->{"__batch_conv_page_count"} + 1, "/$total: $module => $outfile") } # Give each class a chance to init the converter: $page->batch_mode_page_object_init($self, $module, $infile, $outfile, $depth) if $page->can('batch_mode_page_object_init'); $self->batch_mode_page_object_init($page, $module, $infile, $outfile, $depth) if $self->can('batch_mode_page_object_init'); # Now get busy... $self->makepath($outdir => \@namelets); $progress and $progress->reach($self->{"__batch_conv_page_count"}, "Rendering $module"); if( $retval = $page->parse_from_file($infile, $outfile) ) { ++ $self->{"__batch_conv_page_count"} ; $self->note_for_contents_file( \@namelets, $infile, $outfile ); } else { $self->muse("Odd, parse_from_file(\"$infile\", \"$outfile\") returned false."); } $page->batch_mode_page_object_kill($self, $module, $infile, $outfile, $depth) if $page->can('batch_mode_page_object_kill'); # The following isn't a typo. Note that it switches $self and $page. $self->batch_mode_page_object_kill($page, $module, $infile, $outfile, $depth) if $self->can('batch_mode_page_object_kill'); DEBUG > 4 and printf "%s %sb < $infile %s %sb\n", $outfile, -s $outfile, $infile, -s $infile ; undef($page); return $retval;}# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub filespecsys { $_[0]{'_filespecsys'} || 'File::Spec' }# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub note_for_contents_file { my($self, $namelets, $infile, $outfile) = @_; # I think the infile and outfile parts are never used. -- SMB # But it's handy to have them around for debugging. if( $self->contents_file ) { my $c = $self->_contents(); push @$c, [ join("::", @$namelets), $infile, $outfile, $namelets ] # 0 1 2 3 ; DEBUG > 3 and print "Noting @$c[-1]\n"; } return;}#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-sub write_contents_file { my($self, $outdir) = @_; my $outfile = $self->_contents_filespec($outdir) || return; $self->muse("Preparing list of modules for ToC"); my($toplevel, # maps toplevelbit => [all submodules] $toplevel_form_freq, # ends up being 'foo' => 'Foo' ) = $self->_prep_contents_breakdown; my $Contents = eval { $self->_wopen($outfile) }; if( $Contents ) { $self->muse( "Writing contents file $outfile" ); } else { warn "Couldn't write-open contents file $outfile: $!\nAbort writing to $outfile at all"; return; } $self->_write_contents_start( $Contents, $outfile, ); $self->_write_contents_middle( $Contents, $outfile, $toplevel, $toplevel_form_freq ); $self->_write_contents_end( $Contents, $outfile, ); return $outfile;}# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _write_contents_start { my($self, $Contents, $outfile) = @_; my $starter = $self->contents_page_start || ''; { my $css_wad = $self->_css_wad_to_markup(1); if( $css_wad ) { $starter =~ s{(</head>)}{\n$css_wad\n$1}i; # otherwise nevermind } my $javascript_wad = $self->_javascript_wad_to_markup(1); if( $javascript_wad ) { $starter =~ s{(</head>)}{\n$javascript_wad\n$1}i; # otherwise nevermind } } unless(print $Contents $starter, "<dl class='superindex'>\n" ) { warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all"; close($Contents); return 0; } return 1;}# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _write_contents_middle { my($self, $Contents, $outfile, $toplevel2submodules, $toplevel_form_freq) = @_; foreach my $t (sort keys %$toplevel2submodules) { my @downlines = sort {$a->[-1] cmp $b->[-1]} @{ $toplevel2submodules->{$t} }; printf $Contents qq[<dt><a name="%s">%s</a></dt>\n<dd>\n], esc( $t, $toplevel_form_freq->{$t} ) ; my($path, $name); foreach my $e (@downlines) { $name = $e->[0]; $path = join( "/", '.', esc( @{$e->[3]} ) ) . ($HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION); print $Contents qq{ <a href="$path">}, esc($name), "</a> \n"; } print $Contents "</dd>\n\n"; } return 1;}# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _write_contents_end { my($self, $Contents, $outfile) = @_; unless( print $Contents "</dl>\n", $self->contents_page_end || '', ) { warn "Couldn't write to $outfile: $!"; } close($Contents) or warn "Couldn't close $outfile: $!"; return 1;}# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _prep_contents_breakdown { my($self) = @_; my $contents = $self->_contents; my %toplevel; # maps lctoplevelbit => [all submodules] my %toplevel_form_freq; # ends up being 'foo' => 'Foo' # (mapping anycase forms to most freq form) foreach my $entry (@$contents) { my $toplevel = $entry->[0] =~ m/^perl\w*$/ ? 'perl_core_docs' # group all the perlwhatever docs together : $entry->[3][0] # normal case ; ++$toplevel_form_freq{ lc $toplevel }{ $toplevel }; push @{ $toplevel{ lc $toplevel } }, $entry; push @$entry, lc($entry->[0]); # add a sort-order key to the end } foreach my $toplevel (sort keys %toplevel) { my $fgroup = $toplevel_form_freq{$toplevel}; $toplevel_form_freq{$toplevel} = ( sort { $fgroup->{$b} <=> $fgroup->{$a} or $a cmp $b } keys %$fgroup # This hash is extremely unlikely to have more than 4 members, so this # sort isn't so very wasteful )[0]; } return(\%toplevel, \%toplevel_form_freq) if wantarray; return \%toplevel;}# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sub _contents_filespec { my($self, $outdir) = @_; my $outfile = $self->contents_file; return unless $outfile; return $self->filespecsys->catfile( $outdir, $outfile );}#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-sub makepath { my($self, $outdir, $namelets) = @_; return unless @$namelets > 1; for my $i (0 .. ($#$namelets - 1)) { my $dir = $self->filespecsys->catdir( $outdir, @$namelets[0 .. $i] ); if(-e $dir) { die "$dir exists but not as a directory!?" unless -d $dir; next; }⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -