| [ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 2 require 5; 3 package Pod::Simple::HTMLBatch; 4 use strict; 5 use vars qw( $VERSION $HTML_RENDER_CLASS $HTML_EXTENSION 6 $CSS $JAVASCRIPT $SLEEPY $SEARCH_CLASS @ISA 7 ); 8 $VERSION = '3.02'; 9 @ISA = (); # Yup, we're NOT a subclass of Pod::Simple::HTML! 10 11 # TODO: nocontents stylesheets. Strike some of the color variations? 12 13 use Pod::Simple::HTML (); 14 BEGIN {*esc = \&Pod::Simple::HTML::esc } 15 use File::Spec (); 16 use UNIVERSAL (); 17 # "Isn't the Universe an amazing place? I wouldn't live anywhere else!" 18 19 use Pod::Simple::Search; 20 $SEARCH_CLASS ||= 'Pod::Simple::Search'; 21 22 BEGIN { 23 if(defined &DEBUG) { } # no-op 24 elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG } 25 else { *DEBUG = sub () {0}; } 26 } 27 28 $SLEEPY = 1 if !defined $SLEEPY and $^O =~ /mswin|mac/i; 29 # flag to occasionally sleep for $SLEEPY - 1 seconds. 30 31 $HTML_RENDER_CLASS ||= "Pod::Simple::HTML"; 32 33 # 34 # Methods beginning with "_" are particularly internal and possibly ugly. 35 # 36 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', 45 46 'css_flurry', '_css_wad', 'javascript_flurry', '_javascript_wad', 47 'no_contents_links', # set to true to suppress automatic adding of << links. 48 '_contents', 49 ); 50 51 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 52 # Just so we can run from the command line more easily 53 sub go { 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__, 57 ); 58 59 if(defined($ARGV[1]) and length($ARGV[1])) { 60 my $d = $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"; 64 } 65 66 __PACKAGE__->batch_convert(@ARGV); 67 } 68 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 69 70 71 sub new { 72 my $new = bless {}, ref($_[0]) || $_[0]; 73 $new->html_render_class($HTML_RENDER_CLASS); 74 $new->verbose(1 + DEBUG); 75 $new->_contents([]); 76 77 $new->index(1); 78 79 $new-> _css_wad([]); $new->css_flurry(1); 80 $new->_javascript_wad([]); $new->javascript_flurry(1); 81 82 $new->contents_file( 83 'index' . ($HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION) 84 ); 85 86 $new->contents_page_start( join "\n", grep $_, 87 $Pod::Simple::HTML::Doctype_decl, 88 "<html><head>", 89 "<title>Perl Documentation</title>", 90 $Pod::Simple::HTML::Content_decl, 91 "</head>", 92 "\n<body class='contentspage'>\n<h1>Perl Documentation</h1>\n" 93 ); # override if you need a different title 94 95 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", 98 esc( 99 ref($new), 100 eval {$new->VERSION} || $VERSION, 101 $], scalar(gmtime), scalar(localtime), 102 ))); 103 104 return $new; 105 } 106 107 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 108 109 sub muse { 110 my $self = shift; 111 if($self->verbose) { 112 print 'T+', int(time() - $self->{'_batch_start_time'}), "s: ", @_, "\n"; 113 } 114 return 1; 115 } 116 117 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 118 119 sub batch_convert { 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 123 124 if(!defined($dirs) or $dirs eq '' or $dirs eq '@INC' ) { 125 $dirs = ''; 126 } elsif(ref $dirs) { 127 # OK, it's an explicit set of dirs to scan, specified as an arrayref. 128 } else { 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!) 132 require Config; 133 my $ps = quotemeta( $Config::Config{'path_sep'} || ":" ); 134 $dirs = [ grep length($_), split qr/$ps/, $dirs ]; 135 } 136 137 $outdir = $self->filespecsys->curdir 138 unless defined $outdir and length $outdir; 139 140 $self->_batch_convert_main($dirs, $outdir); 141 } 142 143 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 144 145 sub _batch_convert_main { 146 my($self, $dirs, $outdir) = @_; 147 # $dirs is either false, or an arrayref. 148 # $outdir is a pathspec. 149 150 $self->{'_batch_start_time'} ||= time(); 151 152 $self->muse( "= ", scalar(localtime) ); 153 $self->muse( "Starting batch conversion to \"$outdir\"" ); 154 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 162 ); 163 $self->progress($progress); 164 } 165 166 if($dirs) { 167 $self->muse(scalar(@$dirs), " dirs to scan: @$dirs"); 168 } else { 169 $self->muse("Scanning \@INC. This could take a minute or two."); 170 } 171 my $mod2path = $self->find_all_pods($dirs ? $dirs : ()); 172 $self->muse("Done scanning."); 173 174 my $total = keys %$mod2path; 175 unless($total) { 176 $self->muse("No pod found. Aborting batch conversion.\n"); 177 return $self; 178 } 179 180 $progress and $progress->goal($total); 181 $self->muse("Now converting pod files to HTML.", 182 ($total > 25) ? " This will take a while more." : () 183 ); 184 185 $self->_spray_css( $outdir ); 186 $self->_spray_javascript( $outdir ); 187 188 $self->_do_all_batch_conversions($mod2path, $outdir); 189 190 $progress and $progress->done(sprintf ( 191 "Done converting %d files.", $self->{"__batch_conv_page_count"} 192 )); 193 return $self->_batch_convert_finish($outdir); 194 return $self; 195 } 196 197 198 sub _do_all_batch_conversions { 199 my($self, $mod2path, $outdir) = @_; 200 $self->{"__batch_conv_page_count"} = 0; 201 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; 205 } 206 207 return; 208 } 209 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!"); 216 return; 217 } 218 219 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 220 221 sub _do_one_batch_conversion { 222 my($self, $module, $mod2path, $outdir, $outfile) = @_; 223 224 my $retval; 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 231 232 $outfile ||= do { 233 my @n = @namelets; 234 $n[-1] .= $HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION; 235 $self->filespecsys->catfile( $outdir, @n ); 236 }; 237 238 my $progress = $self->progress; 239 240 my $page = $self->html_render_class->new; 241 if(DEBUG > 5) { 242 $self->muse($self->{"__batch_conv_page_count"} + 1, "/$total: ", 243 ref($page), " render ($depth) $module => $outfile"); 244 } elsif(DEBUG > 2) { 245 $self->muse($self->{"__batch_conv_page_count"} + 1, "/$total: $module => $outfile") 246 } 247 248 # Give each class a chance to init the converter: 249 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'); 254 255 # Now get busy... 256 $self->makepath($outdir => \@namelets); 257 258 $progress and $progress->reach($self->{"__batch_conv_page_count"}, "Rendering $module"); 259 260 if( $retval = $page->parse_from_file($infile, $outfile) ) { 261 ++ $self->{"__batch_conv_page_count"} ; 262 $self->note_for_contents_file( \@namelets, $infile, $outfile ); 263 } else { 264 $self->muse("Odd, parse_from_file(\"$infile\", \"$outfile\") returned false."); 265 } 266 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'); 272 273 DEBUG > 4 and printf "%s %sb < $infile %s %sb\n", 274 $outfile, -s $outfile, $infile, -s $infile 275 ; 276 277 undef($page); 278 return $retval; 279 } 280 281 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 282 sub filespecsys { $_[0]{'_filespecsys'} || 'File::Spec' } 283 284 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 285 286 sub note_for_contents_file { 287 my($self, $namelets, $infile, $outfile) = @_; 288 289 # I think the infile and outfile parts are never used. -- SMB 290 # But it's handy to have them around for debugging. 291 292 if( $self->contents_file ) { 293 my $c = $self->_contents(); 294 push @$c, 295 [ join("::", @$namelets), $infile, $outfile, $namelets ] 296 # 0 1 2 3 297 ; 298 DEBUG > 3 and print "Noting @$c[-1]\n"; 299 } 300 return; 301 } 302 303 #_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_- 304 305 sub write_contents_file { 306 my($self, $outdir) = @_; 307 my $outfile = $self->_contents_filespec($outdir) || return; 308 309 $self->muse("Preparing list of modules for ToC"); 310 311 my($toplevel, # maps toplevelbit => [all submodules] 312 $toplevel_form_freq, # ends up being 'foo' => 'Foo' 313 ) = $self->_prep_contents_breakdown; 314 315 my $Contents = eval { $self->_wopen($outfile) }; 316 if( $Contents ) { 317 $self->muse( "Writing contents file $outfile" ); 318 } else { 319 warn "Couldn't write-open contents file $outfile: $!\nAbort writing to $outfile at all"; 320 return; 321 } 322 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, ); 326 return $outfile; 327 } 328 329 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 330 331 sub _write_contents_start { 332 my($self, $Contents, $outfile) = @_; 333 my $starter = $self->contents_page_start || ''; 334 335 { 336 my $css_wad = $self->_css_wad_to_markup(1); 337 if( $css_wad ) { 338 $starter =~ s{(</head>)}{\n$css_wad\n$1}i; # otherwise nevermind 339 } 340 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 344 } 345 } 346 347 unless(print $Contents $starter, "<dl class='superindex'>\n" ) { 348 warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all"; 349 close($Contents); 350 return 0; 351 } 352 return 1; 353 } 354 355 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 356 357 sub _write_contents_middle { 358 my($self, $Contents, $outfile, $toplevel2submodules, $toplevel_form_freq) = @_; 359 360 foreach my $t (sort keys %$toplevel2submodules) { 361 my @downlines = sort {$a->[-1] cmp $b->[-1]} 362 @{ $toplevel2submodules->{$t} }; 363 364 printf $Contents qq[<dt><a name="%s">%s</a></dt>\n<dd>\n], 365 esc( $t, $toplevel_form_freq->{$t} ) 366 ; 367 368 my($path, $name); 369 foreach my $e (@downlines) { 370 $name = $e->[0]; 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"; 374 } 375 print $Contents "</dd>\n\n"; 376 } 377 return 1; 378 } 379 380 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 381 382 sub _write_contents_end { 383 my($self, $Contents, $outfile) = @_; 384 unless( 385 print $Contents "</dl>\n", 386 $self->contents_page_end || '', 387 ) { 388 warn "Couldn't write to $outfile: $!"; 389 } 390 close($Contents) or warn "Couldn't close $outfile: $!"; 391 return 1; 392 } 393 394 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 395 396 sub _prep_contents_breakdown { 397 my($self) = @_; 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) 402 403 foreach my $entry (@$contents) { 404 my $toplevel = 405 $entry->[0] =~ m/^perl\w*$/ ? 'perl_core_docs' 406 # group all the perlwhatever docs together 407 : $entry->[3][0] # normal case 408 ; 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 412 } 413 414 foreach my $toplevel (sort keys %toplevel) { 415 my $fgroup = $toplevel_form_freq{$toplevel}; 416 $toplevel_form_freq{$toplevel} = 417 ( 418 sort { $fgroup->{$b} <=> $fgroup->{$a} or $a cmp $b } 419 keys %$fgroup 420 # This hash is extremely unlikely to have more than 4 members, so this 421 # sort isn't so very wasteful 422 )[0]; 423 } 424 425 return(\%toplevel, \%toplevel_form_freq) if wantarray; 426 return \%toplevel; 427 } 428 429 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 430 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 ); 436 } 437 438 #_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_- 439 440 sub makepath { 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] ); 445 if(-e $dir) { 446 die "$dir exists but not as a directory!?" unless -d $dir; 447 next; 448 } 449 DEBUG > 3 and print " Making $dir\n"; 450 mkdir $dir, 0777 451 or die "Can't mkdir $dir: $!\nAborting" 452 ; 453 } 454 return; 455 } 456 457 #_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_- 458 459 sub batch_mode_page_object_init { 460 my $self = shift; 461 my($page, $module, $infile, $outfile, $depth) = @_; 462 463 # TODO: any further options to percolate onto this new object here? 464 465 $page->default_title($module); 466 $page->index( $self->index ); 467 468 $page->html_css( $self-> _css_wad_to_markup($depth) ); 469 $page->html_javascript( $self->_javascript_wad_to_markup($depth) ); 470 471 $self->add_header_backlink($page, $module, $infile, $outfile, $depth); 472 $self->add_footer_backlink($page, $module, $infile, $outfile, $depth); 473 474 475 return $self; 476 } 477 478 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 479 480 sub add_header_backlink { 481 my $self = shift; 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 || '', 486 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], 490 ) 491 if $self->contents_file 492 ; 493 return; 494 } 495 496 sub add_footer_backlink { 497 my $self = shift; 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], 504 505 $page->html_footer || '', 506 ) 507 if $self->contents_file 508 ; 509 return; 510 } 511 512 sub url_up_to_contents { 513 my($self, $depth) = @_; 514 --$depth; 515 return join '/', ('..') x $depth, esc($self->contents_file); 516 } 517 518 #_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_- 519 520 sub find_all_pods { 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); 526 } 527 528 #_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_- 529 530 sub modnames2paths { # return a hashref mapping modulenames => paths 531 my($self, $dirs) = @_; 532 533 my $m2p; 534 { 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; 544 } 545 546 $self->muse("That's odd... no modules found!") unless keys %$m2p; 547 if( DEBUG > 4 ) { 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"; 551 } 552 print "(total ", scalar(keys %$m2p), ")\n\n"; 553 } elsif( DEBUG ) { 554 print "Found ", scalar(keys %$m2p), " modules.\n"; 555 } 556 $self->muse( "Found ", scalar(keys %$m2p), " modules." ); 557 558 # return the Foo::Bar => /whatever/Foo/Bar.pod|pm hashref 559 return $m2p; 560 } 561 562 #=========================================================================== 563 564 sub _wopen { 565 # this is abstracted out so that the daemon class can override it 566 my($self, $outpath) = @_; 567 require Symbol; 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"); 571 require Carp; 572 Carp::croak("Can't write-open $outpath: $!"); 573 } 574 575 #========================================================================== 576 577 sub add_css { 578 my($self, $url, $is_default, $name, $content_type, $media, $_code) = @_; 579 return unless $url; 580 unless($name) { 581 # cook up a reasonable name based on the URL 582 $name = $url; 583 if( $name !~ m/\?/ and $name =~ m{([^/]+)$}s ) { 584 $name = $1; 585 $name =~ s/\.css//i; 586 } 587 } 588 $media ||= 'all'; 589 $content_type ||= 'text/css'; 590 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 } 594 return; 595 } 596 597 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 598 599 sub _spray_css { 600 my($self, $outdir) = @_; 601 602 return unless $self->css_flurry(); 603 $self->_gen_css_wad(); 604 605 my $lol = $self->_css_wad; 606 foreach my $chunk (@$lol) { 607 my $url = $chunk->[0]; 608 my $outfile; 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"; 612 } else { 613 DEBUG > 5 and print "OK, noting $$chunk[0] as an external CSS.\n"; 614 # Requires no further attention. 615 next; 616 } 617 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"; 622 close($Cssout); 623 DEBUG > 5 and print "Wrote $outfile\n"; 624 } 625 626 return; 627 } 628 629 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 630 631 sub _css_wad_to_markup { 632 my($self, $depth) = @_; 633 634 my @css = @{ $self->_css_wad || return '' }; 635 return '' unless @css; 636 637 my $rel = 'stylesheet'; 638 my $out = ''; 639 640 --$depth; 641 my $uplink = $depth ? ('../' x $depth) : ''; 642 643 foreach my $chunk (@css) { 644 next unless $chunk and @$chunk; 645 646 my( $url1, $url2, $title, $type, $media) = ( 647 $self->_maybe_uplink( $chunk->[0], $uplink ), 648 esc(grep !ref($_), @$chunk) 649 ); 650 651 $out .= qq{<link rel="$rel" title="$title" type="$type" href="$url1$url2" media="$media" >\n}; 652 653 $rel = 'alternate stylesheet'; # alternates = all non-first iterations 654 } 655 return $out; 656 } 657 658 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 659 sub _maybe_uplink { 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{[/\:]} ) 664 ? $uplink 665 : '' 666 # qualify it, if/as needed 667 } 668 669 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 670 sub _gen_css_wad { 671 my $self = $_[0]; 672 my $css_template = $self->_css_template; 673 foreach my $variation ( 674 675 # Commented out for sake of concision: 676 # 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 684 685 qw[ 686 110n=black_with_blue_on_white 687 010n=black_with_magenta_on_white 688 100n=black_with_cyan_on_white 689 690 101=white_with_purple_on_black 691 001=white_with_navy_blue_on_black 692 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 697 ]) { 698 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! 703 704 my $this_css = 705 "/* This file is autogenerated. Do not edit. $variation */\n\n" 706 . $css_template; 707 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; 712 } 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; 715 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 720 721 my $name = $outname; 722 $name =~ tr/-_/ /; 723 $self->add_css( "_$outname.css", 0, $name, 0, 0, \$this_css); 724 } 725 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 730 ]) { 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; }", 736 "\n", 737 ; 738 my $name = $outname; 739 $name =~ tr/-_/ /; 740 $self->add_css( "_$outname.css", 0, $name, 0, 0, \$this_css); 741 } 742 743 return; 744 } 745 746 sub _color_negate { 747 my $x = lc $_[0]; 748 $x =~ tr[0123456789abcdef] 749 [fedcba9876543210]; 750 return $x; 751 } 752 753 #=========================================================================== 754 755 sub add_javascript { 756 my($self, $url, $content_type, $_code) = @_; 757 return unless $url; 758 push @{ $self->_javascript_wad }, [ 759 $url, $content_type || 'text/javascript', $_code 760 ]; 761 return; 762 } 763 764 sub _spray_javascript { 765 my($self, $outdir) = @_; 766 return unless $self->javascript_flurry(); 767 $self->_gen_javascript_wad(); 768 769 my $lol = $self->_javascript_wad; 770 foreach my $script (@$lol) { 771 my $url = $script->[0]; 772 my $outfile; 773 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"; 777 } else { 778 DEBUG > 5 and print "OK, noting $$script[0] as an external JavaScript.\n"; 779 next; 780 } 781 782 #$self->muse( "Writing JavaScript file $outfile" ); 783 my $Jsout = $self->_wopen($outfile); 784 785 print $Jsout ${$script->[-1]} 786 or warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all"; 787 close($Jsout); 788 DEBUG > 5 and print "Wrote $outfile\n"; 789 } 790 791 return; 792 } 793 794 sub _gen_javascript_wad { 795 my $self = $_[0]; 796 my $js_code = $self->_javascript || return; 797 $self->add_javascript( "_podly.js", 0, \$js_code); 798 return; 799 } 800 801 sub _javascript_wad_to_markup { 802 my($self, $depth) = @_; 803 804 my @scripts = @{ $self->_javascript_wad || return '' }; 805 return '' unless @scripts; 806 807 my $out = ''; 808 809 --$depth; 810 my $uplink = $depth ? ('../' x $depth) : ''; 811 812 foreach my $s (@scripts) { 813 next unless $s and @$s; 814 815 my( $url1, $url2, $type, $media) = ( 816 $self->_maybe_uplink( $s->[0], $uplink ), 817 esc(grep !ref($_), @$s) 818 ); 819 820 $out .= qq{<script type="$type" src="$url1$url2"></script>\n}; 821 } 822 return $out; 823 } 824 825 #=========================================================================== 826 827 sub _css_template { return $CSS } 828 sub _javascript { return $JAVASCRIPT } 829 830 $CSS = <<'EOCSS'; 831 /* For accessibility reasons, never specify text sizes in px/pt/pc/in/cm/mm */ 832 833 @media all { .hide { display: none; } } 834 835 @media print { 836 .noprint, div.indexgroup, .backlinktop, .backlinkbottom { display: none } 837 838 * { 839 border-color: black !important; 840 color: black !important; 841 background-color: transparent !important; 842 background-image: none !important; 843 } 844 845 dl.superindex > dd { 846 word-spacing: .6em; 847 } 848 } 849 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"; } 856 } 857 858 @media aural { 859 dl.superindex > dt { pause-before: 600ms; } 860 } 861 862 @media screen, tty, tv, projection { 863 .noscreen { display: none; } 864 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; } 870 871 body.pod { 872 margin: 0 5px; 873 color: #fff; 874 background-color: #000; 875 } 876 877 body.pod h1, body.pod h2, body.pod h3, body.pod h4 { 878 font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif; 879 font-weight: normal; 880 margin-top: 1.2em; 881 margin-bottom: .1em; 882 border-top: thin solid transparent; 883 /* margin-left: -5px; border-left: 2px #7070ff solid; padding-left: 3px; */ 884 } 885 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; } 890 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; } 895 896 body.pod dt { 897 font-size: 105%; /* just a wee bit more than normal */ 898 } 899 900 .indexgroup { font-size: 80%; } 901 902 .backlinktop, .backlinkbottom { 903 margin-left: -5px; 904 margin-right: -5px; 905 background-color: #040; 906 border-top: thin solid #050; 907 border-bottom: thin solid #050; 908 } 909 910 .backlinktop a, .backlinkbottom a { 911 text-decoration: none; 912 color: #080; 913 background-color: #000; 914 border: thin solid #0d0; 915 } 916 .backlinkbottom { margin-bottom: 0; padding-bottom: 0; } 917 .backlinktop { margin-top: 0; padding-top: 0; } 918 919 body.contentspage { 920 color: #fff; 921 background-color: #000; 922 } 923 924 body.contentspage h1 { 925 color: #0d0; 926 margin-left: 1em; 927 margin-right: 1em; 928 text-indent: -.9em; 929 font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif; 930 font-weight: normal; 931 border-top: thin solid #fff; 932 border-bottom: thin solid #fff; 933 text-align: center; 934 } 935 936 dl.superindex > dt { 937 font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif; 938 font-weight: normal; 939 font-size: 90%; 940 margin-top: .45em; 941 /* margin-bottom: -.15em; */ 942 } 943 dl.superindex > dd { 944 word-spacing: .6em; /* most important rule here! */ 945 } 946 dl.superindex > a:link { 947 text-decoration: none; 948 color: #fff; 949 } 950 951 .contentsfooty { 952 border-top: thin solid #999; 953 font-size: 90%; 954 } 955 956 } 957 958 /* The End */ 959 960 EOCSS 961 962 #========================================================================== 963 964 $JAVASCRIPT = <<'EOJAVASCRIPT'; 965 966 // From http://www.alistapart.com/articles/alternate/ 967 968 function setActiveStyleSheet(title) { 969 var i, a, main; 970 for(i=0 ; (a = document.getElementsByTagName("link")[i]) ; i++) { 971 if(a.getAttribute("rel").indexOf("style") != -1 && a.getAttribute("title")) { 972 a.disabled = true; 973 if(a.getAttribute("title") == title) a.disabled = false; 974 } 975 } 976 } 977 978 function getActiveStyleSheet() { 979 var i, a; 980 for(i=0 ; (a = document.getElementsByTagName("link")[i]) ; i++) { 981 if( a.getAttribute("rel").indexOf("style") != -1 982 && a.getAttribute("title") 983 && !a.disabled 984 ) return a.getAttribute("title"); 985 } 986 return null; 987 } 988 989 function getPreferredStyleSheet() { 990 var i, a; 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"); 996 } 997 return null; 998 } 999 1000 function createCookie(name,value,days) { 1001 if (days) { 1002 var date = new Date(); 1003 date.setTime(date.getTime()+(days*24*60*60*1000)); 1004 var expires = "; expires="+date.toGMTString(); 1005 } 1006 else expires = ""; 1007 document.cookie = name+"="+value+expires+"; path=/"; 1008 } 1009 1010 function readCookie(name) { 1011 var nameEQ = name + "="; 1012 var ca = document.cookie.split(';'); 1013 for(var i=0 ; i < ca.length ; i++) { 1014 var c = ca[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); 1017 } 1018 return null; 1019 } 1020 1021 window.onload = function(e) { 1022 var cookie = readCookie("style"); 1023 var title = cookie ? cookie : getPreferredStyleSheet(); 1024 setActiveStyleSheet(title); 1025 } 1026 1027 window.onunload = function(e) { 1028 var title = getActiveStyleSheet(); 1029 createCookie("style", title, 365); 1030 } 1031 1032 var cookie = readCookie("style"); 1033 var title = cookie ? cookie : getPreferredStyleSheet(); 1034 setActiveStyleSheet(title); 1035 1036 // The End 1037 1038 EOJAVASCRIPT 1039 1040 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1041 1; 1042 __END__ 1043 1044 1045 =head1 NAME 1046 1047 Pod::Simple::HTMLBatch - convert several Pod files to several HTML files 1048 1049 =head1 SYNOPSIS 1050 1051 perl -MPod::Simple::HTMLBatch -e 'Pod::Simple::HTMLBatch::go' in out 1052 1053 1054 =head1 DESCRIPTION 1055 1056 This module is used for running batch-conversions of a lot of HTML 1057 documents 1058 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. 1062 1063 The normal use of this class is like so: 1064 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 ); 1070 1071 =head2 FROM THE COMMAND LINE 1072 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. 1078 1079 However, the shortcut requires that you specify exactly two command-line 1080 arguments, C<indirs> and C<outdir>. 1081 1082 Example: 1083 1084 % mkdir out_html 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) 1088 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".) 1093 1094 Example: 1095 1096 % mkdir ../seekrut 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) 1101 1102 Example: 1103 1104 % perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go happydocs . 1105 (to convert all pod from happydocs into the current directory) 1106 1107 1108 1109 =head1 MAIN METHODS 1110 1111 =over 1112 1113 =item $batchconv = Pod::Simple::HTMLBatch->new; 1114 1115 This TODO 1116 1117 1118 =item $batchconv->batch_convert( I<indirs>, I<outdir> ); 1119 1120 this TODO 1121 1122 =item $batchconv->batch_convert( undef , ...); 1123 1124 =item $batchconv->batch_convert( q{@INC}, ...); 1125 1126 These two values for I<indirs> specify that the normal Perl @INC 1127 1128 =item $batchconv->batch_convert( \@dirs , ...); 1129 1130 This specifies that the input directories are the items in 1131 the arrayref C<\@dirs>. 1132 1133 =item $batchconv->batch_convert( "somedir" , ...); 1134 1135 This specifies that the director "somedir" is the input. 1136 (This can be an absolute or relative path, it doesn't matter.) 1137 1138 A common value you might want would be just "." for the current 1139 directory: 1140 1141 $batchconv->batch_convert( "." , ...); 1142 1143 1144 =item $batchconv->batch_convert( 'somedir:someother:also' , ...); 1145 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 1152 C<"c:/perl/lib">.) 1153 1154 (Exactly what separator character should be used, is gotten from 1155 C<$Config::Config{'path_sep'}>, via the L<Config> module.) 1156 1157 =item $batchconv->batch_convert( ... , undef ); 1158 1159 This specifies that you want the HTML output to go into the current 1160 directory. 1161 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.) 1166 1167 =item $batchconv->batch_convert( ... , 'somedir' ); 1168 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.) 1172 1173 =back 1174 1175 1176 Note that you can also call C<batch_convert> as a class method, 1177 like so: 1178 1179 Pod::Simple::HTMLBatch->batch_convert( ... ); 1180 1181 That is just short for this: 1182 1183 Pod::Simple::HTMLBatch-> new-> batch_convert(...); 1184 1185 That is, it runs a conversion with default options, for 1186 whatever inputdirs and output dir you specify. 1187 1188 1189 =head2 ACCESSOR METHODS 1190 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. 1194 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. 1200 1201 =over 1202 1203 1204 =item $batchconv->verbose( I<nonnegative_integer> ); 1205 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. 1211 1212 1213 =item $batchconv->index( I<true-or-false> ); 1214 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. 1218 1219 1220 =item $batchconv->contents_file( I<filename> ); 1221 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. 1225 1226 =item $batchconv->contents_page_start( I<HTML_string> ); 1227 1228 This specifies what string should be put at the beginning of 1229 the contents page. 1230 The default is a string more or less like this: 1231 1232 <html> 1233 <head><title>Perl Documentation</title></head> 1234 <body class='contentspage'> 1235 <h1>Perl Documentation</h1> 1236 1237 =item $batchconv->contents_page_end( I<HTML_string> ); 1238 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: 1241 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> 1246 1247 1248 1249 =item $batchconv->add_css( $url ); 1250 1251 TODO 1252 1253 =item $batchconv->add_javascript( $url ); 1254 1255 TODO 1256 1257 =item $batchconv->css_flurry( I<true-or-false> ); 1258 1259 If true (the default value), we autogenerate some CSS files in the 1260 output directory, and set our HTML files to use those. 1261 TODO: continue 1262 1263 =item $batchconv->javascript_flurry( I<true-or-false> ); 1264 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. 1269 TODO: continue 1270 1271 =item $batchconv->no_contents_links( I<true-or-false> ); 1272 1273 TODO 1274 1275 =item $batchconv->html_render_class( I<classname> ); 1276 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. 1282 1283 =back 1284 1285 1286 1287 1288 =head1 NOTES ON CUSTOMIZATION 1289 1290 TODO 1291 1292 call add_css($someurl) to add stylesheet as alternate 1293 call add_css($someurl,1) to add as primary stylesheet 1294 1295 call add_javascript 1296 1297 subclass Pod::Simple::HTML and set $batchconv->html_render_class to 1298 that classname 1299 and maybe override 1300 $page->batch_mode_page_object_init($self, $module, $infile, $outfile, $depth) 1301 or maybe override 1302 $batchconv->batch_mode_page_object_init($page, $module, $infile, $outfile, $depth) 1303 1304 1305 1306 =head1 ASK ME! 1307 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 1314 you're looking for. 1315 1316 1317 =head1 SEE ALSO 1318 1319 L<Pod::Simple>, L<Pod::Simple::HTMLBatch>, L<perlpod>, L<perlpodspec> 1320 1321 1322 1323 1324 =head1 COPYRIGHT AND DISCLAIMERS 1325 1326 Copyright (c) 2004 Sean M. Burke. All rights reserved. 1327 1328 This library is free software; you can redistribute it and/or modify it 1329 under the same terms as Perl itself. 1330 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. 1334 1335 =head1 AUTHOR 1336 1337 Sean M. Burke C<sburke@cpan.org> 1338 1339 =cut 1340 1341 1342
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
| Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |