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.20';
@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 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
'search_class', # what to use to search for POD documents
'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 easily
sub 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->search_class($SEARCH_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,
"
\n],
$page->html_footer || '',
)
if $self->contents_file
;
return;
}
sub url_up_to_contents {
my($self, $depth) = @_;
--$depth;
return join '/', ('..') x $depth, esc($self->contents_file);
}
#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
sub find_all_pods {
my($self, $dirs) = @_;
# You can override find_all_pods in a subclass if you want to
# do extra filtering or whatnot. But for the moment, we just
# pass to modnames2paths:
return $self->modnames2paths($dirs);
}
#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
sub modnames2paths { # return a hashref mapping modulenames => paths
my($self, $dirs) = @_;
my $m2p;
{
my $search = $self->search_class->new;
DEBUG and print "Searching via $search\n";
$search->verbose(1) if DEBUG > 10;
$search->progress( $self->progress->copy->goal(0) ) if $self->progress;
$search->shadows(0); # don't bother noting shadowed files
$search->inc( $dirs ? 0 : 1 );
$search->survey( $dirs ? @$dirs : () );
$m2p = $search->name2path;
die "What, no name2path?!" unless $m2p;
}
$self->muse("That's odd... no modules found!") unless keys %$m2p;
if( DEBUG > 4 ) {
print "Modules found (name => path):\n";
foreach my $m (sort {lc($a) cmp lc($b)} keys %$m2p) {
print " $m $$m2p{$m}\n";
}
print "(total ", scalar(keys %$m2p), ")\n\n";
} elsif( DEBUG ) {
print "Found ", scalar(keys %$m2p), " modules.\n";
}
$self->muse( "Found ", scalar(keys %$m2p), " modules." );
# return the Foo::Bar => /whatever/Foo/Bar.pod|pm hashref
return $m2p;
}
#===========================================================================
sub _wopen {
# this is abstracted out so that the daemon class can override it
my($self, $outpath) = @_;
require Symbol;
my $out_fh = Symbol::gensym();
DEBUG > 5 and print "Write-opening to $outpath\n";
return $out_fh if open($out_fh, "> $outpath");
require Carp;
Carp::croak("Can't write-open $outpath: $!");
}
#==========================================================================
sub add_css {
my($self, $url, $is_default, $name, $content_type, $media, $_code) = @_;
return unless $url;
unless($name) {
# cook up a reasonable name based on the URL
$name = $url;
if( $name !~ m/\?/ and $name =~ m{([^/]+)$}s ) {
$name = $1;
$name =~ s/\.css//i;
}
}
$media ||= 'all';
$content_type ||= 'text/css';
my $bunch = [$url, $name, $content_type, $media, $_code];
if($is_default) { unshift @{ $self->_css_wad }, $bunch }
else { push @{ $self->_css_wad }, $bunch }
return;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub _spray_css {
my($self, $outdir) = @_;
return unless $self->css_flurry();
$self->_gen_css_wad();
my $lol = $self->_css_wad;
foreach my $chunk (@$lol) {
my $url = $chunk->[0];
my $outfile;
if( ref($chunk->[-1]) and $url =~ m{^(_[-a-z0-9_]+\.css$)} ) {
$outfile = $self->filespecsys->catfile( $outdir, "$1" );
DEBUG > 5 and print "Noting $$chunk[0] as a file I'll create.\n";
} else {
DEBUG > 5 and print "OK, noting $$chunk[0] as an external CSS.\n";
# Requires no further attention.
next;
}
#$self->muse( "Writing autogenerated CSS file $outfile" );
my $Cssout = $self->_wopen($outfile);
print $Cssout ${$chunk->[-1]}
or warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all";
close($Cssout);
DEBUG > 5 and print "Wrote $outfile\n";
}
return;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub _css_wad_to_markup {
my($self, $depth) = @_;
my @css = @{ $self->_css_wad || return '' };
return '' unless @css;
my $rel = 'stylesheet';
my $out = '';
--$depth;
my $uplink = $depth ? ('../' x $depth) : '';
foreach my $chunk (@css) {
next unless $chunk and @$chunk;
my( $url1, $url2, $title, $type, $media) = (
$self->_maybe_uplink( $chunk->[0], $uplink ),
esc(grep !ref($_), @$chunk)
);
$out .= qq{\n};
$rel = 'alternate stylesheet'; # alternates = all non-first iterations
}
return $out;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub _maybe_uplink {
# if the given URL looks relative, return the given uplink string --
# otherwise return emptystring
my($self, $url, $uplink) = @_;
($url =~ m{^\./} or $url !~ m{[/\:]} )
? $uplink
: ''
# qualify it, if/as needed
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub _gen_css_wad {
my $self = $_[0];
my $css_template = $self->_css_template;
foreach my $variation (
# Commented out for sake of concision:
#
# 011n=black_with_red_on_white
# 001n=black_with_yellow_on_white
# 101n=black_with_green_on_white
# 110=white_with_yellow_on_black
# 010=white_with_green_on_black
# 011=white_with_blue_on_black
# 100=white_with_red_on_black
'110n=blkbluw', # black_with_blue_on_white
'010n=blkmagw', # black_with_magenta_on_white
'100n=blkcynw', # black_with_cyan_on_white
'101=whtprpk', # white_with_purple_on_black
'001=whtnavk', # white_with_navy_blue_on_black
'010a=grygrnk', # grey_with_green_on_black
'010b=whtgrng', # white_with_green_on_grey
'101an=blkgrng', # black_with_green_on_grey
'101bn=grygrnw', # grey_with_green_on_white
) {
my $outname = $variation;
my($flipmode, @swap) = ( ($4 || ''), $1,$2,$3)
if $outname =~ s/^([012])([012])([[012])([a-z]*)=?//s;
@swap = () if '010' eq join '', @swap; # 010 is a swop-no-op!
my $this_css =
"/* This file is autogenerated. Do not edit. $variation */\n\n"
. $css_template;
# Only look at three-digitty colors, for now at least.
if( $flipmode =~ m/n/ ) {
$this_css =~ s/(#[0-9a-fA-F]{3})\b/_color_negate($1)/eg;
$this_css =~ s/\bthin\b/medium/g;
}
$this_css =~ s<#([0-9a-fA-F])([0-9a-fA-F])([0-9a-fA-F])\b>
< join '', '#', ($1,$2,$3)[@swap] >eg if @swap;
if( $flipmode =~ m/a/)
{ $this_css =~ s/#fff\b/#999/gi } # black -> dark grey
elsif($flipmode =~ m/b/)
{ $this_css =~ s/#000\b/#666/gi } # white -> light grey
my $name = $outname;
$name =~ tr/-_/ /;
$self->add_css( "_$outname.css", 0, $name, 0, 0, \$this_css);
}
# Now a few indexless variations:
foreach my $variation (
'blkbluw', # black_with_blue_on_white
'whtpurk', # white_with_purple_on_black
'whtgrng', # white_with_green_on_grey
'grygrnw', # grey_with_green_on_white
) {
my $outname = $variation;
my $this_css = join "\n",
"/* This file is autogenerated. Do not edit. $outname */\n",
"\@import url(\"./_$variation.css\");",
".indexgroup { display: none; }",
"\n",
;
my $name = $outname;
$name =~ tr/-_/ /;
$self->add_css( "_$outname.css", 0, $name, 0, 0, \$this_css);
}
return;
}
sub _color_negate {
my $x = lc $_[0];
$x =~ tr[0123456789abcdef]
[fedcba9876543210];
return $x;
}
#===========================================================================
sub add_javascript {
my($self, $url, $content_type, $_code) = @_;
return unless $url;
push @{ $self->_javascript_wad }, [
$url, $content_type || 'text/javascript', $_code
];
return;
}
sub _spray_javascript {
my($self, $outdir) = @_;
return unless $self->javascript_flurry();
$self->_gen_javascript_wad();
my $lol = $self->_javascript_wad;
foreach my $script (@$lol) {
my $url = $script->[0];
my $outfile;
if( ref($script->[-1]) and $url =~ m{^(_[-a-z0-9_]+\.js$)} ) {
$outfile = $self->filespecsys->catfile( $outdir, "$1" );
DEBUG > 5 and print "Noting $$script[0] as a file I'll create.\n";
} else {
DEBUG > 5 and print "OK, noting $$script[0] as an external JavaScript.\n";
next;
}
#$self->muse( "Writing JavaScript file $outfile" );
my $Jsout = $self->_wopen($outfile);
print $Jsout ${$script->[-1]}
or warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all";
close($Jsout);
DEBUG > 5 and print "Wrote $outfile\n";
}
return;
}
sub _gen_javascript_wad {
my $self = $_[0];
my $js_code = $self->_javascript || return;
$self->add_javascript( "_podly.js", 0, \$js_code);
return;
}
sub _javascript_wad_to_markup {
my($self, $depth) = @_;
my @scripts = @{ $self->_javascript_wad || return '' };
return '' unless @scripts;
my $out = '';
--$depth;
my $uplink = $depth ? ('../' x $depth) : '';
foreach my $s (@scripts) {
next unless $s and @$s;
my( $url1, $url2, $type, $media) = (
$self->_maybe_uplink( $s->[0], $uplink ),
esc(grep !ref($_), @$s)
);
$out .= qq{\n};
}
return $out;
}
#===========================================================================
sub _css_template { return $CSS }
sub _javascript { return $JAVASCRIPT }
$CSS = <<'EOCSS';
/* For accessibility reasons, never specify text sizes in px/pt/pc/in/cm/mm */
@media all { .hide { display: none; } }
@media print {
.noprint, div.indexgroup, .backlinktop, .backlinkbottom { display: none }
* {
border-color: black !important;
color: black !important;
background-color: transparent !important;
background-image: none !important;
}
dl.superindex > dd {
word-spacing: .6em;
}
}
@media aural, braille, embossed {
div.indexgroup { display: none; } /* Too noisy, don't you think? */
dl.superindex > dt:before { content: "Group "; }
dl.superindex > dt:after { content: " contains:"; }
.backlinktop a:before { content: "Back to contents"; }
.backlinkbottom a:before { content: "Back to contents"; }
}
@media aural {
dl.superindex > dt { pause-before: 600ms; }
}
@media screen, tty, tv, projection {
.noscreen { display: none; }
a:link { color: #7070ff; text-decoration: underline; }
a:visited { color: #e030ff; text-decoration: underline; }
a:active { color: #800000; text-decoration: underline; }
body.contentspage a { text-decoration: none; }
a.u { color: #fff !important; text-decoration: none; }
body.pod {
margin: 0 5px;
color: #fff;
background-color: #000;
}
body.pod h1, body.pod h2, body.pod h3, body.pod h4 {
font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif;
font-weight: normal;
margin-top: 1.2em;
margin-bottom: .1em;
border-top: thin solid transparent;
/* margin-left: -5px; border-left: 2px #7070ff solid; padding-left: 3px; */
}
body.pod h1 { border-top-color: #0a0; }
body.pod h2 { border-top-color: #080; }
body.pod h3 { border-top-color: #040; }
body.pod h4 { border-top-color: #010; }
p.backlinktop + h1 { border-top: none; margin-top: 0em; }
p.backlinktop + h2 { border-top: none; margin-top: 0em; }
p.backlinktop + h3 { border-top: none; margin-top: 0em; }
p.backlinktop + h4 { border-top: none; margin-top: 0em; }
body.pod dt {
font-size: 105%; /* just a wee bit more than normal */
}
.indexgroup { font-size: 80%; }
.backlinktop, .backlinkbottom {
margin-left: -5px;
margin-right: -5px;
background-color: #040;
border-top: thin solid #050;
border-bottom: thin solid #050;
}
.backlinktop a, .backlinkbottom a {
text-decoration: none;
color: #080;
background-color: #000;
border: thin solid #0d0;
}
.backlinkbottom { margin-bottom: 0; padding-bottom: 0; }
.backlinktop { margin-top: 0; padding-top: 0; }
body.contentspage {
color: #fff;
background-color: #000;
}
body.contentspage h1 {
color: #0d0;
margin-left: 1em;
margin-right: 1em;
text-indent: -.9em;
font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif;
font-weight: normal;
border-top: thin solid #fff;
border-bottom: thin solid #fff;
text-align: center;
}
dl.superindex > dt {
font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif;
font-weight: normal;
font-size: 90%;
margin-top: .45em;
/* margin-bottom: -.15em; */
}
dl.superindex > dd {
word-spacing: .6em; /* most important rule here! */
}
dl.superindex > a:link {
text-decoration: none;
color: #fff;
}
.contentsfooty {
border-top: thin solid #999;
font-size: 90%;
}
}
/* The End */
EOCSS
#==========================================================================
$JAVASCRIPT = <<'EOJAVASCRIPT';
// From http://www.alistapart.com/articles/alternate/
function setActiveStyleSheet(title) {
var i, a, main;
for(i=0 ; (a = document.getElementsByTagName("link")[i]) ; i++) {
if(a.getAttribute("rel").indexOf("style") != -1 && a.getAttribute("title")) {
a.disabled = true;
if(a.getAttribute("title") == title) a.disabled = false;
}
}
}
function getActiveStyleSheet() {
var i, a;
for(i=0 ; (a = document.getElementsByTagName("link")[i]) ; i++) {
if( a.getAttribute("rel").indexOf("style") != -1
&& a.getAttribute("title")
&& !a.disabled
) return a.getAttribute("title");
}
return null;
}
function getPreferredStyleSheet() {
var i, a;
for(i=0 ; (a = document.getElementsByTagName("link")[i]) ; i++) {
if( a.getAttribute("rel").indexOf("style") != -1
&& a.getAttribute("rel").indexOf("alt") == -1
&& a.getAttribute("title")
) return a.getAttribute("title");
}
return null;
}
function createCookie(name,value,days) {
if (days) {
var date = new Date();
date.setTime(date.getTime()+(days*24*60*60*1000));
var expires = "; expires="+date.toGMTString();
}
else expires = "";
document.cookie = name+"="+value+expires+"; path=/";
}
function readCookie(name) {
var nameEQ = name + "=";
var ca = document.cookie.split(';');
for(var i=0 ; i < ca.length ; i++) {
var c = ca[i];
while (c.charAt(0)==' ') c = c.substring(1,c.length);
if (c.indexOf(nameEQ) == 0) return c.substring(nameEQ.length,c.length);
}
return null;
}
window.onload = function(e) {
var cookie = readCookie("style");
var title = cookie ? cookie : getPreferredStyleSheet();
setActiveStyleSheet(title);
}
window.onunload = function(e) {
var title = getActiveStyleSheet();
createCookie("style", title, 365);
}
var cookie = readCookie("style");
var title = cookie ? cookie : getPreferredStyleSheet();
setActiveStyleSheet(title);
// The End
EOJAVASCRIPT
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1;
__END__
=head1 NAME
Pod::Simple::HTMLBatch - convert several Pod files to several HTML files
=head1 SYNOPSIS
perl -MPod::Simple::HTMLBatch -e 'Pod::Simple::HTMLBatch::go' in out
=head1 DESCRIPTION
This module is used for running batch-conversions of a lot of HTML
documents
This class is NOT a subclass of Pod::Simple::HTML
(nor of bad old Pod::Html) -- although it uses
Pod::Simple::HTML for doing the conversion of each document.
The normal use of this class is like so:
use Pod::Simple::HTMLBatch;
my $batchconv = Pod::Simple::HTMLBatch->new;
$batchconv->some_option( some_value );
$batchconv->some_other_option( some_other_value );
$batchconv->batch_convert( \@search_dirs, $output_dir );
=head2 FROM THE COMMAND LINE
Note that this class also provides
(but does not export) the function Pod::Simple::HTMLBatch::go.
This is basically just a shortcut for C<<
Pod::Simple::HTMLBatch->batch_convert(@ARGV) >>.
It's meant to be handy for calling from the command line.
However, the shortcut requires that you specify exactly two command-line
arguments, C and C.
Example:
% mkdir out_html
% perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go @INC out_html
(to convert the pod from Perl's @INC
files under the directory ./out_html)
(Note that the command line there contains a literal atsign-I-N-C. This
is handled as a special case by batch_convert, in order to save you having
to enter the odd-looking "" as the first command-line parameter when you
mean "just use whatever's in @INC".)
Example:
% mkdir ../seekrut
% chmod og-rx ../seekrut
% perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go . ../htmlversion
(to convert the pod under the current dir into HTML
files under the directory ./seekrut)
Example:
% perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go happydocs .
(to convert all pod from happydocs into the current directory)
=head1 MAIN METHODS
=over
=item $batchconv = Pod::Simple::HTMLBatch->new;
This TODO
=item $batchconv->batch_convert( I, I );
this TODO
=item $batchconv->batch_convert( undef , ...);
=item $batchconv->batch_convert( q{@INC}, ...);
These two values for I specify that the normal Perl @INC
=item $batchconv->batch_convert( \@dirs , ...);
This specifies that the input directories are the items in
the arrayref C<\@dirs>.
=item $batchconv->batch_convert( "somedir" , ...);
This specifies that the director "somedir" is the input.
(This can be an absolute or relative path, it doesn't matter.)
A common value you might want would be just "." for the current
directory:
$batchconv->batch_convert( "." , ...);
=item $batchconv->batch_convert( 'somedir:someother:also' , ...);
This specifies that you want the dirs "somedir", "someother", and "also"
scanned, just as if you'd passed the arrayref
C<[qw( somedir someother also)]>. Note that a ":"-separator is normal
under Unix, but Under MSWin, you'll need C<'somedir;someother;also'>
instead, since the pathsep on MSWin is ";" instead of ":". (And
I is because ":" often comes up in paths, like
C<"c:/perl/lib">.)
(Exactly what separator character should be used, is gotten from
C<$Config::Config{'path_sep'}>, via the L module.)
=item $batchconv->batch_convert( ... , undef );
This specifies that you want the HTML output to go into the current
directory.
(Note that a missing or undefined value means a different thing in
the first slot than in the second. That's so that C
with no arguments (or undef arguments) means "go from @INC, into
the current directory.)
=item $batchconv->batch_convert( ... , 'somedir' );
This specifies that you want the HTML output to go into the
directory 'somedir'.
(This can be an absolute or relative path, it doesn't matter.)
=back
Note that you can also call C as a class method,
like so:
Pod::Simple::HTMLBatch->batch_convert( ... );
That is just short for this:
Pod::Simple::HTMLBatch-> new-> batch_convert(...);
That is, it runs a conversion with default options, for
whatever inputdirs and output dir you specify.
=head2 ACCESSOR METHODS
The following are all accessor methods -- that is, they don't do anything
on their own, but just alter the contents of the conversion object,
which comprises the options for this particular batch conversion.
We show the "put" form of the accessors below (i.e., the syntax you use
for setting the accessor to a specific value). But you can also
call each method with no parameters to get its current value. For
example, C<< $self->contents_file() >> returns the current value of
the contents_file attribute.
=over
=item $batchconv->verbose( I );
This controls how verbose to be during batch conversion, as far as
notes to STDOUT (or whatever is C