package Apache::ModuleDoc;

use mod_perl 1.16;
use strict;

use File::Basename 'basename';
use Apache::Util qw(escape_html);
use Apache::Module ();
use Apache::Constants qw(:common :override :args_how :server);

$Apache::ModuleDoc::VERSION = '1.02';
my $ServerVersion;

sub handler {
    my $r = shift;
    $ServerVersion ||= version();

    return DECLINED if -r $r->finfo;

    my $module = basename $r->uri;
    return indexer($r) if $module eq "index";

    my $modp = Apache::Module->find($module);
    unless($modp) {
	$r->custom_response(NOT_FOUND, 
			    "$module not configured with this server");
	return DECLINED;
    } 

    $r->send_http_header("text/html");
    for my $cv (qw(header menu body footer)) {
	(\&$cv)->($r, $modp);
    }

    return OK;
}

sub indexer {
    my $r = shift;
    my $top_module = Apache::Module->top_module;
    $r->send_http_header("text/html");
    start_html("index");
    print "Configured modules for ", SERVER_VERSION, 
          " built on ", SERVER_BUILT;
    print "<ul>\n";
    for (my $modp = $top_module; $modp; $modp = $modp->next) {
	(my $name = $modp->name) =~ s/\.c$//;
	print qq(<li> <a href="./$name"> $name </a><p>);
    }
    print "</ul>\n";
    print "</body></html>";
}

my %AllowOverride = (
   AuthConfig => OR_AUTHCFG,
   Limit      => OR_LIMIT,
   Options    => OR_OPTIONS,
   FileInfo   => OR_FILEINFO,
   Indexes    => OR_INDEXES,
);

my %Syntax = (
   'RAW_ARGS'  => "Raw Text",
   'FLAG'      => "On|Off",
   'NO_ARGS'   => "",
   'TAKE1'     => "Arg1",
   'TAKE2'     => "Arg1 Arg2",
   'TAKE12'    => "Arg1 [Arg2]",
   'TAKE3'     => "Arg1 Arg2 Arg3",
   'TAKE23'    => "Arg1 Arg2 [Arg3]",
   'TAKE123'   => "Arg1 [Arg2 [Arg3]]",
   'ITERATE'   => "Arg1 x n",
   'ITERATE2'  => "Arg1 Arg2 x n",
);

my %PerlSyntax = (
   'RAW_ARGS'  => q[$var{$name} = {key => 'val', ...}],
   'FLAG'      => q{$var = 'On' || 'Off'},
   'NO_ARGS'   => q{$var = ''},
   'TAKE1'     => q{$var = $arg},
   'TAKE2'     => q{push @var, [$arg1 => $arg2]},
   'TAKE12'    => q{push @var, [$arg1 [,$arg2]]},
   'TAKE3'     => q{push @var, [$arg1, $arg2, $arg3]},
   'TAKE23'    => q{push @var, [$arg1, $arg2 [,$arg3]]},
   'TAKE123'   => q{push @var, [$arg1, [,$arg2 [,$arg3]]]},
   'ITERATE'   => q{push @var, $arg1},
   'ITERATE2'  => q{push @var, [$arg1 => $arg2]},	  
);

my %raw_as_hash = map {$_,1} qw(Location VirtualHost Directory Files Limit);
my %asis = map {$_,1} qw(=pod =cut __END__);
my %NA = map {$_,1} qw(<Perl>);

sub overrides {
    my($pm, $pc) = @_;
    my $n = 0;

    my $retval = "Allowed in *.conf ";
    my $override = "<i>Not applicable</i>";

    if (($pc->req_override & (OR_OPTIONS | OR_FILEINFO | OR_INDEXES)) ||
	(($pc->req_override & RSRC_CONF) &&
	 (($pc->req_override & (ACCESS_CONF | OR_AUTHCFG | OR_LIMIT))))) {
	$retval .= "anywhere";
    }
    elsif ($pc->req_override & RSRC_CONF) {
	$retval .= "only outside <Directory> or <Location>";
    }
    else {
	$retval .= "only inside <Directory> or <Location>";
    }

    if (($pc->req_override & (OR_ALL | ACCESS_CONF)) && 
	!$pm->create_dir_config) {
	$retval .= " [no per-dir config]";
    }

    if ($pc->req_override & OR_ALL) {
	$retval .= " and in .htaccess"; 
	
	if (($pc->req_override & OR_ALL) == OR_ALL) {
	    $override = "Any other than None";
	}
	else {
	    my @or = ();
	    for my $key (sort keys %AllowOverride) {
		push @or, $key if $pc->req_override & $AllowOverride{$key};
	    }
	    $override = join " or ", @or;
	}
    }
    return(escape_html($retval), $override);
}

sub start_html {
    my $name = shift;
    print <<EOF;
<HTML>
<HEAD><TITLE>Apache module $name</TITLE></HEAD>

<BODY 
 BGCOLOR="#FFFFFF" TEXT="#000000"
 LINK="#0000FF" VLINK="#000080" ALINK="#FF0000"
>
<!-- generated by Apache::ModuleDoc $Apache::ModuleDoc::VERSION -->
EOF
}

sub version {
    my($v) = SERVER_VERSION =~ m:Apache/(\S+):;
    $v;
}

sub header {
    my($r, $modp) = @_;
    my $name = $modp->name;
    (my $module = $name) =~ s/\.c$//;

    start_html($module);
    print <<EOF;
<DIV ALIGN="CENTER">
 <IMG SRC="../images/sub.gif" ALT="[APACHE DOCUMENTATION]">
 <H3>Apache HTTP Server Version $ServerVersion</H3>
</DIV>
<H1 ALIGN="CENTER">Module $module</H1>
<P>This module is contained in the $name file.</P>
EOF

}

sub menu {
    my($r, $modp) = @_;
    my @cmds = sort by_name @{ $modp->commands };

    print "<UL>\n";
    for my $cmd (@cmds) {
	my $text = escape_html($cmd);
	(my $name = $cmd) =~ s/[<>]/./g;

	print qq(<LI><A HREF="#$name">$text</A>\n);
    }
    print "</UL>\n<HR>\n";
}

sub body {
    my($r, $modp) = @_;
    my @cmds = sort by_name @{ $modp->commands };
    (my $module = $modp->name) =~ s/\.c$//;

    for my $cmd (@cmds) {
	my $text = escape_html($cmd);
	my $cmd_rec = $modp->cmds->find($cmd);
	(my $name = $cmd) =~ s/[<>]/./g;

	my($context,$override) = overrides($modp, $cmd_rec);
	my $args_how = $cmd_rec->args_how;
	my $syntax = $Syntax{$args_how};
	my $perl_syntax = perl_syntax($cmd, $args_how);

	#this one's a wild guess
	my $status = "Extension";
	my $uri = $r->uri . ".html";
	if(-e $r->lookup_uri($uri)->filename) {
	    $status = "Base";
	}
	$status = "Base" if $module eq "http_core";

	print qq(<H2><A name="$name">$text directive</A></H2><P>\n);
	print "Description: ", 
               escape_html($cmd_rec->errmsg), "<br>";
	splain(Syntax     => "$text <EM>$syntax</EM> ($args_how)");
	splain(PerlSyntax => "<tt>$perl_syntax</tt>");
	splain(Context    => $context);
	splain(Override   => $override);
	splain(Status     => $status);
	splain(Module     => $module);
	print "</P><HR>";
    }
}

sub perl_syntax {
    my($cmd, $args_how) = @_;
    my $perl_syntax = $PerlSyntax{$args_how};

    if($args_how == RAW_ARGS) {
	if($cmd =~ /<(\w+)/) {
	    if($raw_as_hash{$1}) {
		my $nm = $1;
		(my $ix = $nm) =~ s/([a-z])([A-Z])/$1.'_'.lc($2)/ge;
		$perl_syntax =~ s/name/lc($ix)."_name"/e;
		$perl_syntax =~ s/var/$nm/;
	    }
	    else {
		$perl_syntax = "N/A"; 
	    }
	}
	else {
	    $perl_syntax = q{$var = $arg};
	}
    }
    elsif($args_how == NO_ARGS and $cmd =~ m:</:) {
	$perl_syntax = "N/A"; 
    }
    $perl_syntax =~ s/var/$cmd/;
    $perl_syntax = $cmd if $asis{$cmd};
    $perl_syntax = "N/A" if $NA{$cmd};
    return $perl_syntax;
}

sub splain {
    my($name, $rest) = @_;
    print <<EOF
<BR><A HREF="directive-dict.html#$name" REL="Help">
<STRONG>$name:</STRONG></A>
$rest
EOF
}

sub footer {
    print <<EOF;
<H3 ALIGN="CENTER">Apache HTTP Server Version $ServerVersion</H3>
<A HREF="./"><IMG SRC="../images/index.gif" ALT="Index"></A>
<A HREF="../"><IMG SRC="../images/home.gif" ALT="Home"></A>
</BODY>
</HTML>
EOF
}

sub by_name {
    (($a =~ /^([A-Z]+)$/i)[0] or "")
	cmp 
    (($b =~ /^([A-Z]+)$/i)[0] or "");
}

1;

__END__

=head1 NAME

Apache::ModuleDoc - Self documentation for Apache C modules

=head1 SYNOPSIS

 <Location /manual/mod>
  SetHandler perl-script
  PerlHandler Apache::ModuleDoc
 </Location>

=head1 DESCRIPTION

This modules provides a documentation template for Apache C modules.
The B<Location> for which this module is configured should be where
the standard Apache module documentation lives.  If a request URI relative
to that B<Location> is a module name (not the .html file), 
B<Apache::ModuleDoc> will do it's work, otherwise it will C<DECLINE> to
handle the request.

=head1 AUTHOR

Doug MacEachern

=head1 SEE ALSO 

Apache::Module(3), Apache(3), mod_perl(3)


