home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Master.pm < prev    next >
Encoding:
Perl POD Document  |  2003-11-21  |  30.1 KB  |  1,210 lines
  1. =head1 NAME
  2.  
  3. Pod::Master - I am the master of HTML Pod.
  4.  
  5. =head1 DESCRIPTION
  6.  
  7. This module uses L<Pod::Html|Pod::Html> to generate HTML versions of
  8. all the documentation it finds using L<Pod::Find|Pod::Find>.
  9.  
  10. It also creates a neat-o table of contents.
  11. Look at B<L<this|"Modules">> to see if you like it.
  12.  
  13. =head1 SYNOPSIS
  14.  
  15. C<perl -MPod::Master -e Update()>
  16. C<perl -MPod::Master -e " Update()->MiniTOC() ">
  17.  
  18.    #!/usr/bin/perl -w
  19.    
  20.    use Pod::Master;
  21.    use strict;
  22.    
  23.    my $pM = new Pod::Master( { verbose => 1 } );
  24.       $pM->UpdatePOD();
  25.       $pM->UpdateTOC(1);
  26.  
  27. =head1 EXPORTS
  28.  
  29. L<C<Update>|"Update"> is the only exported function, and the only
  30. one you need to call, to have a this module do what it does
  31. and have the results end up in C<perl -V:installhtmldir>
  32.  
  33. =cut
  34.  
  35. package Pod::Master;
  36.  
  37. require  5.005; # let's be reasonable now ;)(cause File* and Pod* are)
  38.  
  39. use Config;
  40. use File::Path qw( mkpath );
  41. use File::Spec::Functions qw( canonpath abs2rel splitpath splitdir
  42. catdir );
  43. use Pod::Html qw( 1.04 );
  44. use Pod::Find qw( pod_find );
  45.  
  46. # now it's my problem
  47. use strict;
  48. BEGIN{eval q{use warnings};} # where available only (i wan't em)
  49.  
  50. use vars qw(
  51.    @EXPORT @ISA $VERSION
  52.    $MasterCSS
  53.    $ScriptDir $PrivLib  $SiteLib  $InstallPrefix  $InstallHtmlDir
  54. );
  55.  
  56. $VERSION = 0.013;
  57. @ISA = qw( Exporter );
  58. @EXPORT = qw( Update );
  59.  
  60.  
  61. $ScriptDir = canonpath $Config{scriptdir}; # must be canonical!!!!
  62. $PrivLib = canonpath $Config{privlib};
  63. $SiteLib  = canonpath $Config{sitelib};
  64. $InstallPrefix = canonpath $Config{installprefix};
  65. $InstallHtmlDir = canonpath $Config{installhtmldir};
  66.  
  67.  
  68. =head1 Methods
  69.  
  70. Most of these  return C<$self> if they're not supposed to return anything.
  71.  
  72. =head2 C<new>
  73.  
  74. The constructor (a class method).
  75.  
  76. Takes an optional hashref of C<$options>, which are:
  77.  
  78. =over 4
  79.  
  80. =item boiler
  81.  
  82. I<See L<Header|"Header">>.
  83.  
  84. =item outdir
  85.  
  86. A path (which must exist) where
  87.  
  88.  index.html
  89.  podmaster.toc.html
  90.  lib/strict.html
  91.  ...
  92.  
  93. will reside.
  94.  
  95. =item overwrite
  96.  
  97. A boolean.  Default is 0. It's the default argument to L<"UpdatePOD">.
  98.  
  99. =item verbose
  100.  
  101. A boolean.  If true, prints out messages (it's all or none).
  102.  
  103. =item path
  104.  
  105. An array reference of additional directories to search for pod files.
  106.  
  107. C<perl -V:privlib -V:sitelib -V:scriptdir> are in there by default.
  108.  
  109. =item pod2html
  110.  
  111. A hashref, with options to pass to L<Pod::Html|Pod::Html>.
  112.  
  113. Only the following L<Pod::Html|Pod::Html> options are allowed
  114. (the rest are either automagically generated ):
  115.  
  116.    $self->{pod2html}{backlink}
  117.    $self->{pod2html}{css}
  118.    $self->{pod2html}{quiet}
  119.    $self->{pod2html}{header}
  120.    $self->{pod2html}{verbose}
  121.  
  122. B<BEWARE> the css option.
  123. Any filename you pass to css should reside in $self->{outdir},
  124. otherwise the css link won't be generated correctly.
  125.  
  126. It has to be a relative link, meaning you can't do
  127.  
  128.    my $pM = new Pod::Master({
  129.        pod2html {
  130.            css => 'F:/foo/bar.css',
  131.        },
  132.        outdir => 'G:/baz',
  133.    });
  134.  
  135. and expect it to work.
  136.  
  137.  
  138. =back
  139.  
  140. =cut
  141.  
  142. sub new {
  143.    my( $class, $options ) = @_;
  144.    my $self = ref $options eq 'HASH' ? $options : {};
  145.    $self->{boiler}    ||= 0;
  146.    $self->{verbose}   ||= 0;
  147.    $self->{overwrite} ||= 0;
  148.    $self->{outdir}    ||= $InstallHtmlDir || catdir($InstallPrefix,"html");
  149.    $self->{outdir} = canonpath $self->{outdir};
  150.    $self->{pod2html}  ||= {
  151.        css => 'Active.css',
  152.        backlink => '__top',
  153.        quiet => 1,
  154.        verbose => 0,
  155.        header =>1,
  156.    };
  157.  
  158.    $self->{path} = [
  159.        grep{'.' ne $_ }
  160.        $PrivLib, $SiteLib, $ScriptDir,
  161.        exists $self->{path} ? @{$self->{path}} : ()
  162.    ];
  163.  
  164.    return bless $self, $class;
  165. }
  166.  
  167. =head2 C<Update>
  168.  
  169. The only exported function.
  170.  
  171. Takes a single optional argument, which it passes to L<new|"new">.
  172.  
  173. Unless invoked as a method, creates a new Pod::Master object.
  174.  
  175. Subsequently invokes L<"UpdatePOD"> and L<"UpdateTOC">.
  176.  
  177. If you have ActivePerl::DocTools, you may wish to invoke it as
  178. C<Update({outdir=E<gt>'C:/PodMasterHtmlPod/'})>
  179.  
  180.  
  181. =cut
  182.  
  183. sub Update {
  184.    my( $self ) = @_;
  185.  
  186.    $self = __PACKAGE__->new($self)
  187.      if not defined $self
  188.         or not UNIVERSAL::isa($self,__PACKAGE__);
  189.  
  190.    $self->UpdatePOD();
  191.    $self->UpdateTOC();
  192.    return $self;
  193. }
  194.  
  195.  
  196. =head2 C<UpdatePOD>
  197.  
  198. Runs pod2html for every pod file found whose .html
  199. equivalent is missing, or outdated (modify time).
  200.  
  201. Takes a single optional argument, a true value (1),
  202. which forces pod2html to be run on all pod files.
  203.  
  204. Default agrument is taken from C<$$self{overwrite}>
  205.  
  206. =cut
  207.  
  208. sub UpdatePOD {
  209.    my($self, $overwrite ) = @_;
  210.    $overwrite = $self->{overwrite} unless defined $overwrite;
  211.    $self->_FindEmPods() unless exists $self->{Modules};
  212.  
  213.    chdir $InstallPrefix or die "can't chdir to $InstallPrefix $!";
  214.  
  215.    print "chdir'ed to $InstallPrefix\n" if $self->{verbose};
  216.  
  217.    my $libPods =
  218. 'perlfunc:perlguts:perlvar:perlrun:perlopt:perlapi:perlxs';
  219.    my $BackLink = $self->{pod2html}{backlink};
  220.    my $css = $self->{pod2html}{css} || "Active.css";
  221.    my $p2quiet = $self->{pod2html}{quiet};
  222.    my $p2header = $self->{pod2html}{header};
  223.    my $p2verbose = $self->{pod2html}{verbose};
  224.  
  225.    my $PodPath = join ':',
  226.            map{
  227.                s{\Q$InstallPrefix\E}{};
  228.                canonpath("./$_");
  229.            }
  230.            @{$self->{path}};
  231.            #($ScriptDir,$PrivLib,$SiteLib);
  232.  
  233.    print "podpath = $PodPath\n" if $self->{verbose};
  234.  
  235.    my $OutDir = $self->{outdir};
  236.  
  237.    for my $What (qw( PerlDoc Pragmas Scripts Modules )) {
  238.        print "processing $What \n" if $self->{verbose};
  239.  
  240.        while( my( $name, $InFile ) = each %{$self->{$What}}) {
  241.  
  242. #            my $RelPath = abs2rel( catdir( (splitpath$InFile)[1,2] ), $InstallPrefix );
  243.            my $RelPath = $self->_RelPath( $InFile, $InstallPrefix );
  244.            my $HtmlRoot = catdir map { $_ ? '..' : $_ }
  245. splitdir((splitpath$RelPath)[1]);
  246.            my $OutFile = catdir $OutDir, $RelPath;
  247.               $OutFile =~ s{\.([^\.]+)$}{.html};
  248.  
  249.            my $HtmlDir = catdir( ( splitpath($OutFile) )[0,1] );
  250.  
  251. ###################################################################### 
  252. #added by Randy Kobes - links sometimes don't pick up proper css file
  253.            (my $installhtml = $InstallHtmlDir) =~ s!\\!/!g;
  254.            my $style = 'file://' . $installhtml . '/'. $css;
  255.            my $root = "file://$installhtml";
  256. ###################################################################### 
  257.  
  258.            my @args = (
  259.                "--htmldir=$HtmlDir",
  260. #               "--htmlroot=$HtmlRoot",
  261.                "--htmlroot=$root",
  262.                "--podroot=.",
  263.                "--podpath=$PodPath",
  264.                "--infile=$InFile",
  265.                "--outfile=$OutFile",
  266.                "--libpods=$libPods",
  267. #              "--css=".catdir($HtmlRoot, $css),
  268.            qq{--css=$style},
  269.                "--cachedir=$OutDir",
  270.                $p2header ? "--header" : (),
  271.                $BackLink ? "--backlink=$BackLink" : (),
  272.  
  273.                ( $p2quiet ? "--quiet" : () ),
  274.                ( $p2verbose ? "--verbose" : () ),
  275.            );
  276.  
  277.            if( $overwrite ) {
  278.  
  279.                print "forced overwrite" if $self->{verbose};
  280.                mkpath($HtmlDir);
  281.                $self->pod2html( @args );
  282.  
  283.            }elsif($self->_AmIOlderThanYou($InFile,$OutFile)){
  284.                print "out of sync" if $self->{verbose};
  285.                mkpath($HtmlDir);
  286.                $self->pod2html( @args );
  287.            }
  288.        }
  289.    }
  290.    return $self;
  291. }
  292.  
  293.  
  294. =begin ForInternalUseOnly =head1 C<_AmIOlderThanYou>
  295.  
  296. Takes 2 filenames ( C<$in,$out>). Returns 1 if $in is older than $out,
  297. or $in doesn't exist.  Returns 0 otherwise.
  298.  
  299. =end ForInternalUseOnly
  300.  
  301. =cut
  302.  
  303. sub _AmIOlderThanYou {
  304.    my($self, $in, $out ) = @_;
  305.    return 1 if not -e $in or (stat $in)[9] > (stat $out)[9] ;
  306.    return 0;
  307. }
  308.  
  309.  
  310. =head2 C<UpdateTOC>
  311.  
  312. Refreshes the MasterTOC (podmaster.toc.html).
  313.  
  314. Takes 1 argument, C<$ret>, a boolean, and if it's true,
  315. returns the MasterTOC as string.
  316.  
  317. Re-Creates index.html and Active.css if they're missing,
  318. but only if C<$ret> is false.
  319.  
  320. The standard css is contained in C<$MasterCSS>,
  321. and it is printed if C<$$self{css}> isn't defined.
  322.  
  323. C<$self->_Frame> contains the frameset to be printed.
  324.  
  325. =cut
  326.  
  327. sub UpdateTOC {
  328. #    eval q[use ActivePerl::DocTools::TOC::HTML::Podmaster; ActivePerl::DocTools::TOC::HTML::Podmaster::WriteTOC() ];
  329.  
  330.    my($self, $ret ) = @_;
  331.    $ret ||=0;
  332.  
  333.    $self->_FindEmPods() unless exists $self->{Modules};
  334.  
  335.    my $OutDir = $self->{outdir};
  336.  
  337.    unless (-d $OutDir) {
  338.        mkdir $OutDir or die "Cannot mkdir $OutDir: $!";
  339.    }
  340.    chdir $OutDir or die "can't chdir to $OutDir $!";
  341.  
  342.    print "chdir'ed to $OutDir\n" if $self->{verbose};
  343.  
  344.    my $MasterTOC =  'podmaster.toc.html';
  345.    my $MasterFrame =  'index.html';
  346.  
  347.    unless($ret){
  348.        open(OUT,">$MasterTOC") or die "Couldn't clobber $MasterTOC $!";
  349.        print "outputting html to $MasterTOC\n" if $self->{verbose};
  350.        print OUT $self->_TOC();
  351.        close OUT;
  352.        print "done\n" if $self->{verbose};
  353.    }else{
  354.        return $self->_TOC();
  355.    }
  356.  
  357.    my $MasterCss = $self->{pod2html}{css};
  358.    if(not -e $MasterCss and $MasterCss =~ /Active\.css/){
  359.        $MasterCss = catdir $OutDir, $MasterCss;
  360.        open(OUT,">$MasterCss") or die "Couldn't refresh $MasterCss $!";
  361.        print "Refreshing $MasterCss " if $self->{verbose};
  362.        print OUT $MasterCSS; ## Oouh, case sensitivity ;^)
  363.        close(OUT);
  364.    }
  365.  
  366.    open(OUT,">$MasterFrame") or die "Couldn't refresh $MasterFrame $!";
  367.    print "Refreshing $MasterFrame " if $self->{verbose};
  368.    print OUT $self->_Frame($MasterTOC);
  369.    close(OUT);
  370.  
  371.    return ($self);
  372. }
  373.  
  374. sub _TOC {
  375.    my( $self ) = @_;
  376.    return join '',
  377.        $self->Header(),
  378.        $self->PerlDoc(),
  379.        $self->Pragmas(),
  380.        $self->Scripts(),
  381.        $self->Modules(),
  382.        $self->Footer();
  383. }
  384.  
  385.  
  386. =head2 C<MiniTOC>
  387.  
  388. Like C<UpdateTOC> except it writes to C<podmaster.minitoc.html>.
  389.  
  390. =cut
  391.  
  392. sub MiniTOC {
  393.    my( $self ) = @_;
  394.    my $OutDir = $self->{outdir};
  395.    $self->_FindEmPods() unless exists $self->{Modules};
  396.    chdir $OutDir or die " can't chdir to $OutDir $!";
  397.    open(OUT,">podmaster.minitoc.html") or die "oops
  398. podmaster.minitoc.html $!";
  399.    print OUT $self->Header();
  400.    print OUT q[
  401. <div class="likepre">
  402. <form method=get action="http://search.cpan.org/search" name=f>
  403. <input type="text" name="query" value="" size=36 >
  404. <input type="submit" value="CPAN Search"> in
  405. <select name="mode"><option value="all">All</option>
  406. <option value="module" >Modules</option>
  407. <option value="dist" >Distributions</option>
  408. <option value="author" >Authors</option>
  409. </select>
  410. </form>
  411. <hr>
  412.    <a TARGET="_self" href="podmaster.perldoc.html">Perl Core
  413. Documentation</a><br>
  414.    <a TARGET="_self" href="podmaster.pragmas.html">Pragmas</a><br>
  415.    <a TARGET="_self" href="podmaster.scripts.html">Perl Programs</a><br>
  416.    <a TARGET="_self" href="podmaster.modules.html">Installed
  417. Modules</a><br>
  418. <hr>
  419. go to <a target=_self href='podmaster.toc.html'>toc</a>(the big one)
  420. </div>
  421. ];
  422.    print OUT $self->Footer();
  423.    close OUT;
  424.  
  425.    open(OUT,'>podmaster.miniframe.html') or die "oops
  426. podmaster.miniframe.html $!";
  427.    print OUT $self->_Frame('podmaster.minitoc.html');
  428.    close OUT;
  429.  
  430.    my $MasterCss = $self->{pod2html}{css};
  431.       $MasterCss = catdir $OutDir, $MasterCss;
  432.    if(not -e $MasterCss and $MasterCss eq 'Active.css'){
  433.        open(OUT,">$MasterCss") or die "Couldn't refresh $MasterCss $!";
  434.        print "Refreshing $MasterCss " if $self->{verbose};
  435.        print OUT $MasterCSS; ## Oouh, case sensitivity ;^)
  436.        close(OUT);
  437.    }
  438.  
  439.    for my $f (qw( PerlDoc Pragmas Scripts Modules ) ) {
  440.        open(OUT,">podmaster.\L$f.html") or die "oops
  441. podmaster.\L$_.html $!";
  442.        print OUT $self->Header();
  443.        print OUT "back to <a TARGET=_self
  444. href='podmaster.minitoc.html'>minitoc</a> <br>";
  445.        print OUT $self->$f();
  446.        print OUT $self->Footer();
  447.        close OUT;
  448.    }
  449.  
  450.    return $self;
  451. }
  452.  
  453. =begin ForInternalUseOnly =head1 C<_FindEmPods>
  454.  
  455. Invokes C<Pod::Find::pod_find()> and stores the results as
  456.  
  457.    $self->{PerlDoc} = \%Perldoc;
  458.    $self->{Pragmas} = \%Pragmas;
  459.    $self->{Modules} = \%Modules;
  460.    $self->{Scripts} = \%Scripts;
  461.  
  462. =end ForInternalUseOnly
  463.  
  464. =cut
  465.  
  466. sub _FindEmPods {
  467.    my( $self ) = @_;
  468.    my( %Perldoc, %Pragmas, %Scripts, %Modules);
  469.  
  470.    my @BINC = map { canonpath($_) } @{$self->{path}}; # Must be canonical!!!
  471.  
  472.    print "BINC= @BINC \n" if $self->{verbose};
  473.  
  474.    my @PodList = pod_find( {
  475.            -verbose => 0,
  476.            -perl => 0,
  477.            -inc => 0,  # both -inc and -script automatically turn on -perl
  478.            -script =>0,# this is NOT ****ING DOCUMENTED and cost me an HOUR
  479.        },              # must complain to perl5porters to  document or remove 
  480.        @BINC,
  481.    );
  482.  
  483.    for( my $ix = 0; $ix < $#PodList; $ix+=2 ) {
  484.        my( $filename, $modulename ) = @PodList[$ix,$ix+1];
  485.        $filename = canonpath( $filename );
  486.  
  487.        print "$filename\n" if $self->{verbose};
  488. # perl pragmas are named all lowercase
  489. # and as of Mon Nov 4 2002, no pragma has a  matching .pod file
  490. # Characters such as the following are not pragmas:
  491. #    cgi_to_mod_perl
  492. #    lwpcook
  493. #    mod_perl
  494. #    mod_perl_cvs
  495. #    mod_perl_method_handlers
  496. #    mod_perl_traps
  497. #    mod_perl_tuning
  498. #    perlfilter
  499.  
  500.        if( $modulename =~ /^[Pp]od::(perl[a-z\d]*)/ ) {
  501.            $Perldoc{$1} = $filename;
  502.        }elsif( $filename =~ /^\Q$ScriptDir/i) {
  503.            $Scripts{$modulename} = $filename;
  504.        }elsif($modulename =~ /^([a-z:\d]+)$/
  505.               and ( substr($filename,-4) ne '.pod'
  506.                     or $1 eq 'perllocal'
  507.                   )
  508.              ){
  509.            $Pragmas{$1} = $filename;
  510.        }else{
  511.            $Modules{$modulename} = $filename;
  512.        }
  513.    }
  514.  
  515.    $self->{PerlDoc} = \%Perldoc;
  516.    $self->{Pragmas} = \%Pragmas;
  517.    $self->{Modules} = \%Modules;
  518.    $self->{Scripts} = \%Scripts;
  519.  
  520.    return $self;
  521. }
  522.  
  523.  
  524.  
  525. =begin ForInternalUseOnly =head1 C<_RelPath>
  526.  
  527. Takes 2 absolute paths ( C<$file,$base>).
  528. Returns a absolutely relative path from C<$base> to C<$file>
  529.  
  530. =end ForInternalUseOnly
  531.  
  532. =cut
  533.  
  534.  
  535. sub _RelPath {
  536.    goto &_RelPathForNewerFileSpec if File::Spec->VERSION >= 0.84;
  537.    goto &_RelPathForOlderFileSpec ;
  538. }
  539.  
  540. sub _RelPathForNewerFileSpec {
  541.    my($self, $file, $base ) = @_;
  542.    return abs2rel($file,$base);
  543. }
  544.  
  545. sub _RelPathForOlderFileSpec {
  546.    my($self, $file, $base ) = @_;
  547.    return abs2rel(
  548.        catdir( (splitpath $file )[1,2] ),
  549.        $base
  550.    );
  551. }
  552.  
  553.  
  554. # idea care of ActivePerl::DocTools::TOC
  555. # this crap be maintained manually (i'll fix this);
  556. use vars qw( @PodOrdering );
  557. @PodOrdering = qw(
  558.            perl perlintro perlfaq perltoc perlbook
  559.                    __
  560.            perlsyn perldata perlop perlsub perlfunc perlreftut perldsc
  561.            perlrequick perlpod perlpodspec perlstyle perltrap
  562.                    __
  563.            perlrun perldiag perllexwarn perldebtut perldebug
  564.                    __
  565.            perlvar perllol perlopentut perlretut perlpacktut
  566.                    __
  567.            perlre perlref
  568.                    __
  569.            perlform
  570.                    __
  571.            perlboot perltoot perltootc perlobj perlbot perltie
  572.                    __
  573.            perlipc perlfork perlnumber perlthrtut perlothrtut
  574.                    __
  575.            perlport  perllocale perluniintro perlunicode perlebcdic
  576.                    __
  577.            perlsec
  578.                    __
  579.            perlmod perlmodlib perlmodinstall perlmodstyle perlnewmod
  580.                    __
  581.            perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5
  582.            perlfaq6 perlfaq7 perlfaq8 perlfaq9
  583.                    __
  584.            perlcompile
  585.                    __
  586.            perlembed perldebguts perlxstut perlxs perlclib
  587.            perlguts perlcall perlutil perlfilter
  588.            perldbmfilter perlapi perlintern perlapio perliol
  589.            perltodo perlhack
  590.            __
  591.            perlhist perldelta
  592.            perl572delta perl571delta perl570delta perl561delta
  593.            perl56delta  perl5005delta perl5004delta
  594.            __
  595.            perlapollo perlaix perlamiga perlbeos perlbs2000
  596.            perlce perlcygwin perldos perlepoc perlfreebsd
  597.            perlhpux perlhurd perlirix perlmachten perlmacos
  598.            perlmint perlmpeix perlnetware perlplan9 perlos2
  599.            perlos390 perlqnx perlsolaris perltru64 perluts
  600.            perlvmesa perlvms perlvos perlwin32
  601.        );
  602.  
  603.  
  604. =head1 Subclassing
  605.  
  606. If you wish to change the way the MasterTOC looks,
  607. subclass C<Pod::Master> and override the following  methods.
  608.  
  609. =head3 C<Header>
  610.  
  611. B<Returns> a header ( in this case html).
  612.  
  613. Takes 1 argument, which defaults to L<C<$$self{boiler}>|"new">.
  614. If it's true, and you are using ActivePerl
  615. ( C<$Config{cf_by} eq 'ActiveState'> ),
  616. then the standard boiler from the ActivePerl documentation
  617. will be printed as well (links to the ActivePerl FAQ and stuff).
  618.  
  619. This is all asuming you have C<ActivePerl::DocTools> installed.
  620.  
  621. =cut
  622.  
  623. sub Header {
  624.    my( $self, $boiler) = @_;
  625.    $boiler ||= $self->{boiler};
  626.  
  627.    my $ret = q[
  628. <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
  629. <html>
  630. <head>
  631. <title>Perl User Guide - Table of Contents (according to
  632. Pod::Master)</title>
  633. <link rel="STYLESHEET" href="Active.css" type="text/css">
  634. </head>
  635.  
  636. <body>
  637. <h1>Table of Contents</h1>
  638. <base target="PerlDoc">
  639. ];
  640.    $ret.= "<!-- generated ".scalar(gmtime())." by Pod::Master -->\n";
  641.  
  642.    if( $boiler
  643.        and
  644.        $Config{cf_by} eq 'ActiveState'
  645.        and eval q{require ActivePerl::DocTools::TOC::HTML} ){
  646.        $ret.= ActivePerl::DocTools::TOC::HTML->boiler_links()."</div>";
  647.    }
  648.  
  649.    return $ret;
  650. }
  651.  
  652.  
  653. =head3 C<PerlDoc>
  654.  
  655. B<Returns> the "Perl Core Documentation" part of the toc.
  656.  
  657. Uses C<@Pod::Master::PodOrdering> to do the neato topicalization
  658. of the core pod (inspired by ActivePerl::DocTools).
  659. Accounts for all the Pod::perl files released up to perl-5.8.0.
  660.  
  661.  
  662. =cut
  663.  
  664. sub PerlDoc {
  665.    my $self = shift;
  666.    my $OutDir = $self->{outdir};
  667.  
  668.    $self->_FindEmPods() unless exists $self->{PerlDoc};
  669.    my %PerlDoc = %{$self->{PerlDoc}};
  670.    my $ret = "<h4>Perl Core Documentation</h4>";
  671.  
  672.    for my $item(@PodOrdering) {
  673.        if($item eq "__") {
  674.            $ret .= "<br>";
  675.        }elsif( exists $PerlDoc{$item} ) {
  676.            my $OutFile = $self->_RelPath($PerlDoc{$item}, $InstallPrefix );
  677.            delete  $PerlDoc{$item};
  678.            $OutFile =~ s{\.([^\.]+)$}{.html};
  679.            $OutFile =~ y[\\][/];
  680.            $ret .= qq[<A href="$OutFile">$item</a><br>];
  681.        }
  682.    }
  683.  
  684.    $ret .= "<br>"; # In case we have unknown docs, but we shouldn't
  685.  
  686.    for my $item(keys %PerlDoc) {
  687.        my $OutFile = $self->_RelPath($PerlDoc{$item}, $InstallPrefix );
  688.        delete  $PerlDoc{$item};
  689.        $OutFile =~ s{\.([^\.]+)$}{.html};
  690.        $OutFile =~ y[\\][/];
  691.        $ret .= qq[<A href="$OutFile">$item</a><br>];
  692.    }
  693.  
  694.    return $ret;
  695. }
  696.  
  697. =head3 C<Scripts>
  698.  
  699. B<Returns> the "Perl Programs" part of the toc.
  700.  
  701. =cut
  702.  
  703. sub Scripts {
  704.    my $self = shift;
  705.    my $OutDir = $self->{outdir};
  706.  
  707.    $self->_FindEmPods() unless exists $self->{Scripts};
  708.  
  709.    my $ret = "<h4>Perl Programs</h4>";
  710.  
  711.    for my $item(sort{lc($a)cmp lc($b)}keys %{$self->{Scripts}}) {
  712.        my $OutFile = $self->_RelPath( $self->{Scripts}->{$item},
  713. $InstallPrefix);
  714.        $OutFile =~ s{\.([^\.]+)$}{.html};
  715.        $OutFile =~ y[\\][/]; # fsck MOZILLA HAS ISSUES WITH THIS (MORONS)
  716.        $ret .= qq[<A href="$OutFile">$item</a><br>];
  717.    }
  718.  
  719.    return $ret;
  720. }
  721.  
  722. =head3 C<Pragmas>
  723.  
  724. B<Returns> the "Pragmas" part of the toc.
  725.  
  726. =cut
  727.  
  728. sub Pragmas {
  729.    my $self = shift;
  730.    my $OutDir = $self->{outdir};
  731.  
  732.    my $ret = "<h4>Pragmas</h4>";
  733.    for my $item(sort{lc($a)cmp lc($b)}keys %{$self->{Pragmas}}) {
  734.        my $OutFile = $self->_RelPath( $self->{Pragmas}->{$item},
  735. $InstallPrefix);
  736.        $OutFile =~ s{\.([^\.]+)$}{.html};
  737.        $OutFile =~ y[\\][/];
  738.        $ret .= qq[<A href="$OutFile">$item</a><br>];
  739.    }
  740.  
  741.    return $ret;
  742. }
  743.  
  744. sub pod2html {
  745.    my($self, @args ) = @_;
  746.    print join"\n","\n",@args,"\n" if $self->{verbose};
  747.    Pod::Html::pod2html(@args);    
  748. }
  749.  
  750. =head3 C<Modules>
  751.  
  752. B<Returns> the I<oh-so-pretty> "Installed Modules" part of the toc,
  753. that looks something like
  754. (note the links won't work, and you'll need a css capable browser):
  755.  
  756. =begin html
  757.  
  758. <blockquote> <!-- blockquote not really here -->
  759. <style type="text/css">
  760.  
  761. .blend {
  762.    color: #FFFFFF;
  763.    text-decoration: underline;
  764. }
  765.  
  766. </style>
  767.  
  768. <h4>Installed Modules</h4>
  769.  <A href="site/lib/Apache.html">Apache</a><br>
  770.  <span class="blend">Apache</span><a
  771. href="site/lib/Apache/AuthDBI.html">::AuthDBI</a><br>
  772.  <span class="blend">Apache</span><a
  773. href="site/lib/Apache/Build.html">::Build</a><br>
  774.  <span class="blend">Apache</span><a
  775. href="site/lib/Apache/Constants.html">::Constants</a><br>
  776.  <span class="blend">Apache</span><a
  777. href="site/lib/Apache/CVS.html">::CVS</a><br>
  778.  
  779.  <A href="site/lib/Bundle/Apache.html">Bundle::Apache</a><br>
  780.  <span class="blend">Bundle</span><a
  781. href="site/lib/Bundle/ApacheTest.html">::ApacheTest</a><br> <A
  782. href="site/lib/Bundle/DBD/mysql.html">Bundle::DBD::mysql</a><br>
  783.  <span class="blend">Bundle</span><a
  784. href="site/lib/Bundle/DBI.html">::DBI</a><br>
  785.  <span class="blend">Bundle</span><a
  786. href="site/lib/Bundle/LWP.html">::LWP</a><br>
  787.  <span class="blend">DBD</span><a
  788. href="site/lib/DBD/Proxy.html">::Proxy</a><br> <A
  789. href="site/lib/DBI.html">DBI</a><br>
  790.  <span class="blend">DBI</span><a
  791. href="site/lib/DBI/Changes.html">::Changes</a><br>
  792.  <A
  793. href="site/lib/DBI/Const/GetInfo/ANSI.html">DBI::Const::GetInfo::ANSI</a><br>
  794.  <span class="blend">DBI::Const::GetInfo</span><a
  795. href="site/lib/DBI/Const/GetInfo/ODBC.html">::ODBC</a><br>
  796.  <A
  797. href="site/lib/DBI/Const/GetInfoReturn.html">DBI::Const::GetInfoReturn</a><br>
  798.  <span class="blend">DBI::Const</span><a
  799. href="site/lib/DBI/Const/GetInfoType.html">::GetInfoType</a><br>
  800.  <span class="blend">DBI</span><a
  801. href="site/lib/DBI/DBD.html">::DBD</a><br>
  802.  <span class="blend">DBI</span><a
  803. href="site/lib/DBI/FAQ.html">::FAQ</a><br>
  804.  
  805. </blockquote>
  806.  
  807. =end html
  808.  
  809. In the above example,
  810. you can now search for 'Bundle::DBI' and find it.
  811.  
  812. You can also search for 'E<32>DBI' (note the space prefix) and find it.
  813.  
  814. If you only search for 'DBI', you'll find
  815. 'Apache::AuthDBI' followed by
  816. 'Bundle::DBI' until you get to DBI.
  817.  
  818. Don't you just love Pod::Master ?
  819.  
  820. =cut
  821.  
  822.  
  823. sub Modules {
  824.    my $self = shift;
  825.    my $ret = "<h4>Installed Modules</h4>";
  826.    my %seen = ();
  827.    $self->_FindEmPods() unless exists $self->{Modules};
  828.    my %Modules = %{$self->{Modules}};
  829.  
  830.    for my $key(keys %Modules) {
  831.        my @chunks = split /::/, $key;
  832.        my $chunk = shift@chunks;
  833.        $seen{$chunk}=1;
  834.        while(@chunks){
  835.            $chunk.= '::'.shift @chunks;
  836.            $seen{$chunk}=1;
  837.        }
  838.        $seen{$key}=1;
  839.    }
  840.  
  841.    for my $key(keys %seen) {
  842.        unless(exists $Modules{$key} ) {
  843.            $Modules{$key} = undef;
  844.        }
  845.    }
  846.  
  847. #    printf("%-70.70s = %-5.5s\n",$_,$Modules{$_}) for(sort{lc($a)cmp lc($b)} keys %Modules);die;
  848.  
  849.    my($oldLetter, $newLetter ) = ('a','a');
  850.    my($oldD,$newD) = (0,0);
  851.  
  852.    for my $modulename(sort{lc($a)cmp lc($b)}keys %seen) {
  853.        my $OutFile = $self->_RelPath( $Modules{$modulename}, $InstallPrefix);
  854.        $OutFile =~ s{\.([^\.]+)$}{.html};
  855.        $OutFile =~ y[\\][/];
  856.  
  857.        $oldLetter = $newLetter;
  858.        $newLetter = lc substr $modulename, 0, 1;
  859.        if($oldLetter ne $newLetter ) {
  860.            $ret.=qq[\n <hr>\n];
  861.        }
  862.  
  863. =for NoUse
  864.        $oldD = $newD;
  865.        $newD = () = $modulename =~ /::/g;
  866.  
  867.        $ret.=' <br>' if $newD == 0 and 0 != $oldD;
  868.  
  869. =cut
  870.  
  871.        if( not defined $Modules{$modulename}) {
  872.            if( $modulename =~ /^(.*?)::([^:]+)$/ ) {
  873.                $ret .= qq[
  874.  <span class="blend">$1</span>::$2<br>
  875. ];
  876.            } else {
  877.                $ret .= qq[
  878.  $modulename<br>
  879. ];  
  880.            }
  881.        }elsif( $modulename =~ /^(.*?)::([^:]+)$/ ) {
  882.            $ret .= qq[
  883.  <span class="blend">$1</span><a href="$OutFile">::$2</a><br>
  884. ];
  885.        } else {
  886.            $ret .= qq[
  887.  <A href="$OutFile">$modulename</a><br>
  888. ];
  889.        }
  890.    }
  891.  
  892.    return $ret;
  893. }
  894.  
  895.  
  896. sub ModulesOriginal {
  897.    my $self = shift;
  898.    my $ret = "<h4>Installed Modules</h4>";
  899.    my %seen = ();
  900.    for my $modulename(sort{lc($a)cmp lc($b)}keys %{$self->{Modules}}) {
  901.        my $OutFile = $self->_RelPath( $self->{Modules}->{$modulename}, $InstallPrefix);
  902.        $OutFile =~ s{\.([^\.]+)$}{.html};
  903.        $OutFile =~ y[\\][/];
  904.  
  905.        if( $modulename =~ /^(.*?)::([^:]+)$/ and $seen{$1}) { #
  906. $modulename =~ /::/ and
  907.            $ret .= qq[
  908.  <span class="blend">$1</span><a href="$OutFile">::$2</a><br>
  909. ];
  910.        } else {
  911.            $seen{$1}++ if $1; # wasn't seen, so we sees it now
  912.            $ret .= qq[
  913.  <A href="$OutFile">$modulename</a><br>
  914. ];
  915.        }
  916.        $seen{$modulename}++; # of course we gots to see the module
  917.    }
  918.  
  919.    return $ret;
  920. }
  921.  
  922.  
  923. =head3 C<Footer>
  924.  
  925. B<Returns> a footer ( in this case, closing body and html tags )
  926.  
  927. =cut
  928.  
  929. sub Footer {q[
  930. </body></html>
  931. ];
  932. }
  933.  
  934.  
  935. =head1 BUGS
  936.  
  937. C<Pod::Find> version 0.22 is buggy.
  938. It will not find files in C<perl -V:scriptdir>.
  939. I've sent in a patch, but maybe I ought to distribute a copy.
  940.  
  941. If you run L<Pod::Checker|Pod::Checker> on this document,
  942. you may get a few warnings like:
  943.  
  944.    *** WARNING: line containing nothing but whitespace
  945.  
  946. The L<SYNOPSIS|"SYNOPSIS"> generates these, but don't it look pretty
  947. (I think a single code block is better than 3, for a single example).
  948.  
  949. =head1 AUTHOR
  950.  
  951. D.H. <podmaster@cpan.org>
  952.  
  953. =head1 LICENSE
  954.  
  955. copyright (c) D.H. 2002
  956. All rights reserved.
  957.  
  958. This program is released under the same terms as perl itself.
  959. If you don't know what that means, visit http://perl.com
  960. or execute C<perl -v> at a commandline (assuming you have perl installed).
  961.  
  962. =cut
  963.  
  964.  
  965. $MasterCSS = <<'MASTERCSS';
  966.  
  967. /* for the MasterTOC modules list */
  968. .blend {
  969.    color: #FFFFFF;
  970.    text-decoration: underline;
  971. }
  972.  
  973. /* standard elements */
  974. body {
  975.    background: #FFFFFF;
  976.    font-family: Verdana, Arial, Helvetica, sans-serif;
  977.    font-weight: normal;
  978.    font-size: 70%;
  979. }
  980.    
  981. td {
  982.    font-size: 70%;
  983.    font-family: Verdana, Arial, Helvetica, sans-serif;
  984.    font-weight: normal;
  985.    text-decoration: none;
  986. }
  987.  
  988. input {
  989.    font-size: 12px;
  990. }
  991.  
  992. select {
  993.    font-size: 12px;
  994. }
  995.  
  996. p {
  997.    color: #000000;
  998.    font-family: Verdana, Arial, Helvetica, sans-serif;
  999.    font-weight: normal;
  1000.    padding-left: 1em;
  1001. }
  1002.  
  1003. p.code {
  1004.    padding-left: .1em;
  1005. }
  1006.  
  1007. .likepre {
  1008.    font-size: 120%;
  1009.    border: 1px groove #006000;
  1010.    background: #EEFFCC;
  1011.    padding-top: 1em;
  1012.    padding-bottom: 1em;
  1013.    white-space: pre;
  1014. }
  1015.  
  1016. blockquote {
  1017.    color: #000000;
  1018.    font-family: Verdana, Arial, Helvetica, sans-serif;
  1019.    font-weight: normal;
  1020. }
  1021.  
  1022. dl {
  1023.    color: #000000;
  1024.    font-family: Verdana, Arial, Helvetica, sans-serif;
  1025.    font-weight: normal;
  1026. }
  1027.  
  1028. dt {
  1029.    color: #000000;
  1030.    font-family: Verdana, Arial, Helvetica, sans-serif;
  1031.    font-weight: normal;
  1032.    padding-left: 2em;
  1033. }
  1034.  
  1035. ul {
  1036.    color: #000000;
  1037.    font-family: Verdana, Arial, Helvetica, sans-serif;
  1038.    font-weight: normal;
  1039. }
  1040.  
  1041. li {
  1042.    font-size: 110%;
  1043. }
  1044.  
  1045.  
  1046. ol {
  1047.    color: #000000;
  1048.    font-family: Verdana, Arial, Helvetica, sans-serif;
  1049.    font-weight: normal;
  1050. }
  1051.  
  1052. h1 {
  1053.    font-family: Verdana, Arial, Helvetica, sans-serif;
  1054.    font-size: 18px;
  1055.    font-weight: bold;
  1056.    color: #DC143C;
  1057. /*
  1058.    color: #19881D;
  1059. */
  1060. }
  1061.  
  1062. h2 {
  1063.    font-family: Verdana, Arial, Helvetica, sans-serif;
  1064.    font-size: 13px;
  1065.    font-weight: bold;
  1066.    color: #DC143C;
  1067. /*
  1068.    background-color: #EAE2BB;
  1069.    background-color: #EEE8AE;
  1070. */
  1071. }
  1072.  
  1073. h3 {
  1074.    font-family: Verdana, Arial, Helvetica, sans-serif;
  1075.    font-size: 12px;
  1076.    font-weight: bold;
  1077.    color: #DC143C;
  1078.    border-left: 0.2em solid darkGreen;
  1079.    padding-left: 0.5em;
  1080. }        
  1081.  
  1082. h4 {
  1083.    font-family: Verdana, Arial, Helvetica, sans-serif;
  1084.    font-size: 11px;
  1085.    font-weight: bold;
  1086.    color: #DC143C;
  1087.    background: #ffffff;
  1088.    border: 1px groove black;
  1089.    padding: 2px, 0px, 2px, 1em;
  1090. }    
  1091.  
  1092. pre {
  1093.    font-size: 120%;
  1094. /*    background: #EEFFCC;
  1095.    background: #CCFFD9;
  1096. */
  1097.    border: 1px groove #006000;
  1098.    background: #FFDAB9;
  1099.    padding-top: 1em;
  1100.    padding-bottom: 1em;
  1101.    white-space: pre;
  1102. }
  1103.  
  1104. hr {
  1105.    border: 1px solid #006000;
  1106. }
  1107.  
  1108. tt {
  1109.    font-size: 120%;
  1110. }
  1111.  
  1112. code {
  1113.    font-size: 120%;
  1114.    background: #90EE90;
  1115.    border: 0px solid black;
  1116.    padding: 0px, 4px, 0px, 4px;
  1117. }
  1118.  
  1119. kbd {
  1120.    font-size: 120%;
  1121. }
  1122.  
  1123. /* default links */
  1124.  
  1125. a:link {
  1126. /*
  1127.    color: #B82619;
  1128. */
  1129.    color: #0000CD;
  1130.    text-decoration: underline;
  1131. }
  1132.  
  1133. a:visited {
  1134. /*
  1135.    color: #80764F;
  1136. */
  1137.    color: #8B4513;
  1138.    text-decoration: underline;
  1139. }
  1140.  
  1141. a:hover {
  1142.    color: #000000;
  1143.    text-decoration: underline;
  1144. }
  1145.  
  1146. a:active {
  1147. /*
  1148.    color: #B82619;
  1149. */
  1150.    color: #00525C;
  1151.    text-decoration: underline;
  1152.    /* font-weight: bold; */
  1153. }
  1154.  
  1155. /* crap */
  1156. td.block {
  1157.    font-size: 10pt;
  1158. /*
  1159.    background: #EAE2BB;
  1160.    background: #4EBF51;
  1161.    background: #97EB97;
  1162.    background: #D3FF8C;
  1163.    background: #AED9B1;
  1164.    background: #AEFFB1;
  1165.    background: #BBEAC8;
  1166.    background: #94B819;
  1167. */
  1168.    background: #FFA500;
  1169.    color: #000080;
  1170.    border: 1px dotted #006000;
  1171.    font-weight: bold;
  1172. }  
  1173.  
  1174. MASTERCSS
  1175.  
  1176. sub _Frame {
  1177.    my($self, $toc ) = @_;
  1178.    $toc ||= 'podmaster.toc.html';
  1179.  
  1180.    my $Initial = $self->{PerlDoc}{perl};
  1181. #    my $Initial = catdir $self->{outdir},  $self->_RelPath( $Initial, $InstallPrefix );
  1182.       $Initial = $self->_RelPath( $Initial, $InstallPrefix );
  1183.       $Initial =~ s{\.([^\.]+)$}{.html};
  1184.       $Initial =~ y[\\][/];
  1185.  
  1186.    return qq[
  1187. <HTML>
  1188.  
  1189. <HEAD>
  1190. <title>Perl User Guide (according to Pod::Master)</title>
  1191. </HEAD>
  1192.  
  1193. <FRAMESET cols="320,*">
  1194.  <FRAME name="TOC" src="$toc" target="PerlDoc">
  1195.  <FRAME name="PerlDoc" src="$Initial">
  1196.  <NOFRAMES>
  1197.  <H1>Sorry!</H1>
  1198.  <H3>This page must be viewed by a browser that is capable of viewing
  1199. frames.</H3>
  1200.  </NOFRAMES>
  1201. </FRAMESET>
  1202. <FRAMESET>
  1203. </FRAMESET>
  1204.  
  1205. </HTML>];
  1206.  
  1207. }
  1208.  
  1209. 1; # just in case i screwed up
  1210.