cvsuser 02/02/08 06:05:21
Added: P5EEx/Blue/sbin perldocs.PL
Removed: P5EEx/Blue/sbin perldocs
Log:
added the ability to put the right #! interpreter line in perldocs
Revision Changes Path
1.1 p5ee/P5EEx/Blue/sbin/perldocs.PL
Index: perldocs.PL
===================================================================
use Config;
use File::Basename qw(basename dirname);
chdir(dirname($0));
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$//
if ($Config{'osname'} eq 'VMS' or
$Config{'osname'} eq 'OS2'); # "case-forgiving"
open OUT,">$file" or die "Can't create $file: $!";
chmod(0755, $file);
print "Extracting $file (with variable substitutions)\n";
print OUT <<"!SUBSTITUTIONS!OK!";
$Config{'startperl'} -w
!SUBSTITUTIONS!OK!
print OUT <<'!NO!SUBSTITUTIONS!';
#############################################################################
## $Id: perldocs.PL,v 1.1 2002/02/08 14:05:21 spadkins Exp $
#############################################################################
## (c) 2002 Stephen Adkins <[EMAIL PROTECTED]>
## This is free software, available under the same terms as Perl itself.
#############################################################################
## TODO
## x separate documents from classes in classGroupFrame
## x separate implemented from planned classes in classGroupFrame
## x remove non-implemented classes from inheritance tree
## x use Getopt::Long
## x remove "Deprecated" from the menu
## o add header menu to each of the class doc files
## o implement "Use" list
## o use Template::Toolkit to generate docs (rather than embedded HTML)
## o get documents out of the class hierarchy
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## o allow programmatic access to source code metadata
## o add concept of a "Distribution" (and "Installation" and "Site")
## o rewrite to document uncommented code (i.e. all of /usr/local/lib/perl5)
## o rewrite as OO code that models the source code (tie in with CPAN objects?)
## o implement "Deprecated" list
## o improve the document-detection rules
## o revive the "Documents (planned)" section
#############################################################################
=head1 NAME
perldocs - Perl documentation for multiple "perldoc" files
=head1 SYNOPSIS
sbin/perldocs -dir=htdocs -docroot=/pub/p5ee/software/htdocs -pmlibdirs=P5EEx
-distname=P5EEx-Blue -version=0.01
=head1 DESCRIPTION
The "perldocs" program is a documentation generator for Perl code.
It scans a set of Perl source files, pod files, and output html files
created by pod2html. It augments the html files created by pod2html
and creates additional cross-reference documentation showing the
interrelationships of classes, source files, class groups, distributions,
and installations within the site.
The "perldocs" program is different than the "perldoc" program distributed
with Perl. The "perldoc" program returns documentation from a single file.
The "perldocs" program creates documentation which shows the interrelationships
between files.
=head1 COMMAND USAGE
=head2 Command Line Options
The program is run as
perldocs [-opt=value]
where any number of options may be given, and the available options are
"dir", "docroot", "pmlibdirs", "distname", and "version".
perldocs -dir=htdocs -docroot=/pub/p5ee/software/htdocs -pmlibdirs=P5EEx
-distname=P5EEx-Blue -version=0.01
=head1 DOCUMENTATION USAGE
=head2 Frames and Navigation
The "perldocs" output is inspired by (and similar to) the output of "javadoc".
The standard view is from a web browser using HTML frames.
Two frames on the left assist in navigation, while the main frame on the right
displays the body of the documentation.
The upper left frame is called the "classGroupListFrame". It always contains
a high level index of groups of classes for which documentation is available.
Selecting a class group will cause the complete list of classes in that
class group to be shown in the frame below it.
The lower left frame is called the "classGroupFrame". It always contains a
list of classes from a particular class group. Selecting a class will
cause the class documentation to be displayed in the main frame to the
right.
The main frame on the right is called the "classFrame". It may display
the "Installation Summary", a "Distribution Summary", a "Class Group Summary",
or a "Class Document" (the augmented output of pod2html).
+---------------------+-------------------------------------------+
| | |
| classGroupListFrame | |
| | |
+---------------------+ |
| | classFrame |
| | |
| classGroupFrame | |
| | |
| | |
+---------------------+-------------------------------------------+
The top of each document that appears in the "classFrame" will contain a
navigation menu which allows the user to navigate to a related page of
documentation.
=head1 INTERNALS
=head2 Generated Files
For the overall distribution, the following files are generated.
index.html # the outer frameset
overview-frame.html # list of class groups [classGroupListFrame]
allclasses-frame.html # list of classes and docs [classGroupFrame]
overview-summary.html # summary of class groups [classFrame]
overview-tree.html # inheritance tree [classFrame]
For each Class Group in the Distribution, the following files are generated.
${class_group}-frame.html # list of classes and docs [classGroupFrame]
${class_group}-tree.html # inheritance tree [classFrame]
=cut
use strict;
use Date::Format;
use Getopt::Long;
my $dir = "htdocs";
my $docroot = "";
my $pmlibdirs = "lib";
my $distname = "";
my $version = "";
my $verbose = 0;
my (%data, %source_file, $datetime);
my %warning = (
"mfiup", "Module file [%s] includes unexpected package [%s]\n",
"mdnh2", "Module file [%s] contains method [%s] documentation not as '=head2'\n",
"mwnd", "Module file [%s] contains method [%s] with no documentation\n",
);
{
my ($success, $option);
my %opt_descriptions = (
'dir' => "Directory to correct outputted HTML POD documentation",
'docroot' => "Base of URL tree (corresponding to 'dir' in the directory
tree)",
'distname' => "Distribution name",
'version' => "Distribution version",
'pmlibdirs' => "Directories to scan for .pod and .pm source files",
);
$success = GetOptions (
"dir=s" => \$dir,
"docroot=s" => \$docroot,
"pmlibdirs=s" => \$pmlibdirs,
"distname=s" => \$distname,
"version=s" => \$version,
"verbose" => \$verbose,
);
if (!$success) {
print STDERR "Usage: $0 [-option=value] [-verbose]\n";
foreach $option (sort keys %opt_descriptions) {
printf STDERR " -%-12s %s\n", "$option",
$opt_descriptions{$option};
}
exit (1);
}
$datetime = time2str("%C", time());
mkdir("$dir/api", 0777) if ($dir);
#############################################################################
# Scan .pod and .pm files
#############################################################################
if ($pmlibdirs) {
$pmlibdirs =~ s/,/ /g;
# replace this with the Perl version of "find" someday
my (@podfiles, $podfile, $module);
open (FIND, "find $pmlibdirs -name '*.pod' -print |") || die "Unable to get
file list: $!\n";
@podfiles = <FIND>;
close(FIND);
chomp(@podfiles);
# Search through each POD file
foreach $podfile (@podfiles) {
$module = $podfile;
$module =~ s!\.pod$!!;
$module =~ s!/!::!g;
#print "POD file: $podfile => $module\n";
&scan_source($podfile, $module);
}
# replace this with the Perl version of "find" someday
my (@pmfiles, $pmfile);
open (FIND, "find $pmlibdirs -name '*.pm' -print |") || die "Unable to get
file list: $!\n";
@pmfiles = <FIND>;
close(FIND);
chomp(@pmfiles);
# Search through each PM file
foreach $pmfile (@pmfiles) {
$module = $pmfile;
$module =~ s!\.pm$!!;
$module =~ s!/!::!g;
#print "PM file: $pmfile => $module\n";
&scan_source($pmfile, $module);
}
}
#############################################################################
# Fix up HTML files
#############################################################################
if ($dir && $docroot) {
my (@htmlfiles, $htmlfile, $html, $modified, $unmodified_head,
$modified_head);
my ($title, $short_title);
# replace this with the Perl version of "find" someday
open (FIND, "find $dir -name '*.html' -print |") || die "Unable to get file
list: $!\n";
@htmlfiles = <FIND>;
close(FIND);
chomp(@htmlfiles);
foreach $htmlfile (@htmlfiles) {
$modified = 0;
$html = &read_file($htmlfile);
if ($html !~ m!HREF="$docroot/! &&
$html =~ s!HREF="/!HREF="$docroot/!g) {
$modified = 1;
}
$unmodified_head = <<EOF;
<HTML>
<HEAD>
<TITLE>([^<>]*)</TITLE>
<.*>
</HEAD>
<BODY>
EOF
if ($html =~ m/^$unmodified_head/) {
$title = $1;
$short_title = $title;
$short_title =~ s/ *-.*//;
$modified_head = <<EOF;
<HTML>
<HEAD>
<TITLE>$title</TITLE>
<link rel="stylesheet" type="text/css" href="$docroot/style.css">
</HEAD>
<BODY bgcolor="white" link="#660000" alink="#990000" vlink="#990000">
<table border="0" cellspacing="0">
<tr>
<td valign=middle><img src="$docroot/images/logo.gif" border="0"></td>
<td valign=middle><h1>$short_title</h1></td>
</tr>
</table>
EOF
$html =~ s!^$unmodified_head!$modified_head!s;
$modified = 1;
}
if ($modified) {
print "Modified $htmlfile...\n";
&write_file($htmlfile,$html);
}
}
&write_docs();
}
}
exit 0;
#############################################################################
# Workhorse functions
#############################################################################
# $source_file{$module} file name of source code
# %data
# $data{distribution}{$distribution}
# $data{distribution}{$distribution}{version}
# $data{distribution}{$distribution}{requirements}
# $data{distribution}{$distribution}{design}
#
# $data{classgroup}{$classgroup}
# $data{classgroup}{$classgroup}{description}
# $data{classgroup}{$classgroup}{requirements}
# $data{classgroup}{$classgroup}{design}
# $data{classgroup}{$classgroup}{podclass}
# $data{classgroup}{$classgroup}{classes}
# $data{classgroup}{$classgroup}{class}{$class}{description}
# $data{classgroup}{$classgroup}{class}{$class}{podclass}
#
# $data{class}{$class}
# $data{class}{$class}{parent}
# $data{class}{$class}{parents}
# $data{class}{$class}{children}
# $data{class}{$class}{classgroup}
# $data{class}{$class}{podclass}
# $data{class}{$class}{name}
# $data{class}{$class}{synopsis}
# $data{class}{$class}{description}
# $data{class}{$class}{throws}
# $data{class}{$class}{since}
# $data{class}{$class}{deprecated_since}
# $data{class}{$class}{deprecated_discontinue}
# $data{class}{$class}{authors}
# $data{class}{$class}{author}{$author}{email}
# $data{class}{$class}{license}
# $data{class}{$class}{see_also}
#
# $data{class}{$class}{method}{$method}
# $data{class}{$class}{method}{$method}{doc}
# $data{class}{$class}{method}{$method}{visibility}
# $data{class}{$class}{method}{$method}{signatures}
# $data{class}{$class}{method}{$method}{param}{$param}
# $data{class}{$class}{method}{$method}{param}{$param}{type}
# $data{class}{$class}{method}{$method}{param}{$param}{inout}
# $data{class}{$class}{method}{$method}{return}{$return}
# $data{class}{$class}{method}{$method}{return}{$return}{type}
# $data{class}{$class}{method}{$method}{throws}
# $data{class}{$class}{method}{$method}{since}
# $data{class}{$class}{method}{$method}{deprecated_since}
# $data{class}{$class}{method}{$method}{deprecated_discontinue}
# $data{class}{$class}{method}{$method}{sample_usage}
sub scan_source {
my ($file, $module) = @_;
my ($source);
$source = &read_file($file);
$source_file{$module} = $file;
my (@package_frags, $pf, $package, $pfrag);
my (@head_frags, $hf, $headlevel, $headtext, $hfrag);
my (@sub_frags, $sf, $sub, $sfrag);
my ($dist_name, $class_list, $class_group, $class, $description, $capability,
$method);
# search each package
@package_frags = split(/(\npackage .*\n)/, $source);
unshift(@package_frags, "package $module;");
for ($pf = 0; $pf <= $#package_frags; $pf += 2) {
if ($package_frags[$pf] =~ /package +([A-Za-z0-9:_-]+);/) {
$package = $1;
&docwarn("mfiup", $file, $package) if ($module ne $package);
$pfrag = $package_frags[$pf+1];
#print "package=[$package] pfrag=[$pfrag]\n";
# save info about where this class (package) was detected
$data{classgroup}{allclasses}{classes} = []
if (! defined $data{classgroup}{allclasses}{classes});
if (! defined $data{classgroup}{allclasses}{class}{$package}) {
push(@{$data{classgroup}{allclasses}{classes}}, $package);
$data{classgroup}{allclasses}{class}{$package} = {};
}
# take not of the module that POD for the package is in
if ($pfrag =~ /\n=head1 /s) {
$data{class}{$package}{podclass} = $module;
}
# Scan the ISA list to get the inheritance tree
if ($pfrag =~ /\@ISA *= *([^;#]*)/) {
$class_list = $1;
while ($class_list =~ /([A-Z][A-Za-z0-9_:]+)/g) {
$class = $1;
$data{class}{$package}{parent} = $class
if (!defined $data{class}{$package}{parent});
if (!defined $data{class}{$package}{parents}) {
$data{class}{$package}{parents} = []
}
else {
push(@{$data{class}{$package}{parents}}, $class);
}
$data{class}{$class}{children} = []
if (!defined $data{class}{$class}{children});
push(@{$data{class}{$class}{children}}, $package);
}
}
# search each =head POD directive
@head_frags = split(/(\n=head[12] .*\n)/, $pfrag);
for ($hf = 1; $hf <= $#head_frags; $hf += 2) {
if ($head_frags[$hf] =~ /=head([12]) +(.*)/) {
$headlevel = $1;
$headtext = $2;
$hfrag = $head_frags[$hf+1];
if ($headtext =~ /NAME/) {
}
elsif ($headtext =~ /SYNOPSIS/) {
}
elsif ($headtext =~ /DESCRIPTION/) {
}
elsif ($headtext =~ /ACKNOWLEDGEMENTS/) {
}
elsif ($headtext =~ /SEE ALSO/) {
}
elsif ($headtext =~ /Attributes, Constants, Global Variables,
Class Variables/) {
}
elsif ($headtext =~ /Distribution: *(.*)/) {
$dist_name = $1;
}
elsif ($headtext =~ /Class Groups/) {
while ($hfrag =~ / \* Class Group: *([^-\n]+)( *\n *-
*([^\n]+))?/sg) {
$class_group = $1;
$description = $3;
$class_group =~ s/[\|>].*//;
$class_group =~ s/.*<//;
$data{classgroup}{$class_group}{description} =
$description;
}
}
elsif ($headtext =~ /Class Group Requirements/) {
}
elsif ($headtext =~ /Class Group Design/) {
}
elsif ($headtext =~ /Class Group: *(.*)/) {
$class_group = $1;
$class_group =~ s/[\|>].*//;
$class_group =~ s/.*<//;
$data{classgroup}{$class_group}{podclass} = $module;
while ($hfrag =~ / \* (Class|Document): *([^\n]+)/sg) {
$class = $2;
$class =~ s/[\|>].*//;
$class =~ s/.*<//;
$data{classgroup}{$class_group}{classes} = []
if (! defined
$data{classgroup}{$class_group}{classes});
if (! defined
$data{classgroup}{$class_group}{class}{$class}) {
push(@{$data{classgroup}{$class_group}{classes}},
$class);
$data{classgroup}{$class_group}{class}{$class} = {};
}
$data{classgroup}{allclasses}{classes} = []
if (! defined
$data{classgroup}{allclasses}{classes});
if (! defined
$data{classgroup}{allclasses}{class}{$class}) {
push(@{$data{classgroup}{allclasses}{classes}},
$class);
$data{classgroup}{allclasses}{class}{$class} = {};
}
}
}
elsif ($headtext =~ /Class: *(.*)/) {
$class = $1;
}
elsif ($headtext =~ /Class Capabilities/) {
}
elsif ($headtext =~ /Class Requirements/) {
}
elsif ($headtext =~ /Class Design/) {
}
elsif ($headtext =~ /Constructor Methods: *(.*)/) {
$capability = $1;
}
elsif ($headtext =~ /Public Methods: *(.*)/) {
$capability = $1;
}
elsif ($headtext =~ /Public Methods: *(.*)/) {
$capability = $1;
}
elsif ($headtext =~ /Public Methods: *(.*)/) {
$capability = $1;
}
elsif ($headtext =~ / *(.+)\(\)/) {
$method = $1;
&docwarn("mdnh2", $file, $method) if ($headlevel != 2);
$hfrag =~ s/\nsub .*//s;
$data{class}{$package}{method}{$method}{doc} = $hfrag;
}
else {
}
#print "headlevel=[$headlevel] headtext=[$headtext]
hfrag=[$hfrag]\n";
}
}
# search each subroutine/method definition
@sub_frags = split(/(\nsub .*\n)/, $source);
for ($sf = 1; $sf <= $#sub_frags; $sf += 2) {
if ($sub_frags[$sf] =~ /sub +([A-Za-z0-9_]+)/) {
$method = $1;
$sfrag = $sub_frags[$sf+1]; # { {
$sfrag =~ s/\n}.*/}/s;
$data{class}{$package}{method}{$method}{code} = $sfrag;
if (! defined $data{class}{$package}{method}{$method}{doc}) {
&docwarn("mwnd", $file, $method);
}
#print "method=[$method] sfrag=[$sfrag]\n";
}
}
}
}
}
sub docwarn {
my ($warncode, @args) = @_;
return;
if ($warning{$warncode}) {
printf STDERR $warning{$warncode}, @args;
}
else {
print STDERR "Warning [$warncode] detected but not defined (",
join(",", @args), ")\n";
}
}
sub write_docs {
&write_index();
&write_overview();
&write_overview_summary();
&write_all_trees();
}
sub write_index {
my ($html);
$html = <<EOF;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0
Transitional//EN""http://www.w3.org/TR/REC-html40/loose.dtd">
<HTML>
<HEAD>
<!-- Generated by perldocs on $datetime -->
<TITLE>$distname-$version</TITLE>
</HEAD>
<FRAMESET cols="20%,80%">
<FRAMESET rows="30%,70%">
<FRAME src="overview-frame.html" name="classGroupListFrame">
<FRAME src="allclasses-frame.html" name="classGroupFrame">
</FRAMESET>
<FRAME src="overview-summary.html" name="classFrame">
</FRAMESET>
<NOFRAMES>
<H2>
Frame Alert</H2>
<P>
This document is designed to be viewed using the frames feature. If you see this
message, you are using a non-frame-capable web client.
<BR>
Link to<A HREF="overview-summary.html">Non-frame version.</A></NOFRAMES>
</HTML>
EOF
&write_file("$dir/api/index.html", $html);
}
sub write_overview {
my ($html);
$html = <<EOF;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0
Transitional//EN""http://www.w3.org/TR/REC-html40/loose.dtd">
<HTML>
<HEAD>
<!-- Generated by perldocs on $datetime -->
<TITLE>Overview ($distname-$version)</TITLE>
<LINK REL="stylesheet" TYPE="text/css" HREF="perldocs.css" TITLE="Style">
<SCRIPT>
function asd() {
parent.document.title="Overview ($distname-$version)";
}
</SCRIPT>
</HEAD>
<BODY bgcolor="white" link="#660000" alink="#990000" vlink="#990000" onload="asd();">
<TABLE BORDER="0" WIDTH="100%">
<TR>
<TD NOWRAP><FONT size="+1"
CLASS="FrameTitleFont"><B>$distname-$version</B></FONT></TD>
</TR>
</TABLE>
<TABLE BORDER="0" WIDTH="100%">
<TR>
<TD NOWRAP>
<FONT CLASS="FrameItemFont"><A HREF="allclasses-frame.html"
TARGET="classGroupFrame">All Classes</A></FONT><P>
<FONT size="+1" CLASS="FrameHeadingFont">Class Groups</FONT><BR>
EOF
my ($class_group);
foreach $class_group (sort keys %{$data{classgroup}}) {
$html .= <<EOF;
<FONT CLASS="FrameItemFont"><A HREF="${class_group}-frame.html"
TARGET="classGroupFrame">$class_group</A></FONT><BR>
EOF
&write_class_frame($class_group);
}
&write_class_frame("allclasses", "All Classes");
$html .= <<EOF;
</TD>
</TR>
</TABLE>
<P>
</BODY>
</HTML>
EOF
&write_file("$dir/api/overview-frame.html", $html);
}
sub write_class_frame {
my ($class_group, $title) = @_;
$title = $class_group if (!$title);
my ($html);
$html = <<EOF;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0
Transitional//EN""http://www.w3.org/TR/REC-html40/loose.dtd">
<HTML>
<HEAD>
<!-- Generated by perldocs on $datetime -->
<TITLE>$title</TITLE>
<LINK REL="stylesheet" TYPE="text/css" HREF="perldocs.css" TITLE="Style">
<SCRIPT>
function asd() {
parent.document.title="All Classes";
}
</SCRIPT>
</HEAD>
<BODY bgcolor="white" link="#660000" alink="#990000" vlink="#990000" onload="asd();">
<TABLE BORDER="0" WIDTH="100%">
<TR>
<TD NOWRAP><FONT CLASS="FrameItemFont">
<FONT size="+1" CLASS="FrameHeadingFont"><B>$title</B></FONT><P>
EOF
my ($htmlfile, $is_doc, $doc_html, $doc_nonimp_html, $class_html,
$class_nonimp_html, $class, $classname);
$doc_html = "";
$doc_nonimp_html = "";
$class_html = "";
$class_nonimp_html = "";
foreach $class (sort @{$data{classgroup}{$class_group}{classes}}) {
$classname = $class;
$classname =~ s/^P5EEx::Blue:://;
$htmlfile = $data{class}{$class}{podclass};
# TODO: fix up these rules
if ($classname =~ /^[a-z]/) {
$is_doc = 1;
}
elsif ($classname =~ /::/) {
$is_doc = 0;
}
elsif ($classname =~ /^[A-Z][a-zA-Z0-9]*$/) {
$is_doc = 0;
}
else {
$is_doc = 1;
}
if ($is_doc) {
if ($htmlfile) {
$htmlfile =~ s!::!/!g;
$htmlfile = "../${htmlfile}.html";
$doc_html .= <<EOF;
<A HREF="$htmlfile" TARGET="classFrame">$classname</A><BR>
EOF
}
else {
$doc_nonimp_html .= <<EOF;
$classname<BR>
EOF
}
}
else {
if ($htmlfile) {
$htmlfile =~ s!::!/!g;
$htmlfile = "../${htmlfile}.html";
$class_html .= <<EOF;
<A HREF="$htmlfile" TARGET="classFrame">$classname</A><BR>
EOF
}
else {
$class_nonimp_html .= <<EOF;
$classname<BR>
EOF
}
}
}
if ($doc_html) {
$html .= <<EOF;
<FONT size="+0" CLASS="xFrameHeadingFont"><B>Documents</B></FONT><BR>
$doc_html
<p>
EOF
}
if ($class_html) {
$html .= <<EOF;
<FONT size="+0" CLASS="xFrameHeadingFont"><B>Classes</B></FONT><BR>
$class_html
<p>
EOF
}
# if ($doc_nonimp_html) {
# $html .= <<EOF;
# <FONT size="+0" CLASS="xFrameHeadingFont"><B>Documents
(planned)</B></FONT><BR>
#$doc_nonimp_html
#<p>
#EOF
# }
if ($class_nonimp_html) {
$html .= <<EOF;
<FONT size="+0" CLASS="xFrameHeadingFont"><B>Classes (planned)</B></FONT><BR>
$class_nonimp_html
<p>
EOF
}
$html .= <<EOF;
</FONT></TD>
</TR>
</TABLE>
</BODY>
</HTML>
EOF
&write_file("$dir/api/${class_group}-frame.html", $html);
}
sub write_overview_summary {
my ($html);
$html = <<EOF;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0
Transitional//EN""http://www.w3.org/TR/REC-html40/loose.dtd">
<!--NewPage-->
<HTML>
<HEAD>
<!-- Generated by javadoc on Wed Oct 10 20:02:45 PDT 2001 -->
<TITLE>Overview ($distname-$version)</TITLE>
<LINK REL="stylesheet" TYPE="text/css" HREF="perldocs.css" TITLE="Style">
<SCRIPT>
function asd() {
parent.document.title="Overview ($distname-$version)";
}
</SCRIPT>
</HEAD>
<BODY bgcolor="white" link="#660000" alink="#990000" vlink="#990000" onload="asd();">
<!-- ========== START OF NAVBAR ========== -->
<A NAME="navbar_top"><!-- --></A>
<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0">
<TR>
<TD COLSPAN=3 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<A NAME="navbar_top_firstrow"><!-- --></A>
<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3">
<TR ALIGN="center" VALIGN="top">
<TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev">
<FONT CLASS="NavBarFont1Rev"><B>Overview</B></FONT>
</TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<FONT CLASS="NavBarFont1">Class-Group</FONT>
</TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<FONT CLASS="NavBarFont1">Class</FONT>
</TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<FONT CLASS="NavBarFont1">Use</FONT>
</TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<A HREF="overview-tree.html"><FONT
CLASS="NavBarFont1"><B>Tree</B></FONT></A>
</TD>
<!--
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<A HREF="deprecated-list.html"><FONT
CLASS="NavBarFont1"><B>Deprecated</B></FONT></A>
-->
</TD>
</TR>
</TABLE>
</TD>
<TD ALIGN="right" VALIGN="top" ROWSPAN=3>
<EM><b>$distname-$version</b></EM>
</TD>
</TR>
<TR>
<TD BGCOLOR="white" CLASS="NavBarCell2">
<FONT SIZE="-2"> PREV NEXT</FONT>
</TD>
<TD BGCOLOR="white" CLASS="NavBarCell2">
<FONT SIZE="-2">
<A HREF="index.html" TARGET="_top"><B>FRAMES</B></A>
<A HREF="overview-summary.html" TARGET="_top"><B>NO
FRAMES</B></A>
<SCRIPT>
<!--
if(window==top) {
document.writeln('<A HREF="allclasses-noframe.html" TARGET=""><B>All
Classes</B></A>');
}
//-->
</SCRIPT>
<NOSCRIPT>
<A HREF="allclasses-noframe.html" TARGET=""><B>All Classes</B></A>
</NOSCRIPT>
</FONT>
</TD>
</TR>
</TABLE>
<!-- =========== END OF NAVBAR =========== -->
<HR>
<CENTER>
<H2>$distname-$version API Specification</H2>
</CENTER>
This document is the API specification for the $distname-$version.
<P>
<!--
<B>See:</B>
<BR>
<A
HREF="#overview_description"><B>Description</B></A>
<P>
-->
<TABLE BORDER="1" CELLPADDING="3" CELLSPACING="0" WIDTH="100%">
<TR BGCOLOR="#CCCCFF" CLASS="TableHeadingColor">
<TD COLSPAN=2><FONT SIZE="+2">
<B>$distname Class Groups</B></FONT></TD>
</TR>
EOF
my ($class_group, $description, $url);
foreach $class_group (sort keys %{$data{classgroup}}) {
$description = $data{classgroup}{$class_group}{description};
$description = "The $class_group class group." if (!$description);
$url = $data{classgroup}{$class_group}{podclass};
if ($url) {
$url =~ s!::!/!g;
#$url = "../${url}.html" . lc("#Class Group: $class_group");
$url = "../${url}.html";
$html .= <<EOF;
<TR BGCOLOR="white" CLASS="TableRowColor">
<TD WIDTH="20%"><B><A HREF="$url">$class_group</A></B></TD>
<TD>$description</TD>
</TR>
EOF
}
else {
$html .= <<EOF;
<TR BGCOLOR="white" CLASS="TableRowColor">
<TD WIDTH="20%"><B>$class_group</B></TD>
<TD>$description</TD>
</TR>
EOF
}
}
$html .= <<EOF;
</TABLE>
<P>
<A NAME="overview_description"><!-- --></A>
<P>
This document is the API specification for the $distname-$version.
<p>
<P>
<P>
<HR>
<!-- ========== START OF NAVBAR ========== -->
<A NAME="navbar_bottom"><!-- --></A>
<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0">
<TR>
<TD COLSPAN=3 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<A NAME="navbar_bottom_firstrow"><!-- --></A>
<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3">
<TR ALIGN="center" VALIGN="top">
<TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT
CLASS="NavBarFont1Rev"><B>Overview</B></FONT> </TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT
CLASS="NavBarFont1">Class-Group</FONT> </TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT
CLASS="NavBarFont1">Class</FONT> </TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT
CLASS="NavBarFont1">Use</FONT> </TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="overview-tree.html"><FONT
CLASS="NavBarFont1"><B>Tree</B></FONT></A> </TD>
<!--
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="deprecated-list.html"><FONT
CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
-->
</TR>
</TABLE>
</TD>
<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
<b>$distname-$version</b></EM>
</TD>
</TR>
<TR>
<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
PREV
NEXT</FONT></TD>
<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
<A HREF="index.html" TARGET="_top"><B>FRAMES</B></A>
<A HREF="overview-summary.html" TARGET="_top"><B>NO FRAMES</B></A>
<SCRIPT>
<!--
if(window==top) {
document.writeln('<A HREF="allclasses-noframe.html" TARGET=""><B>All
Classes</B></A>');
}
//-->
</SCRIPT>
<NOSCRIPT>
<A HREF="allclasses-noframe.html" TARGET=""><B>All Classes</B></A>
</NOSCRIPT>
</FONT></TD>
</TR>
</TABLE>
<!-- =========== END OF NAVBAR =========== -->
</BODY>
</HTML>
EOF
&write_file("$dir/api/overview-summary.html", $html);
}
sub write_all_trees {
&write_class_group_tree("allclasses");
my ($class_group);
foreach $class_group (sort keys %{$data{classgroup}}) {
&write_class_group_tree($class_group);
}
}
sub write_class_group_tree {
my ($this_class_group) = @_;
my ($html, $title);
$title = ($this_class_group eq "allclasses") ? "All Class Groups" :
"$this_class_group Class Group";
$html = <<EOF;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0
Transitional//EN""http://www.w3.org/TR/REC-html40/loose.dtd">
<!--NewPage-->
<HTML>
<HEAD>
<!-- Generated by perldocs on $datetime -->
<TITLE>Class Hierarchy ($distname-$version)</TITLE>
<LINK REL="stylesheet" TYPE="text/css" HREF="perldocs.css" TITLE="Style">
<SCRIPT>
function asd() {
parent.document.title="Class Hierarchy ($distname-$version)";
}
</SCRIPT>
</HEAD>
<BODY bgcolor="white" link="#660000" alink="#990000" vlink="#990000" onload="asd();">
<!-- ========== START OF NAVBAR ========== -->
<A NAME="navbar_top"><!-- --></A>
<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0">
<TR>
<TD COLSPAN=3 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<A NAME="navbar_top_firstrow"><!-- --></A>
<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3">
<TR ALIGN="center" VALIGN="top">
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A
HREF="overview-summary.html"><FONT
CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT
CLASS="NavBarFont1">Class-Group</FONT> </TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT
CLASS="NavBarFont1">Class</FONT> </TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT
CLASS="NavBarFont1">Use</FONT> </TD>
<TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT
CLASS="NavBarFont1Rev"><B>Tree</B></FONT> </TD>
<!--
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="deprecated-list.html"><FONT
CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
-->
</TR>
</TABLE>
</TD>
<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
<b>$distname-$version</b></EM>
</TD>
</TR>
<TR>
<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
PREV
NEXT</FONT></TD>
<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
<A HREF="index.html" TARGET="_top"><B>FRAMES</B></A>
<A HREF="overview-tree.html" TARGET="_top"><B>NO FRAMES</B></A>
<SCRIPT>
<!--
if(window==top) {
document.writeln('<A HREF="allclasses-noframe.html" TARGET=""><B>All
Classes</B></A>');
}
//-->
</SCRIPT>
<NOSCRIPT>
<A HREF="allclasses-noframe.html" TARGET=""><B>All Classes</B></A>
</NOSCRIPT>
</FONT></TD>
</TR>
</TABLE>
<!-- =========== END OF NAVBAR =========== -->
<HR>
<CENTER>
<H2>
Hierarchy For $title</H2>
</CENTER>
<DL>
<DT>
<B>Class Group Hierarchies:</B><DD>
EOF
my ($class_group);
if ($this_class_group eq "allclasses") {
foreach $class_group (sort keys %{$data{classgroup}}) {
if ($class_group ne "allclasses") {
$html .= " <A
HREF=\"${class_group}-tree.html\">$class_group</A>,\n";
}
else {
$html .= " <A HREF=\"overview-tree.html\">All Classes</A>\n";
}
}
}
else {
$html .= " <A HREF=\"overview-tree.html\">All Classes</A>\n";
}
$html .= <<EOF;
</DD>
</DT>
</DL>
<HR>
<H2>
Class Hierarchy
</H2>
EOF
$html .= &class_group_tree($this_class_group);
$html .= <<EOF;
<HR>
<!-- ========== START OF NAVBAR ========== -->
<A NAME="navbar_bottom"><!-- --></A>
<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0">
<TR>
<TD COLSPAN=3 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<A NAME="navbar_bottom_firstrow"><!-- --></A>
<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3">
<TR ALIGN="center" VALIGN="top">
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A
HREF="overview-summary.html"><FONT
CLASS="NavBarFont1"><B>Overview</B></FONT></A> </TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT
CLASS="NavBarFont1">Class-Group</FONT> </TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT
CLASS="NavBarFont1">Class</FONT> </TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <FONT
CLASS="NavBarFont1">Use</FONT> </TD>
<TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev"> <FONT
CLASS="NavBarFont1Rev"><B>Tree</B></FONT> </TD>
<!--
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1"> <A HREF="deprecated-list.html"><FONT
CLASS="NavBarFont1"><B>Deprecated</B></FONT></A> </TD>
-->
</TR>
</TABLE>
</TD>
<TD ALIGN="right" VALIGN="top" ROWSPAN=3><EM>
<b>$distname-$version</b></EM>
</TD>
</TR>
<TR>
<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
PREV
NEXT</FONT></TD>
<TD BGCOLOR="white" CLASS="NavBarCell2"><FONT SIZE="-2">
<A HREF="index.html" TARGET="_top"><B>FRAMES</B></A>
<A HREF="overview-tree.html" TARGET="_top"><B>NO FRAMES</B></A>
<SCRIPT>
<!--
if(window==top) {
document.writeln('<A HREF="allclasses-noframe.html" TARGET=""><B>All
Classes</B></A>');
}
//-->
</SCRIPT>
<NOSCRIPT>
<A HREF="allclasses-noframe.html" TARGET=""><B>All Classes</B></A>
</NOSCRIPT>
</FONT></TD>
</TR>
</TABLE>
<!-- =========== END OF NAVBAR =========== -->
</BODY>
</HTML>
EOF
if ($this_class_group eq "allclasses") {
&write_file("$dir/api/overview-tree.html", $html);
}
else {
&write_file("$dir/api/${this_class_group}-tree.html", $html);
}
}
sub class_group_tree {
my ($class_group) = @_;
my ($class, $class2, $html, $children, $classes, @root_classes,
%selected_classes);
my ($htmlfile);
%selected_classes = ();
$html = "";
$classes = $data{classgroup}{$class_group}{classes};
if (defined $classes) {
foreach (sort @$classes) {
$class = $_;
while ($data{class}{$class}{parent}) {
$selected_classes{$class} = 1;
$class = $data{class}{$class}{parent};
}
if (! $selected_classes{$class}) {
push(@root_classes, $class);
$selected_classes{$class} = 1;
}
}
foreach $class (sort @$classes) {
$children = $data{class}{$class}{children};
if (defined $children) {
foreach $class2 (@$children) {
$selected_classes{$class2} = 1;
}
}
}
$html .= "<ul>\n";
foreach $class (sort @root_classes) {
$htmlfile = $data{class}{$class}{podclass};
if ($htmlfile) { # only include classes which are implemented
$html .= &class_tree($class, \%selected_classes);
}
}
$html .= "</ul>\n";
}
$html;
}
sub class_tree {
my ($class, $selected_classes) = @_;
my ($html, $htmlfile, $children, $parents, $parents_text);
$html = "";
$parents = $data{class}{$class}{parents};
$parents_text = "";
if (defined $parents && ref($parents) eq "ARRAY" && $#$parents > -1) {
$parents_text = " (also inherits from " . join(", ", @$parents) . ")";
}
$htmlfile = $data{class}{$class}{podclass};
if ($htmlfile) {
$htmlfile =~ s!::!/!g;
$htmlfile = "../$htmlfile.html";
$html = "<li type=\"circle\"><a
href=\"$htmlfile\">$class</a>$parents_text\n";
}
else {
$html = "<li type=\"circle\">$class$parents_text\n";
}
$children = $data{class}{$class}{children};
if (defined $children) {
$html .= "<ul>\n";
foreach $class (sort @$children) {
if (!defined $selected_classes || !%$selected_classes ||
$selected_classes->{$class}) {
$html .= &class_tree($class, $selected_classes);
}
}
$html .= "</ul>\n";
}
$html;
}
sub navbar {
my ($level, $item) = @_;
my ($distribution, $classgroup, $class);
my (%level_label, $html);
%level_label = (
allclasses => "Site",
distribution => "Distribution",
classgroup => "Class-Group",
class => "Class",
);
$html = <<EOF;
<!-- ========== START OF NAVBAR ========== -->
<A NAME="navbar_top"><!-- --></A>
<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0">
<TR>
<TD COLSPAN=3 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<A NAME="navbar_top_firstrow"><!-- --></A>
<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3">
<TR ALIGN="center" VALIGN="top">
<TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev">
<FONT CLASS="NavBarFont1Rev"><B>Site</B></FONT>
</TD>
<TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev">
<FONT CLASS="NavBarFont1Rev"><B>Distribution</B></FONT>
</TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<FONT CLASS="NavBarFont1">Class-Group</FONT>
</TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<FONT CLASS="NavBarFont1">Class</FONT>
</TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<FONT CLASS="NavBarFont1">Use</FONT>
</TD>
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<A HREF="overview-tree.html"><FONT
CLASS="NavBarFont1"><B>Tree</B></FONT></A>
</TD>
<!--
<TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
<A HREF="deprecated-list.html"><FONT
CLASS="NavBarFont1"><B>Deprecated</B></FONT></A>
</TD>
-->
</TR>
</TABLE>
</TD>
<TD ALIGN="right" VALIGN="top" ROWSPAN=3>
<EM><b>$distname-$version</b></EM>
</TD>
</TR>
<TR>
<TD BGCOLOR="white" CLASS="NavBarCell2">
<FONT SIZE="-2"> PREV NEXT</FONT>
</TD>
<TD BGCOLOR="white" CLASS="NavBarCell2">
<FONT SIZE="-2">
<A HREF="index.html" TARGET="_top"><B>FRAMES</B></A>
<A HREF="overview-summary.html" TARGET="_top"><B>NO
FRAMES</B></A>
<SCRIPT>
<!--
if(window==top) {
document.writeln('<A HREF="allclasses-noframe.html" TARGET=""><B>All
Classes</B></A>');
}
//-->
</SCRIPT>
<NOSCRIPT>
<A HREF="allclasses-noframe.html" TARGET=""><B>All Classes</B></A>
</NOSCRIPT>
</FONT>
</TD>
</TR>
</TABLE>
<!-- =========== END OF NAVBAR =========== -->
EOF
$html;
}
#############################################################################
# Utility functions
#############################################################################
sub read_file {
my ($file) = @_;
local(*FILE);
my ($data, @data);
$data = "";
if (open(FILE, "< $file")) {
@data = <FILE>;
$data = join("", @data);
close(FILE);
#print "Reading [$file] ...\n";
}
else {
print "Failed to open file for reading [$file]: $!\n";
}
$data;
}
sub write_file {
my ($file, $data) = @_;
local(*FILE);
if (open(FILE, "> $file")) {
print FILE $data;
close(FILE);
#print "Writing [$file] ...\n";
}
else {
print "Failed to open file for writing [$file]: $!\n";
}
}
!NO!SUBSTITUTIONS!