gatherHeaderDoc.pl
tool (gatherheaderdoc
# when installed) gathers up a folder full of HTML output from
# headerDoc2HTML.pl
(headerdoc2html
)
# and generates a master table of contents.
#
# This document provides API-level documentation
# on the tool's internals. For user documentation, see
# {@linkdoc //apple_ref/doc/uid/TP40001215 HeaderDoc User Guide}.
# @indexgroup HeaderDoc Tools
# */
# /*! @abstract
# Usually a slash (/); in MacPerl, a colon(:).
# */
my $pathSeparator;
# /*! @abstract
# A 1 if MacPerl, else 0.
# */
my $isMacOS;
# /*! @abstract
# Path to the Perl modules in the source directory.
# */
my $uninstalledModulesPath;
# /*! @abstract
# Path to the Perl modules in the developer tools package.
# */
my $devtoolsModulesPath;
# /*! @abstract
# Indicates that an internal link resolution tool was found.
# */
my $has_resolver;
# /* */
sub resolveLinks($$$);
# /*!
# @abstract
# Storage for the groupHierLimit
config file field.
# */
$HeaderDoc::groupHierLimit = undef;
# /*!
# @abstract
# Storage for the groupHierSubgroupLimit
config file field.
# */
$HeaderDoc::groupHierSubgroupLimit = undef;
BEGIN {
use FindBin qw ($Bin);
if ($^O =~ /MacOS/i) {
$pathSeparator = ":";
$isMacOS = 1;
#$Bin seems to return a colon after the path on certain versions of MacPerl
#if it's there we take it out. If not, leave it be
#WD-rpw 05/09/02
($uninstalledModulesPath = $FindBin::Bin) =~ s/([^:]*):$/$1/;
} else {
$pathSeparator = "/";
$isMacOS = 0;
}
$uninstalledModulesPath = "$FindBin::Bin"."$pathSeparator"."Modules";
$devtoolsModulesPath = "$FindBin::Bin"."$pathSeparator".".."."$pathSeparator"."share"."$pathSeparator"."headerdoc"."$pathSeparator"."Modules";
$HeaderDoc::use_styles = 0;
}
use strict;
# use Cwd;
use File::Basename;
use File::Find;
use File::Copy;
# use Carp qw(cluck);
use lib $uninstalledModulesPath;
use lib $devtoolsModulesPath;
use POSIX;
# /*! @abstract
# Set if you pass the -d flag.
# */
my $generateDocSet = 0;
# /*! @abstract
# Set if you pass the -n flag with the -d flag.
# */
my $skipTOC = 0;
# /*! @abstract
# Set if -N flag is set (disable link resolution).
# */
my $noResolve = 0;
# /*! @abstract
# Set if you pass the -w flag.
# */
$HeaderDoc::useWhatIs = 0;
$has_resolver = 1;
eval "use HeaderDoc::LinkResolver qw (resolveLinks); 1" || do { $has_resolver = 0; };
# print STDERR "HR: $has_resolver\n";
if ($has_resolver) {
print STDERR "LinkResolver will be used to resolve cross-references.\n";
}
# Modules specific to gatherHeaderDoc
use HeaderDoc::DocReference;
use HeaderDoc::Utilities qw(findRelativePath safeName printArray printHash updateHashFromConfigFiles getHashFromConfigFile resolveLinks sanitize stripTags getDefaultEncoding);
$HeaderDoc::modulesPath = $INC{'HeaderDoc/Utilities.pm'};
$HeaderDoc::modulesPath =~ s/Utilities.pm$//s;
# print STDERR "MP: ".$HeaderDoc::modulesPath."\n";
# /*! @abstract
# Always 1.
# */
my $debugging = 1;
######################################## Design Overview ###################################
# - We scan input directory for frameset files (index.html, by default).
# - For each frameset file, we look for a special HTML comment (left by HeaderDoc)
# that tell us the name of the header/class and the type (header or cppclass).
# - We create a DocReference object to store this info, and also the path to the
# frameset file.
# - We run through array of DocRef objs and create a master TOC based on the info
# - Finally, we visit each TOC file in each frameset and add a "[Top]" link
# back to the master TOC. [This is fragile in the current implementation, since
# we find TOCs based on searching for a file called "toc.html" in the frameset dir.]
#
########################## Get command line arguments and flags #######################
# /*! @abstract
# An array of HeaderDoc-generated files.
# */
my @inputFiles;
# /*! @abstract
# An array of all HTML files.
# */
my @contentFiles;
# /*! @abstract
# The diretory for input.
# */
my $inputDir;
# /*! @abstract
# Storage for the externalXRefFiles
config
# file field.
# */
my $externalXRefFiles = "";
# /*! @abstract
# Storage for the contents of the "target=..." attribute
# for generated links.
# @discussion
# Set by the -t
flag on the command line.
# */
my $linktarget = "";
use Getopt::Std;
# /*! @abstract
# Storage for getopt().
# */
my %options = ();
# /*! @abstract
# Per-output-file letter link status variable.
#
# @discussion
# Used for determining whether to put in an anchor
# for jumping to the first two letters of a given symbol.
# (Only inserted the first time those two letters appear
# in a given .)
# */
my %letters_linked = ();
# /*! @abstract
# Per-group letter link status variable.
#
# @discussion
# Used for determining whether to put in an anchor
# for jumping to the first two letters of a given symbol.
# (Only inserted the first time those two letters appear
# in a given .)
# */
my %group_letters_linked = ();
getopts("Nc:dnwt:x:",\%options);
# The options are handled after processing config file so they can
# override behavior. However, we need to handle the options first
# before checking for input file names (which we should do first
# to avoid wasting a lot of time before telling the user he/she
# did something wrong).
# /*! @abstract
# The main TOC file (e.g. index.html).
# */
my $masterTOCFileName = "";
# my $bookxmlname = "";
if (($#ARGV == 0 || $#ARGV == 1 || $#ARGV == 2) && (-d $ARGV[0])) {
$inputDir = $ARGV[0];
if ($#ARGV) {
$masterTOCFileName = $ARGV[1];
}
# if ($#ARGV > 1) {
# $bookxmlname = $ARGV[2];
# }
} else {
die "You must specify a single input directory for processing.\n";
}
########################## Setup from Configuration File #######################
my $localConfigFileName = "headerDoc2HTML.config";
my $preferencesConfigFileName = "com.apple.headerDoc2HTML.config";
my $homeDir;
my $usersPreferencesPath;
my $systemPreferencesPath;
#added WD-rpw 07/30/01 to support running on MacPerl
#modified WD-rpw 07/01/02 to support the MacPerl 5.8.0
if ($^O =~ /MacOS/i) {
eval {
require "FindFolder.pl";
$homeDir = MacPerl::FindFolder("D"); #D = Desktop. Arbitrary place to put things
$usersPreferencesPath = MacPerl::FindFolder("P"); #P = Preferences
};
if ($@) {
import Mac::Files;
$homeDir = Mac::Files::FindFolder(kOnSystemDisk(), kDesktopFolderType());
$usersPreferencesPath = Mac::Files::FindFolder(kOnSystemDisk(), kPreferencesFolderType());
}
$systemPreferencesPath = $usersPreferencesPath;
} else {
$homeDir = (getpwuid($<))[7];
$usersPreferencesPath = $homeDir.$pathSeparator."Library".$pathSeparator."Preferences";
$systemPreferencesPath = "/Library/Preferences";
}
my $devtoolsPreferencesPath = "$FindBin::Bin"."$pathSeparator".".."."$pathSeparator"."share"."$pathSeparator"."headerdoc"."$pathSeparator"."conf";
my $CWD = getcwd();
my @configFiles = ($devtoolsPreferencesPath.$pathSeparator.$preferencesConfigFileName, $systemPreferencesPath.$pathSeparator.$preferencesConfigFileName, $usersPreferencesPath.$pathSeparator.$preferencesConfigFileName, $Bin.$pathSeparator.$localConfigFileName, $CWD.$pathSeparator.$localConfigFileName);
# ($Bin.$pathSeparator.$localConfigFileName, $usersPreferencesPath.$pathSeparator.$preferencesConfigFileName);
# default configuration, which will be modified by assignments found in config files.
# The default values listed in this hash must be the same as those in the identical
# hash in headerDoc2HTML--so that links between the frameset and the masterTOC work.
my %config = (
defaultFrameName => "index.html",
masterTOCName => "MasterTOC.html",
groupHierLimit => 0,
groupHierSubgroupLimit => 0
);
if ($options{c}) {
@configFiles = ( $options{c} );
}
%config = &updateHashFromConfigFiles(\%config,\@configFiles);
my $framesetFileName;
my @TOCTemplateList = ();
my @TOCNames = ();
my $framework = "";
my $frameworknestlevel = -1;
my $frameworkShortName = "";
my $frameworkpath = "";
my $headerpath = "";
my $frameworkrelated = "";
my $frameworkUID = "";
my $frameworkCopyrightString = "";
my $landingPageUID = "";
my $landingPageFrameworkUID = "";
my $stripDotH = 0;
my $gather_functions = 0;
my $gather_types = 0;
my $gather_properties = 0;
my $gather_globals_and_constants = 0;
my $gather_man_pages = 0;
my $apiUIDPrefix = "apple_ref";
my $compositePageName = "CompositePage.html";
my $classAsComposite = 0;
my $externalAPIUIDPrefixes = "";
my %usedInTemplate = ();
if (defined $config{"dateFormat"}) {
$HeaderDoc::datefmt = $config{"dateFormat"};
if ($HeaderDoc::datefmt !~ /\S/) {
$HeaderDoc::datefmt = "%B %d, %Y";
}
} else {
$HeaderDoc::datefmt = "%B %d, %Y";
}
use HeaderDoc::APIOwner;
my $tocEncoding = getDefaultEncoding();
# Backwards compatibility with 8.7+patches. May be removed after 8.8.
if (defined ($config{"tocTemplateEncoding"}) && length($config{"tocTemplateEncoding"})) {
warn("The configuration key tocTemplateEncoding is deprecated.\nUse TOCTemplateEncoding instead.");
$tocEncoding = $config{"tocTemplateEncoding"}
}
if (defined ($config{"TOCTemplateEncoding"}) && length($config{"TOCTemplateEncoding"})) {
$tocEncoding = $config{"TOCTemplateEncoding"}
}
HeaderDoc::APIOwner::fix_date($tocEncoding);
my ($sec,$min,$hour,$mday,$mon,$yr,$wday,$yday,$isdst) = localtime(time());
my $yearStamp = strftime("%Y", $sec, $min, $hour,
$mday, $mon, $yr, $wday, $yday, $isdst);
my $dateStamp = HeaderDoc::HeaderElement::strdate($mon, $mday, $yr + 1900, $tocEncoding);
# die("DS: $dateStamp\n");
if (defined $config{"styleImports"}) {
$HeaderDoc::styleImports = $config{"styleImports"};
$HeaderDoc::styleImports =~ s/[\n\r]/ /sgo;
$HeaderDoc::use_styles = 1;
}
if (defined $config{"groupHierLimit"}) {
$HeaderDoc::groupHierLimit = $config{"groupHierLimit"};
}
if (defined $config{"groupHierSubgroupLimit"}) {
$HeaderDoc::groupHierSubgroupLimit = $config{"groupHierSubgroupLimit"};
}
if (defined $config{"tocStyleImports"}) {
$HeaderDoc::tocStyleImports = $config{"tocStyleImports"};
$HeaderDoc::tocStyleImports =~ s/[\n\r]/ /sgo;
$HeaderDoc::use_styles = 1;
}
if (defined $config{"textStyle"}) {
HeaderDoc::APIOwner->setStyle("text", $config{"textStyle"});
}
if (defined $config{"copyrightOwner"}) {
# /*!
# @abstract
# The copyright owner (from the config file).
# */
$HeaderDoc::copyrightOwner = $config{"copyrightOwner"};
}
if (defined $config{"commentStyle"}) {
HeaderDoc::APIOwner->setStyle("comment", $config{"commentStyle"});
}
if (defined $config{"preprocessorStyle"}) {
HeaderDoc::APIOwner->setStyle("preprocessor", $config{"preprocessorStyle"});
}
if (defined $config{"funcNameStyle"}) {
HeaderDoc::APIOwner->setStyle("function", $config{"funcNameStyle"});
}
if (defined $config{"stringStyle"}) {
HeaderDoc::APIOwner->setStyle("string", $config{"stringStyle"});
}
if (defined $config{"charStyle"}) {
HeaderDoc::APIOwner->setStyle("char", $config{"charStyle"});
}
if (defined $config{"numberStyle"}) {
HeaderDoc::APIOwner->setStyle("number", $config{"numberStyle"});
}
if (defined $config{"keywordStyle"}) {
HeaderDoc::APIOwner->setStyle("keyword", $config{"keywordStyle"});
}
if (defined $config{"typeStyle"}) {
HeaderDoc::APIOwner->setStyle("type", $config{"typeStyle"});
}
if (defined $config{"paramStyle"}) {
HeaderDoc::APIOwner->setStyle("param", $config{"paramStyle"});
}
if (defined $config{"varStyle"}) {
HeaderDoc::APIOwner->setStyle("var", $config{"varStyle"});
}
if (defined $config{"templateStyle"}) {
HeaderDoc::APIOwner->setStyle("template", $config{"templateStyle"});
}
if (defined $config{"externalXRefFiles"}) {
$externalXRefFiles = $config{"externalXRefFiles"};
}
if (defined $config{"externalAPIUIDPrefixes"}) {
$externalAPIUIDPrefixes = $config{"externalAPIUIDPrefixes"};
}
if (defined $config{"defaultFrameName"}) {
$framesetFileName = $config{"defaultFrameName"};
}
if (defined $config{"apiUIDPrefix"}) {
$apiUIDPrefix = $config{"apiUIDPrefix"};
}
if (defined $config{"compositePageName"}) {
$compositePageName = $config{"compositePageName"};
}
if (defined $config{"classAsComposite"}) {
$classAsComposite = $config{"classAsComposite"};
$classAsComposite =~ s/\s*//;
} else {
$classAsComposite = 0;
}
if (defined $config{"masterTOCName"} && $masterTOCFileName eq "") {
$masterTOCFileName = $config{"masterTOCName"};
}
if (defined $config{"stripDotH"}) {
$stripDotH = $config{"stripDotH"};
}
# /*!
# @abstract
# The background color for the built-in (default) template.
# */
$GHD::bgcolor = "#ffffff";
my $TOCTemplateFile = "HEADERDOC_DEFAULT_INTERNAL_TEMPLATE";
if (defined $config{"TOCTemplateFile"}) {
$TOCTemplateFile = $config{"TOCTemplateFile"};
}
my $oldRecSep = $/;
undef $/; # read in files as strings
my @filelist = split(/\s/, $TOCTemplateFile);
foreach my $file (@filelist) {
my %used = ();
my $TOCTemplate = "";
my $found = 0;
my $foundpath = "";
if ($file eq "HEADERDOC_DEFAULT_INTERNAL_TEMPLATE") {
$found = 1;
$foundpath = "n/a";
$TOCTemplate = default_template();
} else {
print STDERR "Searching for $file\n";
my @templateFiles = ($devtoolsPreferencesPath.$pathSeparator.$file, $systemPreferencesPath.$pathSeparator.$file, $usersPreferencesPath.$pathSeparator.$file, $Bin.$pathSeparator.$file, $file);
foreach my $filename (@templateFiles) {
if (open(TOCFILE, "<$filename")) {
$TOCTemplate = \@indexgroup
) for
# the destination.
# @param typename
# The name of the type of the destination (e.g. header, category, ...)
# @discussion
# In addition to being a link, the anchors returned may also
# be jump link destinations for letter groups within long
# sets of links. Thus, this function needs to know the name
# of the group that the destination is in, as well as the
# type (e.g. header, category...).
# */
sub getLinkToFramesetFrom {
my $masterTOCFile = shift;
my $dest = shift;
my $name = shift;
my $group = shift;
my $typename = shift;
my $mansrc = shift;
my $linkString;
my %manPageTypes = (
"base" => "Mac OS X (client) manual page",
"server" => "Mac OS X Server manual page",
"devtools" => "Developer tools manual page",
"chud" => "CHUD (part of developer tools) manual page",
"internal" => "INTERNAL MANUAL PAGE"
);
my $maninsert = "";
if ($mansrc) {
$maninsert = "•";
$mansrc = " mansrc=\"$mansrc\" class=\"manpage_source_$mansrc\" title=\"".$manPageTypes{$mansrc}."\" ";
}
my $relPath = &findRelativePath($masterTOCFile, $dest);
my $namestring = getNameStringForLink($name, $group, $typename);
$linkString = "$maninsert$name\@indexgroup
) for
# the destination.
# @param typename
# The name of the type of the destination (e.g. header, category, ...)
# @discussion
# Used by {@link getLinkToFramesetFrom} and
# {@link getLinkToFunctionFrom}.
# */
sub getNameStringForLink
{
my $name = shift;
my $group = shift;
my $typename = shift;
my $namestring = "";
my $groupns = $group;
$groupns =~ s/\s/_/sg;
my $grouptype = $groupns."_".$typename;
my $firsttwo = uc($name);
$firsttwo =~ s/^(..).*$/$1/s;
# print STDERR "FIRSTTWO: $firsttwo\n";
# cluck("test\n");
if (!$letters_linked{$firsttwo}) {
$namestring = "name=\"group_$grouptype"."_$firsttwo\"";
$letters_linked{$firsttwo} = 1;
# print STDERR "SET letters_linked{$firsttwo}\n";
} else {
$letters_linked{$firsttwo}++;
}
return $namestring;
}
# /*!
# @abstract
# Returns a relative link to a function, data type, or other
# non-API-owning API element (i.e. not an entire header or class).
# @param masterTOCFile
# The path of the TOC file that this will go into.
# @param dest
# The filesystem path of the destination content.
# @param name
# The name of the destination as it should appear in the human-readable
# text for the link.
# @param group
# The name of the group (from \@indexgroup
) for
# the destination.
# @param typename
# The name of the type of the destination (e.g. header, category, ...)
# @discussion
# In addition to being a link, the anchors returned may also
# be jump link destinations for letter groups within long
# sets of links. Thus, this function needs to know the name
# of the group that the destination is in, as well as the
# type (e.g. header, category...).
# */
sub getLinkToFunctionFrom {
my $masterTOCFile = shift;
my $dest = shift;
my $name = shift;
my $uid = shift;
my $group = shift;
my $typename = shift;
my $linkString;
$uid =~ s/^"//;
$uid =~ s/"$//;
my $relPath = &findRelativePath($masterTOCFile, $dest);
my $ns = getNameStringForLink($name, $group, $typename);
my $noClassName = $name;
$noClassName =~ s/.*\:\://s;
my $urlname = sanitize($noClassName);
my $lp = "";
if ($uid && length($uid)) {
$urlname = $uid;
$lp = " logicalPath=\"$uid\"";
}
# print STDERR "UIDCHECK: $uid\n";
if ($uid =~ /\/\/apple_ref\/occ\/(clm|instm|intfcm|intfm)\//) {
# Format Objective-C class name
my $type = $1;
$name =~ s/^(.*)\:\://;
my $class = $1;
my $plusmin = "+";
if ($type eq "instm") {
$plusmin = "-";
}
$name = $plusmin."[ $class $name ]";
}
$linkString = "$name\$\$frameworkdiscussion\@\@
"; $template .= "\$\$headersection\@\@\n\$\$headerlist cols=2 order=down atts=border=\"0\" width=\"80%\"\@\@\n\$\$/headersection\@\@\n"; $template .= "\$\$classsection\@\@
\n\$\$classlist cols=2 order=down atts=border=\"0\" width=\"80%\"\@\@\n\$\$/classsection\@\@\n"; $template .= "\$\$categorysection\@\@
\n\$\$categorylist cols=2 order=down atts=border=\"0\" width=\"80%\"\@\@\n\$\$/categorysection\@\@\n"; $template .= "\$\$protocolsection\@\@
\n\$\$protocollist cols=2 order=down atts=border=\"0\" width=\"80%\"\@\@\n\$\$/protocolsection\@\@\n"; $template .= "\$\$functionsection\@\@
\n\$\$functionlist cols=2 order=down atts=border=\"0\" width=\"80%\"\@\@\n\$\$/functionsection\@\@\n"; $template .= "\$\$typesection\@\@
\n\$\$typelist cols=2 order=down atts=border=\"0\" width=\"80%\"\@\@\n\$\$/typesection\@\@\n"; $template .= "\$\$datasection\@\@
\n\$\$datalist cols=2 order=down atts=border=\"0\" width=\"80%\"\@\@\n\$\$/datasection\@\@\n"; $template .= "\$\$propsection\@\@
\n\$\$proplist cols=2 order=down atts=border=\"0\" width=\"80%\"\@\@\n\$\$/propsection\@\@\n"; $template .= "\$\$copyright\@\@\n"; $template .= "\n\n"; $gather_globals_and_constants = 1; $gather_types = 1; $gather_functions = 1; return $template; } # /*! # @abstract # Returns a link string linking to a jump destination for a # given letter group within an
\@indexgroup
# group within a data type family (e.g. headers,
# functions, etc.).
# @param group
# The \@indexgroup
group that this will appear under.
# @param linkletter
# A name for the letter range suitable for inclusion in an anchor's
# "name" attribute.
# @param letter
# The first letter of the letter range.
# @param typename
# The name of the type of the destination (e.g. header, category, ...)
# @param optional_last
# The end of the letter range. (Optional.)
#
# If omitted, for a single-character letter, the last part of
# the range is omitted. For example, instead of showing "A-B",
# it would just show "A". If the start of the range (letter) is
# two characters, in which case the range is automatically assumed
# to end with a Z (AM-AZ, for example).
#
# */
sub gethierlinkstring
{
my $group = shift;
my $linkletter = shift;
my $letter = shift;
my $typename = shift;
my $optional_last = "";
if (@_) {
$optional_last = shift;
$optional_last = "-$optional_last";
} elsif ($letter =~ /../) {
$optional_last = $letter;
$optional_last =~ s/(.)./$1Z/s;
$optional_last = "-$optional_last";
}
my $groupns = $group;
$groupns =~ s/\s/_/sg;
my $grouptype = $groupns."_".$typename;
return "$letter$optional_last";
}
# /*!
# @abstract
# Generates a multi-column table of links.
# @param inputstring
# A pile of links, one per line.
# @param settings
# The table parameters from the template file. (These are
# documented in the template section of the
# {@linkdoc //apple_ref/doc/uid/TP40001215 HeaderDoc User Guide}).
# @param groupname
# The \@indexgroup
group that this will appear under.
# @param typename
# The name of the type of the destination (e.g. header, category, ...)
# @param isman
# Set to 1 for manual pages. This causes the code to generate
# multiple tables, one per manual section.
# */
sub genTable
{
my $inputstring = shift;
my $settings = shift;
my $groupname = shift;
my $typename = shift;
my $isman = 0;
if (@_) {
$isman = shift;
}
my $ncols = 0;
my $order = "down";
my $attributes = "border=\"0\" width=\"100%\"";
my $tdclass = "";
my $trclass = "";
my $localDebug = 0;
my $addempty = 0;
my $notable = 0;
print STDERR "genTable(IS: [omitted], SET: $settings, GN: $groupname, TN: $typename, IM: $isman)\n" if ($localDebug);
my $mansectiontext = "";
if ($isman) {
my $mansectionname = $groupname;
$mansectionname =~ s/^\s*Section\s+//s;
my $filename="sectiondesc/man$mansectionname".".html";
if (open(SECTIONTEXT, "<$filename")) {
my $lastrs = $/;
$/ = undef;
$mansectiontext = \n"; # Reduce the subgroup limit and increase the attempt count so that if # we execute this code again, we will probably get more subgroups. # Use the attempts count to ensure that this loop isn't infinite if # all entries have the same first letter. if ($splitparts < $minsplit) { print STDERR "Minimum split count $minsplit not reached. Split count was $splitparts. Reducing split count.\n" if ($localDebug); $subgroupLimit = $subgroupLimit / $minsplit; } $attempts++; } print STDERR "SPLITPARTS: $splitparts\n" if ($localDebug); if ($splitparts <= 1) { print STDERR "Could not split list at all. Dropping singleton.\n" if ($localDebug); $hierstring = ""; # eliminate singleton lists. } # } else { # print STDERR "Not over limit: $groupname\n"; } # print STDERR "HIERSTRING: $hierstring\n"; my $ngroups = scalar(keys(%groups)); my $groupnamestring = ""; if ($groupname =~ /\S/) { my $groupnospc = $groupname; $groupnospc =~ s/\s/_/sg; $groupnamestring = "\n"; } if ($groupname eq "hd_master_letters_linked") { $groupnamestring = ""; } my $groupheadstring = "
\n"; print STDERR "GROUPNAME: $groupname\n" if ($localDebug); my $groupns = $groupname; $groupns =~ s/\s/_/sg; my $grouptype = $groupns."_".$typename; print STDERR "GROUPTYPE: \"$grouptype\"\n" if ($localDebug); my %twoletterlinkcounts = %{$group_letters_linked{$grouptype}}; print STDERR "GLLCHECK: ".scalar(keys %{$group_letters_linked{$grouptype}})."\n" if ($localDebug); my %oneletterlinkcounts = (); foreach my $twoletter (sort keys %twoletterlinkcounts) { # print STDERR "TL: $twoletter\n"; my $firstletter = $twoletter; $firstletter =~ s/^(.).*$/$1/s; if (!$oneletterlinkcounts{$firstletter}) { # print STDERR "FIRST $firstletter; linkletter -> $twoletter\n"; $oneletterlinkcounts{$firstletter} = $twoletterlinkcounts{$twoletter}; if ($prevletter ne "") { $hierstring .= gethierlinkstring($groupname, $linkletter, $prevletter, $typename)." | \n"; } $prevletter = $firstletter; $linkletter = $twoletter; $splitparts++; } elsif ($oneletterlinkcounts{$firstletter} + $twoletterlinkcounts{$twoletter} > $subgroupLimit) { # print STDERR "LIMIT $firstletter; linkletter -> $twoletter\n"; $hierstring .= gethierlinkstring($groupname, $linkletter, $prevletter, $typename, $prevtwoletter)." | \n"; $prevletter = $twoletter; $linkletter = $twoletter; $splitparts++; } $prevtwoletter = $twoletter; } if ($prevletter ne "") { $hierstring .= gethierlinkstring($groupname, $linkletter, $prevletter, $typename); } $hierstring .= "
\n"; my $grouptailstring = "\n"; if (!$ngroups) { $groupheadstring = ""; $grouptailstring = ""; } $settings =~ s/^\s*(\w+list)\s*//; my $name = $1; if ($settings =~ s/^nogroups\s+//) { $ngroups = 0; } if ($settings =~ s/^cols=(\d+)\s+//) { $ncols = $1; } if ($settings =~ s/^order=(\w+)\s+//) { $order = $1; if (!$ncols) { $ncols = 1; } } if ($settings =~ s/^trclass=(\w+)\s+//) { $trclass = " class=\"$1\""; if (!$ncols) { $ncols = 1; } } if ($settings =~ s/^tdclass=(\w+)\s+//) { $tdclass = " class=\"$1\""; if (!$ncols) { $ncols = 1; } } if ($settings =~ s/^notable//) { $notable = 1; $ncols = 1; } if ($settings =~ s/^addempty=(\d+)//) { $addempty = $1; } if ($settings =~ s/^atts=//) { $attributes = $settings; $settings = ""; if (!$ncols) { $ncols = 1; } } if ($ncols) { if (!$nlines) { return ""; } my @columns = (); my $loopindex = $ncols; while ($loopindex--) { my @column = (); push(@columns, \@column); } my $curcolumn = 0; my $curline = 0; my $lines_per_column = int(($nlines + $ncols - 1) / $ncols); # ceil(nlines/ncols) my $blanks = ($lines_per_column * $ncols) - $nlines; $nlines += $blanks; while ($blanks) { push(@lines, ""); $blanks--; } warn "NLINES: $nlines\n" if ($localDebug); warn "Lines per column: $lines_per_column\n" if ($localDebug); foreach my $line (@lines) { warn "columns[$curcolumn] : adding line\n" if ($localDebug); my $columnref = $columns[$curcolumn]; push(@{$columnref}, $line); $curline++; if ($order eq "across") { $curcolumn = ($curcolumn + 1) % $ncols; } elsif ($curline >= $lines_per_column) { $curline = 0; $curcolumn++; } } if ($localDebug) { $loopindex = 0; while ($loopindex < $ncols) { warn "Column ".$loopindex.":\n"; foreach my $line (@{$columns[$loopindex]}) { warn "$line\n"; } $loopindex++; } } # warn("TABLE $attributes\n"); my $outstring = ""; if (!$notable) { $outstring .= "
\n"; } } } my $line = ${$columns[$curcolumn]}[$currow]; my $val = floor(100/$ncols); if ($notable) { $outstring .= "$line | $line | \n"; } $curline++; $curcolumn = ($curcolumn + 1) % $ncols; } if (!$notable) { $outstring .= "
\@indexgroup
groups
# within the TOC.
# */
sub groupList
{
my $string = "";
my $first = 1;
my @list = groupsort(keys(%groups));
foreach my $group (@list) {
if ($group !~ /\S/) { next; }
if ($first) { $first = 0; }
else { $string .= " | \n"; }
my $groupnospc = $group;
$groupnospc =~ s/\s/_/sg;
my $groupnobr = $group;
$groupnobr =~ s/\s/ /sg;
$string .= "$groupnobr";
}
# $string .= "