package HeaderDoc::Utilities;
use strict;
use vars qw(@ISA @EXPORT $VERSION);
use Carp qw(cluck);
use IPC::Open2;
use IO::Handle;
use Cwd;
use Encode;
use Encode::Guess;
use Encode qw(encode decode);
use HTML::Entities qw(encode_entities);
use Exporter;
foreach (qw(Mac::Files Mac::MoreFiles)) {
eval "use $_";
}
my $depth = 0;
$HeaderDoc::Utilities::VERSION = '$Revision: 1334261201 $';
@ISA = qw(Exporter);
@EXPORT = qw(findRelativePath safeName safeNameNoCollide linesFromFile makeAbsolutePath
printHash printArray fileNameFromPath folderPathForFile
updateHashFromConfigFiles getHashFromConfigFile getVarNameAndDisc
getAPINameAndDisc
registerUID resolveLink parseTokens isKeyword html2xhtml
resolveLinks stringToFields sanitize warnHDComment
classTypeFromFieldAndBPinfo casecmp unregisterUID
unregister_force_uid_clear dereferenceUIDObject validTag emptyHDok
addAvailabilityMacro complexAvailabilityToArray
filterHeaderDocComment filterHeaderDocTagContents processTopLevel
processHeaderComment getLineArrays objectForUID
loadHashes saveHashes getAbsPath allow_everything
getAvailabilityMacros printFields stripTags
objName byLinkage byAccessControl objGroup linkageAndObjName
byMethodType getLangAndSubLangFromFilename splitOnPara
peek dumpCaches getDefaultEncoding stripLeading
fixXHTMLAttributes html_fixup_links xml_fixup_links
calcDepth);
my %uid_list_by_uid = ();
my %uid_list = ();
my %uid_conflict = ();
my %uid_candidates = ();
my $xmllintversion = "";
my $xmllint = "/usr/bin/xmllint";
my %objid_hash;
my $pathSeparator;
my $isMacOS;
BEGIN {
if ($^O =~ /MacOS/io) {
$pathSeparator = ":";
$isMacOS = 1;
} else {
$pathSeparator = "/";
$isMacOS = 0;
}
}
$xmllint = "/usr/bin/xmllint";
if ( ! -x $xmllint ) {
if ( -x "/usr/local/bin/xmllint" ) {
$xmllint = "/usr/local/bin/xmllint";
} elsif (-x "/sw/bin/xmllint" ) {
$xmllint = "/sw/bin/xmllint";
} elsif (-x "/opt/local/bin/xmllint" ) {
$xmllint = "/sw/bin/xmllint";
}
}
open(XMLLINTPIPE, "$xmllint --version 2>&1 |");
$xmllintversion = <XMLLINTPIPE>;
close(XMLLINTPIPE);
$xmllintversion =~ s/\n.*//sg;
$xmllintversion =~ s/.*?(\d+)/$1/s;
if ($xmllintversion eq "20607") {
warn "Old LibXML2 version. XML Output may not work correctly.\n";
}
my $macFileLengthLimit;
BEGIN {
if ($isMacOS) {
$macFileLengthLimit = 31;
} else {
$macFileLengthLimit = 255;
}
}
my $longestExtension = 5;
sub findRelativePath {
my ($fromMe, $toMe) = @_;
if ($fromMe eq $toMe) {return "";}; my @fromMeParts = split (/$pathSeparator/, $fromMe);
my @toMeParts = split (/$pathSeparator/, $toMe);
my $i = 0;
my $oldWarningLevel = $^W;
{
$^W = 0;
while ($fromMeParts[$i] eq $toMeParts[$i]) { $i++;};
}
$^W = $oldWarningLevel;
@fromMeParts = splice (@fromMeParts, $i);
@toMeParts = splice (@toMeParts, $i);
my $numFromMeParts = @fromMeParts; my $relPart = "../" x ($numFromMeParts - 1);
my $relPath = $relPart.join("/", @toMeParts);
return $relPath;
}
my %safeNameDefaults = (filename => "", fileLengthLimit =>"$macFileLengthLimit", longestExtension => "$longestExtension");
sub safeName {
my %args = (%safeNameDefaults, @_);
my ($filename) = $args{"filename"};
my $returnedName="";
my $safeLimit;
my $partLength;
my $nameLength;
$safeLimit = ($args{"fileLengthLimit"} - $args{"longestExtension"});
$partLength = int (($safeLimit/2)-1);
$filename =~ tr/a-zA-Z0-9./_/cs; $nameLength = ($filename =~ tr/a-zA-Z0-9._//);
if ( $nameLength > $safeLimit) {
my $safeName = $filename;
$safeName =~ s/^(.{$partLength}).*(.{$partLength})$/$1_$2/;
$returnedName = $safeName;
} else {
$returnedName = $filename;
}
return $returnedName;
}
my %dispensedSafeNames;
sub safeNameNoCollide {
my %args = (%safeNameDefaults, @_);
my ($filename) = $args{"filename"};
my $returnedName="";
my $safeLimit;
my $partLength;
my $nameLength;
my $localDebug = 0;
$filename =~ tr/a-zA-Z0-9./_/cs; if (exists $dispensedSafeNames{lc($filename)}) {
while (exists $dispensedSafeNames{lc($filename)}) {
$filename =~ /(\D+)(\d*)((\.\w*)*)/o;
my $rootTextPart = $1;
my $rootNumPart = $2;
my $extension = $4;
if (defined $rootNumPart) {
$rootNumPart++;
} else {
$rootNumPart = 2
}
if (!$extension){$extension = '';};
$filename = $rootTextPart.$rootNumPart.$extension;
}
}
$returnedName = $filename;
$safeLimit = ($args{"fileLengthLimit"} - $args{"longestExtension"});
$partLength = int (($safeLimit/2)-1);
$nameLength = length($filename);
if ($nameLength > $safeLimit) {
my $safeName = $filename;
$safeName =~ s/^(.{$partLength}).*(.{$partLength})$/$1_$2/;
if (exists $dispensedSafeNames{lc($safeName)}) {
my $i = 1;
while (exists $dispensedSafeNames{lc($safeName)}) {
$safeName =~ s/^(.{$partLength}).*(.{$partLength})$/$1$i$2/;
$i++;
}
}
my $lcSafename = lc($safeName);
print STDERR "\t $lcSafename\n" if ($localDebug);
$returnedName = $safeName;
} else {
$returnedName = $filename;
}
$dispensedSafeNames{lc($returnedName)}++;
return $returnedName;
}
sub makeAbsolutePath {
my $relPath = shift;
my $relTo = shift;
if ($relPath !~ /^\//o) { # doesn't start with a slash
$relPath = $relTo."/".$relPath;
}
return $relPath;
}
sub guess_prioritized_encoding
{
my $text = shift;
my $filePath = shift; my $encDebug = shift;
my $decoder = guess_encoding($text, qw/iso-8859-1 UTF-8/);
if ($text !~ /\S/) { return undef; };
print STDERR "FILEPATH $filePath DECODER: $decoder\n" if ($encDebug);
print "TEXT: $text\n" if ($encDebug);
if ($decoder =~ /utf8/ && $decoder =~ /iso-8859-1/) {
print STDERR "Could be UTF-8 or ISO-8859-1. Going with UTF-8.\n" if ($encDebug);
$decoder = guess_encoding($text);
}
print STDERR "POINT 2\n" if ($encDebug);
if (!ref($decoder)) {
$decoder = guess_encoding($text, qw/Windows-1252/);
}
print STDERR "POINT 3\n" if ($encDebug);
if (!ref($decoder)) {
$decoder = guess_encoding($text, qw/euc-jp shiftjis 7bit-jis/);
}
print STDERR "POINT 4\n" if ($encDebug);
if (!ref($decoder)) {
$decoder = guess_encoding($text, qw/euc-jp shiftjis 7bit-jis/);
}
print STDERR "POINT 5\n" if ($encDebug);
if (!ref($decoder)) {
$decoder = guess_encoding($text, qw/iso-8859-2/);
}
print STDERR "POINT 6\n" if ($encDebug);
if (!ref($decoder)) {
$decoder = guess_encoding($text, qw/iso-8859-3/);
}
print STDERR "POINT 7\n" if ($encDebug);
if (!ref($decoder)) {
$decoder = guess_encoding($text, qw/iso-8859-4/);
}
print STDERR "POINT 8\n" if ($encDebug);
if (!ref($decoder)) {
$decoder = guess_encoding($text, qw/iso-8859-5/);
}
print STDERR "POINT 9\n" if ($encDebug);
if (!ref($decoder)) {
$decoder = guess_encoding($text, qw/iso-8859-6/);
}
print STDERR "POINT 10\n" if ($encDebug);
if (!ref($decoder)) {
$decoder = guess_encoding($text, qw/iso-8859-7/);
}
print STDERR "POINT 11\n" if ($encDebug);
if (!ref($decoder)) {
$decoder = guess_encoding($text, qw/iso-8859-8/);
}
print STDERR "POINT 12\n" if ($encDebug);
if (!ref($decoder)) {
$decoder = guess_encoding($text, qw/iso-8859-9/);
}
print STDERR "POINT 13\n" if ($encDebug);
if (!ref($decoder)) {
$decoder = guess_encoding($text, qw/iso-8859-10/);
}
print STDERR "POINT 14\n" if ($encDebug);
if (!ref($decoder)) {
$decoder = guess_encoding($text, qw/iso-8859-11/);
}
print STDERR "POINT 15\n" if ($encDebug);
print STDERR "POINT 19\n" if ($encDebug);
ref($decoder) or die "Can't guess encoding: $decoder";
print STDERR "ENC is ".$decoder->name."\n" if ($encDebug);
return $decoder;
}
sub getAPINameAndDisc {
my $line = shift;
my $lang = shift; my $joinpattern = shift;
my ($name, $disc, $operator);
my $localDebug = 0;
print STDERR "LINE: $line\n" if ($localDebug);
if ($line =~ /^\s*\n\s*/o) {
print STDERR "returning discussion only.\n" if ($localDebug);
$line =~ s/^\s+//o;
return ("", "$line", 0);
}
my $nameline = 0;
$line =~ s/^\s+//o;
if ($line =~ /\S+.*\n.*\S+/o) {
$nameline = 0;
($name, $disc) = split (/\n/, $line, 2);
} else {
$nameline = 1;
($name, $disc) = smartsplit($line, $joinpattern, $lang);
}
$disc =~ s/\s*$//o;
if ($name =~ /operator/o) { ($operator, $name, $disc) = split (/\s/, $line, 3);
$name = $operator." ".$name;
}
print STDERR "name is $name, disc is $disc, nameline is $nameline" if ($localDebug);
return ($name, $disc, $nameline);
}
sub smartsplit
{
my $line = shift;
my $pattern = shift;
my $lang = shift;
my $localDebug = 0;
print STDERR "LINE: $line\n" if ($localDebug);
print STDERR "PATTERN: $pattern\n" if ($localDebug);
if (!$pattern || $pattern eq "") {
return split (/\s/, $line, 2);
}
my @parts = split(/(\s+|$pattern)/, $line);
my $leading = 1;
my $lastspace = "";
my $name = "";
my $desc = "";
my @matchstack = ();
foreach my $part (@parts) {
if ($part eq "") { next; }
print STDERR "PART: $part\n" if ($localDebug);
if ($desc eq "") {
print STDERR "Working on name.\n" if ($localDebug);
if ($part =~ /\s/) {
if ($leading) {
print STDERR "Clear leading (space).\n" if ($localDebug);
$name .= $part;
$leading = 0;
} else {
print STDERR "Set lastspace.\n" if ($localDebug);
$lastspace = $part;
}
} else {
if ($leading) {
print STDERR "Clear leading (text).\n" if ($localDebug);
$leading = 0;
$name .= $part;
} else {
if ($part =~ /($pattern)/) {
print STDERR "Appending to name (pattern match).\n" if ($localDebug);
$name .= $lastspace.$part;
$lastspace = "";
$leading = 1;
my $isbrace = HeaderDoc::BlockParse::bracematching($part, $lang);
if ($isbrace ne "") {
print STDERR "Adding to match stack\n" if ($localDebug);
push(@matchstack, $part);
} elsif ($part eq HeaderDoc::BlockParse::peekmatch(\@matchstack, $lang)) {
print STDERR "Popping from match stack\n" if ($localDebug);
pop(@matchstack);
}
} elsif (scalar(@matchstack)) {
print STDERR "Stack not empty. Appending to name\n" if ($localDebug);
$name .= $lastspace.$part;
$lastspace = "";
$leading = 1;
} elsif ($lastspace eq "") {
print STDERR "Appending to name.\n" if ($localDebug);
$name .= $part;
} else {
print STDERR "Starting description.\n" if ($localDebug);
$desc = $part;
}
}
}
} else {
$desc .= $part;
}
}
$name =~ s/^\s*//s;
print STDERR "Returning NAME: $name DESC: $desc\n" if ($localDebug);
return ($name, $desc);
}
sub updateHashFromConfigFiles {
my $configHashRef = shift;
my $fileArrayRef = shift;
foreach my $file (@{$fileArrayRef}) {
my %hash = &getHashFromConfigFile($file);
%{$configHashRef} = (%{$configHashRef}, %hash); }
return %{$configHashRef};
}
sub getHashFromConfigFile {
my $configFile = shift;
my %hash;
my $localDebug = 0;
my @lines;
if ((-e $configFile) && (-f $configFile)) {
print STDERR "reading $configFile\n" if ($localDebug);
open(INFILE, "<$configFile") || die "Can't open $configFile.\n";
@lines = <INFILE>;
close INFILE;
} else {
print STDERR "No configuration file found at $configFile\n" if ($localDebug);
return;
}
foreach my $line (@lines) {
if ($line =~/^ chomp $line;
my ($key, $value) = split (/\s*=>\s*/, $line);
if ((defined($key)) && (length($key))){
print STDERR " $key => $value\n" if ($localDebug);
$hash{$key} = $value;
}
}
undef @lines;
return %hash;
}
sub linesFromFile {
my $filePath = shift;
my $useFilter = 0;
if (@_) {
$useFilter = shift;
}
my $oldRecSep;
my $fileString;
$oldRecSep = $/;
undef $/; if (!open(INFILE, "<$filePath")) {
$HeaderDoc::exitstatus = -1;
warn "Can't open $filePath: $!\n";
return ();
}
$fileString = <INFILE>;
close INFILE;
$/ = $oldRecSep;
if ($HeaderDoc::enable_macro_filter && $useFilter) {
$fileString = HeaderDoc::MacroFilter::filterFileString($fileString);
}
my $encDebug = 0;
print STDERR "POINT 1\n" if ($encDebug);
my $decoder = guess_prioritized_encoding($fileString, $filePath, $encDebug);
my $encoding = "";
if ($decoder) {
$encoding = $decoder->name;
} else {
$encoding = "ascii";
}
$fileString =~ s/\015\012/\n/go;
$fileString =~ s/\r\n/\n/go;
$fileString =~ s/\n\r/\n/go;
$fileString =~ s/\r/\n/go;
my @lineArray = split (/\n/, $fileString);
my @retarr = map($_."\n", @lineArray);
return ($encoding, \@retarr);
}
sub chooseBestAPIRef
{
my $fromObj = shift;
my $arrayref = shift;
my @arr = @{$arrayref};
my $localDebug = 0;
my $bogus = 0;
if ($fromObj) {
my $headerName = "";
my $className = "";
my $targetLang = $fromObj->lang();
my $targetSubLang = $fromObj->sublang();
my $apiOwner = $fromObj->apiOwner();
my $name = $fromObj->apiuidname();
if ($fromObj->isAPIOwner()) {
my $class = ref($fromObj) || $fromObj;
if ($class !~ /HeaderDoc::Header/) {
$className = $fromObj->name();
}
} else {
my $class = ref($apiOwner) || $apiOwner;
if ($class !~ /HeaderDoc::Header/) {
$className = $apiOwner->name();
}
}
my $class = ref($apiOwner) || $apiOwner;
my $headerObj = undef;
if ($class =~ /HeaderDoc::Header/) {
$headerObj = $apiOwner;
} else {
$headerObj = $apiOwner->headerObject();
}
$headerName = $headerObj->filename();
$className =~ s/\s//sgo;
$className =~ s/<.*?>//sgo;
$headerName =~ s/\s//sgo;
$headerName =~ s/<.*?>//sgo;
my @newarr = ();
foreach my $ref (@arr) {
if ($ref =~ /^\/\/([^\/]+)\/([^\/]+)\/([^\/]+)\/([^\/]+)\/([^\/]+)\/([^\/]+)(\/|$)/) {
my $apple_ref_part = $1;
my $language_part = $2;
my $reftype_part = $3;
my $class_part = $4;
my $owning_symbol_part = $5;
my $symbol_part = $6;
print STDERR "POINT A: REF: $ref reftype_part: $reftype_part\n" if ($localDebug);
if ($reftype_part =~ /(functionparam|methodparam|defineparam|enumconstant|functionvar|methodvar|definevar|structfield|typedeffield)/) {
if (($class_part eq $className) && ($owning_symbol_part eq $name)) {
print STDERR "CLASSMATCH OWNERMATCH (($class_part eq $className) && ($owning_symbol_part eq $name))\n" if ($localDebug);
return ($ref, $bogus);
}
} else {
push(@newarr, $ref);
}
} elsif ($ref =~ /^\/\/([^\/]+)\/([^\/]+)\/([^\/]+)\/([^\/]+)\/([^\/]+)(\/|$)/) {
my $apple_ref_part = $1;
my $language_part = $2;
my $reftype_part = $3;
my $owning_symbol_part = $4;
my $symbol_part = $5;
print STDERR "POINT B: REF: $ref reftype_part: $reftype_part\n" if ($localDebug);
if ($reftype_part =~ /(functionparam|methodparam|defineparam|enumconstant|functionvar|methodvar|definevar|structfield|typedeffield)/) {
if (($owning_symbol_part eq $name) && ($className eq "")) {
print STDERR "OWNERMATCH ($owning_symbol_part eq $name)\n" if ($localDebug);
return ($ref, $bogus);
}
} else {
push(@newarr, $ref);
}
} else {
push(@newarr, $ref);
}
}
@arr = @newarr;
if ($localDebug) {
print STDERR "BOGOSITY CHECK: scalar(\@newarr) is ".scalar(@newarr)."\n";
foreach my $item (@newarr) {
print STDERR "BOGOSITY CHECK: $item\n";
}
}
if (scalar(@newarr) == 1) { $bogus = 1; }
foreach my $ref (@arr) {
print STDERR "PASS 1. CHECKING REF: $ref\n" if ($localDebug);
if ($ref =~ /^\/\/([^\/]+)\/([^\/]+)\/([^\/]+)\/([^\/]+)\/([^\/]+)(\/|$)/) {
my $apple_ref_part = $1;
my $language_part = $2;
my $reftype_part = $3;
my $class_part = $4;
my $symbol_part = $5;
print STDERR "LANGUAGE PART $language_part TARGET: $targetLang OR $targetSubLang\n" if ($localDebug);
print STDERR "CLASS PART: $class_part TARGET: $className\n" if ($localDebug);
if ($language_part eq $targetLang || $language_part eq $targetSubLang) {
if ($class_part eq $className) { return ($ref, $bogus); }
}
}
}
foreach my $ref (@arr) {
print STDERR "PASS 2. CHECKING REF: $ref\n" if ($localDebug);
if ($ref =~ /^\/\/([^\/]+)\/([^\/]+)\/([^\/]+)\/([^\/]+)\/([^\/]+)(\/|$)/) {
my $apple_ref_part = $1;
my $language_part = $2;
my $reftype_part = $3;
my $class_part = $4;
my $symbol_part = $5;
print STDERR "LANGUAGE PART $language_part TARGET: $targetLang OR $targetSubLang\n" if ($localDebug);
print STDERR "HEADER PART: $class_part TARGET: $headerName\n" if ($localDebug);
if ($language_part eq $targetLang || $language_part eq $targetSubLang) {
if ($class_part eq $headerName) { return ($ref, $bogus); }
}
}
}
foreach my $ref (@arr) {
print STDERR "PASS 3. CHECKING REF: $ref\n" if ($localDebug);
my $toObj = objectForUID($ref);
if ($toObj && ($toObj ne "3")) {
bless($toObj, "HeaderDoc::HeaderElement");
bless($toObj, $toObj->class());
print STDERR "FOR UID $ref, got object.\n" if ($localDebug);
print STDERR "FILENAME: ".$toObj->filename()." TARGET: ".$fromObj->filename()."\n" if ($localDebug);
if ($toObj->filename() eq $fromObj->filename()) {
return ($ref, $bogus);
}
} elsif (!$toObj) {
warn("No object found for UID $ref\n");
}
}
}
return ($arr[0], $bogus);
}
sub resolveLink
{
my $fromObj = shift;
my $symbol = shift;
my $linkedword = "linked";
if (@_) {
$linkedword = shift;
}
my $ret = "";
my $fullpath = $HeaderDoc::headerObject->fullpath();
$symbol =~ s/\s*\(\s*\)\s*$//;
my $uid = $uid_list{$symbol};
if ($uid && length($uid)) {
$ret = $uid;
if ($uid_conflict{$symbol}) {
my @candidates = @{$uid_candidates{$symbol}};
my $conflict_is_bogus;
($uid, $conflict_is_bogus) = chooseBestAPIRef($fromObj, $uid_candidates{$symbol});
$ret = $uid;
if (!$conflict_is_bogus) {
warn "$fullpath:0: warning: multiple matches found for symbol \"$symbol\"!!! Only the nearest matching symbol will be $linkedword. Replace the symbol with a specific api ref tag (e.g. apple_ref) in header file to fix this conflict.\n\nCandidates are:\n\t".join("\n\t", @candidates)."\n\nDefault is:\n\t$uid\n";
}
}
}
if ($ret eq "") {
if ($symbol !~ /^\/\//){
warn "$fullpath:0: warning: no symbol matching \"$symbol\" found. If this symbol is not in this file or class, you need to specify it with an api ref tag (e.g. apple_ref).\n";
$ret = $fromObj->genRef("", $symbol, $symbol, "", 1);
} else {
$ret = $symbol; }
}
return $ret;
}
sub registerUID($$$)
{
my $uid = shift;
my $name = shift;
my $object = shift;
my $localDebug = 0;
cluck("registerUID: $name\n") if ($localDebug);
if ($HeaderDoc::ignore_apiuid_errors == 2) { return; }
if ($object->noRegisterUID()) { return; }
my $objtype = ref($object) || $object;
if ($objtype =~ /HeaderDoc::HeaderElement/) { return; }
if ($objtype =~ /HeaderDoc::APIOwner/) { return; }
if ($uid =~ /^\/\/[^\/]+\/[^\/]+\/internal_temporary_object$/ || $uid =~ /^\/\/[^\/]+\/[^\/]+\/internal_temporary_object\/.*$/) { return; }
print STDERR "OBJECT: $object\n" if ($localDebug);
print STDERR "New UID registered: $object -> $uid.\n" if ($localDebug);
cluck("New UID registered: $object -> $uid. Backtrace follows\n") if ($localDebug);
if ($uid_list_by_uid{$uid} != undef) {
if ($uid_list_by_uid{$uid} != $object) {
if ($uid_list_by_uid{$uid} eq "3") {
$uid_list_by_uid{$uid} = $object;
} else {
my $oldobj = $uid_list_by_uid{$uid};
bless($oldobj, "HeaderDoc::HeaderElement");
bless($oldobj, $oldobj->{CLASS});
my $line_1 = $oldobj->linenum();
my $filename_1 = $oldobj->filename();
my $line_2 = $object->linenum();
my $filename_2 = $object->filename();
my $objname = sanitize($uid, 1);
my $objid = $objid_hash{$objname};
if (!$objid) {
$objid = 0;
}
$objid_hash{$objname} = $objid + 1;
my $newuid = $uid . "_DONTLINK_$objid";
if ($uid_list_by_uid{$newuid} == undef) {
my $quiet = 0;
if ($HeaderDoc::running_test) { $quiet = 1; }
if ($object->can("returntype")) {
if ($object->returntype() == undef) {
if ($objtype =~ /HeaderDoc::Method/) { $quiet = 1; }
if ($objtype =~ /HeaderDoc::Function/) {
my $apio = $object->apiOwner();
my $apioname = ref($apio) || $apio;
if ($apioname !~ /HeaderDoc::Header/) { $quiet = 1; }
}
}
}
if (!$quiet) {
if ($newuid=~/^\/\/[^\/]+\/doc\/title:(.*?)\//) {
warn("$filename_2:$line_2: Warning: same name used for more than one comment (base apple_ref type was $1)\n");
warn(" UID changed from $uid to $newuid\n");
warn(" The conflicting declaration appeared at $filename_1:$line_1\n");
} else {
warn("Warning: UID $uid shared by multiple objects. Disambiguating: new uid is $newuid\n");
}
if ($localDebug) { cluck("Backtrace follows\n"); }
}
}
$uid = $newuid;
$uid_list_by_uid{$uid} = $object;
}
}
} else {
$uid_list_by_uid{$uid} = $object;
}
print STDERR "registered UID $uid\n" if ($localDebug);
my $old_uid = $uid_list{$name};
if ($old_uid && length($old_uid) && $old_uid ne $uid) {
print STDERR "OU: $old_uid NU: $uid\n" if ($localDebug);
$uid_conflict{$name} = 1;
if (!$uid_candidates{$name}) {
my @arr = ();
push(@arr, $old_uid);
$uid_candidates{$name} = \@arr;
}
my @arr = @{$uid_candidates{$name}};
push(@arr, $uid);
$uid_candidates{$name} = \@arr;
}
$uid_list{$name} = $uid;
return $uid;
}
sub objectForUID
{
my $uid = shift;
return $uid_list_by_uid{$uid};
}
sub dereferenceUIDObject
{
my $uid = shift;
my $object = shift;
if ( $uid_list_by_uid{$uid} == $object) {
$uid_list_by_uid{$uid} = undef;
$uid_list_by_uid{$uid} = 3;
return 1;
}
return 0;
}
sub unregisterUID
{
my $uid = shift;
my $name = shift;
if ($HeaderDoc::ignore_apiuid_errors == 2) { return 0; }
my $old_uid = $uid_list{$name};
my $ret = 1;
if ($uid_list{$name} eq $uid) {
$uid_list{$name} = undef;
} else {
$ret = 0;
}
return 0;
}
sub unregister_force_uid_clear
{
my $uid = shift;
$uid_list_by_uid{$uid} = undef;
}
sub printArray {
my (@theArray) = @_;
my ($i, $length);
$i = 0;
$length = @theArray;
print STDERR "Printing contents of array:\n";
while ($i < $length) {
print STDERR "Element $i ---> |$theArray[$i++]|\n";
}
print STDERR "\n\n";
}
sub printHash {
my (%theHash) = @_;
print STDERR "Printing contents of hash:\n";
foreach my $keyword (keys(%theHash)) {
print STDERR "$keyword => $theHash{$keyword}\n";
}
print STDERR "-----------------------------------\n\n";
}
sub parseTokens
{
my $lang = shift;
my $sublang = shift;
my $localDebug = 0;
my %parseTokens = ();
$parseTokens{sotemplate} = "";
$parseTokens{eotemplate} = "";
$parseTokens{soc} = "";
$parseTokens{eoc} = "";
$parseTokens{ilc} = "";
$parseTokens{ilc_b} = "";
$parseTokens{soconstructor} = "";
$parseTokens{sofunction} = "";
$parseTokens{soprocedure} = "";
$parseTokens{operator} = "";
$parseTokens{sopreproc} = "";
$parseTokens{lbrace} = "";
$parseTokens{lbraceunconditionalre} = "";
$parseTokens{lbraceconditionalre} = "";
$parseTokens{rbrace} = "";
$parseTokens{enumname} = "enum";
$parseTokens{unionname} = "union";
$parseTokens{structname} = "struct";
$parseTokens{typedefname} = "typedef";
$parseTokens{varname} = "";
$parseTokens{constname} = "";
$parseTokens{functionisbrace} = 0;
$parseTokens{classisbrace} = 0;
$parseTokens{structisbrace} = 0;
my %macronames = ();
$parseTokens{classregexp} = "";
$parseTokens{classbraceregexp} = "";
$parseTokens{classclosebraceregexp} = "";
$parseTokens{accessregexp} = "";
$parseTokens{requiredregexp} = "";
$parseTokens{propname} = "";
$parseTokens{objcdynamicname} = "";
$parseTokens{objcsynthesizename} = "";
$parseTokens{moduleregexp} = "";
$parseTokens{assignmentwithcolon} = 0;
$parseTokens{labelregexp} = "";
$parseTokens{parmswithcurlybraces} = 0;
$parseTokens{superclasseswithcurlybraces} = 0;
$parseTokens{definename} = "";
my $langDebug = 0;
print STDERR "PARSETOKENS FOR lang: $lang sublang: $sublang\n" if ($localDebug);
if ($lang eq "perl" || $lang eq "shell" || $lang eq "tcl") {
print STDERR "Language is Perl or Shell script.\n" if ($langDebug);
if ($lang eq "perl") {
$parseTokens{sotemplate} = "<";
$parseTokens{eotemplate} = ">";
}else {
$parseTokens{sotemplate} = "";
$parseTokens{eotemplate} = "";
}
$parseTokens{sopreproc} = "";
$parseTokens{soc} = "";
$parseTokens{eoc} = "";
$parseTokens{ilc} = "#";
if ($lang eq "perl") { $parseTokens{sofunction} = "sub"; }
elsif ($lang eq "tcl") {
$parseTokens{soconstructor} = "constructor";
$parseTokens{sofunction} = "method";
$parseTokens{soprocedure} = "proc";
}
else { $parseTokens{sofunction} = "function"; }
$parseTokens{lbrace} = "{";
$parseTokens{rbrace} = "}";
$parseTokens{enumname} = "";
$parseTokens{unionname} = "";
$parseTokens{structname} = "";
$parseTokens{typedefname} = "";
$parseTokens{varname} = "";
if ($lang eq "perl") {
$parseTokens{classregexp} = "^(package)\$";
}
if ($lang eq "tcl") {
$parseTokens{parmswithcurlybraces} = 1;
$parseTokens{superclasseswithcurlybraces} = 1;
$parseTokens{classregexp} = "^(class)\$";
$parseTokens{varname} = "attribute";
}
if ($lang eq "shell" && $sublang eq "csh") {
$parseTokens{varname} = "setenv";
}
$parseTokens{constname} = "";
$parseTokens{structisbrace} = 0;
if ($lang eq "perl") {
$parseTokens{regexpAllowedAfter} = '(\~|\(|\=|\,)';
$parseTokens{regexpcharpattern} = "[[|{}#(/'\"<`]";
$parseTokens{regexpfirstcharpattern} = "[/]";
$parseTokens{regexppattern} = "qq|qr|qx|qw|q|m|s|tr|y";
$parseTokens{singleregexppattern} = "qq|qr|qx|qw|q|m";
} elsif ($lang eq "tcl") {
$parseTokens{TCLregexpcommand} = "regexp";
$parseTokens{regexpfirstcharpattern} = "[{]";
$parseTokens{regexpcharpattern} = "[[|{}#(/'\"<`]";
}
} elsif ($lang eq "pascal") {
print STDERR "Language is Pascal.\n" if ($langDebug);
$parseTokens{sotemplate} = "";
$parseTokens{eotemplate} = "";
$parseTokens{sopreproc} = "#"; $parseTokens{soc} = "{";
$parseTokens{eoc} = "}";
$parseTokens{ilc} = "";
$parseTokens{sofunction} = "function";
$parseTokens{soprocedure} = "procedure";
$parseTokens{lbrace} = "begin";
$parseTokens{rbrace} = "end";
$parseTokens{enumname} = "";
$parseTokens{unionname} = "";
$parseTokens{structname} = "record";
$parseTokens{typedefname} = "type";
$parseTokens{varname} = "var";
$parseTokens{constname} = "const";
$parseTokens{structisbrace} = 1;
} elsif ($lang eq "python") {
$parseTokens{classregexp} = "^(class|module)\$";
$parseTokens{moduleregexp} = "^(module)\$";
$parseTokens{ilc} = "#";
$parseTokens{soc} = "\"\"\"";
$parseTokens{eoc} = "\"\"\"";
$parseTokens{lbrace} = "";
$parseTokens{lbraceunconditionalre} = "^(for|if)";
$parseTokens{lbraceconditionalre} = "^(begin|while|until)";
$parseTokens{rbrace} = "end";
$parseTokens{sofunction} = "def";
$parseTokens{structisbrace} = 0;
$parseTokens{functionisbrace} = 1;
$parseTokens{classisbrace} = 1;
} elsif ($lang eq "ruby") {
$parseTokens{classregexp} = "^(class|module)\$";
$parseTokens{moduleregexp} = "^(module)\$";
$parseTokens{ilc} = "#";
$parseTokens{soc} = "=begin";
$parseTokens{eoc} = "=end";
$parseTokens{lbrace} = "";
$parseTokens{lbraceunconditionalre} = "^(for|if)";
$parseTokens{lbraceconditionalre} = "^(begin|while|until)";
$parseTokens{rbrace} = "end";
$parseTokens{sofunction} = "def";
$parseTokens{structisbrace} = 0;
$parseTokens{functionisbrace} = 1;
$parseTokens{classisbrace} = 1;
$parseTokens{regexpAllowedAfter} = '(\~|\(|\=|\,|if|elsif|while|unless|until|when)';
$parseTokens{regexpAllowedAtStartOfLine} = 1;
$parseTokens{regexpfirstcharpattern} = "[/]";
$parseTokens{regexpcharpattern} = "[[|{}#(/'\"<`]";
} elsif ($lang eq "applescript") {
$parseTokens{classregexp} = "^(script)\$";
$parseTokens{soc} = "(*";
$parseTokens{eoc} = "*)";
$parseTokens{ilc} = "--";
$parseTokens{ilc_b} = "#";
$parseTokens{lbraceunconditionalre} = "^(tell)";
$parseTokens{rbrace} = "end";
$parseTokens{rbracetakesargument} = 1;
$parseTokens{varname} = "property";
$parseTokens{structisbrace} = 0;
$parseTokens{functionisbrace} = 1;
$parseTokens{classisbrace} = 1;
$parseTokens{assignmentwithcolon} = 1;
$parseTokens{labelregexp} = "^(about|above|against|apart from|around|aside from|at|below|beneath|beside|between|by|for|from|instead of|into|on|onto|out of|over|since|thru|through|under)\$";
$parseTokens{sofunction} = "on";
$parseTokens{soprocedure} = "to";
} else {
$parseTokens{classregexp} = "^(class|namespace)\$";
$parseTokens{moduleregexp} = "^(namespace)\$";
if ($lang eq "C" || $lang eq "Csource") {
$parseTokens{typedefname} = "typedef";
}
if (($lang eq "C" && $sublang ne "php" && $sublang ne "IDL" && $sublang ne "MIG") || $lang =~ /Csource/) {
print STDERR "Language is C or variant.\n" if ($langDebug);
$parseTokens{sotemplate} = "<";
$parseTokens{eotemplate} = ">";
$parseTokens{accessregexp} = "^(public|private|protected)\$";
$parseTokens{operator} = "operator";
$parseTokens{sopreproc} = "#";
if ($sublang eq "occ") {
$parseTokens{accessregexp} = "^(\@?public|\@?private|\@?protected|\@package)\$";
$parseTokens{requiredregexp} = "^(\@optional|\@required)\$";
$parseTokens{propname} = "\@property";
}
} elsif ($sublang eq "IDL") {
print STDERR "Language is IDL.\n" if ($langDebug);
$parseTokens{sopreproc} = "#";
} elsif ($sublang eq "MIG") {
print STDERR "Language is MIG.\n" if ($langDebug);
$parseTokens{sopreproc} = "#";
$parseTokens{typedefname} = "type";
} else {
print STDERR "Language is Unknown.\n" if ($langDebug);
}
if (($lang eq "C" || $lang eq "Csource") && $sublang ne "php" && $sublang ne "IDL") { $parseTokens{classregexp} = "^(class|\@class|\@interface|\@protocol|\@implementation|namespace)\$";
$parseTokens{classbraceregexp} = "^(\@interface|\@protocol|\@implementation)\$";
$parseTokens{classclosebraceregexp} = "^(\@end)\$";
}
if ($lang eq "C" && $sublang eq "IDL") {
$parseTokens{classregexp} = "^(module|interface)\$";
$parseTokens{classbraceregexp} = "";
$parseTokens{classclosebraceregexp} = "";
$parseTokens{sotemplate} = "["; $parseTokens{eotemplate} = "]"; $parseTokens{moduleregexp} = "^(module)\$";
}
if ($lang eq "java" && $sublang eq "java") {
$parseTokens{classregexp} = "^(class|interface|namespace)\$";
$parseTokens{accessregexp} = "^(public|private|protected|package)\$";
} elsif ($sublang eq "php") {
$parseTokens{accessregexp} = "^(public|private|protected)\$";
$parseTokens{ilc_b} = "#";
}
if ($lang eq "java" && $sublang eq "javascript") {
$parseTokens{regexpAllowedAfter} = '(\(|\=|\,)';
$parseTokens{regexpcharpattern} = "[[|{}#(/'\"<`]";
$parseTokens{regexpfirstcharpattern} = '[/]';
}
$parseTokens{soc} = "/*";
$parseTokens{eoc} = "*/";
$parseTokens{ilc} = "//";
$parseTokens{lbrace} = "{";
$parseTokens{rbrace} = "}";
if ($lang eq "C" || $lang eq "Csource" || $lang eq "java") {
$parseTokens{enumname} = "enum";
}
if ($lang eq "C" || $lang eq "Csource") {
$parseTokens{unionname} = "union";
$parseTokens{structname} = "struct";
}
$parseTokens{varname} = "";
$parseTokens{constname} = "const";
$parseTokens{structisbrace} = 0;
if ($sublang ne "php" && $sublang ne "IDL") {
%macronames = ( "#if" => 1, "#ifdef" => 1, "#ifndef" => 1, "#endif" => 1, "#else" => 1, "#undef" => 1, "#elif" =>1, "#error" => 1, "#warning" => 1, "#pragma" => 1, "#import" => 1, "#include" => 1, "#define" => 1);
$parseTokens{definename} = "#define";
} elsif ($sublang eq "IDL") {
%macronames = ( "#if" => 1, "#ifdef" => 1, "#ifndef" => 1, "#endif" => 1, "#else" => 1, "#undef" => 1, "#elif" =>1, "#error" => 1, "#warning" => 1, "#pragma" => 1, "#import" => 1, "#include" => 1, "#define" => 1, "import" => 1 );
$parseTokens{definename} = "#define";
}
}
$parseTokens{macronames} = \%macronames;
return \%parseTokens;
}
sub isKeyword
{
my $token = shift;
my $keywordref = shift;
my $case_sensitive = shift;
my %keywords = %{$keywordref};
my $localDebug = 0;
print STDERR "isKeyWord: TOKEN: \"$token\"\n" if ($localDebug);
print STDERR "#keywords: ".scalar(keys %keywords)."\n" if ($localDebug);
if ($localDebug) {
foreach my $keyword (keys %keywords) {
print STDERR "isKeyWord: keyword_list: $keyword\n" if ($localDebug);
}
}
if ($case_sensitive) {
if ($keywords{$token}) {
print STDERR "MATCH\n" if ($localDebug);
return $keywords{$token};
}
} else {
foreach my $keyword (keys %keywords) {
print STDERR "isKeyWord: keyword: $keyword\n" if ($localDebug);
if ($token =~ /^\Q$keyword\E$/i) {
print STDERR "MATCH\n" if ($localDebug);
return $keywords{$keyword};
}
}
}
return 0;
}
sub html2xhtml
{
my $html = shift;
my $encoding = shift;
my $debugname = shift;
my $localDebug = 0;
local $/;
my $xmlout = "--xmlout";
if ($xmllintversion eq "20607") {
$xmlout = "";
}
if (! -x $xmllint) {
print STDERR "Error: xmllint is not installed. Please install it and try again.\n";
return $html;
}
warn "PREOPEN\n" if ($localDebug);
my $pid = open2( \*fromLint, \*toLint, "$xmllint --html $xmlout --recover --nowarning - 2> /dev/null");
warn "ONE\n" if ($localDebug);
toLint->autoflush();
my $str = "<html><head><meta http-equiv='Content-Type' content='text/html; charset=$encoding'></head><body>$html</body></html>\n";
print toLint $str;
toLint->flush();
warn "TWO\n" if ($localDebug);
close toLint;
my $xhtml = <fromLint>;
warn "TWO-A\n" if ($localDebug);
close fromLint;
warn "THREE\n" if ($localDebug);
my $old_xhtml = $xhtml;
warn "FOUR\n" if ($localDebug);
$xhtml =~ s/^\s*<!DOCTYPE .*?>//so;
$xhtml =~ s/^\s*<\?xml.*?\?>\s*//so;
$xhtml =~ s/^\s*<!.*?>\s*//so;
$xhtml =~ s/^\s*<html>//so;
$xhtml =~ s/<\/html>\s*$//so;
$xhtml =~ s/^\s*<head>.*<\/head>\s*//s;
if ($xhtml =~ /^\s*<body\/>\s*/o) {
$xhtml = "";
} else {
$xhtml =~ s/^\s*<body>//so;
$xhtml =~ s/<\/body>\s*$//so;
}
my @selfClosingTags = ( "br", "hr", "link", "area", "base",
"basefont", "input", "img", "meta");
for my $tag (@selfClosingTags) {
$xhtml =~ s/<\Q$tag\E>/<$tag \/>/sg;
$xhtml =~ s/<\/\Q$tag\E>//sg;
$xhtml =~ s/<\Q$tag\E\s[^>]*>/<$tag \/>/sg;
$xhtml =~ s/<\/\Q$tag\E\s[^>]*>//sg;
}
my $htmllengthcheck = $html;
my $xhtmllengthcheck = $xhtml;
$htmllengthcheck =~ s/\s//sgo;
$xhtmllengthcheck =~ s/\s//sgo;
$htmllengthcheck =~ s/<.*?>//sgo;
$xhtmllengthcheck =~ s/<.*?>//sgo;
$htmllengthcheck =~ s/\&.*?;//sgo;
$xhtmllengthcheck =~ s/\&.*?;//sgo;
my $pos = 32;
while ($pos < 38) {
$htmllengthcheck = unescape_legal($htmllengthcheck, $pos);
$pos++;
}
$pos = 50;
while ($pos < 60) {
$htmllengthcheck = unescape_legal($htmllengthcheck, $pos);
$pos++;
}
$htmllengthcheck = unescape_legal($htmllengthcheck, 61); while ($pos < 127) {
$htmllengthcheck = unescape_legal($htmllengthcheck, $pos);
$pos++;
}
$htmllengthcheck =~ s/\& $xhtmllengthcheck =~ s/\& $htmllengthcheck =~ s/\& $xhtmllengthcheck =~ s/\&
$htmllengthcheck =~ s/&.*?;//sg;
$xhtmllengthcheck =~ s/&.*?;//sg;
$htmllengthcheck =~ s/[<>]//sg; # These commonly cause bogus warnings.
$xhtmllengthcheck =~ s/[<>]//sg; # These commonly cause bogus warnings.
$htmllengthcheck =~ s/[^!-~]//sg; # Eliminate nbsp bits, etc.
$xhtmllengthcheck =~ s/[^!-~]//sg; # Eliminate nbsp bits, etc.
$htmllengthcheck =~ s/&//sg; # For bad HTML.
if (length($xhtmllengthcheck) < length($htmllengthcheck)) {
warn "DEBUGNAME: $debugname\n" if ($localDebug);
warn "$debugname: XML to HTML translation failed.\n";
warn "XHTML was truncated (".length($xhtmllengthcheck)." < ".length($htmllengthcheck).").\n";
warn "BEGIN HTML:\n$html\nEND HTML\nBEGIN XHTML:\n$xhtml\nEND XHTML\n";
print STDERR "A: \"$htmllengthcheck\"\nB: \"$xhtmllengthcheck\"\n";
}
print STDERR "FROM HTML: $html\n" if ($localDebug);
print STDERR "GOT RAW XHTML: $old_xhtml\n" if ($localDebug);
print STDERR "RETURNING XHTML (oldlen = ".length($html)."): $xhtml\n" if ($localDebug);
my $retval = waitpid($pid, 0);
my $exitstatus = $?;
if ($exitstatus) {
warn "DEBUGNAME: $debugname\n" if ($localDebug);
warn "$debugname:XML to HTML translation failed.\n";
warn "Error was $exitstatus\n";
}
return $xhtml;
}
sub unescape_legal
{
my $string = shift;
my $value = shift;
my $hexvalue = sprintf("%x", $value);
my $character = chr($value);
$string =~ s/& $string =~ s/&
return $string;
}
sub resolveLinks($$$)
{
my $path = shift;
if (@_) {
my $externalXRefFiles = shift;
if (length($externalXRefFiles)) {
my @files = split(/\s/s, $externalXRefFiles);
foreach my $file (@files) {
$path .= " -s \"$file\"";
}
}
}
if (@_) {
my $externalAPIRefs = shift;
if (length($externalAPIRefs)) {
my @refs = split(/\s/s, $externalAPIRefs);
foreach my $ref (@refs) {
$path .= " -r \"$ref\"";
}
}
}
my $resolverpath = "/usr/bin/resolveLinks";
if ( ! -x $resolverpath) {
$resolverpath = "/usr/local/bin/resolveLinks";
}
if ( ! -x $resolverpath) {
$resolverpath = "/opt/local/bin/resolveLinks";
}
if ( ! -x $resolverpath) {
$resolverpath = "/sw/bin/resolveLinks";
}
if ( ! -x $resolverpath) {
$resolverpath = $HeaderDoc::modulesPath."../../../../bin/resolveLinks";
}
if ( ! -x $resolverpath) {
$resolverpath = $HeaderDoc::modulesPath."bin/resolveLinks";
warn("You are probably using an old resolveLinks.\n");
}
$path =~ s/"/\\"/sg;
print STDERR "EXECUTING $resolverpath \"$path\"\n";
my $retval = system($resolverpath." \"$path\"");
if ($retval == -1) {
warn "error: resolveLinks not installed. Please check your installation.\n";
} elsif ($retval) {
warn "error: resolveLinks failed ($retval). Please check your installation.\n";
}
}
sub validTag
{
my $field = shift;
my $include_first_tier = 1;
my $include_second_tier = 1;
if (@_) {
my $level = shift;
if ($level == 0) {
$include_first_tier = 1;
$include_second_tier = 1;
} elsif ($level == 1) {
$include_first_tier = 1;
$include_second_tier = 0;
} elsif ($level == 2) {
$include_first_tier = 0;
$include_second_tier = 1;
}
}
SWITCH: {
($field =~ s/^\/\*\!//so) && do { return ($include_first_tier || $include_second_tier); };
($field =~ s/^\/\/\!//so) && do { return ($include_first_tier || $include_second_tier); };
($field =~ s/^abstract(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^alsoinclude(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^apiuid(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^attribute(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^attributeblock(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^attributelist(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^author(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^availability(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^availabilitymacro(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^brief(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^callback(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^category(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^CFBundleIdentifier(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^charset(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^coclass(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^class(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^classdesign(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^compilerflag(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^const(ant)?(\s+|$)//sio) && do { return ($include_first_tier || $include_second_tier); };
($field =~ s/^copyright(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^define(d)?(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^define(d)?block(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^\/define(d)?block(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^dependency(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^deprecated(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^description(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^details(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^discussion(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^encoding(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^enum(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^exception(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^field(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^file(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^flag(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^framework(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^frameworkuid(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^frameworkpath(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^frameworkcopyright(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^function(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^functiongroup(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^group(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^<\/hd_link>//sio) && do { return $include_second_tier; }; # note: opening tag not needed.
($field =~ s/^header(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^headerpath(\s+|$)//sio) && do { return $include_second_tier; }; # for @framework
($field =~ s/^helper(class)?(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^helps(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^hidesingletons(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^hidecontents(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^ignore(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^ignorefuncmacro(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^important(\s+|$)//sio) && do { return -$include_second_tier; };
($field =~ s/^indexgroup(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^instancesize(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^interface(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^internal(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^language(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^link(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^\/link//sio) && do { return $include_second_tier; };
($field =~ s/^meta(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^method(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^methodgroup(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^name(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^namespace(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^note(\s+|$)//sio) && do { return -$include_second_tier; };
($field =~ s/^noParse(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^ownership(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^param(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^parseOnly(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^preprocinfo(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^performance(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^property(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^protocol(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^related(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^result(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^return(s)?(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^security(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^see(also|)(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^serial(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^serialData(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^serialfield(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^since(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^struct(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^super(class|)(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^template(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^templatefield(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^throws(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^typedef(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^union(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^unformatted(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^unsorted(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^updated(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^var(\s+|$)//sio) && do { return $include_first_tier; };
($field =~ s/^vargroup(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^version(\s+|$)//sio) && do { return $include_second_tier; };
($field =~ s/^warning(\s+|$)//sio) && do { return -$include_second_tier; };
($field =~ s/^whyinclude(\s+|$)//sio) && do { return $include_second_tier; };
{ if (length($field)) {
return 0;
}
return 1;
};
}
}
sub replaceTag($$$)
{
my $fieldsref = shift;
my $iter = shift;
my $xml_mode = shift;
my $localDebug = 0;
my @fields = @{$fieldsref};
my $tag = $fields[$iter];
my $dropfield = 0;
my $previousfield = $iter - 1;
if ($iter) {
$dropfield = 1;
} else {
$previousfield = $iter;
}
my $xmlkey = "";
my $title = "";
my $body = "";
my $text;
my $rest;
my $more_after;
if ($tag =~ s/^warning(\s|$)//si) {
$tag =~ s/^\s*//sg;
($text, $rest, $more_after) = splitOnPara($tag);
$xmlkey = "hd_warning_internal";
$body = $text;
} elsif ($tag =~ s/^important(\s|$)//si) {
$tag =~ s/^\s*//sg;
($text, $rest, $more_after) = splitOnPara($tag);
$xmlkey = "hd_important_internal";
$body = $text;
} elsif ($tag =~ s/^note(\s|$)//si) {
my $notitle = 0;
if ($1 =~ /[\n\r]/ || $tag =~ /^\s*[\n\r]+/) {
$notitle = 1;
}
$tag =~ s/^\s*//sg;
($text, $rest, $more_after) = splitOnPara($tag);
if ($notitle) {
$body = $text;
} else {
($title, $body) = split(/[\n\r]+/, $text, 2);
}
if ($title !~ /\S/) {
$title = "Note";
}
$xmlkey = "hd_note_internal";
} else {
warn "Could not replace unknown tag \"$tag\"\n";
return ($fieldsref, 0, "");
}
$fields[$iter] = "";
my $append = "";
my $tail = "";
$append = "<$xmlkey><note_title>$title</note_title><p>".$body;
$tail = "</p></$xmlkey>\n$rest";
if ($localDebug) {
print STDERR "CONVERSION:\n";
print STDERR " XMLKEY: $xmlkey\n";
print STDERR " TEXT: $text\n";
print STDERR " TITLE: $title\n";
print STDERR " BODY: $body\n";
print STDERR "APPEND: $append\n";
print STDERR "TAIL: $tail\n";
print STDERR "ITER: $iter\n";
}
if ($more_after) {
print STDERR "DONE. ADDING $tail TO APPEND\n" if ($localDebug);
$append .= $tail;
} else {
if ($iter == $#fields) {
$append .= $tail;
print STDERR "LASTFIELD. ADDING $tail TO APPEND\n" if ($localDebug);
} else {
my $origiter = $iter;
$iter++;
while (1) {
my $nextfield = $fields[$iter];
if (validTag($nextfield)) {
if ($nextfield !~ /^(link|linkdoc|linkplain|docroot|value|inheritDoc|\/link)/) {
last;
}
} elsif ($nextfield !~ /\n\n/) {
$iter++; last;
}
$iter++;
if ($iter > $#fields) { last; } }
print STDERR "Adding $tail before node ".$fields[$iter]."\n" if ($localDebug);
$iter--;
if ($iter == $origiter) {
$append .= $tail;
} else {
print STDERR "IN NODE $iter: ".$fields[$iter]."\n" if ($localDebug);
($text, $rest, $more_after) = splitOnPara($fields[$iter]);
print STDERR "TEXT: $text\nREST: $rest\nDONE: $more_after\n" if ($localDebug);
$fields[$iter] = $text.$tail.$rest;
print STDERR "MODIFYING FIELD WITH $tail\n" if ($localDebug);
print STDERR "NOW: ".$fields[$iter]."\n" if ($localDebug);
}
}
}
return (\@fields, 2, $append);
}
sub stringToFields($$$$$$)
{
my $line = shift;
my $fullpath = shift;
my $linenum = shift;
my $xmlmode = shift;
my $lang = shift; my $sublang = shift;
my $localDebug = 0;
print STDERR "LINE WAS: \"$line\"\n" if ($localDebug);
my @fields = split(/\@/s, $line);
my @newfields = ();
my $lastappend = "";
my $in_textblock = 0;
my $in_link = 0;
my $lastlinkfield = "";
my $keepfield = "";
foreach my $field (@fields) {
if ($field =~ /\\$/s) {
$field =~ s/\\$//s;
if ($keepfield ne "") {
$keepfield .= "@".$field;
} else {
$keepfield = $field;
}
} elsif ($keepfield ne "") {
$field = $keepfield."@".$field;
$keepfield = "";
push(@newfields, $field);
} else {
push(@newfields, $field);
}
}
@fields = @newfields;
@newfields = ();
for (my $iter = 0; $iter <= $#fields; $iter++) {
my $rawfield = $fields[$iter];
my $field = filterHTMLLinks($rawfield);
my $dropfield = 0;
print STDERR "processing $field\n" if ($localDebug);
if ($in_textblock) {
if ($field =~ /^\/textblock/so) {
print STDERR "out of textblock\n" if ($localDebug);
if ($in_textblock == 1) {
my $cleanfield = $field;
$cleanfield =~ s/^\/textblock//sio;
$lastappend .= $cleanfield;
push(@newfields, $lastappend);
print STDERR "pushed \"$lastappend\"\n" if ($localDebug);
$lastappend = "";
}
$in_textblock = 0;
} else {
$field =~ s/\</\<\;/sgo;
$field =~ s/\>/\>\;/sgo;
$lastappend .= "\@$field";
print STDERR "new field is \"$lastappend\"\n" if ($localDebug);
}
} else {
if ($field =~ s/^value/<hd_value\/>/sio) {
$lastappend = pop(@newfields);
}
if ($field =~ s/^inheritDoc/<hd_ihd\/>/sio) {
$lastappend = pop(@newfields);
}
if ($field =~ s/^\/link/<\/hd_link>/sio) {
if ($field =~ /^<\/hd_link>\s+[,.!?]/s) { $field =~ s/^<\/hd_link>\s+/<\/hd_link>/s; }
if ($in_link) {
$in_link = 0;
} else {
my $lastfield = pop(@newfields);
$field =~ s/^<\/hd_link>//s;
push(@newfields, $lastfield.$field);
$field = "";
$dropfield = 1;
}
}
my $valid = validTag($field);
if ($valid == -1) {
my ($fieldsref, $newdrop, $append) = replaceTag(\@fields, $iter, $xmlmode);
@fields = @{$fieldsref};
$dropfield = $newdrop;
if ($append) {
my $prev = pop(@newfields);
if (!$prev) { $prev = ""; }
push(@newfields, $prev.$append);
$dropfield = 2;
}
}
if ($field =~ s/^link\s+//sio) {
$lastlinkfield = $field;
$in_link = 1;
my $target = "";
my $lastfield;
if ($lastappend eq "") {
$lastfield = pop(@newfields);
} else {
$lastfield = "";
}
$lastappend .= $lastfield;
if ($field =~ /^(\S*?)\s/so) {
$target = $1;
} else {
$target = $field;
}
my $localDebug = 0;
print STDERR "target $target\n" if ($localDebug);
$field =~ s/^\Q$target\E//sg;
$field =~ s/\\$/\@/so;
print STDERR "name $field\n" if ($localDebug);
$target =~ s/\\\//\//g;
if ($field !~ /\S/) { $field = nameFromAPIRef($target); }
$lastappend .= "<hd_link posstarget=\"$target\">";
$lastappend .= "$field";
} elsif ($field =~ /^textblock\s/sio) {
if ($lastappend eq "") {
$in_textblock = 1;
print STDERR "in textblock\n" if ($localDebug);
$lastappend = pop(@newfields);
} else {
$in_textblock = 2;
print STDERR "in textblock (continuation)\n" if ($localDebug);
}
$field =~ s/^textblock(?:[ \t]+|([\n\r]))/$1/sio;
$field =~ s/\</\<\;/sgo;
$field =~ s/\>/\>\;/sgo;
$lastappend .= "$field";
print STDERR "in textblock.\nLASTAPPEND:\n$lastappend\nENDLASTAPPEND\n" if ($localDebug);
} elsif ($dropfield) {
if ($dropfield == 1) {
warn "$fullpath:$linenum:Unexpected \@/link tag found in HeaderDoc comment.\n";
}
} elsif (!$valid) {
my $fieldword = $field;
my $lastfield = "";
if ($lastappend == "") {
$lastfield = pop(@newfields);
} else {
$lastfield = "";
}
$lastappend .= $lastfield;
$fieldword =~ s/\s.*$//sg;
warn "$fullpath:$linenum:Unknown field type \@".$fieldword." in HeaderDoc comment.\n";
if ($localDebug) {
cluck("Backtrace follows.\n");
}
$lastappend .= "\@".$field;
if ($field !~ s/\\$/\@/so) {
push(@newfields, $lastappend);
$lastappend = "";
}
} elsif ($field =~ s/\\$/\@/so) {
$lastappend .= $field;
} elsif ($lastappend eq "") {
push(@newfields, $field);
} else {
$lastappend .= $field;
push(@newfields, $lastappend);
$lastappend = "";
}
}
}
if (!($lastappend eq "")) {
push(@newfields, $lastappend);
}
if ($in_link) {
warn "$fullpath:$linenum: warning: Unterminated \@link tag (starting field was: $lastlinkfield)\n";
}
if ($in_textblock) {
warn "$fullpath:$linenum: warning: Unterminated \@textblock tag\n";
}
@fields = @newfields;
if ($localDebug) {
print STDERR "FIELDS:\n";
for my $field (@fields) {
print STDERR "FIELD:\n$field\n";
}
}
return \@fields;
}
sub sanitize
{
my $string = shift;
my $isname = 0;
if (@_) {
$isname = shift;
}
my $isoperator = 0;
if ($isname) {
if ($string =~ /operator/) { $isoperator = 1; }
}
my $newstring = "";
my $prepart = "";
my $postpart = "";
if ($string =~ /^\w*$/o) { return $string; }
if ($string =~ s/^\///so) {
$prepart = "/";
}
if ((!$isname) || (!$isoperator)) {
if ($string =~ s/\/$//so) {
$postpart = "/";
}
}
my @parts = split(/(\W|\s)/, $string);
foreach my $part (@parts) {
if (!length($part)) {
next;
} elsif ($part =~ /\w/o) {
$newstring .= $part;
} elsif ($part =~ /\s/o) {
} elsif ($part =~ /[\~\:\,\.\-\_\+\!\*\(\)]/o) {
$newstring .= $part;
} elsif ((!$isname) && $part =~ /\//o) {
$newstring .= $part;
} else {
if (!$isname || ($isoperator && $part =~ /[\=\|\/\&\%\^\!\<\>]/)) {
my $val = ord($part);
my $valstring = uc(sprintf("%02x", $val));
$newstring .= "\%$valstring";
}
}
}
return $prepart.$newstring.$postpart;
}
sub nestignore
{
my $tag = shift;
my $dectype = shift;
if ($dectype =~ /defineblock/o && ($tag =~ /^\@define/o || $tag =~ /^\s*[^\s\@]/)) {
return 1;
}
return 0;
}
sub warnHDComment
{
my $linearrayref = shift;
my $blocklinenum = shift;
my $blockoffset = shift;
my $lang = shift;
my $dectype = shift;
my $dp = shift;
my $parseTokensRef = shift;
my $optional_lastComment = shift;
my $fullpath = $HeaderDoc::headerObject->fullpath();
my $localDebug = 2; my $rawLocalDebug = 0;
my $maybeblock = 0;
print STDERR "DT: $dectype\n" if ($rawLocalDebug);
if ($dectype =~ /blockMode:\ $maybeblock = 1;
}
my $line = ${$linearrayref}[$blocklinenum];
my $linenum = $blocklinenum + $blockoffset;
print STDERR "LINE WAS $line\n" if ($rawLocalDebug);
my $isshell = 0;
my %parseTokens = %{$parseTokensRef};
my $soc = $parseTokens{soc}; my $ilc = $parseTokens{ilc}; my $indefineblock = 0;
if ($optional_lastComment =~ /\s*\/\*\!\s*\@define(d)?block\s+/s) {
print STDERR "INBLOCK\n" if ($rawLocalDebug);
$indefineblock = 1;
$dectype = "defineblock";
} else {
print STDERR "optional_lastComment: $optional_lastComment\n" if ($rawLocalDebug);
}
if (($lang eq "shell") || ($lang eq "perl") || ($lang eq "tcl")) {
$isshell = 1;
}
my $debugString = "";
if ($localDebug) { $debugString = " [debug point $dp]"; }
if ((!$isshell && $line =~ /\Q$soc\E\!(.*)$/s) || ($isshell && $line =~ /\Q$ilc\E\s*\/\*\!(.*)$/s)) {
my $rest = $1;
$rest =~ s/^\s*//so;
$rest =~ s/\s*$//so;
while (!length($rest) && ($blocklinenum < scalar(@{$linearrayref}))) {
$blocklinenum++;
$rest = ${$linearrayref}[$blocklinenum];
$rest =~ s/^\s*//so;
$rest =~ s/\s*$//so;
}
print STDERR "REST: $rest\nDECTYPE: $dectype\n" if ($rawLocalDebug);
if ($rest =~ /^\@/o) {
if (nestignore($rest, $dectype)) {
print STDERR "NEST IGNORE[1]\n" if ($rawLocalDebug);
return 0;
}
} else {
print STDERR "Nested headerdoc markup with no tag.\n" if ($rawLocalDebug);
if (nestignore($rest, $dectype)) {
print STDERR "NEST IGNORE[2]\n" if ($rawLocalDebug);
return 0;
}
}
if ($maybeblock) {
print STDERR "CHECKING FOR END OF DEFINE BLOCK. REST IS \"$rest\"\n" if ($rawLocalDebug);
if ($rest =~ /^\s*\@define(d?)\s+/) {
print STDERR "DEFINE\n" if ($rawLocalDebug);
return 2;
}
if ($rest =~ /^\s*[^\@\s]/) {
print STDERR "OTHER\n" if ($rawLocalDebug);
return 2;
}
}
if (!$HeaderDoc::ignore_apiuid_errors) {
warn("$fullpath:$linenum: warning: Unexpected headerdoc markup found in $dectype declaration$debugString. Output may be broken.\n");
}
print STDERR "RETURNING 1\n" if ($rawLocalDebug);
return 1;
}
print STDERR "RETURNING 0\n" if ($rawLocalDebug);
return 0;
}
sub classTypeFromFieldAndBPinfo
{
my $classKeyword = shift;
my $classBPtype = shift;
my $classBPdeclaration = shift;
my $fullpath = shift;
my $linenum = shift;
my $sublang = shift;
my $deccopy = $classBPdeclaration;
$deccopy =~ s/[\n\r]/ /s;
$deccopy =~ s/\{.*$//sg;
$deccopy =~ s/\).*$//sg;
$deccopy =~ s/;.*$//sg;
SWITCH: {
($classBPtype =~ /^\@protocol/) && do { return "intf"; };
($classKeyword =~ /category/) && do { return "occCat"; };
($classBPtype =~ /^\@class/) && do { return "occ"; };
($classBPtype =~ /^\@interface/) && do {
if ($classKeyword =~ /class/) {
return "occ";
} elsif ($deccopy =~ /\:/s) {
return "occ";
} elsif ($deccopy =~ /\(/s) {
return "occCat";
} else {
last SWITCH;
}
};
($classKeyword =~ /class/) && do { return $sublang; };
($classBPtype =~ /typedef/) && do { return "C"; };
($classBPtype =~ /struct/) && do { return "C"; };
($classBPtype =~ /class/) && do { return $sublang; };
($classBPtype =~ /script/) && do { return $sublang; };
($classBPtype =~ /interface/) && do { return $sublang; };
($classBPtype =~ /implementation/) && do { return $sublang; };
($classBPtype =~ /module/) && do { return $sublang; };
($classBPtype =~ /namespace/) && do { return $sublang; };
($classBPtype =~ /package/) && do { return $sublang; };
}
warn "$fullpath:$linenum: warning: Unable to determine class type.\n";
warn "KW: $classKeyword\n";
warn "BPT: $classBPtype\n";
warn "DEC: $deccopy\n";
return "cpp";
}
sub casecmp
{
my $a = shift;
my $b = shift;
my $case = shift;
if (!$case) {
$a = lc($a);
$b = lc($b);
}
if (($a eq $b) && ($a ne "") && ($b ne "")) { return 1; }
return 0;
}
sub emptyHDok
{
my $line = shift;
my $okay = 0;
SWITCH: {
($line =~ /\@param(\s|$)/o) && do { $okay = 1; };
($line =~ /\@name(\s|$)/o) && do { $okay = 1; };
($line =~ /\@(function|method|)group(\s|$)/o) && do { $okay = 2; };
($line =~ /\@language(\s|$)/o) && do { $okay = 1; };
($line =~ /\@file(\s|$)/o) && do { $okay = 1; };
($line =~ /\@header(\s|$)/o) && do { $okay = 1; };
($line =~ /\@framework(\s|$)/o) && do { $okay = 1; };
($line =~ /\@\/define(d)?block(\s|$)/o) && do { $okay = 2; };
($line =~ /\@lineref(\s|$)/o) && do { $okay = 1; };
}
return $okay;
}
sub addAvailabilityMacro($$;$)
{
my $token = shift;
my $description = shift;
my $has_args = 0;
if (@_) {
$has_args = shift || 0;
}
my $localDebug = 0;
if (length($token) && length($description)) {
print STDERR "AVTOKEN: \"$token\"\nDESC: $description\nHAS ARGS: $has_args\n" if ($localDebug);
$HeaderDoc::availability_defs{$token} = $description;
$HeaderDoc::availability_has_args{$token} = $has_args;
HeaderDoc::BlockParse::cpp_remove($token);
}
}
sub complexAvailabilityTokenToOSAndVersion($)
{
my $string = shift;
my $os = "";
if ($string =~ s/^__IPHONE_//) {
$os = "iOS";
} elsif ($string =~ s/^__MAC_//) {
$os = "Mac OS X";
} else {
warn "Unknown OS in availability string \"$string\". Giving up.\n";
return "";
}
my $version = $string;
$version =~ s/_/\./g;
return ($os, $version);
}
sub complexAvailabilityToArray($$)
{
my $token = shift;
my $availstring = shift;
my @returnarray = ();
$availstring =~ s/\s*//sg;
my @availparts = split(/,/, $availstring);
if ($token eq "NS_AVAILABLE" || $token eq "CF_AVAILABLE" || $token eq "NS_CLASS_AVAILABLE") {
$token = "__OSX_AVAILABLE_STARTING";
$availparts[0] = "__MAC_".$availparts[0];
$availparts[1] = "__IPHONE_".$availparts[1];
} elsif ($token eq "NS_AVAILABLE_MAC" || $token eq "CF_AVAILABLE_MAC") {
$token = "__OSX_AVAILABLE_STARTING";
$availparts[0] = "__MAC_".$availparts[0];
$availparts[1] = "__IPHONE_NA";
} elsif ($token eq "NS_AVAILABLE_IPHONE" || $token eq "CF_AVAILABLE_IPHONE" ||
$token eq "NS_AVAILABLE_IOS" || $token eq "CF_AVAILABLE_IOS") {
$token = "__OSX_AVAILABLE_STARTING";
$availparts[0] = "__MAC_NA";
$availparts[1] = "__IPHONE_".$availstring;
} elsif ($token eq "NS_DEPRECATED" || $token eq "CF_DEPRECATED") {
$token = "__OSX_AVAILABLE_BUT_DEPRECATED";
$availparts[0] = "__MAC_".$availparts[0];
$availparts[1] = "__MAC_".$availparts[1];
$availparts[2] = "__IPHONE_".$availparts[2];
$availparts[3] = "__IPHONE_".$availparts[3];
} elsif ($token eq "NS_DEPRECATED_MAC" || $token eq "CF_DEPRECATED_MAC") {
$token = "__OSX_AVAILABLE_BUT_DEPRECATED";
$availparts[0] = "__MAC_".$availparts[0];
$availparts[1] = "__MAC_".$availparts[1];
$availparts[2] = "__IPHONE_NA";
$availparts[3] = "__IPHONE_NA";
} elsif ($token eq "NS_DEPRECATED_IPHONE" || $token eq "CF_DEPRECATED_IPHONE" ||
$token eq "NS_DEPRECATED_IOS" || $token eq "CF_DEPRECATED_IOS") {
my $iphone_avail = $availparts[0];
my $iphone_dep = $availparts[1];
$token = "__OSX_AVAILABLE_BUT_DEPRECATED";
$availparts[0] = "__MAC_NA";
$availparts[1] = "__MAC_NA";
$availparts[2] = "__IPHONE_".$iphone_avail;
$availparts[3] = "__IPHONE_".$iphone_dep;
}
if ($token eq "__OSX_AVAILABLE_STARTING") {
my $macstarttoken = $availparts[0];
my $iphonestarttoken = $availparts[1];
my ($macstartos, $macstartversion) = complexAvailabilityTokenToOSAndVersion($macstarttoken);
my ($iphonestartos, $iphonestartversion) = complexAvailabilityTokenToOSAndVersion($iphonestarttoken);
if ($macstartversion eq "NA") {
push(@returnarray, "Not available in $macstartos.");
} else {
push(@returnarray, "Available in $macstartos v$macstartversion.");
}
if ($iphonestartversion eq "NA") {
push(@returnarray, "Not available in $iphonestartos.");
} else {
push(@returnarray, "Available in $iphonestartos v$iphonestartversion.");
}
} elsif ($token eq "__OSX_AVAILABLE_BUT_DEPRECATED") {
my $macstarttoken = $availparts[0];
my $macdeptoken = $availparts[1];
my $iphonestarttoken = $availparts[2];
my $iphonedeptoken = $availparts[3];
my ($macstartos, $macstartversion) = complexAvailabilityTokenToOSAndVersion($macstarttoken);
my ($iphonestartos, $iphonestartversion) = complexAvailabilityTokenToOSAndVersion($iphonestarttoken);
my ($macdepos, $macdepversion) = complexAvailabilityTokenToOSAndVersion($macdeptoken);
my ($iphonedepos, $iphonedepversion) = complexAvailabilityTokenToOSAndVersion($iphonedeptoken);
if ($macstartversion eq "NA") {
push(@returnarray, "Not available in $macstartos.");
} elsif ($macdepversion eq "NA") {
push(@returnarray, "Available in $macstartos v$macstartversion.");
} else {
if ($macstartversion eq $macdepversion) {
push(@returnarray, "Introduced in $macstartos v$macstartversion, and deprecated in $macstartos v$macdepversion.");
} else {
push(@returnarray, "Introduced in $macstartos v$macstartversion, but later deprecated in $macstartos v$macdepversion.");
}
}
if ($iphonestartversion eq "NA") {
push(@returnarray, "Not available in $iphonestartos.");
} elsif ($iphonedepversion eq "NA") {
push(@returnarray, "Available in $iphonestartos v$iphonestartversion.");
} else {
if ($iphonestartversion eq $iphonedepversion) {
push(@returnarray, "Introduced in $iphonestartos v$iphonestartversion, and deprecated in $iphonestartos v$iphonedepversion.");
} else {
push(@returnarray, "Introduced in $iphonestartos v$iphonestartversion, but later deprecated in $iphonestartos v$iphonedepversion.");
}
}
} else {
warn "Unknown complex availability token \"$token\". Giving up.\n";
return \@returnarray;
}
return \@returnarray;
}
sub getJustTheTag
{
my $rawtag = shift;
my $tag = lc($rawtag);
$tag =~ s/^<\s*//s;
$tag =~ s/>.*$//s;
$tag =~ s/\s+.*$//s;
return $tag;
}
sub newHTMLTagContext
{
my $tag = shift;
my $synthesized = shift;
my $obj = ();
$obj->{tag} = getJustTheTag($tag);
$obj->{synthesized} = $synthesized;
return $obj;
}
sub canMatchTag
{
my $arrayref = shift;
my $tag = shift;
my @arr = @{$arrayref};
my @copy = @arr;
my $top = pop(@copy);
my $localDebug = 0;
$tag =~ s/^\///s;
print STDERR "MATCHING TAG IS $tag\n" if ($localDebug);
while ($top) {
print STDERR "TOP IS ".$top->{tag}.", ".$top->{synthesized}."\n" if ($localDebug);
if ($top->{tag} eq $tag) {
print STDERR "RETURNING 1\n" if ($localDebug);
return 1;
}
if (!$top->{synthesized}) {
if ($tag eq "div" && $top->{tag} eq "p") {
print STDERR "Auto-closing paragraph in div.\n" if ($localDebug);
} elsif ($tag eq "ul" || $tag eq "ol" && $top->{tag} eq "li") {
print STDERR "Auto-closing li in ul or ol.\n" if ($localDebug);
} else {
print STDERR "RETURNING 0\n" if ($localDebug);
return 0;
}
}
$top = pop(@copy);
}
return 0;
}
sub fixXHTMLAttributes
{
my $orig_attributes = shift;
my $localDebug = 0;
my @parts = split(/([^:A-Z_a-z\xC0-\xD6\xD8-\xF6\xF8-\x{2FF}\x{370}-\x{37D}\x{37F}-\x{1FFF}\x{200C}-\x{200D}\x{2070}-\x{218F}\x{2C00}-\x{2FEF}\x{3001}-\x{D7FF}\x{F900}-\x{FDCF}\x{FDF0}-\x{FFFD}\x{10000}-\x{EFFFF}.0-9\xB7\x{0300}-\x{036F}\x{203F}-\x{2040}-])/, $orig_attributes);
my $insquo = 0; my $indquo = 0;
my $attpending = 0; my $attributes = "";
my $droprest = 0; my $needspace = "";
foreach my $part (@parts) {
print STDERR "PART: $part\n" if ($localDebug);
if ($indquo) {
print STDERR "INDQUO\n" if ($localDebug);
if ($part eq "\"") {
print STDERR "INDQUO -> 0\n" if ($localDebug);
$indquo = 0;
$needspace = " ";
}
} elsif ($insquo) {
print STDERR "INDQUO\n" if ($localDebug);
if ($part eq "'") {
print STDERR "INSQUO -> 0\n" if ($localDebug);
$insquo = 0;
$needspace = " ";
}
} elsif ($part eq "'") {
print STDERR "INSQUO -> 1\n" if ($localDebug);
$insquo = 1; $attpending = 0;
} elsif ($part eq "\"") {
print STDERR "INDQUO -> 1\n" if ($localDebug);
$indquo = 1; $attpending = 0;
} elsif ($attpending) {
print STDERR "ATTPENDING\n" if ($localDebug);
if ($part eq "=") {
print STDERR "ATTPENDING -> 2\n" if ($localDebug);
$attpending = 2;
} elsif ($part =~ /\w/) {
print STDERR "ATTPENDING, WORD\n" if ($localDebug);
if ($attpending == 1) {
print STDERR "ATTPENDING == 1, WORD\n" if ($localDebug);
$part = "=\"\" ".$part;
} else {
print STDERR "ATTPENDING == 2, WORD\n" if ($localDebug);
$part = "\"$part\" ";
$attpending = 0;
}
}
} elsif ($part =~ /\w/) {
$part = $needspace.$part;
$needspace = "";
print STDERR "ATTPENDING -> 1\n" if ($localDebug);
$attpending = 1;
} elsif ($part =~ /\s/) {
$needspace = "";
} elsif ($part eq "=") {
$part = "";
warn("WARNING: Invalid HTML (attribute list is broken.) Errant text was:\n$orig_attributes\n") if (!$HeaderDoc::running_test);
warn("Truncating to $attributes\n") if (!$HeaderDoc::running_test);
return $attributes;
}
print STDERR "APPENDING $part\n" if ($localDebug);
if (!$droprest) {
$attributes .= $part;
}
}
if ($attpending == 1) {
print STDERR "ATTPENDING == 1 AT END\n" if ($localDebug);
$attributes .= "=\"\"";
} elsif ($attpending == 2) {
print STDERR "ATTPENDING == 2 AT END\n" if ($localDebug);
$attributes .= "\"\"";
};
if ($attributes ne $orig_attributes) {
warn("WARNING: Changed non-XHTML attributes from \"$orig_attributes\" to \"$attributes\"\n") if (!$HeaderDoc::running_test);
}
return $attributes;
}
sub filterHeaderDocTagContents
{
my $origtagcontents = shift;
my $filterTagsDebug = 0;
my %custom_tags = ();
if ($HeaderDoc::custom_tags) {
%custom_tags = %{$HeaderDoc::custom_tags};
}
my %recommended_tags = (
"a" => 1,
"abbr" => 1,
"acronym" => 1,
"address" => 1,
"b" => 1,
"bdo" => 1,
"big" => 1,
"blockquote" => 1,
"br" => 1,
"caption" => 1,
"center" => 1,
"cite" => 1,
"code" => 1,
"dd" => 1,
"dfn" => 1,
"dl" => 1,
"dt" => 1,
"em" => 1,
"font" => 1,
"i" => 1,
"img" => 1,
"kbd" => 1,
"li" => 1,
"ol" => 1,
"p" => 1,
"pre" => 1,
"q" => 1,
"s" => 1, "samp" => 1,
"small" => 1,
"strike" => 1,
"strong" => 1,
"sub" => 1,
"sup" => 1,
"table" => 1,
"tbody" => 1,
"td" => 1,
"tfoot" => 1,
"th" => 1,
"thead" => 1,
"tr" => 1,
"tt" => 1,
"u" => 1,
"ul" => 1,
"var" => 1,
"hd_warning_internal" => 1, "hd_important_internal" => 1, "hd_note_internal" => 1 );
my %discouraged_tags = (
"applet" => 1, "area" => 1, "base" => 1, "basefont" => 1, "button" => 1, "col" => 1, "colgroup" => 1, "del" => 1, "dir" => 1, "fieldset" => 1,
"form" => 1,
"h1" => 1, "h2" => 1, "h3" => 1, "h4" => 1, "h5" => 1, "h6" => 1, "hr" => 1, "input" => 1,
"ins" => 1,
"label" => 1,
"legend" => 1,
"link" => 1, "map" => 1, "menu" => 1, "meta" => 1, "noscript" => 1,
"object" => 1,
"optgroup" => 1,
"option" => 1,
"param" => 1, "script" => 1,
"select" => 1,
"textarea" => 1
);
my %illegal_tags = (
"body" => 1, "frame" => 1,
"frameset" => 1,
"head" => 1,
"html" => 1, "iframe" => 1, "noframes" => 1, "style" => 1, "title" => 1 );
if ($HeaderDoc::ExtraAppleWarnings) {
$illegal_tags{"span"} = 1;
$illegal_tags{"div"} = 1;
} else {
$recommended_tags{"span"} = 1;
$recommended_tags{"div"} = 1;
}
my @htmltags = split(/(<)/, $origtagcontents);
my $tagcontents = "";
my $first = 1;
foreach my $htmltag (@htmltags) {
if ($first) {
$tagcontents .= $htmltag; $first = 0;
} elsif ($htmltag eq "<") {
$tagcontents .= $htmltag;
} else {
my @parts;
my $tagname = "";
my $attributes = "";
my $rest = "";
my $close = "";
if ($htmltag =~ s/^\///s) { $close = "/"; }
if ($htmltag =~ />/) {
@parts = split(/>/, $htmltag, 2);
($tagname, $attributes) = split(/\s/, $parts[0], 2);
$rest = $parts[1];
} else {
@parts = split(/\W/, $htmltag, 2);
$tagname = $parts[0];
$rest = $parts[1];
print STDERR "TAGNAME $tagname REST $rest\n" if ($filterTagsDebug);
if (length($tagname)) {
warn("WARNING: Tag $close$htmltag not properly closed. Guessing.\n") if (!$HeaderDoc::running_test);
} else {
$tagname = $htmltag;
$rest = "";
}
}
if ($tagname eq "hd_link") {
$tagcontents .= $close.$htmltag;
} elsif ($tagname eq "!--") {
$tagcontents .= $close.$htmltag;
} elsif ($tagname eq "note_title") {
$tagcontents .= $close.$htmltag;
} elsif ($recommended_tags{lc($tagname)} || $custom_tags{lc($tagname)}) {
print STDERR "Recommented tag $tagname\n" if ($filterTagsDebug);
$attributes = fixXHTMLAttributes($attributes);
if (length($attributes)) { $attributes = " $attributes"; }
if ($tagname =~ s/\/$//s) {
$attributes = " /".$attributes;
}
$tagcontents .= $close.$tagname.$attributes.">".$rest;
} elsif ($discouraged_tags{lc($tagname)}) {
warn("WARNING: Tag $tagname is not recommended.\n") if (!$HeaderDoc::running_test);
$attributes = fixXHTMLAttributes($attributes);
if (length($attributes)) { $attributes = " $attributes"; }
if ($tagname =~ s/\/$//s) {
$attributes = " /".$attributes;
}
$tagcontents .= $close.$tagname.$attributes.">".$rest;
} elsif ($illegal_tags{lc($tagname)}) {
warn("WARNING: Tag $tagname is illegal and has been dropped.\n") if (!$HeaderDoc::running_test);
$tagcontents =~ s/<$//s;
$tagcontents .= $rest;
} else {
warn("WARNING: Tag $tagname is not a valid HTML tag and has been converted to text.\n") if (!$HeaderDoc::running_test);
$tagcontents =~ s/<$//s;
$tagcontents .= encode_entities("<".$htmltag);
}
}
}
print STDERR "PRE:\n$origtagcontents\n\nPOST:\n$tagcontents\n\n" if ($filterTagsDebug);
my $opentags = '<\s*p[^>]*>|<\s*h[1-6][^>]*>|<\s*ul[^>]*>|<\s*ol[^>]*>|<\s*pre[^>]*>|<\s*dl[^>]*>|<\s*hd_(?:warning|important|note)[^>]*>|<\s*div[^>]*>|<\s*noscript[^>]*>|<\s*blockquote[^>]*>|<\s*form[^>]*>|<\s*hr[^>]*>|<\s*table[^>]*>|<\s*fieldset[^>]*>|<\s*address[^>]*>|<\s*li[^>]*>';
my $closetags = '<\s*\/p\s*>|<\s*\/h[1-6]\s*>|<\s*\/ul\s*>|<\s*\/ol\s*>|<\s*\/pre\s*>|<\s*\/dl\s*>|<\s*\/hd_(?:warning|important|note)\s*>|<\s*\/div\s*>|<\s*\/noscript\s*>|<\s*\/blockquote\s*>|<\s*\/form\s*>|<\s*\/hr\s*>|<\s*\/table\s*>|<\s*\/fieldset\s*>|<\s*\/address\s*>|<\s*\/li\s*>';
my @parts = split(/($opentags|$closetags|\n)/sio, $tagcontents);
my $localDebug = 0;
my $output = "";
my @ibestack = ();
my @tagstack = ();
my $root = newHTMLTagContext("body", 0);
push(@tagstack, $root);
my $line_is_empty = 0;
foreach my $part (@parts) {
my $stacktop = peek(\@tagstack);
$stacktop = $stacktop->{tag};
print STDERR "TOP OF TAG STACK: ".$stacktop."\n" if ($localDebug);
my $tag = getJustTheTag($part);
if ($part ne "") {
print STDERR "FHDTC PART: $part\n" if ($localDebug);
if ($part =~ /\n/) {
if ($line_is_empty) {
print STDERR "NEWLINE: EMPTYLINE\n" if ($localDebug);
if ($stacktop eq "p") {
print STDERR "INSERT PARA\n" if ($localDebug);
$output .= "</p>";
pop(@tagstack);
$stacktop = peek(\@tagstack);
$stacktop = $stacktop->{tag};
}
$line_is_empty = 0;
} else {
print STDERR "NEWLINE\n" if ($localDebug);
$line_is_empty = 1;
}
$output .= $part;
} elsif ($part =~ /$opentags/sio) {
print STDERR "OPENTAG\n" if ($localDebug);
while ($stacktop eq "p") {
print STDERR "CLOSING PARA\n" if ($localDebug);
$output .= "</p>\n"; pop(@tagstack);
$stacktop = peek(\@tagstack);
$stacktop = $stacktop->{tag};
}
$line_is_empty = 0;
if ($tag eq "li" && $stacktop eq "li") {
print STDERR "BLOCK IS LI TAG WITH IMPLICIT CLOSE OF PRIOR TAG\n" if ($localDebug);
$output .= "</li>";
} elsif ($tag eq "li" && $stacktop ne "ul" && $stacktop ne "ol") {
print STDERR "BLOCK IS LI OUTSIDE A LIST\n" if ($localDebug);
$output .= "<ul>";
push(@tagstack, newHTMLTagContext("ul", 1));
push(@tagstack, newHTMLTagContext($part, 0));
$stacktop = peek(\@tagstack);
$stacktop = $stacktop->{tag};
} elsif ($tag eq "p") {
print STDERR "BLOCK IS OPEN PARA\n" if ($localDebug);
push(@tagstack, newHTMLTagContext("p", 0));
$stacktop = peek(\@tagstack);
$stacktop = $stacktop->{tag};
} else {
print STDERR "BLOCK IS NOT OPEN PARA\n" if ($localDebug);
push(@tagstack, newHTMLTagContext($part, 0));
$stacktop = peek(\@tagstack);
$stacktop = $stacktop->{tag};
}
$output .= $part;
} elsif ($part =~ /$closetags/sio) {
print STDERR "CLOSETAG\n" if ($localDebug);
$line_is_empty = 0;
print STDERR "STACKTOP A: $stacktop\n" if ($localDebug);
if (canMatchTag(\@tagstack, $tag)) {
my $open = $tag;
$open =~ s/^\///s;
print STDERR "STACKTOP B: $stacktop CMP $open\n" if ($localDebug);
while ($stacktop ne $open) {
$output .= "</$stacktop>";
pop(@tagstack);
$stacktop = peek(\@tagstack);
$stacktop = $stacktop->{tag};
print STDERR "STACKTOP C: $stacktop\n" if ($localDebug);
}
pop(@tagstack);
$stacktop = peek(\@tagstack);
$stacktop = $stacktop->{tag};
}
$output .= $part;
} elsif ((canMatchTag(\@tagstack, "body") || canMatchTag(\@tagstack, "li") || canMatchTag(\@tagstack, "div")) && $stacktop ne "p" && $part =~ /\S/) {
while ($stacktop ne "body" && $stacktop ne "li" && $stacktop ne "div") {
$output .= "</$stacktop>";
pop(@tagstack);
$stacktop = peek(\@tagstack);
$stacktop = $stacktop->{tag};
print STDERR "STACKTOP D: $stacktop\n" if ($localDebug);
}
print STDERR "OPENING IMPLICIT PARA\n" if ($localDebug);
$output .= "<p>";
$line_is_empty = 0;
push(@tagstack, newHTMLTagContext("p", 1));
$stacktop = peek(\@tagstack);
$stacktop = $stacktop->{tag};
$output .= $part;
} else {
print STDERR "NORMAL TEXT\n" if ($localDebug);
$line_is_empty = 0;
$output .= $part;
}
}
}
if (0) {
print STDERR "IN filterHeaderDocTagContents:\n";
print STDERR "PRE:\n$tagcontents\nENDPRE\n";
print STDERR "POST:\n$output\nENDPOST\n";
}
return $output;
}
sub filterHeaderDocComment
{
my $headerDocCommentLinesArrayRef = shift;
my $lang = shift;
my $sublang = shift;
my $inputCounter = shift;
my %parseTokens = %{parseTokens($lang, $sublang)};
my $fullpath = $HeaderDoc::headerObject->fullpath();
my @headerDocCommentLinesArray = @{$headerDocCommentLinesArrayRef};
my $returnComment = "";
my $localDebug = 0;
my $liteDebug = 0;
my $commentDumpDebug = 0;
my $linenum = 0;
my $curtextblockstarred = 1;
my @textblock_starred_array = ();
my $outerstarred = 1;
my $textblock_number = 0;
if ($lang eq "perl" || $lang eq "shell" || $lang eq "tcl") {
$parseTokens{soc} = "/*";
$parseTokens{eoc} = "*/";
$parseTokens{ilc} = "";
}
my $eoc = $parseTokens{eoc};
my $paranoidstate = 0;
foreach my $lineref (@headerDocCommentLinesArray) {
my %lineentry = %{$lineref};
my $in_textblock = $lineentry{INTEXTBLOCK};
my $in_pre = $lineentry{INPRE};
my $leaving_textblock = $lineentry{LEAVINGTEXTBLOCK};
my $leaving_pre = $lineentry{LEAVINGPRE};
my $line = $lineentry{LINE};
print STDERR "PREPASS LINE: \"$line\"\n" if ($localDebug || $liteDebug);
if (!$linenum) {
print STDERR "PREPASS SKIP\n" if ($localDebug);
$linenum++;
} else {
if ($in_textblock) {
print STDERR "PREPASS IN TEXTBLOCK\n" if ($localDebug);
if ($line !~ /^\s*\*/) {
print STDERR "CURRENT TEXT BLOCK NOT STARRED\n" if ($localDebug);
$curtextblockstarred = 0;
}
} elsif ($leaving_textblock) {
print STDERR "PREPASS LEAVING TEXTBLOCK #".$textblock_number." (STARRED = $curtextblockstarred)\n" if ($localDebug);
$textblock_starred_array[$textblock_number++] = $curtextblockstarred;
$curtextblockstarred = 1;
} else {
print STDERR "PREPASS NORMAL LINE\n" if ($localDebug);
if ($line !~ /^\s*\*/) {
print STDERR "PREPASS OUTER NOT STARRED\n" if ($localDebug);
$outerstarred = 0;
} else {
if ($line !~ /^\s*\Q$eoc\E/) {
print STDERR "PARANOID STATE -> 1\n" if ($localDebug);
$paranoidstate = 1;
} else {
print STDERR "EOC\n" if ($localDebug);
}
}
}
$linenum++;
}
}
print STDERR "OUTERSTARRED: $outerstarred\n" if ($localDebug);
if ($paranoidstate && !$outerstarred && !$HeaderDoc::running_test) {
warn("$fullpath:$inputCounter: Partially starred comment.\n");
warn("$fullpath:$inputCounter: Comment follows:\n");
foreach my $lineref (@headerDocCommentLinesArray) {
my %lineentry = %{$lineref};
my $line = $lineentry{LINE};
warn($line);
}
warn("$fullpath:$inputCounter: End of comment.\n");
}
my $starslash = 0;
my $lastlineref = pop(@headerDocCommentLinesArray);
my %lastline = %{$lastlineref};
my $lastlinetext = $lastline{LINE};
print STDERR "LLT: $lastlinetext\n" if ($localDebug);
my $origlastlinetext = $lastlinetext;
if ($lastlinetext =~ s/\Q$eoc\E\s*\\?\s*.*$//s) {
if ($origlastlinetext !~ s/\Q$eoc\E\s*\\?\s*$//s) {
warn("$fullpath:$inputCounter: Line contains content after the end of comment marker. If this tag is not in a structure, class, union, or enumeration, this may not work correctly. (If it is, ignore this warning.)\nLast line was: $origlastlinetext\n");
}
$lastline{LINE} = $lastlinetext;
print STDERR "FOUND */\n" if ($localDebug);
if ($lastlinetext !~ /\S/) {
print STDERR "LL dropped because it is empty: $lastlinetext\n" if ($localDebug);
$starslash = 1;
} else {
print STDERR "LL retained (nonempty): $lastlinetext\n" if ($localDebug);
push(@headerDocCommentLinesArray, $lastlineref);
}
} else {
print STDERR "NO EOC ($eoc)\n";
print STDERR "LL: $lastlinetext\n" if ($localDebug);
push(@headerDocCommentLinesArray, $lastlineref);
}
$lastlineref = \%lastline;
$textblock_number = 0;
my $old_in_textblock = 0;
foreach my $lineref (@headerDocCommentLinesArray) {
my %lineentry = %{$lineref};
my $in_textblock = $lineentry{INTEXTBLOCK};
my $in_pre = $lineentry{INPRE};
my $line = $lineentry{LINE};
my $leaving_textblock = $lineentry{LEAVINGTEXTBLOCK};
my $leaving_pre = $lineentry{LEAVINGPRE};
print STDERR "FILTER LINE: $line\n" if ($localDebug);
print STDERR "IT: $in_textblock IP: $in_pre LT: $leaving_textblock LP: $leaving_pre\n" if ($localDebug);
if ($in_textblock && $old_in_textblock) {
if ($outerstarred) {
my $tbstarred = $textblock_starred_array[$textblock_number];
if ($tbstarred) {
$line =~ s/^\s*[*]//so;
}
}
} else {
if ($outerstarred) {
my $tbstarred = $textblock_starred_array[$textblock_number];
if (!$leaving_textblock || $tbstarred) {
$line =~ s/^\s*[*]//so;
}
}
if (!$in_pre && !$leaving_pre && !$leaving_textblock) {
$line =~ s/^[ \t]*//o; # remove leading whitespace
}
$old_in_textblock = $in_textblock;
}
if ($leaving_textblock) {
$textblock_number++;
}
$returnComment .= $line;
}
if ($starslash) {
$returnComment .= $eoc;
}
if (0) { foreach my $lineref (@headerDocCommentLinesArray) {
my %lineentry = %{$lineref};
my $in_textblock = $lineentry{INTEXTBLOCK};
my $in_pre = $lineentry{INPRE};
my $line = $lineentry{LINE};
$line =~ s/^\s*[*]\s+(\S.*)/$1/o; if (!$in_textblock && !$in_pre) {
$line =~ s/^[ \t]*//o; # remove leading whitespace
if ($line !~ /\S/) {
$line = "<br><br>\n";
}
$line =~ s/^\s*[*]\s*$/<br><br>\n/o; } else {
$line =~ s/^\s*[*]\s*$/\n/o; }
$returnComment .= $line;
}
}
print STDERR "RESULTING COMMENT:\n$returnComment\nEOCOMMENT\n" if ($localDebug || $commentDumpDebug || $liteDebug);
return $returnComment;
}
sub processTopLevel
{
my ($inHeader, $inClass, $inInterface, $inCPPHeader, $inOCCHeader, $inPerlScript, $inShellScript, $inPHPScript, $inJavaSource, $inFunctionGroup, $inGroup, $inFunction, $inPDefine, $inTypedef, $inUnion, $inStruct, $inConstant, $inVar, $inEnum, $inMethod, $inAvailabilityMacro, $inUnknown, $classType, $line, $inputCounter, $blockOffset, $fullpath, $linenumdebug, $localDebug) = @_;
$localDebug = $localDebug || 0;
if ($localDebug) {
my $token = $line;
$token =~ s/\s*(\/\*|\/\/)\!//s;
$token =~ s/^\s*//s;
$token =~ s/\s.*$//s;
print STDERR "TOKEN: $token\n";
}
$line =~ s/^\s*//s;
SWITCH: { ($line =~ /^\/\*!\s+\@file\s*/io) && do {$inHeader = 1; last SWITCH;};
($line =~ /^\/\*!\s+\@header\s*/io) && do {$inHeader = 1; last SWITCH;};
($line =~ /^\/\*!\s+\@framework\s*/io) && do {$inHeader = 1; last SWITCH;};
($line =~ /^\/\*!\s+\@template\s*/io) && do {$inClass = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@interface\s*/io) && do {$inClass = 1; $inInterface = 1; last SWITCH;};
($line =~ /^\/\*!\s+\@class\s*/io) && do {$inClass = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@protocol\s*/io) && do {$inClass = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@category\s*/io) && do {$inClass = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@language\s+.*c\+\+\s*/io) && do {$inCPPHeader = 1; last SWITCH;};
($line =~ /^\/\*!\s+\@language\s+.*objc\s*/io) && do {$inOCCHeader = 1; last SWITCH;};
($line =~ /^\/\*!\s+\@language\s+.*perl\s*/io) && do {$inPerlScript = 1; last SWITCH;};
($line =~ /^\/\*!\s+\@language\s+.*shell\s*/io) && do {$inShellScript = 1; last SWITCH;};
($line =~ /^\/\*!\s+\@language\s+.*php\s*/io) && do {$inPHPScript = 1; last SWITCH;};
($line =~ /^\/\*!\s+\@language\s+.*java\s*/io) && do {$inJavaSource = 1; last SWITCH;};
($line =~ /^\/\*!\s+\@language\s+.*javascript\s*/io) && do {$inJavaSource = 1; last SWITCH;};
($line =~ /^\/\*!\s+\@functiongroup\s*/io) && do {$inFunctionGroup = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@group\s*/io) && do {$inGroup = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@name\s*/io) && do {$inGroup = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@function\s*/io) && do {$inFunction = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@availabilitymacro(\s+)/io) && do { $inAvailabilityMacro = 1; $inPDefine = 1; last SWITCH;};
($line =~ /^\/\*!\s+\@methodgroup\s*/io) && do {$inFunctionGroup = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@method\s*/io) && do {
if ($classType eq "occ" ||
$classType eq "intf" ||
$classType eq "occCat") {
$inMethod = 1;last SWITCH;
} else {
$inFunction = 1;last SWITCH;
}
};
($line =~ /^\/\*!\s+\@typedef\s*/io) && do {$inTypedef = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@union\s*/io) && do {$inUnion = 1;$inStruct = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@struct\s*/io) && do {$inStruct = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@const(ant)?\s*/io) && do {$inConstant = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@var\s*/io) && do {$inVar = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@property\s*/io) && do {$inUnknown = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@define(d)?block\s*/io) && do {
print STDERR "IN DEFINE BLOCK\n" if ($localDebug);
$inPDefine = 2;
last SWITCH;
};
($line =~ /^\/\*!\s+\@\/define(d)?block\s*/io) && do {
print STDERR "OUT OF DEFINE BLOCK\n" if ($localDebug);
$inPDefine = 0;
last SWITCH;
};
($line =~ /^\/\*!\s+\@define(d)?\s*/io) && do {$inPDefine = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@lineref\s+(\d+)/io) && do {
$blockOffset = $1 - $inputCounter;
$inputCounter--;
print STDERR "DECREMENTED INPUTCOUNTER [M4]\n" if ($HeaderDoc::inputCounterDebug);
print STDERR "BLOCKOFFSET SET TO $blockOffset\n" if ($linenumdebug);
last SWITCH;
};
($line =~ /^\/\*!\s+\@enum\s*/io) && do {$inEnum = 1;last SWITCH;};
($line =~ /^\/\*!\s+\@serial(Data|Field|)\s+/io) && do {$inUnknown = 2;last SWITCH;};
($line =~ /^\/\*!\s*[^\@\s]/io) && do {$inUnknown = 1;last SWITCH;};
my $linenum = $inputCounter - 1 + $blockOffset;
print STDERR "CHECKING VALIDFIELD FOR \"$line\".\n" if ($localDebug);;
if (!validTag($line)) {
warn "$fullpath:$linenum: warning: HeaderDoc comment is not of known type. Comment text is:\n";
print STDERR " $line\n";
}
$inUnknown = 1;
}
return ($inHeader, $inClass, $inInterface, $inCPPHeader, $inOCCHeader, $inPerlScript, $inShellScript, $inPHPScript, $inJavaSource, $inFunctionGroup, $inGroup, $inFunction, $inPDefine, $inTypedef, $inUnion, $inStruct, $inConstant, $inVar, $inEnum, $inMethod, $inAvailabilityMacro, $inUnknown, $classType, $line, $inputCounter, $blockOffset, $fullpath, $linenumdebug, $localDebug);
}
sub processHeaderComment {
my $apiOwner = shift;
my $rootOutputDir = shift;
my $fieldArrayRef = shift;
my $debugging = shift;
my $reprocess_input_ref = shift;
my $lang = shift;
my $sublang = shift;
my $reprocess_input = ${$reprocess_input_ref};
my @fields = @$fieldArrayRef;
my $linenum = $apiOwner->linenum();
my $fullpath = $apiOwner->fullpath();
my $localDebug = 0;
foreach my $field (@fields) {
print STDERR "header field: |$field|\n" if ($localDebug);
SWITCH: {
($field =~ /^\/\*\!/o)&& do {last SWITCH;}; (($lang eq "java") && ($field =~ /^\s*\/\*\*/o)) && do {last SWITCH;}; ($field =~ /^see(also|)\s+/o) &&
do {
$apiOwner->see($field);
last SWITCH;
};
($field =~ /^frameworkcopyright\s+/sio) &&
do {
my $copy = $field;
$copy =~ s/frameworkcopyright\s+//s;
$copy =~ s/^\s+//sg;
$copy =~ s/\s+$//sg;
$apiOwner->attribute("Requested Copyright", $copy, 0, 1);
last SWITCH;
};
($field =~ /^internal\s+/sio) && do {
$apiOwner->isInternal(1);
last SWITCH;
};
($field =~ /^apiuid\s+/sio) &&
do {
my $uid = $field;
$uid =~ s/apiuid\s+//s;
$apiOwner->requestedUID($uid);
last SWITCH;
};
($field =~ /^frameworkuid\s+/sio) &&
do {
my $uid = $field;
$uid =~ s/frameworkuid\s+//s;
$uid =~ s/\s+//sg;
$apiOwner->attribute("Requested UID", $uid, 0, 1);
last SWITCH;
};
($field =~ /^frameworkpath\s+/sio) &&
do {
my $path = $field;
$path =~ s/frameworkpath\s+//s;
$path =~ s/\s+//sg;
$path =~ s/\/$//sg;
$apiOwner->attribute("Framework Path", $path, 0);
last SWITCH;
};
($field =~ /^headerpath\s+/sio) &&
do {
my $path = $field;
$path =~ s/headerpath\s+//s;
$path =~ s/\s+//sg;
$path =~ s/\/$//sg;
$apiOwner->attribute("Path To Headers", $path, 0);
last SWITCH;
};
(($field =~ /^header\s+/sio) ||
($field =~ /^file\s+/sio) ||
($field =~ /^framework\s+/sio)) &&
do {
if ($field =~ s/^framework//sio) {
$apiOwner->isFramework(1);
} else {
$field =~ s/^(header|file)//o;
}
my ($name, $disc, $is_nameline_disc);
($name, $disc, $is_nameline_disc) = &getAPINameAndDisc($field, $lang);
if (length($name) && ((!$HeaderDoc::ignore_apiowner_names) || $apiOwner->isFramework())) {
print STDERR "Setting header name to $name\n" if ($debugging);
$apiOwner->name($name);
}
print STDERR "Discussion is:\n" if ($debugging);
print STDERR "$disc\n" if ($debugging);
if (length($disc)) {
if ($is_nameline_disc) {
$apiOwner->nameline_discussion($disc);
} else {
$apiOwner->discussion($disc);
}
}
last SWITCH;
};
($field =~ s/^dependency(\s+)/$1/sio) && do {$apiOwner->attributelist("Dependencies", $field); last SWITCH;};
($field =~ s/^availability\s+//sio) && do {$apiOwner->availability($field); last SWITCH;};
($field =~ s/^since\s+//sio) && do {$apiOwner->availability($field); last SWITCH;};
($field =~ s/^author\s+//sio) && do {$apiOwner->attribute("Author", $field, 0); last SWITCH;};
($field =~ s/^version\s+//sio) && do {$apiOwner->attribute("Version", $field, 0); last SWITCH;};
($field =~ s/^deprecated\s+//sio) && do {$apiOwner->attribute("Deprecated", $field, 0); last SWITCH;};
($field =~ s/^version\s+//sio) && do {$apiOwner->attribute("Version", $field, 0); last SWITCH;};
($field =~ s/^performance(\s+)/$1/sio) && do {$apiOwner->attribute("Performance", $field, 1); last SWITCH;};
($field =~ s/^attribute\s+//sio) && do {
my ($attname, $attdisc, $is_nameline_disc) = &getAPINameAndDisc($field, $lang);
if (length($attname) && length($attdisc)) {
$apiOwner->attribute($attname, $attdisc, 0);
} else {
warn "$fullpath:$linenum: warning: Missing name/discussion for attribute\n";
}
last SWITCH;
};
($field =~ s/^indexgroup(\s+)/$1/sio) && do {$apiOwner->indexgroup($field); last SWITCH;};
($field =~ s/^attributelist\s+//sio) && do {
$field =~ s/^\s*//so;
$field =~ s/\s*$//so;
my ($name, $lines) = split(/\n/, $field, 2);
$name =~ s/^\s*//so;
$name =~ s/\s*$//so;
$lines =~ s/^\s*//so;
$lines =~ s/\s*$//so;
if (length($name) && length($lines)) {
my @attlines = split(/\n/, $lines);
foreach my $line (@attlines) {
$apiOwner->attributelist($name, $line);
}
} else {
warn "$fullpath:$linenum: warning: Missing name/discussion for attributelist\n";
}
last SWITCH;
};
($field =~ s/^attributeblock\s+//sio) && do {
my ($attname, $attdisc, $is_nameline_disc) = &getAPINameAndDisc($field, $lang);
if (length($attname) && length($attdisc)) {
$apiOwner->attribute($attname, $attdisc, 1);
} else {
warn "$fullpath:$linenum: warning: Missing name/discussion for attributeblock\n";
}
last SWITCH;
};
($field =~ s/^updated\s+//sio) && do {$apiOwner->updated($field); last SWITCH;};
($field =~ s/^unsorted\s+//sio) && do {$apiOwner->unsorted(1); last SWITCH;};
($field =~ s/^abstract\s+//sio) && do {$apiOwner->abstract($field); last SWITCH;};
($field =~ s/^brief\s+//sio) && do {$apiOwner->abstract($field, 1); last SWITCH;};
($field =~ s/^description(\s+|$)//sio) && do {$apiOwner->discussion($field); last SWITCH;};
($field =~ s/^details(\s+|$)//sio) && do {$apiOwner->discussion($field); last SWITCH;};
($field =~ s/^discussion(\s+|$)//sio) && do {$apiOwner->discussion($field); last SWITCH;};
($field =~ s/^copyright\s+//sio) && do { $apiOwner->headerCopyrightOwner($field); last SWITCH;};
($field =~ s/^meta\s+//sio) && do {$apiOwner->HTMLmeta($field); last SWITCH;};
($field =~ s/^language\s+//sio) && do {
SWITCH {
($field =~ /^\s*applescript\s*$/sio) && do { $sublang = "applescript"; last SWITCH; };
($field =~ /^\s*c\s*$/sio) && do { $sublang = "C"; last SWITCH; };
($field =~ /^\s*c\+\+\s*$/sio) && do { $sublang = "cpp"; last SWITCH; };
($field =~ /^\s*csh\s*$/sio) && do { $sublang = "csh"; last SWITCH; };
($field =~ /^\s*java\s*$/sio) && do { $sublang = "java"; last SWITCH; };
($field =~ /^\s*javascript\s*$/sio) && do { $sublang = "javascript"; last SWITCH; };
($field =~ /^\s*objc\s*$/sio) && do { $sublang = "occ"; last SWITCH; };
($field =~ /^\s*pascal\s*$/sio) && do { $sublang = "pascal"; last SWITCH; };
($field =~ /^\s*perl\s*$/sio) && do { $sublang = "perl"; last SWITCH; };
($field =~ /^\s*php\s*$/sio) && do { $sublang = "php"; last SWITCH; };
($field =~ /^\s*python\s*$/sio) && do { $sublang = "python"; last SWITCH; };
($field =~ /^\s*ruby\s*$/sio) && do { $sublang = "ruby"; last SWITCH; };
($field =~ /^\s*shell\s*$/sio) && do { $sublang = "shell"; last SWITCH; };
($field =~ /^\s*tcl\s*$/sio) && do { $sublang = "tcl"; last SWITCH; };
{
warn("$fullpath:$linenum: warning: Unknown language $field in header comment\n");
};
};
};
($field =~ s/^CFBundleIdentifier\s+//sio) && do {$apiOwner->attribute("CFBundleIdentifier", $field, 0); last SWITCH;};
($field =~ s/^related\s+//sio) && do {$apiOwner->attributelist("Related Headers", $field); last SWITCH;};
($field =~ s/^security(\s+)/$1/sio) && do {$apiOwner->attribute("Security", $field, 1); last SWITCH;};
($field =~ s/^(compiler|)flag\s+//sio) && do {$apiOwner->attributelist("Compiler Flags", $field); last SWITCH;};
($field =~ s/^preprocinfo\s+//sio) && do {$apiOwner->attribute("Preprocessor Behavior", $field, 1); last SWITCH;};
($field =~ s/^whyinclude\s+//sio) && do {$apiOwner->attribute("Reason to Include", $field, 1); last SWITCH;};
($field =~ s/^ignorefuncmacro\s+//sio) && do { $field =~ s/\n//smgo; $field =~ s/<br\s*\/?>//sgo; $field =~ s/^\s*//sgo; $field =~ s/\s*$//sgo;
$HeaderDoc::perHeaderIgnoreFuncMacros{$field} = $field;
if (!($reprocess_input)) {$reprocess_input = 1;} print STDERR "ignoring $field" if ($localDebug); last SWITCH;};
($field =~ s/^namespace(\s+)/$1/sio) && do {$apiOwner->namespace($field); last SWITCH;};
($field =~ s/^charset(\s+)/$1/sio) && do {$apiOwner->encoding($field); last SWITCH;};
($field =~ s/^encoding(\s+)/$1/sio) && do {$apiOwner->encoding($field); last SWITCH;};
($field =~ s/^ignore\s+//sio) && do { $field =~ s/\n//smgo; $field =~ s/<br\s*\/?>//sgo;$field =~ s/^\s*//sgo; $field =~ s/\s*$//sgo;
$HeaderDoc::perHeaderIgnorePrefixes{$field} = $field;
if (!($reprocess_input)) {$reprocess_input = 1;} print STDERR "ignoring $field" if ($localDebug); last SWITCH;};
warn("$fullpath:$linenum: warning: Unknown field (\@$field) in header comment.\n");
}
}
return ($lang, $sublang);
}
sub getLangAndSubLangFromFilename
{
my $filename = shift;
my $rootFileName;
my $lang = "";
my $sublang = "";
($rootFileName = $filename) =~ s/\.(cpp|c|C|h|m|M|i|hdoc|php|php\d|class|pas|p|java|j|jav|jsp|js|jscript|html|shtml|dhtml|htm|shtm|dhtm|pl|pm|bsh|csh|ksh|sh|defs|idl|conf|rb|rbx|rhtml|ruby|py|pyw|applescript|scpt|tcl)$/_$1/;
if ($filename =~ /\.(php|php\d|class)$/) {
$lang = "php";
$sublang = "php";
} elsif ($filename =~ /\.c$/) {
$lang = "Csource";
$sublang = "Csource";
} elsif ($filename =~ /\.(C|cpp)$/) {
$lang = "C";
$sublang = "cpp";
} elsif ($filename =~ /\.(m|M)$/) {
$lang = "C";
$sublang = "occ";
} elsif ($filename =~ /\.(s|d|)htm(l?)$/i) {
$lang = "java";
$sublang = "javascript";
} elsif ($filename =~ /\.j(s|sp|script)$/i) {
$lang = "java";
$sublang = "javascript";
} elsif ($filename =~ /\.j(ava|av|)$/i) {
$lang = "java";
$sublang = "java";
} elsif ($filename =~ /\.p(as|)$/i) {
$lang = "pascal";
$sublang = "pascal";
} elsif ($filename =~ /\.p(l|m)$/i) {
$lang = "perl";
$sublang = "perl";
} elsif ($filename =~ /\.(c|b|k|)sh$/i ||
$filename =~ /\.conf$/i) {
$lang = "shell";
if ($filename =~ /\.csh$/i) {
$sublang = "csh";
} else {
$sublang = "shell";
}
} else {
$lang = "C";
$sublang = "C";
}
if ($filename =~ /\.(rb|rbx|rhtml|ruby)$/o) {
$lang = "ruby";
$sublang = "ruby";
}
if ($filename =~ /\.(applescript|scpt)$/o) {
$lang = "applescript";
$sublang = "applescript";
}
if ($filename =~ /\.(tcl)$/o) {
$lang = "tcl";
$sublang = "tcl";
}
if ($filename =~ /\.(py|pyw)$/o) {
$lang = "python";
$sublang = "python";
}
if ($filename =~ /\.idl$/o) {
$lang = "C";
$sublang = "IDL";
}
if ($filename =~ /\.defs$/o) {
$lang = "C";
$sublang = "MIG";
}
$HeaderDoc::lang = $lang;
$HeaderDoc::sublang = $sublang;
return ($rootFileName, $lang, $sublang);
}
sub getLineArrays {
my $classDebug = 0;
my $localDebug = 0;
my $blockDebug = 0;
my $dumpOnly = 0;
my $rawLineArrayRef = shift;
my @arrayOfLineArrays = ();
my @generalHeaderLines = ();
my @classStack = ();
my $lang = shift;
my $sublang = shift;
my $inputCounter = 0;
my $lastArrayIndex = @{$rawLineArrayRef};
my $line = "";
my $className = "";
my $classType = "";
my $isshell = 0;
if ($lang eq "shell" || $lang eq "perl" || $lang eq "tcl") {
$isshell = 1;
}
my %parseTokens = %{parseTokens($lang, $sublang)};
my $soc = $parseTokens{soc};
my $ilc = $parseTokens{ilc};
my $eoc = $parseTokens{eoc};
if ($isshell) {
$eoc = "*/";
}
while ($inputCounter <= $lastArrayIndex) {
$line = ${$rawLineArrayRef}[$inputCounter];
my $startline = $inputCounter;
print STDERR "MYLINE: \"$line\"\n" if ($localDebug);
print STDERR "SOC: $soc\n" if ($localDebug);
print STDERR "EOC: $eoc\n" if ($localDebug);
print STDERR "ISSHELL: $isshell\n" if ($localDebug);
if (($isshell && $line =~ /^\s*\Q$ilc\E\s*\/\*\!(.*)$/s) ||
(!$isshell &&
(($line =~ /^\s*\Q$soc\E\!/s) ||
(($lang eq "java" || $HeaderDoc::parse_javadoc) &&
($line =~ /^\s*\Q$soc\E\*[^*]/s))))) { print STDERR "inHDComment\n" if ($localDebug);
my $headerDocComment = "";
my @headerDocCommentLinesArray = ();
print STDERR "RESET headerDocCommentLinesArray\n" if ($localDebug);
{
local $^W = 0; my $in_textblock = 0; my $in_pre = 0;
my $leaving_textblock = 0; my $leaving_pre = 0;
my $nextclosecurlybrace = "";
while (($line !~ /\Q$eoc\E/s) && ($inputCounter <= $lastArrayIndex)) {
if ($nextclosecurlybrace) {
$line =~ s/}/$nextclosecurlybrace/s;
$nextclosecurlybrace = "";
}
if ($line =~ s/\{\s*\@linkdoc\s*([^}]*)$/<i>\@link $1/s) {
$nextclosecurlybrace="\@/link</i>";
} elsif ($line =~ s/\{\s*\@linkplain\s*([^}]*)$/\@link $1/s) {
$nextclosecurlybrace="\@/link";
} elsif ($line =~ s/\{\s*\@link\s*([^}]*)$/<code>\@link $1/s) {
$nextclosecurlybrace = "\@/link</code>";
} elsif ($line =~ s/\{\s*\@docroot\s*([^}]*)$/\\\@\\\@docroot $1/sgio) {
$nextclosecurlybrace = "";
} elsif ($line =~ s/\{\@value\s*([^}]*)$/\@value $1/sgio) {
$nextclosecurlybrace = "";
} elsif ($line =~ s/\{\@inheritDoc\s*([^}]*)$/\@inheritDoc $1/s) {
$nextclosecurlybrace = "";
}
if ($isshell) {
$line =~ s/^[ \t]* }
$line =~ s/\@ref\s+(\w+)\s*(\(\))?/<code>\@link $1\@\/link<\/code>/sgio;
$line =~ s/\{\s*\@linkdoc\s+(.*?)\}/<i>\@link $1\@\/link<\/i>/sgio;
$line =~ s/\{\s*\@linkplain\s+(.*?)\}/\@link $1\@\/link/sgio;
$line =~ s/\{\s*\@link\s+(.*?)\}/<code>\@link $1\@\/link<\/code>/sgio;
$line =~ s/\{\s*\@docroot\s*\}/\\\@\\\@docroot/sgio;
$line =~ s/\{\@value\}/\@value/sgio;
$line =~ s/\{\@inheritDoc\}/\@inheritDoc/sgio;
$line =~ s/([^\\])\@docroot/$1\\\@\\\@docroot/sgi;
my $templine = $line;
$leaving_textblock = 0; $leaving_pre = 0;
while ($templine =~ s/\@textblock//sio) { $in_textblock++; }
while ($templine =~ s/\@\/textblock//sio) { $in_textblock--; $leaving_textblock = 1;}
while ($templine =~ s/<pre>//sio) { $in_pre++; }
while ($templine =~ s/<\/pre>//sio) { $in_pre--; $leaving_pre = 1; }
my %lineentry = ();
$lineentry{INTEXTBLOCK} = $in_textblock;
$lineentry{INPRE} = $in_pre;
$lineentry{LEAVINGTEXTBLOCK} = $leaving_textblock;
$lineentry{LEAVINGPRE} = $leaving_pre;
$lineentry{LINE} = $line;
my $ref = \%lineentry;
print STDERR "PUSH[1] $line ($ref)\n" if ($localDebug);
push(@headerDocCommentLinesArray, $ref);
$line = ${$rawLineArrayRef}[++$inputCounter];
warnHDComment($rawLineArrayRef, $inputCounter, 0, $lang, "HeaderDoc comment", "33", \%parseTokens);
}
if ($isshell) {
$line =~ s/^[ \t]* }
$line =~ s/\{\s*\@linkdoc\s+(.*?)\}/<i>\@link $1\@\/link<\/i>/sgio;
$line =~ s/\{\s*\@linkplain\s+(.*?)\}/\@link $1\@\/link/sgio;
$line =~ s/\{\s*\@link\s+(.*?)\}/<code>\@link $1\@\/link<\/code>/sgio;
$line =~ s/\{\@value\}/\@value/sgio;
$line =~ s/\{\@inheritDoc\}/\@inheritDoc/sgio;
$line =~ s/\{\s*\@docroot\s*\}/\\\@\\\@docroot/sgo;
my %lineentry = ();
$lineentry{INTEXTBLOCK} = $in_textblock;
$lineentry{INPRE} = $in_pre;
$lineentry{LINE} = $line;
print STDERR "PUSH[2] $line\n" if ($localDebug);
push(@headerDocCommentLinesArray, \%lineentry);
$line = ${$rawLineArrayRef}[++$inputCounter];
if (0) {
print STDERR "\n\nCOMMENT DUMP:\n";
for my $lineToPrintRef (@headerDocCommentLinesArray) {
my %lineToPrint = %{$lineToPrintRef};
print STDERR "LINE: ".$lineToPrint{LINE}."\n";
}
print STDERR "END COMMENT DUMP\n\n\n";
}
$headerDocComment = filterHeaderDocComment(\@headerDocCommentLinesArray, $lang, $sublang, $inputCounter);
my $hasTrailingContent = 0;
if ($line =~ /\Q$eoc\E.*\S/s) {
$hasTrailingContent = 1;
}
if ((!emptyHDok($headerDocComment)) && (!$hasTrailingContent)) {
my $emptyDebug = 0;
warn "curline is $line" if ($emptyDebug);
print STDERR "HEADERDOC COMMENT WAS $headerDocComment\n" if ($localDebug);
warnHDComment($rawLineArrayRef, $inputCounter, 0, $lang, "HeaderDoc comment", "35", \%parseTokens, $headerDocComment);
}
} if ($localDebug) { print STDERR "first line after $headerDocComment is $line\n"; }
if ($isshell) {
$headerDocComment = "#".$headerDocComment;
if ($headerDocComment =~ s/(\r\n|\n\r|\n|\r)/$1 $headerDocComment =~ s/(\r\n|\n\r|\n|\r) }
}
push(@generalHeaderLines, $headerDocComment);
$inputCounter--;
print STDERR "DECREMENTED INPUTCOUNTER [M10]\n" if ($HeaderDoc::inputCounterDebug);
} else {
push (@generalHeaderLines, $line); print STDERR "PUSHED $line\n" if ($blockDebug);
}
$inputCounter++;
print STDERR "INCREMENTED INPUTCOUNTER [M11]\n" if ($HeaderDoc::inputCounterDebug);
}
if ($localDebug || $dumpOnly) {
print STDERR "DUMPING LINES.\n";
for my $line (@generalHeaderLines) {
print STDERR "$line";
}
print STDERR "DONE DUMPING LINES.\n";
}
push (@arrayOfLineArrays, \@generalHeaderLines);
return @arrayOfLineArrays;
}
my %uid_list_by_uid_0 = ();
my %uid_list_by_uid_1 = ();
my %uid_list_0 = ();
my %uid_list_1 = ();
my %uid_conflict_0 = ();
my %uid_conflict_1 = ();
my %uid_candidates_0 = ();
my %uid_candidates_1 = ();
my %objid_hash_0 = ();
my %objid_hash_1 = ();
sub savehashes
{
my $alldecs = shift;
if ($alldecs) {
%uid_list_by_uid_0 = %uid_list_by_uid;
%uid_list_0 = %uid_list;
%uid_conflict_0 = %uid_conflict;
%uid_candidates_0 = %uid_candidates;
%objid_hash_0 = %objid_hash;
} else {
%uid_list_by_uid_1 = %uid_list_by_uid;
%uid_list_1 = %uid_list;
%uid_conflict_1 = %uid_conflict;
%uid_candidates_1 = %uid_candidates;
%objid_hash_1 = %objid_hash;
}
}
sub loadhashes
{
my $alldecs = shift;
if ($alldecs) {
%uid_list_by_uid = %uid_list_by_uid_0;
%uid_list = %uid_list_0;
%uid_conflict = %uid_conflict_0;
%uid_candidates = %uid_candidates_0;
%objid_hash = %objid_hash_0;
} else {
%uid_list_by_uid = %uid_list_by_uid_1;
%uid_list = %uid_list_1;
%uid_conflict = %uid_conflict_1;
%uid_candidates = %uid_candidates_1;
%objid_hash = %objid_hash_1;
}
}
sub getAbsPath
{
my $filename = shift;
if ($filename =~ /^\Q$pathSeparator\E/) {
return $filename;
}
return cwd().$pathSeparator.$filename;
}
sub allow_everything
{
my $lang = shift;
my $sublang = shift;
if ($lang eq "C") {
return 1;
} elsif ($lang =~ /Csource/) {
return 1;
} elsif ($lang eq "java") {
if ($sublang ne "javascript") {
return 1;
}
} elsif ($lang eq "pascal") {
return 1; } elsif ($lang eq "perl") {
return 1; } elsif ($lang eq "tcl") {
if ($HeaderDoc::running_test) { return 1; }
return 0; }
return 0;
}
sub reencodeInUTF8
{
my $string = shift;
my $srcencoding = shift;
my $decoded = decode($srcencoding, $string);
return encode("utf8", $decoded);
}
sub getAvailabilityMacros
{
my $filename = shift;
my $quiet = shift;
print STDERR "Reading availability macros from \"$filename\".\n" if (!$quiet);
my @availabilitylist = ();
if (-f $filename) {
my ($encoding, $arrayref) = linesFromFile($filename);
@availabilitylist = @{$arrayref}
} else {
warn "Can't open $filename for availability macros\n";
}
foreach my $line (@availabilitylist) {
my ($token, $description, $has_args) = split(/\t/, $line, 3);
addAvailabilityMacro($token, $description, $has_args);
}
}
sub printFields
{
my $fieldref = shift;
my @fields = @{$fieldref};
my $first = 1;
print STDERR "FIELDS:\n";
foreach my $field (@fields) {
if ($first) { print STDERR "FIELD: $field\n"; $first = 0; }
else { print STDERR "FIELD: \@$field\n"; }
}
print STDERR "END OF FIELDS\n";
}
sub stripTags
{
my $html = shift;
eval {
require HTML::FormatText;
};
if ($@) {
die("Using the -d flag requires the HTML::FormatText module.\nTo install it, type:\n sudo cpan HTML::FormatText\n");
}
eval {
require HTML::TreeBuilder;
};
if ($@) {
die("Using the -d flag requires the HTML::TreeBuilder module.\nTo install it, type:\n sudo cpan HTML::TreeBuilder\n");
}
my $tree = HTML::TreeBuilder->new->parse($html."\n");
my $formatter = HTML::FormatText->new(leftmargin => 0, rightmargin => 50);
my $text = $formatter->format($tree);
$text =~ s/^[\n\r]*//s;
$text =~ s/[\n\r]*$//s;
$text =~ s/&/&/g;
$text =~ s/</</g;
$text =~ s/>/>/g;
my $decoder = guess_prioritized_encoding($text, "tag stripping");
if ((!$decoder) || $decoder =~ /utf8/) {
return $text;
}
return reencodeInUTF8($text, $decoder->name);
}
sub objName($$) { my $obj1 = shift;
my $obj2 = shift;
return (lc($obj1->name()) cmp lc($obj2->name()));
}
sub byLinkage($$) { my $obj1 = shift;
my $obj2 = shift;
return (lc($obj1->linkageState()) cmp lc($obj2->linkageState()));
}
sub byAccessControl($$) { my $obj1 = shift;
my $obj2 = shift;
return (lc($obj1->accessControl()) cmp lc($obj2->accessControl()));
}
sub objGroup($$) { my $obj1 = shift;
my $obj2 = shift;
return (lc($obj1->group()) cmp lc($obj2->group()));
}
sub linkageAndObjName($$) { my $obj1 = shift;
my $obj2 = shift;
my $linkAndName1 = $obj1->linkageState() . $obj1->name();
my $linkAndName2 = $obj2->linkageState() . $obj2->name();
if ($HeaderDoc::sort_entries) {
return (lc($linkAndName1) cmp lc($linkAndName2));
} else {
return byLinkage($obj1, $obj2);
}
}
sub byMethodType($$) { my $obj1 = shift;
my $obj2 = shift;
if ($HeaderDoc::sort_entries) {
return (lc($obj1->isInstanceMethod()) cmp lc($obj2->isInstanceMethod()));
} else {
return (1 cmp 2);
}
}
sub splitOnPara
{
my $string = shift;
if ($string =~ /\n\n/) {
my ($fieldpart, $rest) = split(/\n\n/, $string, 2);
return ($fieldpart, $rest, 1);
}
return ($string, "", 0);
}
sub peek
{
my $ref = shift;
my @stack = @{$ref};
my $tos = pop(@stack);
push(@stack, $tos);
return $tos;
}
sub dumpCaches
{
print STDERR "DUMPING uid_list_by_uid:\n";
foreach my $key (keys %uid_list_by_uid) {
print STDERR " $key => ".$uid_list_by_uid{$key}."\n";
}
print STDERR "DUMPING uid_list:\n";
foreach my $key (keys %uid_list) {
print STDERR " $key => ".$uid_list{$key}."\n";
}
print STDERR "DUMPING uid_conflict:\n";
foreach my $key (keys %uid_conflict) {
print STDERR " $key => ".$uid_conflict{$key}."\n";
}
print STDERR "DUMPING uid_candidates:\n";
foreach my $key (keys %uid_candidates) {
print STDERR " $key => \n";
my @values = @{$uid_candidates{$key}};
foreach my $value (@values) {
print STDERR " ".$value."\n";
}
}
}
sub getDefaultEncoding
{
my $current_encoding = $ENV{"LC_ALL"};
if (!$current_encoding) {
$current_encoding = $ENV{"LC_TIME"};
}
if (!$current_encoding) {
$current_encoding = $ENV{"LANG"};
}
if ($current_encoding && ($current_encoding =~ /\./)) {
$current_encoding =~ s/^.*\.//g;
} else {
warn("No default encoding. Guessing. If date formats are wrong, try\nspecifying an appropriate value in the LANG environment variable.\n");
$current_encoding = "ISO8859-1";
}
return $current_encoding;
}
sub filterHTMLLinks
{
my $field = shift;
my @tags = split(/(<)/, $field);
my $first = 1;
my $newfield = "";
my $inlink = 0;
foreach my $tag (@tags) {
if ($first) {
$first = 0;
$newfield = $tag;
} else {
if ($tag =~ /^link(?:\s[^>]*)?>(.*)$/) {
my $origtarget = $1;
$origtarget =~ s/^\s*//;
$origtarget =~ s/\s*$//;
if ($inlink) {
warn("Nested <link> tag found. Closing.\n");
$newfield .= "</hd_link>";
}
my $target = nameFromAPIRef($origtarget);
$tag =~ s/link.*?>/hd_link posstarget="$target">/s;
$inlink = 1;
} elsif ($tag =~ /^\/link(\s|\>)/) {
$tag =~ s/\/link.*?>/\/hd_link>/s;
$inlink = 0;
}
$newfield .= $tag;
}
}
if ($inlink) {
warn("Unterminated <link> found. Closing.\n");
$newfield .= "}";
}
if ($field ne $newfield) {
warn("WARNING: The syntax <link>...</link> is not supported HeaderDoc Markup.\nInstead, use {\@link ... }\n\n");
}
return $newfield;
}
sub stripLeading
{
my $string = shift;
my $token = shift;
my @lines = split(/(\r\n|\n\r|\n|\r)/, $string);
my $result = "";
foreach my $line (@lines) {
$line =~ s/^*\Q$token\E//s;
$result .= $line;
}
return $result;
}
sub nameFromAPIRef
{
my $name = shift;
if ($name !~ /^\/\//) { return $name; }
my @parts = split(/\//, $name);
my $symbol_lang = $parts[3];
my $symbol_type = $parts[4];
my $field1 = $parts[5]; my $field2 = $parts[6];
my $field3 = $parts[7];
my $field4 = $parts[8];
my $field5 = $parts[9];
my $field6 = $parts[10];
if (($symbol_type eq "func") && $field2) {
return $field1;
}
if ($symbol_type eq "ftmplt") {
if ($field3) {
return nameAndClass($field1, $field2, $symbol_lang);
}
return $field1;
}
if ($symbol_type eq "instm") {
return nameAndClass($field1, $field2, $symbol_lang);
}
if ($symbol_type eq "intfm") {
return nameAndClass($field1, $field2, $symbol_lang);
}
if ($symbol_type eq "intfcm") {
return nameAndClass($field1, $field2, $symbol_lang);
}
if ($symbol_type eq "intfp") {
return nameAndClass($field1, $field2, $symbol_lang);
}
if ($symbol_type eq "instp") {
return nameAndClass($field1, $field2, $symbol_lang);
}
if ($field6) {
return $field6;
}
if ($field5) {
return $field5;
}
if ($field4) {
return $field4;
}
if ($field3) {
return $field3;
}
if ($field2) {
return $field2;
}
return $field1;
}
sub nameAndClass($$$$)
{
my $classname = shift;
my $methodname = shift;
my $lang = shift;
if (!$lang) { return $methodname; }
my $baremode = $HeaderDoc::nameFromAPIRefReturnsOnlyName;
if ($lang eq "occ") {
if ($baremode == 1 || $baremode == 3) { return $methodname; }
return "[ ".$classname." ".$methodname." ]";
} else {
if ($baremode == 2 || $baremode == 3) { return $methodname; }
return $classname."::".$methodname;
}
}
sub fixup_links
{
my $self = shift;
my $string = shift;
my $mode = shift;
my $ret = "";
my $localDebug = 0;
my $linkprefix = "";
my $count = $depth;
while ($count) {
$linkprefix .= "../";
$count--;
}
$linkprefix =~ s/\/$//o;
$string =~ s/\@\@docroot/$linkprefix/sgo;
my @elements = split(/</, $string);
push(@elements, "");
my $first = 1;
my $element = "";
my $movespace = "";
my $in_link = 0;
my $in_warning_et_al = "";
foreach my $nextelt (@elements) {
if ($first) { $first = 0; $element = $nextelt; next; }
if ($nextelt =~ /^\/hd_link>/s) {
$element =~ s/(\s*)$//s;
$movespace = $1;
}
if ($element =~ /^hd_warning_internal>/o) {
$in_warning_et_al .= "<".$element;
} elsif ($element =~ s/^\/hd_warning_internal>//o) {
$ret .= warningFixup($self, "WARNING:", "warning_indent", $mode, $in_warning_et_al);
$in_warning_et_al = "";
} elsif ($element =~ /^hd_important_internal>/o) {
$in_warning_et_al .= "<".$element;
} elsif ($element =~ s/^\/hd_important_internal>//o) {
$ret .= warningFixup($self, "Important:", "important_indent", $mode, $in_warning_et_al);
$in_warning_et_al = "";
} elsif ($element =~ /^hd_note_internal>/o) {
$in_warning_et_al .= "<".$element;
} elsif ($element =~ s/^\/hd_note_internal>//o) {
$ret .= warningFixup($self, "Note:", "note_indent", $mode, $in_warning_et_al);
$in_warning_et_al = "";
} elsif ($in_warning_et_al) {
$in_warning_et_al .= "<".$element;
} elsif ($element =~ /^hd_link posstarget=\"(.*?)\">/o) {
$in_link = 1;
my $oldtarget = $1;
my $newtarget = $oldtarget;
my $prefix = $self->apiUIDPrefix();
if (!($oldtarget =~ /\/\//)) {
warn("link needs to be resolved.\n") if ($localDebug);
warn("target is $oldtarget\n") if ($localDebug);
$newtarget = resolveLink($self, $oldtarget);
warn("new target is $newtarget\n") if ($localDebug);
}
$element =~ s/^hd_link.*?>\s?//o;
print STDERR "link name is $element\n" if ($localDebug);
if ($mode) {
if ($newtarget =~ /logicalPath=\".*\"/o) {
$ret .= "<hd_link $newtarget>";
} else {
$ret .= "<hd_link logicalPath=\"$newtarget\">";
}
$ret .= $element;
} else {
$ret .= "<!-- a logicalPath=\"$newtarget\" -->";
$ret .= $element;
}
} elsif ($element =~ s/^\/hd_link>//o) {
$in_link = 0;
if ($nextelt =~ /^\s*[.,?!]/) {
$movespace = "";
}
if ($mode) {
$ret .= "</hd_link>$movespace";
} else {
$ret .= "<!-- /a -->$movespace";
}
$ret .= $element;
} else {
$ret .= "<$element";
}
$element = $nextelt;
}
$ret =~ s/^<//o;
if ($in_warning_et_al) {
warn("Error: unterminated warning, important, or note box. Please file a bug.\n");
$ret .= $in_warning_et_al;
}
return $ret;
}
sub warningFixup
{
my $self = shift;
my $htmlkey = shift;
my $cssindentclass = shift;
my $xml_mode = shift;
my $contents = shift;
my $localDebug = 0;
print STDERR "INITIAL CONTENTS: $contents\n" if ($localDebug);
$contents =~ s/^\s*<\s*(.*?)\s*>//s;
my $xmlkey = $1;
$xmlkey =~ s/_internal$//s;
$contents =~ s/^\s*<note_title>(.*?)<\/note_title>//s;
my $title = $1;
my $append = "";
my $tail = "";
print STDERR " HTMLKEY: $htmlkey\n" if ($localDebug);
print STDERR " CSSCLASS: $cssindentclass\n" if ($localDebug);
print STDERR " XMLKEY: $xmlkey\n" if ($localDebug);
print STDERR " TITLE: $title\n" if ($localDebug);
print STDERR " CONTENTS: $contents\n" if ($localDebug);
if ($title) {
if ($xml_mode) {
$append = "<$xmlkey><title>$title</title>";
$tail = "</$xmlkey>\n";
} else {
$append = "<p><b>$title:</b><br /></p><div class='$cssindentclass'>";
$tail = "</div>\n";
}
} else {
if ($xml_mode) {
$append = "<$xmlkey>";
$tail = "</$xmlkey>\n";
} else {
$append = "<p><b>$htmlkey</b><br /></p><div class='$cssindentclass'>";
$tail = "</div>\n";
}
}
my $updatedcontents = fixup_links($self, $contents, $xml_mode);
print STDERR "CONTENTS: $contents\n" if ($localDebug);
print STDERR "UPDATED CONTENTS: $updatedcontents\n" if ($localDebug);
return $append.$updatedcontents.$tail;
}
sub html_fixup_links
{
my $self = shift;
my $string = shift;
my $resolver_output = fixup_links($self, $string, 0);
return $resolver_output;
}
sub xml_fixup_links
{
my $self = shift;
my $string = shift;
my $resolver_output = fixup_links($self, $string, 1);
return $resolver_output;
}
sub calcDepth
{
my $filename = shift;
my $base = $HeaderDoc::headerObject->outputDir();
my $origfilename = $filename;
my $localDebug = 0;
$filename =~ s/^\Q$base//;
my @parts = split(/\//, $filename);
$depth = (scalar @parts)-1;
warn("Filename: $origfilename; Depth: $depth\n") if ($localDebug);
return $depth;
}
1;
__END__