#!/tools/contrib/bin/perl -w

use HTML::Parser;
use File::Basename;
use CGI qw(:standard :html3);
use CGI::Carp;
use Tie::IxHash;
use lib qw(lib);
use CCwwwutil;

($filename, $levels) = (0 , 3);
if (defined(param('file'))) {
    $filename = param('file');
    $levels = param('depth') if defined(param('depth'));
} else {
    $filename = shift;
}
$doc = rootify("cgi-bin/1/na.html");
usage() unless $filename;
%seen = ();
%tree = ();
@errors = ();
%buf = (); tie %buf, "Tie::IxHash";
%footer = (); tie %footer, "Tie::IxHash";
$link = 0;

$treeRef = \%tree;
$filename = rootify($filename);
parse_rec($filename);

$treeRef = \%{$tree{$filename}{"tree"}};
$title = $tree{$filename}{"title"} ?
    $tree{$filename}{"title"} : basename($filename);
print header(), "\n", start_html($title), "\n",
    h1(a({href=>$filename}, $tree{$filename}{"title"} ?
	 $tree{$filename}{"title"} : "Map")), "\n";
print h2("Errors"), "\n", ul(li(@errors)), "\n", br(), "\n" if @errors;
write_list("");
write_footer();

sub write_footer() {
    print hr(), "\n";
    my ($k, $v, @a) = ();
    while (($k, $v) = each(%footer)) {
	push @a, a({href=>$k}, $v);
    }
    print join(", ", @a), "\n", br(),
    "This page is generated: ", a({href=>$doc}, "documentation"),
    "\n", end_html(), "\n";
}

sub write_list($) {
    my $prefix = shift;
    my @fn = keys %$treeRef;
    if (@fn) {
	print "$prefix<ul>\n";
	foreach (@fn) {
	    $px = $prefix . "  ";
	    print "$px<li><a href=\"$_\">", $$treeRef{$_}{"title"} ?
		$$treeRef{$_}{"title"} : $$treeRef{$_}{"text"}, "</a>\n";
	    {
		local $treeRef = \%{$$treeRef{$_}{"tree"}};
		write_list($px . "  ");
	    }
	}
	print "$prefix</ul>\n";
    }
}

sub parse_rec($) {
    my ($filename) = shift;
    local $dir = dirname($filename);
    local $parentRef = \%{$$treeRef{$filename}};
    local $treeRef = \%{$$treeRef{$filename}{"tree"}};
    tie %$treeRef, "Tie::IxHash";
    local $levels = $levels - 1;
    $seen{$filename}++;
    my $p = HTML::Parser->new(api_version => 3);
    $p->handler(start => \&title_start_handler, "self,tagname");
    $p->report_tags("title");
    $p->parse_file(viewify($filename)) || push @errors, "$!: $filename\n";
    my ($k, $v) = ();
    while (($k, $v) = each(%buf)) {
	$footer{$k} = $v;
    }
    %buf = ();
    if ($levels) {
	my $f = 0;
	foreach $f (keys %$treeRef) { parse_rec($f); }
    }
}

sub title_start_handler {
    my($self, $tag) = @_;
    return unless $tag eq "title";

    $self->handler(text  => [], '@{dtext}' );
    $self->handler(end   => \&title_end_handler, "self,tagname");
}

sub title_end_handler {
    my($self, $tag) = @_;
    my $text = join("", @{$self->handler("text")});
    $text =~ s/^\s+//;
    $text =~ s/\s+$//;
    $text =~ s/\s+/ /g;
    $$parentRef{"title"} = $text;

    $self->report_tags("body");
    $self->handler("text", undef);
    $self->handler("start", \&body_start_handler, "self,tagname");
    $self->handler("end", undef);
}

sub body_start_handler {
    my($self, $tag) = @_;
    return unless $tag eq "body";
    $self->handler("start", \&hr_a_start_handler, "self,tagname,attr");
    $self->report_tags(qw(a hr));
}

sub hr_a_start_handler {
    my($self, $tag, $attr) = @_;
    return unless ($tag eq "a") or ($tag eq "hr");
    if ($tag eq "hr") {
	my ($k, $v) = ();
	while (($k, $v) = each(%buf)) {
	    $$treeRef{$k}{"text"} = $v;
	}
	%buf = ();
	return;
    }
    return unless exists $attr->{href};
    my $fn = $attr->{href};
    return if $fn =~ /[:\?]/;
    $fn =~ s/\#.*$//;
    return unless $fn =~ /\.html?$/;
    $fn = normalize($dir . '/' . $fn) unless $fn =~ /^\//;
    if ($seen{$fn}++) {
	if ($footer{$fn}) { delete($footer{$fn}); }
	else              { return; }
    }
    $link = $fn;

    $self->handler(text  => [], '@{dtext}' );
    $self->handler(end   => \&a_end_handler, "self,tagname");
}

sub a_end_handler {
    my($self, $tag) = @_;
    my $text = join("", @{$self->handler("text")});
    $text =~ s/^\s+//;
    $text =~ s/\s+$//;
    $text =~ s/\s+/ /g;
    $buf{$link} = $text;

    $self->handler("text", undef);
    $self->handler("end", undef);
}

sub usage() {
    print header(), "\n", start_html(basename($0)), "\n", h1("Usage"), "\n",
      p("Some parameters expected:", a({href=>$doc}, "documentation")),
      "\n", end_html(), "\n";
    exit 0;
}