3 package Pod::Simple::HTMLBatch;
5 use vars qw( $VERSION $HTML_RENDER_CLASS $HTML_EXTENSION
6 $CSS $JAVASCRIPT $SLEEPY $SEARCH_CLASS @ISA
9 @ISA = (); # Yup, we're NOT a subclass of Pod::Simple::HTML!
11 # TODO: nocontents stylesheets. Strike some of the color variations?
13 use Pod::Simple::HTML ();
14 BEGIN {*esc = \&Pod::Simple::HTML::esc }
17 # "Isn't the Universe an amazing place? I wouldn't live anywhere else!"
19 use Pod::Simple::Search;
20 $SEARCH_CLASS ||= 'Pod::Simple::Search';
23 if(defined &DEBUG) { } # no-op
24 elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG }
25 else { *DEBUG = sub () {0}; }
28 $SLEEPY = 1 if !defined $SLEEPY and $^O =~ /mswin|mac/i;
29 # flag to occasionally sleep for $SLEEPY - 1 seconds.
31 $HTML_RENDER_CLASS ||= "Pod::Simple::HTML";
34 # Methods beginning with "_" are particularly internal and possibly ugly.
37 Pod::Simple::_accessorize( __PACKAGE__,
38 'verbose', # how verbose to be during batch conversion
39 'html_render_class', # what class to use to render
40 'contents_file', # If set, should be the name of a file (in current directory)
41 # to write the list of all modules to
42 'index', # will set $htmlpage->index(...) to this (true or false)
43 'progress', # progress object
44 'contents_page_start', 'contents_page_end',
46 'css_flurry', '_css_wad', 'javascript_flurry', '_javascript_wad',
47 'no_contents_links', # set to true to suppress automatic adding of << links.
51 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
52 # Just so we can run from the command line more easily
54 @ARGV == 2 or die sprintf(
55 "Usage: perl -M%s -e %s:go indirs outdir\n (or use \"\@INC\" for indirs)\n",
56 __PACKAGE__, __PACKAGE__,
59 if(defined($ARGV[1]) and length($ARGV[1])) {
61 -e $d or die "I see no output directory named \"$d\"\nAborting";
62 -d $d or die "But \"$d\" isn't a directory!\nAborting";
63 -w $d or die "Directory \"$d\" isn't writeable!\nAborting";
66 __PACKAGE__->batch_convert(@ARGV);
68 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
72 my $new = bless {}, ref($_[0]) || $_[0];
73 $new->html_render_class($HTML_RENDER_CLASS);
74 $new->verbose(1 + DEBUG);
79 $new-> _css_wad([]); $new->css_flurry(1);
80 $new->_javascript_wad([]); $new->javascript_flurry(1);
83 'index' . ($HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION)
86 $new->contents_page_start( join "\n", grep $_,
87 $Pod::Simple::HTML::Doctype_decl,
89 "<title>Perl Documentation</title>",
90 $Pod::Simple::HTML::Content_decl,
92 "\n<body class='contentspage'>\n<h1>Perl Documentation</h1>\n"
93 ); # override if you need a different title
96 $new->contents_page_end( sprintf(
97 "\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",
100 eval {$new->VERSION} || $VERSION,
101 $], scalar(gmtime), scalar(localtime),
107 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
112 print 'T+', int(time() - $self->{'_batch_start_time'}), "s: ", @_, "\n";
117 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
120 my($self, $dirs, $outdir) = @_;
121 $self ||= __PACKAGE__; # tolerate being called as an optionless function
122 $self = $self->new unless ref $self; # tolerate being used as a class method
124 if(!defined($dirs) or $dirs eq '' or $dirs eq '@INC' ) {
127 # OK, it's an explicit set of dirs to scan, specified as an arrayref.
129 # OK, it's an explicit set of dirs to scan, specified as a
130 # string like "/thing:/also:/whatever/perl" (":"-delim, as usual)
131 # or, under MSWin, like "c:/thing;d:/also;c:/whatever/perl" (";"-delim!)
133 my $ps = quotemeta( $Config::Config{'path_sep'} || ":" );
134 $dirs = [ grep length($_), split qr/$ps/, $dirs ];
137 $outdir = $self->filespecsys->curdir
138 unless defined $outdir and length $outdir;
140 $self->_batch_convert_main($dirs, $outdir);
143 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
145 sub _batch_convert_main {
146 my($self, $dirs, $outdir) = @_;
147 # $dirs is either false, or an arrayref.
148 # $outdir is a pathspec.
150 $self->{'_batch_start_time'} ||= time();
152 $self->muse( "= ", scalar(localtime) );
153 $self->muse( "Starting batch conversion to \"$outdir\"" );
155 my $progress = $self->progress;
156 if(!$progress and $self->verbose > 0 and $self->verbose() <= 5) {
157 require Pod::Simple::Progress;
158 $progress = Pod::Simple::Progress->new(
159 ($self->verbose < 2) ? () # Default omission-delay
160 : ($self->verbose == 2) ? 1 # Reduce the omission-delay
161 : 0 # Eliminate the omission-delay
163 $self->progress($progress);
167 $self->muse(scalar(@$dirs), " dirs to scan: @$dirs");
169 $self->muse("Scanning \@INC. This could take a minute or two.");
171 my $mod2path = $self->find_all_pods($dirs ? $dirs : ());
172 $self->muse("Done scanning.");
174 my $total = keys %$mod2path;
176 $self->muse("No pod found. Aborting batch conversion.\n");
180 $progress and $progress->goal($total);
181 $self->muse("Now converting pod files to HTML.",
182 ($total > 25) ? " This will take a while more." : ()
185 $self->_spray_css( $outdir );
186 $self->_spray_javascript( $outdir );
188 $self->_do_all_batch_conversions($mod2path, $outdir);
190 $progress and $progress->done(sprintf (
191 "Done converting %d files.", $self->{"__batch_conv_page_count"}
193 return $self->_batch_convert_finish($outdir);
198 sub _do_all_batch_conversions {
199 my($self, $mod2path, $outdir) = @_;
200 $self->{"__batch_conv_page_count"} = 0;
202 foreach my $module (sort {lc($a) cmp lc($b)} keys %$mod2path) {
203 $self->_do_one_batch_conversion($module, $mod2path, $outdir);
204 sleep($SLEEPY - 1) if $SLEEPY;
210 sub _batch_convert_finish {
211 my($self, $outdir) = @_;
212 $self->write_contents_file($outdir);
213 $self->muse("Done with batch conversion. $$self{'__batch_conv_page_count'} files done.");
214 $self->muse( "= ", scalar(localtime) );
215 $self->progress and $self->progress->done("All done!");
219 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
221 sub _do_one_batch_conversion {
222 my($self, $module, $mod2path, $outdir, $outfile) = @_;
225 my $total = scalar keys %$mod2path;
226 my $infile = $mod2path->{$module};
227 my @namelets = grep m/\S/, split "::", $module;
228 # this can stick around in the contents LoL
229 my $depth = scalar @namelets;
230 die "Contentless thingie?! $module $infile" unless @namelets; #sanity
234 $n[-1] .= $HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION;
235 $self->filespecsys->catfile( $outdir, @n );
238 my $progress = $self->progress;
240 my $page = $self->html_render_class->new;
242 $self->muse($self->{"__batch_conv_page_count"} + 1, "/$total: ",
243 ref($page), " render ($depth) $module => $outfile");
245 $self->muse($self->{"__batch_conv_page_count"} + 1, "/$total: $module => $outfile")
248 # Give each class a chance to init the converter:
250 $page->batch_mode_page_object_init($self, $module, $infile, $outfile, $depth)
251 if $page->can('batch_mode_page_object_init');
252 $self->batch_mode_page_object_init($page, $module, $infile, $outfile, $depth)
253 if $self->can('batch_mode_page_object_init');
256 $self->makepath($outdir => \@namelets);
258 $progress and $progress->reach($self->{"__batch_conv_page_count"}, "Rendering $module");
260 if( $retval = $page->parse_from_file($infile, $outfile) ) {
261 ++ $self->{"__batch_conv_page_count"} ;
262 $self->note_for_contents_file( \@namelets, $infile, $outfile );
264 $self->muse("Odd, parse_from_file(\"$infile\", \"$outfile\") returned false.");
267 $page->batch_mode_page_object_kill($self, $module, $infile, $outfile, $depth)
268 if $page->can('batch_mode_page_object_kill');
269 # The following isn't a typo. Note that it switches $self and $page.
270 $self->batch_mode_page_object_kill($page, $module, $infile, $outfile, $depth)
271 if $self->can('batch_mode_page_object_kill');
273 DEBUG > 4 and printf "%s %sb < $infile %s %sb\n",
274 $outfile, -s $outfile, $infile, -s $infile
281 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
282 sub filespecsys { $_[0]{'_filespecsys'} || 'File::Spec' }
284 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
286 sub note_for_contents_file {
287 my($self, $namelets, $infile, $outfile) = @_;
289 # I think the infile and outfile parts are never used. -- SMB
290 # But it's handy to have them around for debugging.
292 if( $self->contents_file ) {
293 my $c = $self->_contents();
295 [ join("::", @$namelets), $infile, $outfile, $namelets ]
298 DEBUG > 3 and print "Noting @$c[-1]\n";
303 #_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
305 sub write_contents_file {
306 my($self, $outdir) = @_;
307 my $outfile = $self->_contents_filespec($outdir) || return;
309 $self->muse("Preparing list of modules for ToC");
311 my($toplevel, # maps toplevelbit => [all submodules]
312 $toplevel_form_freq, # ends up being 'foo' => 'Foo'
313 ) = $self->_prep_contents_breakdown;
315 my $Contents = eval { $self->_wopen($outfile) };
317 $self->muse( "Writing contents file $outfile" );
319 warn "Couldn't write-open contents file $outfile: $!\nAbort writing to $outfile at all";
323 $self->_write_contents_start( $Contents, $outfile, );
324 $self->_write_contents_middle( $Contents, $outfile, $toplevel, $toplevel_form_freq );
325 $self->_write_contents_end( $Contents, $outfile, );
329 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
331 sub _write_contents_start {
332 my($self, $Contents, $outfile) = @_;
333 my $starter = $self->contents_page_start || '';
336 my $css_wad = $self->_css_wad_to_markup(1);
338 $starter =~ s{(</head>)}{\n$css_wad\n$1}i; # otherwise nevermind
341 my $javascript_wad = $self->_javascript_wad_to_markup(1);
342 if( $javascript_wad ) {
343 $starter =~ s{(</head>)}{\n$javascript_wad\n$1}i; # otherwise nevermind
347 unless(print $Contents $starter, "<dl class='superindex'>\n" ) {
348 warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all";
355 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
357 sub _write_contents_middle {
358 my($self, $Contents, $outfile, $toplevel2submodules, $toplevel_form_freq) = @_;
360 foreach my $t (sort keys %$toplevel2submodules) {
361 my @downlines = sort {$a->[-1] cmp $b->[-1]}
362 @{ $toplevel2submodules->{$t} };
364 printf $Contents qq[<dt><a name="%s">%s</a></dt>\n<dd>\n],
365 esc( $t, $toplevel_form_freq->{$t} )
369 foreach my $e (@downlines) {
371 $path = join( "/", '.', esc( @{$e->[3]} ) )
372 . ($HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION);
373 print $Contents qq{ <a href="$path">}, esc($name), "</a> \n";
375 print $Contents "</dd>\n\n";
380 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
382 sub _write_contents_end {
383 my($self, $Contents, $outfile) = @_;
385 print $Contents "</dl>\n",
386 $self->contents_page_end || '',
388 warn "Couldn't write to $outfile: $!";
390 close($Contents) or warn "Couldn't close $outfile: $!";
394 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
396 sub _prep_contents_breakdown {
398 my $contents = $self->_contents;
399 my %toplevel; # maps lctoplevelbit => [all submodules]
400 my %toplevel_form_freq; # ends up being 'foo' => 'Foo'
401 # (mapping anycase forms to most freq form)
403 foreach my $entry (@$contents) {
405 $entry->[0] =~ m/^perl\w*$/ ? 'perl_core_docs'
406 # group all the perlwhatever docs together
407 : $entry->[3][0] # normal case
409 ++$toplevel_form_freq{ lc $toplevel }{ $toplevel };
410 push @{ $toplevel{ lc $toplevel } }, $entry;
411 push @$entry, lc($entry->[0]); # add a sort-order key to the end
414 foreach my $toplevel (sort keys %toplevel) {
415 my $fgroup = $toplevel_form_freq{$toplevel};
416 $toplevel_form_freq{$toplevel} =
418 sort { $fgroup->{$b} <=> $fgroup->{$a} or $a cmp $b }
420 # This hash is extremely unlikely to have more than 4 members, so this
421 # sort isn't so very wasteful
425 return(\%toplevel, \%toplevel_form_freq) if wantarray;
429 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
431 sub _contents_filespec {
432 my($self, $outdir) = @_;
433 my $outfile = $self->contents_file;
434 return unless $outfile;
435 return $self->filespecsys->catfile( $outdir, $outfile );
438 #_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
441 my($self, $outdir, $namelets) = @_;
442 return unless @$namelets > 1;
443 for my $i (0 .. ($#$namelets - 1)) {
444 my $dir = $self->filespecsys->catdir( $outdir, @$namelets[0 .. $i] );
446 die "$dir exists but not as a directory!?" unless -d $dir;
449 DEBUG > 3 and print " Making $dir\n";
451 or die "Can't mkdir $dir: $!\nAborting"
457 #_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
459 sub batch_mode_page_object_init {
461 my($page, $module, $infile, $outfile, $depth) = @_;
463 # TODO: any further options to percolate onto this new object here?
465 $page->default_title($module);
466 $page->index( $self->index );
468 $page->html_css( $self-> _css_wad_to_markup($depth) );
469 $page->html_javascript( $self->_javascript_wad_to_markup($depth) );
471 $self->add_header_backlink($page, $module, $infile, $outfile, $depth);
472 $self->add_footer_backlink($page, $module, $infile, $outfile, $depth);
478 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
480 sub add_header_backlink {
482 return if $self->no_contents_links;
483 my($page, $module, $infile, $outfile, $depth) = @_;
484 $page->html_header_after_title( join '',
485 $page->html_header_after_title || '',
487 qq[<p class="backlinktop"><b><a name="___top" href="],
488 $self->url_up_to_contents($depth),
489 qq[" accesskey="1" title="All Documents"><<</a></b></p>\n],
491 if $self->contents_file
496 sub add_footer_backlink {
498 return if $self->no_contents_links;
499 my($page, $module, $infile, $outfile, $depth) = @_;
500 $page->html_footer( join '',
501 qq[<p class="backlinkbottom"><b><a name="___bottom" href="],
502 $self->url_up_to_contents($depth),
503 qq[" title="All Documents"><<</a></b></p>\n],
505 $page->html_footer || '',
507 if $self->contents_file
512 sub url_up_to_contents {
513 my($self, $depth) = @_;
515 return join '/', ('..') x $depth, esc($self->contents_file);
518 #_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
521 my($self, $dirs) = @_;
522 # You can override find_all_pods in a subclass if you want to
523 # do extra filtering or whatnot. But for the moment, we just
524 # pass to modnames2paths:
525 return $self->modnames2paths($dirs);
528 #_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
530 sub modnames2paths { # return a hashref mapping modulenames => paths
531 my($self, $dirs) = @_;
535 my $search = $SEARCH_CLASS->new;
536 DEBUG and print "Searching via $search\n";
537 $search->verbose(1) if DEBUG > 10;
538 $search->progress( $self->progress->copy->goal(0) ) if $self->progress;
539 $search->shadows(0); # don't bother noting shadowed files
540 $search->inc( $dirs ? 0 : 1 );
541 $search->survey( $dirs ? @$dirs : () );
542 $m2p = $search->name2path;
543 die "What, no name2path?!" unless $m2p;
546 $self->muse("That's odd... no modules found!") unless keys %$m2p;
548 print "Modules found (name => path):\n";
549 foreach my $m (sort {lc($a) cmp lc($b)} keys %$m2p) {
550 print " $m $$m2p{$m}\n";
552 print "(total ", scalar(keys %$m2p), ")\n\n";
554 print "Found ", scalar(keys %$m2p), " modules.\n";
556 $self->muse( "Found ", scalar(keys %$m2p), " modules." );
558 # return the Foo::Bar => /whatever/Foo/Bar.pod|pm hashref
562 #===========================================================================
565 # this is abstracted out so that the daemon class can override it
566 my($self, $outpath) = @_;
568 my $out_fh = Symbol::gensym();
569 DEBUG > 5 and print "Write-opening to $outpath\n";
570 return $out_fh if open($out_fh, "> $outpath");
572 Carp::croak("Can't write-open $outpath: $!");
575 #==========================================================================
578 my($self, $url, $is_default, $name, $content_type, $media, $_code) = @_;
581 # cook up a reasonable name based on the URL
583 if( $name !~ m/\?/ and $name =~ m{([^/]+)$}s ) {
589 $content_type ||= 'text/css';
591 my $bunch = [$url, $name, $content_type, $media, $_code];
592 if($is_default) { unshift @{ $self->_css_wad }, $bunch }
593 else { push @{ $self->_css_wad }, $bunch }
597 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
600 my($self, $outdir) = @_;
602 return unless $self->css_flurry();
603 $self->_gen_css_wad();
605 my $lol = $self->_css_wad;
606 foreach my $chunk (@$lol) {
607 my $url = $chunk->[0];
609 if( ref($chunk->[-1]) and $url =~ m{^(_[-a-z0-9_]+\.css$)} ) {
610 $outfile = $self->filespecsys->catfile( $outdir, "$1" );
611 DEBUG > 5 and print "Noting $$chunk[0] as a file I'll create.\n";
613 DEBUG > 5 and print "OK, noting $$chunk[0] as an external CSS.\n";
614 # Requires no further attention.
618 #$self->muse( "Writing autogenerated CSS file $outfile" );
619 my $Cssout = $self->_wopen($outfile);
620 print $Cssout ${$chunk->[-1]}
621 or warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all";
623 DEBUG > 5 and print "Wrote $outfile\n";
629 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
631 sub _css_wad_to_markup {
632 my($self, $depth) = @_;
634 my @css = @{ $self->_css_wad || return '' };
635 return '' unless @css;
637 my $rel = 'stylesheet';
641 my $uplink = $depth ? ('../' x $depth) : '';
643 foreach my $chunk (@css) {
644 next unless $chunk and @$chunk;
646 my( $url1, $url2, $title, $type, $media) = (
647 $self->_maybe_uplink( $chunk->[0], $uplink ),
648 esc(grep !ref($_), @$chunk)
651 $out .= qq{<link rel="$rel" title="$title" type="$type" href="$url1$url2" media="$media" >\n};
653 $rel = 'alternate stylesheet'; # alternates = all non-first iterations
658 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
660 # if the given URL looks relative, return the given uplink string --
661 # otherwise return emptystring
662 my($self, $url, $uplink) = @_;
663 ($url =~ m{^\./} or $url !~ m{[/\:]} )
666 # qualify it, if/as needed
669 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
672 my $css_template = $self->_css_template;
673 foreach my $variation (
675 # Commented out for sake of concision:
677 # 011n=black_with_red_on_white
678 # 001n=black_with_yellow_on_white
679 # 101n=black_with_green_on_white
680 # 110=white_with_yellow_on_black
681 # 010=white_with_green_on_black
682 # 011=white_with_blue_on_black
683 # 100=white_with_red_on_black
686 110n=black_with_blue_on_white
687 010n=black_with_magenta_on_white
688 100n=black_with_cyan_on_white
690 101=white_with_purple_on_black
691 001=white_with_navy_blue_on_black
693 010a=grey_with_green_on_black
694 010b=white_with_green_on_grey
695 101an=black_with_green_on_grey
696 101bn=grey_with_green_on_white
699 my $outname = $variation;
700 my($flipmode, @swap) = ( ($4 || ''), $1,$2,$3)
701 if $outname =~ s/^([012])([012])([[012])([a-z]*)=?//s;
702 @swap = () if '010' eq join '', @swap; # 010 is a swop-no-op!
705 "/* This file is autogenerated. Do not edit. $variation */\n\n"
708 # Only look at three-digitty colors, for now at least.
709 if( $flipmode =~ m/n/ ) {
710 $this_css =~ s/(#[0-9a-fA-F]{3})\b/_color_negate($1)/eg;
711 $this_css =~ s/\bthin\b/medium/g;
713 $this_css =~ s<#([0-9a-fA-F])([0-9a-fA-F])([0-9a-fA-F])\b>
714 < join '', '#', ($1,$2,$3)[@swap] >eg if @swap;
716 if( $flipmode =~ m/a/)
717 { $this_css =~ s/#fff\b/#999/gi } # black -> dark grey
718 elsif($flipmode =~ m/b/)
719 { $this_css =~ s/#000\b/#666/gi } # white -> light grey
723 $self->add_css( "_$outname.css", 0, $name, 0, 0, \$this_css);
726 # Now a few indexless variations:
727 foreach my $variation (qw[
728 black_with_blue_on_white white_with_purple_on_black
729 white_with_green_on_grey grey_with_green_on_white
731 my $outname = "indexless_$variation";
732 my $this_css = join "\n",
733 "/* This file is autogenerated. Do not edit. $outname */\n",
734 "\@import url(\"./_$variation.css\");",
735 ".indexgroup { display: none; }",
740 $self->add_css( "_$outname.css", 0, $name, 0, 0, \$this_css);
748 $x =~ tr[0123456789abcdef]
753 #===========================================================================
756 my($self, $url, $content_type, $_code) = @_;
758 push @{ $self->_javascript_wad }, [
759 $url, $content_type || 'text/javascript', $_code
764 sub _spray_javascript {
765 my($self, $outdir) = @_;
766 return unless $self->javascript_flurry();
767 $self->_gen_javascript_wad();
769 my $lol = $self->_javascript_wad;
770 foreach my $script (@$lol) {
771 my $url = $script->[0];
774 if( ref($script->[-1]) and $url =~ m{^(_[-a-z0-9_]+\.js$)} ) {
775 $outfile = $self->filespecsys->catfile( $outdir, "$1" );
776 DEBUG > 5 and print "Noting $$script[0] as a file I'll create.\n";
778 DEBUG > 5 and print "OK, noting $$script[0] as an external JavaScript.\n";
782 #$self->muse( "Writing JavaScript file $outfile" );
783 my $Jsout = $self->_wopen($outfile);
785 print $Jsout ${$script->[-1]}
786 or warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all";
788 DEBUG > 5 and print "Wrote $outfile\n";
794 sub _gen_javascript_wad {
796 my $js_code = $self->_javascript || return;
797 $self->add_javascript( "_podly.js", 0, \$js_code);
801 sub _javascript_wad_to_markup {
802 my($self, $depth) = @_;
804 my @scripts = @{ $self->_javascript_wad || return '' };
805 return '' unless @scripts;
810 my $uplink = $depth ? ('../' x $depth) : '';
812 foreach my $s (@scripts) {
813 next unless $s and @$s;
815 my( $url1, $url2, $type, $media) = (
816 $self->_maybe_uplink( $s->[0], $uplink ),
817 esc(grep !ref($_), @$s)
820 $out .= qq{<script type="$type" src="$url1$url2"></script>\n};
825 #===========================================================================
827 sub _css_template { return $CSS }
828 sub _javascript { return $JAVASCRIPT }
831 /* For accessibility reasons, never specify text sizes in px/pt/pc/in/cm/mm */
833 @media all { .hide { display: none; } }
836 .noprint, div.indexgroup, .backlinktop, .backlinkbottom { display: none }
839 border-color: black !important;
840 color: black !important;
841 background-color: transparent !important;
842 background-image: none !important;
850 @media aural, braille, embossed {
851 div.indexgroup { display: none; } /* Too noisy, don't you think? */
852 dl.superindex > dt:before { content: "Group "; }
853 dl.superindex > dt:after { content: " contains:"; }
854 .backlinktop a:before { content: "Back to contents"; }
855 .backlinkbottom a:before { content: "Back to contents"; }
859 dl.superindex > dt { pause-before: 600ms; }
862 @media screen, tty, tv, projection {
863 .noscreen { display: none; }
865 a:link { color: #7070ff; text-decoration: underline; }
866 a:visited { color: #e030ff; text-decoration: underline; }
867 a:active { color: #800000; text-decoration: underline; }
868 body.contentspage a { text-decoration: none; }
869 a.u { color: #fff !important; text-decoration: none; }
874 background-color: #000;
877 body.pod h1, body.pod h2, body.pod h3, body.pod h4 {
878 font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif;
882 border-top: thin solid transparent;
883 /* margin-left: -5px; border-left: 2px #7070ff solid; padding-left: 3px; */
886 body.pod h1 { border-top-color: #0a0; }
887 body.pod h2 { border-top-color: #080; }
888 body.pod h3 { border-top-color: #040; }
889 body.pod h4 { border-top-color: #010; }
891 p.backlinktop + h1 { border-top: none; margin-top: 0em; }
892 p.backlinktop + h2 { border-top: none; margin-top: 0em; }
893 p.backlinktop + h3 { border-top: none; margin-top: 0em; }
894 p.backlinktop + h4 { border-top: none; margin-top: 0em; }
897 font-size: 105%; /* just a wee bit more than normal */
900 .indexgroup { font-size: 80%; }
902 .backlinktop, .backlinkbottom {
905 background-color: #040;
906 border-top: thin solid #050;
907 border-bottom: thin solid #050;
910 .backlinktop a, .backlinkbottom a {
911 text-decoration: none;
913 background-color: #000;
914 border: thin solid #0d0;
916 .backlinkbottom { margin-bottom: 0; padding-bottom: 0; }
917 .backlinktop { margin-top: 0; padding-top: 0; }
921 background-color: #000;
924 body.contentspage h1 {
929 font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif;
931 border-top: thin solid #fff;
932 border-bottom: thin solid #fff;
937 font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif;
941 /* margin-bottom: -.15em; */
944 word-spacing: .6em; /* most important rule here! */
946 dl.superindex > a:link {
947 text-decoration: none;
952 border-top: thin solid #999;
962 #==========================================================================
964 $JAVASCRIPT = <<'EOJAVASCRIPT';
966 // From http://www.alistapart.com/articles/alternate/
968 function setActiveStyleSheet(title) {
970 for(i=0 ; (a = document.getElementsByTagName("link")[i]) ; i++) {
971 if(a.getAttribute("rel").indexOf("style") != -1 && a.getAttribute("title")) {
973 if(a.getAttribute("title") == title) a.disabled = false;
978 function getActiveStyleSheet() {
980 for(i=0 ; (a = document.getElementsByTagName("link")[i]) ; i++) {
981 if( a.getAttribute("rel").indexOf("style") != -1
982 && a.getAttribute("title")
984 ) return a.getAttribute("title");
989 function getPreferredStyleSheet() {
991 for(i=0 ; (a = document.getElementsByTagName("link")[i]) ; i++) {
992 if( a.getAttribute("rel").indexOf("style") != -1
993 && a.getAttribute("rel").indexOf("alt") == -1
994 && a.getAttribute("title")
995 ) return a.getAttribute("title");
1000 function createCookie(name,value,days) {
1002 var date = new Date();
1003 date.setTime(date.getTime()+(days*24*60*60*1000));
1004 var expires = "; expires="+date.toGMTString();
1007 document.cookie = name+"="+value+expires+"; path=/";
1010 function readCookie(name) {
1011 var nameEQ = name + "=";
1012 var ca = document.cookie.split(';');
1013 for(var i=0 ; i < ca.length ; i++) {
1015 while (c.charAt(0)==' ') c = c.substring(1,c.length);
1016 if (c.indexOf(nameEQ) == 0) return c.substring(nameEQ.length,c.length);
1021 window.onload = function(e) {
1022 var cookie = readCookie("style");
1023 var title = cookie ? cookie : getPreferredStyleSheet();
1024 setActiveStyleSheet(title);
1027 window.onunload = function(e) {
1028 var title = getActiveStyleSheet();
1029 createCookie("style", title, 365);
1032 var cookie = readCookie("style");
1033 var title = cookie ? cookie : getPreferredStyleSheet();
1034 setActiveStyleSheet(title);
1040 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1047 Pod::Simple::HTMLBatch - convert several Pod files to several HTML files
1051 perl -MPod::Simple::HTMLBatch -e 'Pod::Simple::HTMLBatch::go' in out
1056 This module is used for running batch-conversions of a lot of HTML
1059 This class is NOT a subclass of Pod::Simple::HTML
1060 (nor of bad old Pod::Html) -- although it uses
1061 Pod::Simple::HTML for doing the conversion of each document.
1063 The normal use of this class is like so:
1065 use Pod::Simple::HTMLBatch;
1066 my $batchconv = Pod::Simple::HTMLBatch->new;
1067 $batchconv->some_option( some_value );
1068 $batchconv->some_other_option( some_other_value );
1069 $batchconv->batch_convert( \@search_dirs, $output_dir );
1071 =head2 FROM THE COMMAND LINE
1073 Note that this class also provides
1074 (but does not export) the function Pod::Simple::HTMLBatch::go.
1075 This is basically just a shortcut for C<<
1076 Pod::Simple::HTMLBatch->batch_convert(@ARGV) >>.
1077 It's meant to be handy for calling from the command line.
1079 However, the shortcut requires that you specify exactly two command-line
1080 arguments, C<indirs> and C<outdir>.
1085 % perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go @INC out_html
1086 (to convert the pod from Perl's @INC
1087 files under the directory ../htmlversion)
1089 (Note that the command line there contains a literal atsign-I-N-C. This
1090 is handled as a special case by batch_convert, in order to save you having
1091 to enter the odd-looking "" as the first command-line parameter when you
1092 mean "just use whatever's in @INC".)
1097 % chmod og-rx ../seekrut
1098 % perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go . ../htmlversion
1099 (to convert the pod under the current dir into HTML
1100 files under the directory ../htmlversion)
1104 % perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go happydocs .
1105 (to convert all pod from happydocs into the current directory)
1113 =item $batchconv = Pod::Simple::HTMLBatch->new;
1118 =item $batchconv->batch_convert( I<indirs>, I<outdir> );
1122 =item $batchconv->batch_convert( undef , ...);
1124 =item $batchconv->batch_convert( q{@INC}, ...);
1126 These two values for I<indirs> specify that the normal Perl @INC
1128 =item $batchconv->batch_convert( \@dirs , ...);
1130 This specifies that the input directories are the items in
1131 the arrayref C<\@dirs>.
1133 =item $batchconv->batch_convert( "somedir" , ...);
1135 This specifies that the director "somedir" is the input.
1136 (This can be an absolute or relative path, it doesn't matter.)
1138 A common value you might want would be just "." for the current
1141 $batchconv->batch_convert( "." , ...);
1144 =item $batchconv->batch_convert( 'somedir:someother:also' , ...);
1146 This specifies that you want the dirs "somedir", "somother", and "also"
1147 scanned, just as if you'd passed the arrayref
1148 C<[qw( somedir someother also)]>. Note that a ":"-separator is normal
1149 under Unix, but Under MSWin, you'll need C<'somedir;someother;also'>
1150 instead, since the pathsep on MSWin is ";" instead of ":". (And
1151 I<that> is because ":" often comes up in paths, like
1154 (Exactly what separator character should be used, is gotten from
1155 C<$Config::Config{'path_sep'}>, via the L<Config> module.)
1157 =item $batchconv->batch_convert( ... , undef );
1159 This specifies that you want the HTML output to go into the current
1162 (Note that a missing or undefined value means a different thing in
1163 the first slot than in the second. That's so that C<batch_convert()>
1164 with no arguments (or undef arguments) means "go from @INC, into
1165 the current directory.)
1167 =item $batchconv->batch_convert( ... , 'somedir' );
1169 This specifies that you want the HTML output to go into the
1170 directory 'somedir'.
1171 (This can be an absolute or relative path, it doesn't matter.)
1176 Note that you can also call C<batch_convert> as a class method,
1179 Pod::Simple::HTMLBatch->batch_convert( ... );
1181 That is just short for this:
1183 Pod::Simple::HTMLBatch-> new-> batch_convert(...);
1185 That is, it runs a conversion with default options, for
1186 whatever inputdirs and output dir you specify.
1189 =head2 ACCESSOR METHODS
1191 The following are all accessor methods -- that is, they don't do anything
1192 on their own, but just alter the contents of the conversion object,
1193 which comprises the options for this particular batch conversion.
1195 We show the "put" form of the accessors below (i.e., the syntax you use
1196 for setting the accessor to a specific value). But you can also
1197 call each method with no parameters to get its current value. For
1198 example, C<< $self->contents_file() >> returns the current value of
1199 the contents_file attribute.
1204 =item $batchconv->verbose( I<nonnegative_integer> );
1206 This controls how verbose to be during batch conversion, as far as
1207 notes to STDOUT (or whatever is C<select>'d) about how the conversion
1208 is going. If 0, no progress information is printed.
1209 If 1 (the default value), some progress information is printed.
1210 Higher values print more information.
1213 =item $batchconv->index( I<true-or-false> );
1215 This controls whether or not each HTML page is liable to have a little
1216 table of contents at the top (which we call an "index" for historical
1217 reasons). This is true by default.
1220 =item $batchconv->contents_file( I<filename> );
1222 If set, should be the name of a file (in the output directory)
1223 to write the HTML index to. The default value is "index.html".
1224 If you set this to a false value, no contents file will be written.
1226 =item $batchconv->contents_page_start( I<HTML_string> );
1228 This specifies what string should be put at the beginning of
1230 The default is a string more or less like this:
1233 <head><title>Perl Documentation</title></head>
1234 <body class='contentspage'>
1235 <h1>Perl Documentation</h1>
1237 =item $batchconv->contents_page_end( I<HTML_string> );
1239 This specifies what string should be put at the end of the contents page.
1240 The default is a string more or less like this:
1242 <p class='contentsfooty'>Generated by
1243 Pod::Simple::HTMLBatch v3.01 under Perl v5.008
1244 <br >At Fri May 14 22:26:42 2004 GMT,
1245 which is Fri May 14 14:26:42 2004 local time.</p>
1249 =item $batchconv->add_css( $url );
1253 =item $batchconv->add_javascript( $url );
1257 =item $batchconv->css_flurry( I<true-or-false> );
1259 If true (the default value), we autogenerate some CSS files in the
1260 output directory, and set our HTML files to use those.
1263 =item $batchconv->javascript_flurry( I<true-or-false> );
1265 If true (the default value), we autogenerate a JavaScript in the
1266 output directory, and set our HTML files to use it. Currently,
1267 the JavaScript is used only to get the browser to remember what
1268 stylesheet it prefers.
1271 =item $batchconv->no_contents_links( I<true-or-false> );
1275 =item $batchconv->html_render_class( I<classname> );
1277 This sets what class is used for rendering the files.
1278 The default is "Pod::Simple::Search". If you set it to something else,
1279 it should probably be a subclass of Pod::Simple::Search, and you should
1280 C<require> or C<use> that class so that's it's loaded before
1281 Pod::Simple::HTMLBatch tries loading it.
1288 =head1 NOTES ON CUSTOMIZATION
1292 call add_css($someurl) to add stylesheet as alternate
1293 call add_css($someurl,1) to add as primary stylesheet
1297 subclass Pod::Simple::HTML and set $batchconv->html_render_class to
1300 $page->batch_mode_page_object_init($self, $module, $infile, $outfile, $depth)
1302 $batchconv->batch_mode_page_object_init($page, $module, $infile, $outfile, $depth)
1308 If you want to do some kind of big pod-to-HTML version with some
1309 particular kind of option that you don't see how to achieve using this
1310 module, email me (C<sburke@cpan.org>) and I'll probably have a good idea
1311 how to do it. For reasons of concision and energetic laziness, some
1312 methods and options in this module (and the dozen modules it depends on)
1313 are undocumented; but one of those undocumented bits might be just what
1319 L<Pod::Simple>, L<Pod::Simple::HTMLBatch>, L<perlpod>, L<perlpodspec>
1324 =head1 COPYRIGHT AND DISCLAIMERS
1326 Copyright (c) 2004 Sean M. Burke. All rights reserved.
1328 This library is free software; you can redistribute it and/or modify it
1329 under the same terms as Perl itself.
1331 This program is distributed in the hope that it will be useful, but
1332 without any warranty; without even the implied warranty of
1333 merchantability or fitness for a particular purpose.
1337 Sean M. Burke C<sburke@cpan.org>