# Richard A. DeVenezia
# October 6, 2003
# http://www.devenezia.com
# Improve SAS Online help - tested with version 8 and 9
# Browse extractDir\index.html after running the script

my %param = ( modules    => "common af fsp"
            , extractDir => "c:\\temp\\sas"
            , noiseLevel => 9
            , pageLimit  => 0
            );

# This perl script was tested on a Windows 2000 machine
# perl for windows can be downloaded from http://www.activestate.com
# The source was edited using UltraEdit found at http://www.ultraedit.com
#
# I agree this script may contain stupid perl
#
# Runtime parameters
# -----
# modules    - space separated list of SAS help chm modules,
#              full list can be seen at !SASROOT\core\help
# extractDir - local path where chm help modules get decompiled
# noiseLevel - higher means more messages
# pageLimit  - 0 means process all files, otherwise process only
#              first N files of each module (only use N>0 when testing)
#
# module common is needed for style sheets
# the program adds an A{} block to make links more visible
#
#-------------------------------------
# What does the script do ?
#-------------------------------------
#
# Modify html files extracted from SAS chm files:
# - color links that refer to pages that refer back
# - link to __ALL__ pages that are referers
# - list dead links found on a page
# - indicate if the page is an orphan
# Generate an index that:
# - links to table of contents
# - links to list of keywords
# - lists orphan pages
# - lists pages with dead links
# - lists pages with duplicate titles
#
# Requires:
#   Access to registry to determine SAS installation location
#   Microsoft Html Help (hh.exe) so that .chm files can be decompiled.
# Following a link into an existing chm requires:
#   Internet Explorer with JavaScript enabled
#
#-------------------------------------
# Background
#-------------------------------------
#
# The SAS Online documentation is quite complete and very informative.
# That does not mean it can not be improved.  One area I find needing
# improvement is back links.  Often a keyword search will take me to a
# page that does not have information to allow it to be 'located' in
# the contents tree when the location button is pressed.  Nor is there
# a link to another page having 'parent' or 'aggregating' context.
#
# This is especially troublesome for AF programmers whose search places
# them at a methods or attributes page.  These pages do not have back
# links to the class containing the method (ouch!).
#
# I would prefer each page have to link to _every_ page that links to it.
# Doing so provides a much richer information net and lets me get a
# taste of the oosphere.
#
# So, I am addressing the situation
# A ---> B    ( A is a referer of B )
# by altering B so the relations are
# A <--> B    ( force B to be a referer of A )
#
# An even better improvement (not being done by this program) would be to
# ensure the forced back link goes to the point in A where B is first referred to
#
# A more difficult yet equally useful navigation change would be to
# enable some form of horizontal travesal. (Some sections of SAS help do
# exhibit this feature.)
#
# Consider:
#
#     A      level 1      A
#    /|\                 /|\
#   / | \               / | \
#  B  C  D   level 2   B--C--D
#
# I prefer all nodes on level 2 have links to every other node on level 2.
# At a minimum each node should provide a previous and next.  In terms of
# SAS/AF, it would mean when you are looking at method page, you are one
# or two clicks away from another classes method or attribute page.
# Anyway, that is for a later day...
#
# I studied the html files decompiled out of af and fsp chm and found
# several things:
#
# 1. very good consistency
# 2. consistency means simplistic pattern matching and replacement can
#    be used to extract information and manipulate the html files to my
#    own purposes.
#
#-------------------------------------
# What are the patterns ?
#-------------------------------------
#
# All link navigation is of form <A HREF="destination">information</A>.
# destination is of form MS-ITS:<module>.chm::/<module>.hlp/<some-destination>.
# The decompiled html files are placed in a <module>.hlp subfolder.
# Image SRC refer to a root absolute /<module>.hlp/images/ instead of
# relative ../<module>.hlp/images
#
# With such good consistency we can
#
# 1. make changes to HREFs so online help works in decompiled form
#    1a. some advanced mojo is used to change links to modules _not_ decompiled.
#        the links are changed to cause htmlhelp to open when the link is clicked.
#        the mojo only works in Internet Explorer browser.
# 2. determine incoming and outgoing links of each page for processing
#    I.E.
#    - if a page P has links incoming from A,B,C,X,Y and has outgoing links to B,C,X,Y,Z
#      I want to add to page P outgoing links to A and colorized the outgoing links
#      B,C,X,Y
#
#-------------------------------------
# How is the link data processed ?
#-------------------------------------
#
# Regular Expressions and Hashes!!!
#
# Each file in the <module>.hlp folders is scanned and information extracted.
# At the same time, 'fixes' are made to the links so they work in decompiled form.
#
# There will be three conceptual hashes maintained
# - pages - hash for page data, each file scanned has 'page data'
#   o page data - an array
#     - incoming, hash for page referers
#     - outgoing, hash for page href destinations
#     - title of page
#
# The data requires to passes
# pass 1. fix necessary links and record linkages
# pass 2. analyze linkages and update pages if necessary
#
# Once the data is in hashes, it is a relatively simple matter to
# perform all the interesting set analysis we want.
#
#-------------------------------------
# How big is this stuff ?
#-------------------------------------
# common, af and fsp ends up with ~7,500 files (36mb)
# and requires about 100 seconds to process when run on a
# Windows 2000 / Intel 3.06gHz / 1g ram / ata-100 system
#
# I have not tried recompiling the modified html back into
# chm files.

use strict;
use Time::HiRes qw(gettimeofday);
use Win32::TieRegistry;
use DirHandle;

#----------------------------------------------------------------------

#---- move parameters into variables

my         ($modules,$extractDir,$noiseLevel,$pageLimit) =
   @param{qw/modules  extractDir  noiseLevel  pageLimit/};

if ( ! defined $noiseLevel ) { $noiseLevel = 0; }
if ( ! defined $pageLimit )  { $pageLimit = 0; }

if ( $modules !~ /\bcommon\b/ ) {
      die "Call me stubborn, no running without common module." ;
}

#---- check if hh.exe will run

my $rc = system ( "hh.exe -decompile foo bar" );
if ( $rc ) {
  die "Problem running HtmlHelp decompiler.\n";
}

#---- determine location of SAS installation

my $sasRoot;
my $saskey  = "HKEY_LOCAL_MACHINE\\SOFTWARE\\SAS Institute Inc.\\The SAS System\\";
my $keyname = "${saskey}CurrentVersion\\CurrentVersion";
my $curver  = $Registry->{$keyname};

if (! $curver) {
  die "Problem retrieving SAS current version from registry.\n";
}

$keyname = "${saskey}${curver}\\DefaultRoot";
$sasRoot = $Registry->{$keyname};

if (! $sasRoot) {
  die "Problem retrieving SAS root from registry.\n";
}

undef $Registry;

#---- is extract folder is available ?

my $chmRoot = "${sasRoot}\\core\\help";

if ( ! -d $extractDir ) {
  die "Folder ${extractDir} does not exist, and I won't make it for you." ;
}

my $helpFolder = actualFolder ( $chmRoot );
my $htmlFolder = actualFolder ( $extractDir );

#----

my @modules = split / / , $modules;
   $modules = join ("|", @modules);  # rx alternation
my $folder = $htmlFolder;

my $rxfolder = $folder;
   $rxfolder =~ s/\\/\\\\/g;  # folder for use in rx patterns

my $helpFldr = $helpFolder;
   $helpFldr =~ s#\\#/#g;     # helpFolder for use in javascript:showHelp

#---- for reporting

my $readCount = 0;
my $writeCount = 0;
my $rereadCount = 0;
my $tweakCount = 0;
my $detweakCount = 0;

#----

my %pages;   # one array of page data per html file
my %titles;  # one array of pages for each page title;

#---- constants for page data array

my $_INCOMING  = 0;
my $_OUTGOING  = 1;
my $_TITLE     = 2;
my $_ISTWEAKED = 3;
my $_SHOWHELP  = 4;

#---- array for recording timing splits

my @timeMark;


tmark(1);


decompile();

translate_hhc();
translate_hhk();
fix_hyperlinks();

hash_titles();

report_incoming();
create_root_index();
report_files_read();

create_link_colorizer();
tweak_common_css();

install_back_links();

#------- The End
tsplit(1,'magic');


print "\n\nmodules: " . join(" ", @modules)
    . "\nadjust   read: " . $readCount
    . "\nadjust  write: " . $writeCount
    . "\nimprove  read: " . $rereadCount
    . "\nimprove write: " . $tweakCount
    . "\ndetweak write: " . $detweakCount
    ;

exit 0;
#----------------------------------------------------------------------
#----------------------------------------------------------------------



#----------------------------------------------------------------------
sub tmark {
  my ($n) = @_;
  $timeMark [ $n ] = gettimeofday;
}

#----------------------------------------------------------------------
sub tsplit {
  my ($n, $label) = @_;
  my $t = gettimeofday;
  my $e = $t - $timeMark[ $n ] ;

  $timeMark[$n] = $t;

  if ($n<=$noiseLevel && defined($label)) {
    print "\n[" . " "x(2*$n-1) . "$label: ${e}s ]";
  }
  return $e;
}

#----------------------------------------------------------------------
sub actualFolder {
  my ($folder) = @_;
  return "$folder\\";
}

#----------------------------------------------------------------------
sub readFile {
  my ($file, $content_ref) = @_;
  local(*INPUT, $/);
  open (INPUT, $file)     || die "can't open $file: $!";
  $$content_ref = <INPUT>;
}

#----------------------------------------------------------------------
sub writeFile {
  my ($file, $content_ref) = @_;
  local(*OUTPUT, $/);
  open (OUTPUT, ">${file}")     || die "can't open $file: $!";
  print OUTPUT $$content_ref;
}

#----------------------------------------------------------------------
sub addToHtml {
    my ($file, $snippet) = @_;

    my ($gulp, $burp);

    readFile ( $file, \$gulp );
    $rereadCount++;

    print "\n"," "x10,"read $file(".length($gulp).")" if $noiseLevel>=99;

    $burp = $gulp;

    $burp =~ s{\n?<!-- start-rad -->.*?<!-- end-rad -->\n?}{}gos;

    $burp =~ s{(</BODY>)}{\n<!-- start-rad -->${snippet}\n<!-- end-rad -->\n$1}
      if defined $snippet;

    if ($gulp ne $burp ) {
        writeFile ( $file, \$burp );
        print "\n"," "x9,"write $file(".length($burp).") ".defined($snippet) if $noiseLevel>=99;
        return 1;
    }
    else {
        return 0
    }
}


#----------------------------------------------------------------------
sub filesInFolder {
    my $folder = shift;

    my $dh = DirHandle->new($folder);

    return  sort
            grep {  -f          }
            map  { "$folder$_"  }
            grep { /html?$/       }
            $dh->read();
}

#----------------------------------------------------------------------
sub decompile {
    tmark(2);
    tmark(3);
    foreach my $module (@modules) {
        next if (-d "${folder}${module}.hlp");
        system ("hh.exe -decompile ${folder} ${helpFolder}${module}.chm");
        tsplit(3,"decompile $module");
    }
    tsplit(2,'decompile sas help');
}

#----------------------------------------------------------------------
sub translate_hhc {
    tmark(2);
    tmark(3);
    foreach my $module (@modules) {
        my $hhc = "${folder}${module}.hhc";
        my $htm = "${folder}${module}.hlp\\${module}-contents.htm";

        next if (! -e $hhc) ;

        my ($gulp, $burp);

        readFile ($hhc, \$gulp);
        $burp = $gulp;

        # change href from ms-its path to local relative path
        $burp =~
        s{  \s*? <OBJECT\ type="text/sitemap">
            \s*? <param\ name="Name"\ value="(.*?)">
            \s*? <param\ name="Local"\ value="ms-its:($modules)[.]chm::[/](\2[.]hlp[/].*?)">
            \s*? </OBJECT>
         }
         {<A HREF="../$3">$1</A>}gox;  # o-compile once

        # change remaining ms-its hrefs to javascript:showHelp hrefs
        $burp =~
        s{  \s*? <OBJECT\ type="text/sitemap">
            \s*? <param\ name="Name"\ value="(.*?)">
            \s*? <param\ name="Local"\ value="ms-its:((.*? )[.]chm::[/](\3[.]hlp[/].*?))">
            \s*? </OBJECT>
        }
        {<A HREF="javascript:window.showHelp('ms-its:${helpFldr}$2')">$1</A>}gox;

        # change objects with no Local param to just show the name
        $burp =~
        s{  \s*? <OBJECT\ type="text/sitemap">
            \s*? <param\ name="Name"\ value="(.*?)">
            \s*? </OBJECT>
        }
        {$1}gox;

        # comment out remaining objects
        $burp =~
        s{  (<OBJECT.*?</OBJECT>)
        }
        {<!--\n$1\n-->}goxs;

        # add a title
        $burp =~
        s{<HEAD>}
         {<HEAD><TITLE>$module table of contents</TITLE>};

        # add a call for colorizing showHelp links
        $burp =~
        s{</BODY>}
         {<SCRIPT LANGUAGE="JAVASCRIPT" SRC="../colorizer.js"></SCRIPT>
          <SCRIPT LANGUAGE="JAVASCRIPT">colorShowHelp()</SCRIPT>
          </BODY>};

        writeFile ($htm, \$burp);
        tsplit(3,$htm);
    }
    tsplit(2,'translate hhc');
}

#----------------------------------------------------------------------
sub translate_hhk {
    tmark(2);
    tmark(3);
    foreach my $module (@modules) {
        my $hhk = "${folder}${module}.hhk";
        my $htm = "${folder}${module}.hlp\\${module}-keywords.htm";

        next if (! -e $hhk) ;

        my ($gulp, $burp);

        readFile ($hhk, \$gulp);
        $burp = $gulp;

        # change first name/value param of OBJECT to be simple text
        $burp =~
        s{  \s*? <OBJECT\ type="text/sitemap">
            \s*? <param\ name="Name"\ value="(.*?)">
          (.*?) </OBJECT>
        }
        {$1 $2}goxs;

        #change remain pairs of Name/Local parameters to an <A HREF
        $burp =~
        s{  \s*? <param\ name="Name"\ value="(.*?)">
            \s*? <param\ name="Local"\ value="(.*?)">
            \s*?
        }
        {\n<BR><A HREF="../$2">$1</A>}gox;

        # add a title
        $burp =~
        s{<HEAD>}
         {<HEAD><TITLE>$module keywords</TITLE>};

        # add a call for colorizing showHelp links
        $burp =~
        s{</BODY>}
         {<SCRIPT LANGUAGE="JAVASCRIPT" SRC="../colorizer.js"></SCRIPT>
          <SCRIPT LANGUAGE="JAVASCRIPT">colorShowHelp()</SCRIPT>
          </BODY>};

        writeFile ($htm, \$burp);
        tsplit(3,$htm);
    }
    tsplit(2,'translate hhk');
}

#----------------------------------------------------------------------
sub fix_hyperlinks {
    tmark(2);
    tmark(3);
    foreach my $module (@modules) {
        my $pageCount = 0;
        my $hrefCount = 0;
        my $maxTime = -1;
        my $maxTimePage = '';
        my $maxHrefCount = -1;
        my $maxHrefCountPage = '';

        my $path = "${folder}${module}.hlp\\";
        my @pages = filesInFolder ($path);

        # at noise level 4, at every 800 files a log line shows
        # number of files:hrefs, file that took the longest,
        # the file with the most hrefs and interval duration

        tmark(4);
        foreach my $page (@pages) {
            tmark(5);

            last if ( ++$pageCount > $pageLimit && $pageLimit > 0 ) ;

            my ($gulp, $burp);

            readFile ($page, \$gulp);
            $readCount ++;

            print "\n"," "x10,"read $page(".length($gulp).")" if $noiseLevel>=99;

            $burp = $gulp;

            # if href is a showhelp construct, then we are reprocessing a file
            # thus, restore it back to 'pristine' form prior to transforming per 'module' form

            $burp =~ s{"javascript:window.showHelp\('(ms-its:).*?(($modules)[.]chm.*?)'\)"}
                      {"$1$2"}go;

            # if href is a module related construct, transform it to a local disk relative reference

            $burp =~ s{ms-its:($modules)[.]chm::[/]\1[.]hlp[/]}
                      {../$1.hlp/}go;

            # if href is a non-module related construct, transform it to a showhelp local disk absolute reference

            $burp =~ s{"(ms-its:)((.*?)[.]chm::[/]\3[.]hlp[/].*?)"}
                      {"javascript:window.showHelp('$1$helpFldr$2')"}go;

            # fix image references so they work when local disk browsing

            $burp =~ s{(<IMG.*?SRC=")([/].*?[.]hlp[/]images[/])}
                      {$1..$2}goi;

            # if anything got changed, then adjust the original file

            if ( $gulp ne $burp )
            {
                writeFile ($page, \$burp);
                $writeCount ++;
            }

            #-----

            # - parse for page title
            # - strip any stuff I may have placed in the html during an earlier run
            #   any stuff present in unparsed files will be 'detweaked' during improvement phase

            $pages{$page}[$_TITLE]     = ( $burp =~ /<TITLE>(.*?)\s*<\/TITLE>/mso ) ? $1 : "[no title]";
            $pages{$page}[$_ISTWEAKED] = ( $burp =~ s{\n<!-- start-rad -->.*?<!-- end-rad -->}{}gos );
            $pages{$page}[$_SHOWHELP]  = ( $burp =~ /javascript:window[.]showHelp/ );

            my $count = 0;

            # record all hrefs that have construct ../<module>.hlp/* as construct <absolute-path>/<module>.hlp/*

            while ( $burp =~ m#HREF\s*=\s*"[.][.][/](($modules)[.]hlp[/].*?[.]htm)#goi ) {

                # convert relative href to absolute path

                print "\n", " "x9,"match ",$1 if $noiseLevel>=99;

                ($_ = $1) =~ s#/#\\#go;
                my $destination = $folder . $_;

                # this is the core
                # everything this program does is based on these two simple assignments

                $pages{$page}       [$_OUTGOING]{$destination} = 1 if $page ne $destination;
                $pages{$destination}[$_INCOMING]{$page}        = 1 if $page ne $destination;

                $count++;
            }
            $hrefCount += $count;

            if ( $maxTime < (my $e = tsplit (5)) ) {
                $maxTime = $e;
                $maxTimePage = $page
            }
            if ( $maxHrefCount < $count ) {
                $maxHrefCount = $count;
                $maxHrefCountPage = $page;
            }
            if ( $pageCount % 800 == 0 ) {
                $maxTimePage =~ s/.*\\//go;
                $maxHrefCountPage=~ s/.*\\//go;
                tsplit(4,"${pageCount}:${hrefCount} ${maxTimePage}(${maxTime}s) ${maxHrefCountPage}(${maxHrefCount}->)");
                $maxTime = -1;
                $maxHrefCount = -1;
            }
        }
        if ($maxHrefCount) {
            $maxTimePage =~ s/.*\\//go;
            $maxHrefCountPage=~ s/.*\\//go;
            tsplit(4,"${pageCount}:${hrefCount} ${maxTimePage}(${maxTime}s) ${maxHrefCountPage}(${maxHrefCount}->)")
        }
        tsplit(3,$module);
    }
    tsplit(2,'fix hyperlinks');
}

#----------------------------------------------------------------------
sub by_title {

    my $A = uc ( $pages{$a}[$_TITLE] );
    my $B = uc ( $pages{$b}[$_TITLE] );

    $A cmp $B;
}

#----------------------------------------------------------------------
sub hash_titles {
    foreach my $page ( keys %pages ) {
        next if ! defined (my $title = $pages{$page}[$_TITLE]);
        next if $title eq "[no title]";

        push @{$titles{$title}}, $page;
    }
}

#----------------------------------------------------------------------
sub create_root_index {
    tmark(2);

    my $file = "${folder}index-rad.css";
    open (OUTPUT, ">$file")     || die "can't open $file: $!";
    print OUTPUT <<EOCSS;

UL.cnb { white-space: nowrap; margin-left: 0 }
UL.cnb LI { display: inline; }
UL.cnb LI A { background-color: #EEE; font-weight: bold; text-decoration: none; text-align: center; padding: 0px 1em 0px 1em; border: 1px #666 solid; }
UL.cnb LI A:hover { background-color: #777; color: #FFF; }
UL.cnb LI.cnbf { font-size:120%; font-weight:bold; margin-right:1em }

/* same title not orphan */
A.stno { background-color:#FFE8B8;padding-left:4px;padding-right:4px }
SPAN.orphan { background-color:#FF8888 }

EOCSS

    $file = "${folder}index.html";
    open (OUTPUT, ">$file")     || die "can't open $file: $!";
    print OUTPUT <<THINGY1;

<HTML><HEAD><TITLE>A web of decompiled SAS Online Help</TITLE>
<LINK REL="StyleSheet" TYPE="text/css" HREF="index-rad.css">
</HEAD>
<BODY>
<UL CLASS="cnb"><LI><A HREF="#Orphans">Orphans</A></LI><LI><A HREF="#DeadLinks">Dead Links</A></LI><LI><A HREF="#DupTitles">Duplicate Titles</A></LI></UL>
<H1>Root index</H1>
<P>Generated by program written by <A HREF="http://www.devenezia.com">Richard A. DeVenezia</A>
<BR>modules:<B>$modules</B>, pageLimit:<B>$pageLimit</B></P>
<UL><LI><A HREF="files-read.html">Files read</A></LI>
<LI><A HREF="javascript:window.showHelp('ms-its:${helpFldr}common.chm::/common.hlp/sashelp_main.htm')">Open SAS Help</A></LI>
</UL>
<H2>Module Contents</H2>
<P>Each link takes you to a translation of the modules <B>.hhc</B> file</P>
<UL>

THINGY1

    print OUTPUT map "<LI><A HREF=\"$_.hlp/$_-contents.htm\">$_</A></LI>", @modules;
    print OUTPUT <<THINGY2;

</UL>
<H2>Module Keywords</H2>
<P>Each link takes you to a translation of the modules <B>.hhk</B> file</P>
<UL>

THINGY2

    print OUTPUT map "<LI><A HREF=\"$_.hlp/$_-keywords.htm\">$_</A></LI>", @modules;
    print OUTPUT <<THINGY3;

</UL>
<H2>Status reports</H2>
<A NAME="Orphans"></A>
<UL CLASS="cnb"><LI CLASS="cnbf">Orphaned pages</LI><LI><A HREF="#DeadLinks">Dead Links</A></LI><LI><A HREF="#DupTitles">Duplicate Titles</A></LI></UL>
<P>Pages with no incoming links (within network of above listed modules)</P>

THINGY3

    report_orphans();
    print OUTPUT <<THINGY4;

<A NAME="DeadLinks"></A>
<UL CLASS="cnb"><LI CLASS="cnbf">Dead link pages</LI><LI><A HREF="#DupTitles">Duplicate Titles</A></LI><LI><A HREF="#Orphans">Orphans</A></LI></UL>
<P>Pages with links to pages that do not exist.</P>

THINGY4

    report_dead_links();
    print OUTPUT <<THINGY5;

<A NAME="DupTitles"></A>
<UL CLASS="cnb"><LI CLASS="cnbf">Duplicate Titles</LI><LI><A HREF="#Orphans">Orphans</A></LI><LI><A HREF="#DeadLinks">Dead Links</A></LI></UL>
<P>Different pages with the same title.</P>

THINGY5

    report_duplicate_titles();
    print OUTPUT "<P>modules:<B>$modules</B>, pageLimit:<B>$pageLimit</B></P></BODY></HTML>";

    tsplit(2,'create root index');
}

#----------------------------------------------------------------------
sub report_incoming {
    tmark(2);

    my $file = "${folder}incoming-report.txt";
    open (OUTPUT, ">$file")     || die "can't open $file: $!";

    foreach my $page ( sort keys %pages ) {

        print OUTPUT "\n",$page,":";
        print OUTPUT -e $page ? "*" : "!" if ! defined $pages{$page}[$_TITLE];

        foreach my $referer ( keys %{$pages{$page}[$_INCOMING]} ) {
            print OUTPUT "\t$referer";
        }
    }
    tsplit(2,'report incoming');
    close OUTPUT;
}

#----------------------------------------------------------------------
sub report_orphans {
    tmark(3);

    my $message = '<P>How is one expected to get there ? By searching alone ? Are they abandoned pages after being cloned (see duplicates) ?'
                . '<BR>I would prefer each module be entirely self contained and not have module anonymous pages that are destinations of module external pages</P>'
                . '<UL>';

    my $haveOrphans = 0;

    foreach my $page ( sort by_title keys %pages )
    {
        my ($href, $title, $state, $a, $sub, $other_page);

        next if keys %{$pages{$page}[$_INCOMING]};

        $haveOrphans = print OUTPUT $message if ! $haveOrphans ;

        $_ = $page;
        s#\\#/#go if s#^$rxfolder(.*)#$1#o;
        $href = $_;

        $title = defined $pages{$page}[$_TITLE] ? $pages{$page}[$_TITLE] : "unparsed - $href";
        $title.= " - $href" if $title eq '[no title]';

        $a = "<A HREF=\"$href\">$title</A>";

        # look for other pages with same title that are not orphans

        $sub = "";
        foreach $other_page (@{$titles{$title}}) {
            next if $other_page eq $page;
            next if ! keys %{$pages{$other_page}[$_INCOMING]};

            $_ = $other_page;
            s#\\#/#go if s#^$rxfolder(.*)#$1#o;
            $href = $_;

            $sub .= "\n<LI><A CLASS=\"stno\" HREF=\"$href\">same title - not orphan ($_)</A></LI>";
        }

        print OUTPUT "\n<LI>";
        print OUTPUT $a;
        print OUTPUT "<UL>", $sub, "</UL>" if $sub;
        print OUTPUT "</LI>";
    }

    print OUTPUT $haveOrphans ? '</UL>' : '<P>All pages have at least one referer, good job!</P>';
    tsplit(3,'report orphans');
}

#----------------------------------------------------------------------
sub report_dead_links {
    tmark(3);

    my $haveDeadLinks = 0;

    foreach my $page ( sort keys %pages ) {

        my $started = 0;

        foreach my $destination ( keys %{$pages{$page}[$_OUTGOING]} ) {

            next if defined $pages{$destination}[$_TITLE];
            next if -e $destination;

            if (!$started) {
                $haveDeadLinks = print OUTPUT "<UL>" if ! $haveDeadLinks;

                $_ = $page;
                s#\\#/#go if s#^$rxfolder(.*)#$1#o;
                my $href = $_;

                print OUTPUT "<LI><A HREF=\"${href}\">$pages{$page}[$_TITLE]</A></LI><UL>";
                $started = 1;
            }
            $_ = $destination;
            s#\\#/#go if s#^$rxfolder(.*)#$1#o;
            my $href = $_;

            print OUTPUT "<LI>$href</LI>";
        }
        if ($started) {
            print OUTPUT "</UL>";
            $started = 0;
        }
    }
    print OUTPUT $haveDeadLinks ? '</UL>' : '<P>There are no dead links today, good job!</P>';
    tsplit(3,'dead links');
}

#----------------------------------------------------------------------
sub report_duplicate_titles {
    tmark(3);

    my $haveDups = 0;

    foreach my $title ( sort keys %titles ) {

        next if @{$titles{$title}} < 2;

        $haveDups = print OUTPUT "<UL>" if ! $haveDups ;

        print OUTPUT "<LI>$title<UL>";

        foreach my $page (@{$titles{$title}}) {

            my $orphan = keys %{$pages{$page}[$_INCOMING]} ? '' : '<SPAN style="color:red"> (orphan)</SPAN>';

            $_ = $page;
            s#\\#/#go if s#^$rxfolder(.*)#$1#o;
            my $href = $_;

            print OUTPUT "\n<LI><A HREF=\"$href\">$page</A>$orphan</LI>";
        }
        print OUTPUT "</UL></LI>";
    }
    print OUTPUT $haveDups ? "</UL>" : "<P>No duplicate titles observed.</P>";;
    tsplit(3,'duplicate titles');
}

#----------------------------------------------------------------------
sub report_files_read {
    tmark(2);

    my $file = "${folder}files-read.html";

    open (OUTPUT, ">$file")     || die "can't open $file: $!";
    print OUTPUT '<HTML><HEAD><TITLE>Files read</TITLE>'
               , '<LINK REL="StyleSheet" TYPE="text/css" HREF="index-rad.css"></HEAD>'
               , '<BODY><H1>Files read</H1><P>Sorted by filename.  Goto <A HREF="index.html">main index</A></P><OL>';

    foreach my $page ( sort keys %pages ) {

        my ($href, $title, $orphan);

        $_ = $page;
        s#\\#/#go if s#^$rxfolder(.*)#$1#o;
        $href = $_;

        $title = defined $pages{$page}[$_TITLE] ? $pages{$page}[$_TITLE] : "unparsed - $href";
        $title.= " - $href" if $title eq '[no title]';

        $orphan = keys %{$pages{$page}[$_INCOMING]} ? '' : ' <SPAN class="orphan">(orphan)</SPAN>';

        print OUTPUT "\n<LI><A HREF=\"$href\">$href</A> - <B>$title$orphan</B></LI>"
    }

    print OUTPUT "</OL>";
    print OUTPUT "<P>modules:$modules, pageLimit:$pageLimit</P></BODY></HTML>";
    tsplit(2,'create files read');
}

#----------------------------------------------------------------------
sub create_link_colorizer {
    tmark(2);

    my $file = "${folder}colorizer.js";

    open (OUTPUT, ">$file")     || die "can't open $file: $!";
    print OUTPUT <<THINGY6;

function colorLinks (links) {
  var a = document.getElementsByTagName ('a')
  for (var i=0; links && i<a.length; i++)
  {
    var href = a[i].href + ""
    for (var j=1; j<links.length; j++)
    {
      var lookfor = links[j][0].substr(3)
      if (href.indexOf(lookfor) > -1)
      {
        a[i].style.backgroundColor = "#227722"
        a[i].style.color = "#FFFFFF"
      }
    }
  }
}

function colorShowHelp () {
  var a = document.getElementsByTagName ('a')
  for (var i=0; i<a.length; i++)
  {
    var href = a[i].href + ""
    if (href.indexOf ('javascript:window.showHelp') > -1)
    {
      a[i].style.backgroundColor = "#6699CC"
      a[i].style.color = "#FFFFFF"
    }
  }
}

THINGY6

    tsplit(2,'create colorizer.js');
}

#----------------------------------------------------------------------
sub tweak_common_css {
    tmark(2);

    my $file = "${folder}common.hlp\\ss\\style.css";
    my ($gulp, $burp);

    readFile ( $file, \$gulp);

    $burp = $gulp;
    $burp =~ s{/\*-- rad --\*/.*?/\*-- rad --\*/}{}gs;
    $burp .= "/*-- rad --*/ A { background-color: #E8E8E8; border: 1px dashed #AAA; } /*-- rad --*/";

    writeFile ( $file, \$burp ) if ( $burp ne $gulp );
    tsplit(2,'tweak css');
}

#----------------------------------------------------------------------
sub install_back_links {
    tmark(2);

    my $pageCount = 0;
    my $maxTime = -1;
    my $maxTimePage = '';

    foreach my $page ( keys %pages ) {
        tmark(3);

        my $outgoing  = $pages{$page}[$_OUTGOING];
        my $incoming  = $pages{$page}[$_INCOMING];
        my $title     = $pages{$page}[$_TITLE];

        my $newlinks  = '';
        my $reflinks  = '';
        my $deadlinks = '';
        my $orphanmsg = '';

        if ( ! defined $title ) {
            $orphanmsg = 'This page was not parsed.';
            next if ! -e $page;
        }
        elsif ( ! keys %$incoming ) {
            $orphanmsg = 'This page is an orphan';
        }
        else {
            #-- check for referers that are not linked to
            foreach my $referer ( sort by_title keys %$incoming ) {
                my $r_title    = $pages{$referer}[$_TITLE];
                my $r_isOrphan = ! keys %{$pages{$referer}[$_INCOMING]};

                $_ = $referer;
                s#\\#/#go if s#^$rxfolder(.*)#../$1#o;
                my $href = $_;

                my $status = '';
                if ( ! defined $r_title ) {
                    $status = 'not parsed';
                }
                elsif ( $r_isOrphan ) {
                    $status = 'orphan';
                }

                if ( ! exists $outgoing->{$referer} ) {
                    $status = " ($status)" if $status;
                    $newlinks .= "\n<LI><A HREF=\"$href\">$r_title$status</A></LI>";
                }
                else {
                    $reflinks .= ",[\"$href\",\"$status\"]";
                }

                $outgoing->{$referer} = 0;  # 0 indicates backlink established;
            }
        }

        # check for dead links
        foreach my $destination ( keys %$outgoing) {
            next if $outgoing->{$destination} == 0;
            next if -e $destination;

            $_ = $destination;
            s#\\#/#go if s#^$rxfolder(.*)#$1#o;
             my $href = $_;

            $deadlinks .= "\n<LI>$href</LI>";
        }

        if ($orphanmsg || $newlinks || $deadlinks || $reflinks || $pages{$page}[$_SHOWHELP]) {
            my $div = '';
            if ( $orphanmsg ) {
                $div .= "\n<DIV ID=\"Orphan\" STYLE=\"margin-top:1em;background-color:rgb(220,160,160);border:1px solid rgb(120,60,60)\">"
                     .  "\n<H2><I>&nbsp;${orphanmsg}</I></H2>"
                     .  "<P>&nbsp;Goto <A HREF=\"../index.html\">main index</A></P>"
                     .  "</DIV>";
            }
            if ( $reflinks || $pages{$page}[$_SHOWHELP] ) {
                $div .= '<SCRIPT LANGUAGE="JAVASCRIPT" SRC="../colorizer.js"></SCRIPT>'
            }
            if ( $pages{$page}[$_SHOWHELP] ) {
                $div .= '<SCRIPT LANGUAGE="JAVASCRIPT">colorShowHelp()</SCRIPT>'
            }
            if ( $reflinks || $newlinks ) {
                $div .= "\n<DIV ID=\"Backref\" STYLE=\"margin-top:1em;background-color:rgb(255,255,128);border:1px solid rgb(128,128,0)\">";

                $div .= "\n<SCRIPT LANGUAGE=\"JAVASCRIPT\">colorLinks([[]$reflinks])</SCRIPT>"
                     .  "\n<A NAME=\"brexist\"></A><H2><I>&nbsp;<SPAN style='background-color:#227722;color:white'>Colored</SPAN> links are to pages that link back</I></H2>"
                     if $reflinks;

                $div .= "\n<A NAME=\"brnew\"></A><H2><I>&nbsp;Other pages that link to this page</I></H2>"
                     .  "\n<UL>${newlinks}</UL>"
                     if $newlinks;

                $div .= "<P>&nbsp;Goto <A HREF=\"../index.html\">main index</A></P>"
                     .  "</DIV>";

            }
            if ( $deadlinks ne '' ) {
                $div .= "\n<DIV ID=\"Deadlinks\" STYLE=\"margin-top:1em;background-color:rgb(255,128,128);border:1px solid rgb(128,0,0)\">"
                     .  "\n<H2><I>&nbsp;Dead links found on this page</I></H2>"
                     .  "\n<UL>${deadlinks}</UL>"
                     .  "<P>&nbsp;Goto <A HREF=\"../index.html\">main index</A></P>"
                     .  "</DIV>";
            }
            $tweakCount += addToHtml ( $page, $div );
        }
        elsif ( $pages{$page}[$_ISTWEAKED] ) {
            $detweakCount += addToHtml ( $page );
        }

        if ( $maxTime < (my $e = tsplit (3)) ) {
            $maxTime = $e;
            $maxTimePage = $page
        }

        if ( ++$pageCount % 800 == 0 ) {
            $maxTimePage =~ s/.*\\//go;
            tsplit(4,"${pageCount}: ${maxTimePage}(${maxTime}s)");
            $maxTime = -1;
        }
    }
    tsplit(2,'install back links');
}