File Coverage

lib/Pod/HtmlTree.pm

Criterion	Covered	Total	%
statement	110	123	89.4
branch	17	30	56.6
condition	5	8	62.5
subroutine	19	20	95.0
pod	2	7	28.5
total	153	188	81.3

############################################################
package Pod::HtmlTree;
############################################################
use strict;
use warnings;

use Exporter;
use Pod::Html;
use Text::Wrap;
use File::Find;
use File::Spec;
use File::Basename;
use File::Path;
use Pod::Html;
use Cwd;
use File::Temp qw(tempfile);

our $VERSION     = '0.97';

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
our @EXPORT_OK   = ( @{ $EXPORT_TAGS{'all'} },
                     qw(pms modules
                        pod2htmltree banner
                       ) );
our @EXPORT      = qw( );

my $HTML_DIR      = "docs/html";
my $BASE          = cwd();
my @SEARCH_DIRS   = qw(. lib);
my $SEARCH_DIRS_PATTERN = join('|', map { "^" . quotemeta($_) } @SEARCH_DIRS);

############################################################
# Get a list of all *.pm files in the specified directory
# and recursively in its subdirectories. Prune the find
# tree in the given dirs.
############################################################
sub pms {
############################################################
    my($start_dir, $prune_dirs) = @_;

        # Default if no prune_dirs are given
    $prune_dirs ||= ['blib', 'docs'];

    my @pms = ();

    File::Find::find( sub {

        if(-d $_) {
            for my $dir (@$prune_dirs) {
                if($_ eq $dir) {
                    $File::Find::prune = 1;
                    return;
                }
            }
        }

        return if ! -f or ! (/\.pm$/ || /\.pod$/);

        (my $path = $File::Find::name) =~ s#^./##;

        push @pms, $path;
    }, $start_dir );

    return @pms;
}

############################################################
# Get a list of all modules (pm files) in the tree.
############################################################
sub modules {
############################################################
    my($start_dir, $prune_dirs) = @_;

    my @pms = paths_to_modules(pms($start_dir, $prune_dirs));

    return @pms;
}

############################################################
# Format something in form of a banner
############################################################
sub banner {
############################################################

    my $TOTAL_LEN = 50;

    my $out = "*" x $TOTAL_LEN;
    $out .= "\n";
    $Text::Wrap::columns = $TOTAL_LEN - 2;
    for my $line (split /\n/, Text::Wrap::fill('* ','* ', @_)) {
        chomp $line;
        if(length($line) < $TOTAL_LEN - 2) {
            $line .= (" " x ($TOTAL_LEN - 2 - length($line))) . " *\n";
        }
        $out .= $line;
    }
    $out .= "*" x $TOTAL_LEN;
    $out .= "\n";

    return $out;
}

############################################################
sub paths_to_modules {
############################################################
    my(@paths) = @_;

    my @modules = map { s#$SEARCH_DIRS_PATTERN##o;
                        s#^/##;
                        s#/#::#g;
                        s#\.pm##;
                        s#\.pod##;
                        $_;
                      } @paths;

    # Remove double entries (e.g. If a module consists of a .pm
    # and a .pod file)
    @modules = do { my %myhash; @myhash{@modules} = (); keys %myhash};

    return @modules;
}

############################################################
# Set up the doc tree
############################################################
sub pod2htmltree {
############################################################
    my($htmlroot_to_module, $htmldocdir) = @_;

    $htmldocdir = $HTML_DIR unless defined $htmldocdir;

    my ($fh,$tmpfile) = tempfile();
    close $fh;

    my @dirs    = pms(".");
    my @modules = modules(".");

    my $see_also = "=head1 SEE ALSO\n\n";
    $see_also .= join ', ', map( { "L<$_|$_>" } @modules );
    $see_also .= "\n\n";
    $see_also .= "B _SRC_HERE_\n\n";

    mkpath $htmldocdir unless -d $htmldocdir;

    for my $pm (@dirs) {
        (my $module) = paths_to_modules($pm);
        (my $relpath = $pm) =~ s#$SEARCH_DIRS_PATTERN##o;
        my $htmlfile = File::Spec->catfile($htmldocdir, $relpath);
        $htmlfile =~ s/\.pm$/\.html/;
        $htmlfile =~ s/\.pod$/\.html/;

        my $dir     = dirname($htmlfile);

        mkpath($dir) unless -d $dir;

        open FILE, "<$pm" or die "Cannot open $pm";
        my $data = join '', ;
        close FILE;

        $data =~ s/^=head1 SEE ALSO.*?(?=^=)/$see_also/ms;

        open FILE, ">$tmpfile" or die "Cannot open $tmpfile";
        print FILE $data;
        close FILE;

        my $podroot = (-d "lib" ? "lib" : ".");

        pod2html("--infile=$tmpfile",
                 "--outfile=$htmlfile",
                 "--podroot=$podroot",
                 "--podpath=.",
                 '--recurse',
                 "--htmlroot=$htmlroot_to_module/$htmldocdir",
                 "--css=$htmlroot_to_module/$htmldocdir/default.css",
        );

        # Patch src link
        open FILE, "<$htmlfile" or die "Cannot open $htmlfile";
        $data = join '', ;
        close FILE;
        open FILE, ">$htmlfile" or die "Cannot open $htmlfile";
            # If it's a separate pod, link to the .pm
        $pm =~ s/\.pod$/.pm/;
        if(-f $pm) {
          $data =~ s#_SRC_HERE_#$module#g;
        } else {
          $data =~ s#_SRC_HERE_##g;
        }
        print FILE $data;
        close FILE;
    }

    #unlink $tmpfile;
    stylesheet_write(File::Spec->catfile($htmldocdir, "default.css"));
}

############################################################
sub stylesheet_write {
############################################################
    my($dstfile, $csstext) = @_;

    $csstext = stylesheet_default() unless defined $csstext;

    open FILE, ">$dstfile" or die "Cannot open $dstfile";
    print FILE $csstext;
    close FILE;
}

############################################################
# Default style sheet
############################################################
sub stylesheet_default {
############################################################
    return <
body {
    background:  #FFFFFF;
    font-family: Arial;
}
input {
    font-size: 12px;
}
select {
    font-size: 12px;
}
tt {
    font-family: Lucida Console;
    font-size: 10px;
}
pre {
    font-family: Lucida Console;
    font-size: 12px;
}
code {
    font-family: Lucida Console;
    font-size: 12px;
}
p {
    color: #000000;
    font-size: 12px;
    font-family: Arial;
    }
blockquote {
    color: #000000;
    font-size: 12px;
    font-family: Arial;
    font-weight: normal;
}
b {
    font-weight: bold;
}

h1 {
    font-family: Arial;
    font-size: 16px;
    font-weight: bold;
    color: #B82831;
}
h2 {
    font-family: Arial;
    font-size: 14px;
    font-weight: bold;
    color: #B82831;
}
a:link {
	color: #B82831;
        text-decoration: underline;
}
a:visited {
	color: #80933F;
        text-decoration: underline;
}
EOT
}

1;

__END__