#!/usr/local/bin/perl
#
# script for building the HTML search databases for the Help system's
# Search capability.  Typically, there is one search database (index.db)
# built for each product.  As an argument, specify the pathname
# of the directory subtree to be indexed.
#
# $Revision: 1.3 $  $Date: 2002/05/22 16:46:43 $
#

$helproot = $ENV{PWD} . "/";
if ($#ARGV < 0){ 
  $subdir = "./"; }
else { 
  $subdir = $ARGV[0] . "/"; 
  $subdir =~ s|//$|/|; }

#
require 5;
use DB_File;    # Access DB databases
use Fcntl;      # Needed for above...
use File::Find; # Directory searching
$DB_File::DB_BTREE->{cachesize} = 10_000_000; # 10meg cache
$DB_File::DB_BTREE->{psize} = 32*1024; # 32k pages
undef $/; # Don't obey line boundaries
$currentKey = 0;
@exclusion_list = ("an", "the", "of" );

############################################################################

# Delete old index.db and attach %indexdb to database
$rcode = unlink($subdir . "index.db");
if ($rcode == 0) {truncate($subdir . "index.db", 0);}; # can't delete, so truncate
tie(%indexdb,'DB_File',$subdir . "index.db",
    O_RDWR | O_CREAT, 0644, $DB_File::DB_BTREE);
find(\&IndexFile,"$subdir");
&FlushWordCache();
untie(%indexdb); # release database

###########################################################################

sub IndexFile {
    if(!-f) { return; }

    $myfilename = $File::Find::name;
    if (
        # exclude certain files
        ($myfilename =~ m|tocframe\.html| ) ||
        ($myfilename =~ m|ixframe\.html| ) ||
        ($myfilename =~ m|/ref/group| ) ||
        ($myfilename =~ m|/ref/ch1_| ) ||
        ($myfilename =~ m|/ref/refix| ) ||
        ($myfilename =~ m|techdoc/relnotes/newfeat_r11| ) ||
        ($myfilename =~ m|base/relnotes/r12/| ) ||
        ($myfilename =~ m|base/relnotes/r12/newfeat_r11| ) ||
        ($myfilename =~ m|techdoc/printing| ) ||
        ($myfilename =~ m|techdoc/frameedit| ) ||
        ($myfilename =~ m|techdoc/plotedit| ) ||
        ($myfilename =~ m|techdoc/pgsetup| ) ||
        ($myfilename =~ m|techdoc/property_editor| ) ||
        (($myfilename =~ m|techdoc/infotool/|) && ($myfilename !~ m|doc_frame.html|) ) ||
        (($subdir eq "techdoc/") && ($myfilename =~ m|techdoc/relnotes/|))
       )
      { 
       return;
      };

    if(/\.html?$/) { # Handle HTML files
	print "$File::Find::name\n";
	open(HTML_FILE,$_) || die "Can't open $_: $!";
	my($text) = <HTML_FILE>; # Read entire file
        close(HTML_FILE);

	# If there is a "See Also" section, chop it off
	if ($text =~ m|<a name\=\"seeal_sec\">|)
          {
           # Remove from header to next header or end of file.
           $text =~ s|<a name\=\"seeal_sec\"></a><!-- H2 -->|<a name="seeal_sec"></a>|;
           $text .= "<!-- H2 -->";
	   $text =~ s|<a name\=\"seeal_sec\">.*?<!-- H2 -->||s;
          };

        # Remove material in bottom page footer
	if ($text =~ m|<table.*<img src\=\"b_prev.gif\".*</table>|)
          {
           # Remove from header to end of file.
	   $text =~ s|<table.*<img src\=\"b_prev.gif\".*</table>||;
          };

        # Remove material in FRAMESET files
	if ($text =~ m|<frameset.*>|)
          {
           # Remove material between HEAD tags.
	   $text =~ s|<head.*?</head>||s;
           # Remove material between SCRIPT tags.
	   $text =~ s|<script.*?</script>||s;
          };

        # Strip out all HTML tags 
	$text =~ s/<[^>]*>//g; 
        # Convert non-breaking space entities to spaces
	$text =~ s|&nbsp;| |g; 

	# Index all the words under the current key
	# Map key to this filename
#	$indexdb{pack("xn",$currentKey)} = $File::Find::name;
	$myfilename = $File::Find::name;
	$fullpathname = $helproot . $myfilename;
	open(INFILE, $fullpathname) || die "cannot open $fullpathname for reading\n";
	$count = read(INFILE, $firstline, 5000);

	$docname = "";
	$docnameStartPos = index($firstline, "<!-- DOCNAME:");
	if ($docnameStartPos > -1)
	{
	    $docnameline = substr($firstline, $docnameStartPos + 13, 80);
	    $docnameEndPos = index($docnameline, "-->");
	    $docname = substr($docnameline, 0, $docnameEndPos);
	};

        $title = "";
        $skip_this_one = 0;
        if ($firstline =~ m|<title>.*</title>|)
        {
           $title = $&;
           if (($title =~ m|: Table of Contents|) || ($title =~ m|: Index|))
           {
              $skip_this_one = 1;
           };
           $title =~ s|<.*?>||g;
           $title =~ s|\(.*?\)||;
        };

        $title2 = "";
        if ($firstline =~ m|<!-- CHAPNAME:.*?>|)
        {
           $title2 = $&;
           if ($title2 =~ m|: Index -->|)
           {
              $skip_this_one = 1;
           };
           $title2 =~ s|<!-- CHAPNAME: ||;
           $title2 =~ s| *-->||;
        }

        $title3 = "";
        if ($firstline =~ m|<!-- CHUNKNAME:.*?>|)
        {
           $title3 = $&;
           $title3 =~ s|<!-- CHUNKNAME: ||;
           $title3 =~ s| *-->||;
        }
        elsif ($firstline =~ m|<!-- FNAME:.*?-->|)
        {
           $title3 = $&;
           $title3 =~ s|<!-- FNAME:||;
           $title3 =~ s| *-->||;
        }
        elsif ($firstline =~ m|<!-- H1.*|)
        {
           $title3 = $&;
        }
        elsif ($firstline =~ m|<h1>.*|)
        {
           $title3 = $&;
        }
        elsif ($firstline =~ m|<!-- H2.*|)
        {
           $title3 = $&;
        }
        elsif ($firstline =~ m|<h2>.*|)
        {
           $title3 = $&;
        }
        elsif ($firstline =~ m|<h3>.*|)
        {
           $title3 = $&;
        };

        ## provide substitute title strings if needed
        $substitutetitle = $title;
        $shortfilename = $myfilename;
        $shortfilename =~ s|^.*/||;
        if ($title3 eq "")
        {
           $title3 = $substitutetitle;
           $substitutetitle = $shortfilename;
        };
        if ($title2 eq "")
        {
           $title2 = $substitutetitle;
        };
        if ($docname eq "")
        {
           $docname = $substitutetitle;
        };

        ## clean up title strings
        $title2 =~ s| *$||;
        $title2 =~ s|<.*?>||g;
        $title2 =~ s|&nbsp;||g;
        $title2 = cv_entities($title2);
        $title3 =~ s| *$||;
        $title3 =~ s|<.*?>||g;
        $title3 =~ s|&nbsp;||g;
        $title3 = cv_entities($title3);

	if (($title3 ne "") && ($skip_this_one == 0))
	{
	    my($wordsIndexed) = &IndexWords($text,$currentKey);
	    $line = $myfilename . "::" . $docname . "::" . $title2 . "::" . $title3;
	    # print "$line\n";
	    $indexdb{pack("xn",$currentKey)} = $line;
	    $currentKey++;
	}
	close(INFILE);

	$fileCount++;
	if($fileCount > 500) {
	    &FlushWordCache();
	    $fileCount=0;
	}
    }
}

###########################################################################

sub IndexWords {
    my($words, $fileKey) = @_;
    my(%worduniq); # for unique-ifying word list
    # Split text into Array of words
    my(@words) = split(/[^a-zA-Z0-9\xc0-\xff\+\_\-#%']+/, lc $words);
    @words = grep { $worduniq{$_}++ == 0 } # Remove duplicates
	     grep { s/^[^a-zA-Z0-9\xc0-\xff\-#%]+//; $_ } # Strip leading punct
	     grep { s/'$//; $_ } # Strip trailing apostrophe
             grep { length > 1 } # Must be longer than one character
             grep { /[a-zA-Z0-9\xc0-\xff]/ } # must have an alphanumeric
             @words;

    ## exclude words on the exclusion list
    foreach (@exclusion_list) {
        $w = $_; 
        @words = grep {!/^$w$/ } @words;
    }

    # For each word, add key to word database
    foreach (sort @words) {
	my($a) = $wordcache{$_};
	$a .= pack "n",$fileKey;
        $wordcache{$_} = $a;
    }

    # Return count of words indexed
    return scalar(@words);
}

###########################################################################
# Flush temporary in-memory %wordcache to disk database %indexdb

sub FlushWordCache {
    my($word,$entry);
    # Do merge in sorted order to improve cache response of on-disk DB
    foreach $word (sort keys %wordcache) {
	$entry = $wordcache{$word};
	if(defined $indexdb{$word}) {
	    my($codedList);
	    $codedList = $indexdb{$word};
	    $entry = &MergeLists($codedList,$entry);
	}

	# Store merged list into database
	$indexdb{$word} = $entry;
    }
    %wordcache = (); # Empty the holding queue
}

###########################################################################

sub MergeLists {
    my($list);
    # Simply append all the lists
    foreach (@_) { $list .= $_; }
    # Now, remove any duplicate entries
    my(@unpackedList) = unpack("n*",$list); # Unpack into integers
    my(%uniq); # sort and unique-ify
    @unpackedList = grep { $uniq{$_}++ == 0 }
                    sort { $a <=> $b }
                    @unpackedList;
    return pack("n*",@unpackedList); # repack
}

###########################################################################

sub cv_entities
{
  local($strng) = @_ ;

  while ($strng =~ m|&#.*?;|)
    {
     $ccode = $&;
     $ccode =~ s|&#||;
     $ccode =~ s|;||;
     $cchar = chr($ccode);
     $strng =~ s|&#.*?;|$cchar|;
    };

  $strng =~ s|&lt;|<|g;
  $strng =~ s|&gt;|>|g;
  $strng =~ s|&amp;|&|g;

  return($strng);

} # end cv_entities

###########################################################################
