#!perl
#
# document.pl
#
#   Process .pod and .pm files to create an HTML documentation tree.
#

=head1 NAME

document.pl

=head1 SYNOPSIS

Find all documentation and generate HTML pages for it in a new
sub-directory.  Usage:

    perl document.pl

=head1 DESCRIPTION

Find all files in the current directory and all sub-directories
with POD markup and process them to generate HTML output files.
Place the output files in a sub-directory named 'html' and create
a table of contents HTML file with hyperlinks to the generated files.
Create a frame-based index HTML file also, with the table of contents
in the left frame and selected documents in the right frame.

=cut

use     DirHandle;
use     Pod::Html;

$suffix = '.html';
$target = 'html';

###########################################################################
sub check   # $path
# Check for directories containing pod files.
#   Determine pod files by looking for pod in each file (!).
#   Create recursive array reference structure and path list.
#
    {
    my  $path = shift;
    my  $src  = $path ? $path : '.';
    my  $dir  = new DirHandle $src;
    my  $wrk  = [ ];
    
    warn "Unable to open directory:\n  $src\nfor reading:\n  $!\n",
    return
        unless defined $dir;
    
    while (defined($_ = $dir->read))
        {
        next if /^\./
             || /^blib/
             || /\.bak$/
             || /\.dll$/
             || /\.obj$/
             || /\.exe$/;
        
        my  $entity = $path ? "$path/$_" : $_;
        
        next if $entity eq $target;
        
        if (-d $entity)
            {
            # Found sub-directory, process in turn:
            my  $subwrk = check($entity);
            
            push @$wrk, $subwrk
                if @$subwrk;
            
            next;
            }
        
        # Must be file, check to see if it has POD in it:
        my  $pod = undef;
        
        open FILE, "<$entity"
            or warn($indent, "Unable to open file:\n$indent  $entity\n${indent}because:\n$indent  $!\n"),
               next;
        
        while (<FILE>)
            {
            next unless /^=(cut|head|item)/i;
            $pod = 1;
            last;
            }
        
        close FILE;
        
        push @$wrk, $entity
            if $pod;
        }

    $dir->close;
    undef $dir;
    
    if (@$wrk)
        {
        $paths = $paths ? "$paths:$src" : $src
            if grep { ! ref } @$wrk;
        
        unshift(@$wrk, $src);
        
        return $wrk;
        }
    
    undef
    }

###########################################################################
sub process # $work, $indent;
# From recursive array reference structure do all actual work.
#
    {
    my ($work, $indent) = @_;
    my  $dir = shift @$work;
    my  @dir = split('/', $dir);
    my  $lst = $dir[$#dir];

    unless ($lst eq '.')
        {
        print TOC "$indent<strong>$lst</strong><br>\n";
        $indent .= "&nbsp;&nbsp;";
        }
   
    # Make sure our output directory exists:
    $dir = "$target/$dir";
    
    warn("Unable to create directory:\n  $dir\nbecause:\n  $!\n"),
    last
        unless -d $dir || mkdir $dir;
    
    # Process entries for this directory:
    for my $entry (sort sorter @$work)
        {
        if (ref $entry)
            {
            # Subdirectory to process:
            process($entry, $indent);
            next;
            }
        
        # Generate the doc file:
        my  $dest = $entry;
        my  @file = split('/', $entry);
        my  $last = $file[$#file];
        
        $dest  =~ s|(\.[^/]*)$||;
        $dest .=  $suffix;
        
        print TOC "$indent<a href='$dest'>$last</a><br>\n";
        
        $intro = $dest unless $intro || $last !~ m|^intro\.|;
        $ovrvw = $dest unless $ovrvw || $last !~ m|^overview\.|;
        
        pod2html($entry,
                 "--infile=$entry",
                 "--outfile=$target/$dest",
                 "--podpath=$paths",
                 "--htmldir=html",
                 "--podroot=.",
                 "--recurse",
                 "--header",
                 "--index")
        }
    }

###########################################################################
sub sorter  # $a $b
# Sort one level of recursive array reference structure.
#
    {
    return $a[0] cmp $b[0]  if     ref($a) && ref($b);
    return $a    cmp $b     unless ref($a) || ref($b);
    
    ref($a) ? 1 : -1
    }

###########################################################################
###########################################################################
#
#   Main program:
#

die "Unable to create directory:\n  $target\nbecause:\n  $!\n"
    unless -d $target
        || mkdir $target;

die "Unable to create table of contents because:\n  $!\n"
    unless open TOC, ">$target/TOC$suffix";

print TOC <<BEGIN_TOC;
<html>
<head>
  <title>Parrot Documentation index</title>
  <base target="doc">
</head>
<body>
  <h1>Parrot</h1>
BEGIN_TOC

process(check);

# process;
    
print TOC <<END_TOC;
</body>
</html>
END_TOC

close TOC;

$docsrc = $intro || $ovrvw;
$docsrc = "src='$docsrc'" if $docsrc;

die "Unable to create index file because:\n  $!\n"
    unless open FRAME, ">$target/index$suffix";

print FRAME <<FRAMES;
<html>
<head>
  <title>Parrot Documentation</title>
</head>

<frameset cols='30%,*'>
  <frame name=toc src='TOC$suffix'>
  <frame name=doc $docsrc>
  <noframes>
    We're sorry, but you don't have a frame-enabled browser.
    Please use the <a href='TOC$suffix'>Table of Contents</a> directly.
  </noframes>
</frameset>
</html>
FRAMES

close FRAME;

