Apache-Module
view release on metacpan or search on metacpan
lib/Apache/ModuleDoc.pm view on Meta::CPAN
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",
lib/Apache/ModuleDoc.pm view on Meta::CPAN
'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 "")
( run in 1.345 second using v1.01-cache-2.11-cpan-d7f47b0818f )