home *** CD-ROM | disk | FTP | other *** search
/ Chip: Windows 2000 Professional Resource Kit / W2KPRK.iso / apps / perl / ActivePerl.exe / data.z / HtmlHelp.pm < prev    next >
Encoding:
Text File  |  1999-10-14  |  63.2 KB  |  2,049 lines
  1. #####################################################################
  2. # Library       HtmlHelp.pm
  3. # Title         HtmlHelp.pm
  4. # Version       1.0.2
  5. # Author        David Grove (pete) [pete@activestate.com]
  6. # Company       ActiveState Tool Corp. -
  7. #                   Professional Tools for Perl Developers
  8. #####################################################################
  9. # Description   Miscelaneous routines for working with Microsoft's
  10. #               HtmlHelp system.
  11. #####################################################################
  12. # REVISION HISTORY
  13. #
  14. # 1.0.0         First final release, went out with 502
  15. # 1.0.1         Temporary, removed CSS insertion in favor of just
  16. #               adding a link to the css, since it's being built
  17. #               on the user's machine now; and temporarily added
  18. #               the hardcoded contents of the main toc to the
  19. #               built toc until I have time to build it codewise.
  20. # 1.0.2 gsar    Fixed much brokenness.  Much ugliness remains.
  21.  
  22. =head1 TITLE
  23.  
  24. HtmlHelp.pm
  25.  
  26. =head1 SYNOPSIS
  27.  
  28. Routines to create HtmlHelp from HTML or POD source (including the
  29. Pod in PM library files) using Microsoft's HtmlHelp compiler. This
  30. creates the intermediate project files and from those creates the
  31. htmlhelp windows 32-bit help files.
  32.  
  33. Along with this libaray comes a set of programs that can be used
  34. either as-is or as examples for perl development. Each of the public
  35. functions in this libray is represented by one such script.
  36.  
  37. =head1 USAGE
  38.  
  39. There are two "builds" of perl help, the core build (build for core
  40. Perl and it's packages), and the packages build (build from a devel
  41. directory of directories which contain blib directories to draw
  42. upon). These are run by different people on different machines at
  43. different times in different situations, so they are mostly separate
  44. until the time comes within this module to actuall build the helpfiles.
  45. There is also a build (html index) that works on the user's computer
  46. after installing a new module.
  47.  
  48. For the core build
  49.  
  50.    perl makehelp.pl
  51.  
  52. for the package build
  53.  
  54.    perl makepackages.pl
  55.  
  56. for the html index build
  57.  
  58.    perl makehtmlindex.pl
  59.  
  60. The functions in this module can also be called programmatically
  61.  
  62. =head1 FUNCTIONS
  63.  
  64. The individual functions that were designed with working with
  65. html help files rather than the Perl htmlhelp documentation are
  66. deprecated in favor of doing things with a single command. Some
  67. of them need work in order to work again.
  68.  
  69. =over 4
  70.  
  71. =item MakeHelp
  72.  
  73. Turns a single html page into htmlhelp document.
  74.  
  75. =item MakeHelpFromDir
  76.  
  77. Turns a directory's worth of html pages into a single htmlhelp document.
  78.  
  79. =item MakeHelpFromTree
  80.  
  81. Turns a tree's worth of html pages into a single htmlhelp document.
  82.  
  83. =item MakeHelpFromHash
  84.  
  85. Creates an htmlhelp document where the labels on the folders are passed
  86. into the program. Useful for labels like Tk::Whatsis::Gizmo to replace
  87. the default ones looking like c:/perl/lib/site/Tk/Whatsis/Gizmo.
  88.  
  89. =item MakeHelpFromPod
  90.  
  91. Turns a single Pod or pm document into htmlhelp document.
  92.  
  93. =item MakeHelpFromPodDir
  94.  
  95. Turns a dir's worth of Pod or pm into a single htmlhelp document.
  96.  
  97. =item MakeHelpFromPodTree
  98.  
  99. Turns a tree's worth of Pod or pm into a single htmlhelp document.
  100.  
  101. =item MakeHelpFromPodHash
  102.  
  103. Like MaheHelpFromHash() but for Pod instead of html.
  104.  
  105. =item MakePerlHtmlIndex
  106.  
  107. Creates an HTML version of an index or TOC for perl help.
  108.  
  109. =item MakePerlHtml
  110.  
  111. Does everything for perl HTML works.
  112.  
  113. =back
  114.  
  115. =head1 CONFIG.PM
  116.  
  117. This library makes use of Config.pm to know where to get its stuff.
  118.  
  119. =head1 HHC.EXE
  120.  
  121. This library makes use of the HtmlHelp compiler by microsoft.
  122.  
  123. =head1 VARIABLES
  124.  
  125. =over4
  126.  
  127. =item $HtmlHelp::CSS
  128.  
  129. Determines the stylesheet to be used for the htmlhelp files. Default
  130. is the ActiveState common stylesheet. This variable can be set to
  131. an empty string to allow for just plain old HTML with nothing fancy.
  132.  
  133. Default is perl.css.
  134.  
  135. =item $HtmlHelp::COMPILER
  136.  
  137. Complete path and file name of the HtmlHelp compiler from Microsoft.
  138. This is REQUIRED for this library to run. It defaults to it's install
  139. directory within <lib>/HtmlHelp. Feel free to move this in $COMPILER
  140. if you have the HtmlHelp workshop from Microsoft and you want to
  141. use the compiler from a different location.
  142.  
  143. =item $HtmlHelp::FULLTEXTSEARCH
  144.  
  145. Whether to create full text search. Defaults to true.
  146.  
  147. =item $HtmlHelp::CLEANUP
  148.  
  149. Whether to clean up temporary files (and html files if building
  150. from raw Pod) after building the htmlhelp. This can be useful,
  151. for example, when you need to keep the intermediate files created
  152. by the process for inclusion into a collective help file.
  153.  
  154. =back
  155.  
  156. =head1 TARGET AUDIENCE
  157.  
  158. Mostly this module is created for internal use for ActiveState Tool
  159. Corp., but since it is a part of the standard distrib for Win32 Perl
  160. then I expect it to be used or tried by the general public. However,
  161. no support for this module is available for the public; and it may
  162. be changed at any time.
  163.  
  164. =head1 INSTALLATION
  165.  
  166. First of all, this is designed for use with the Perl Resource
  167. Kit. Use with other versions of perl should be considered
  168. unsupported. Perl should be fully installed and configured to
  169. use this thing
  170.  
  171. Next, Config.pm must be fully configured. Using Config.pm allows
  172. me to program remotely for tools at ActiveState corporate office.
  173. There were some early problems with Config.pm with the PRK and
  174. build 500 of Perl for Win32. These need to be corrected to use
  175. this library.
  176.  
  177. Perl needs to have $Config{privlib}/../Html and also
  178. $Config{privlib}/../HtmlHelp to use this library. These should be
  179. created before doing anything. Copy the html files and gif
  180. files from this library to the Html directory. All other
  181. files will be created during run.
  182.  
  183. Finally, copy all the files to $Config{privlib}/HtmlHelp, and the
  184. file HtmlHelp.pm to $Config{privlib}. The former is the normal site
  185. for the htmlhelp compiler (hhc.exe), and it is expected there.
  186.  
  187. To use this tool, you need to have the compiler's dll's installed
  188. on your system. You should install the htmlhelp workshop from
  189. microsoft for these. Otherwise you should get these dll's from
  190. someone who has them. I think there's only one or two.
  191.  
  192. =head1 USAGE
  193.  
  194. =head2 Building HtmlHelp
  195.  
  196. Building HtmlHelp for main perl is done using the script
  197. makehelp.pl. It requires no command line arguments because it
  198. gets all its information from Config.pm.
  199.  
  200. Individual files are created as follows:
  201.  
  202. =over4
  203.  
  204. =item file2hhelp.pl for .html to .chm
  205.  
  206. =item dir2hhelp.pl for dir of .html to .chm
  207.  
  208. =item tree2hhelp.pl for tree of .html to .chm(s)
  209.  
  210. =item Pod2hhelp.pl for .Pod or .pm to .chm
  211.  
  212. =item Podd2hhelp.pl for dir of .Pod or .pm to .chm
  213.  
  214. =item Podt2hhelp.pl for tree of .Pod or .pm to .chm(s)
  215.  
  216. =back
  217.  
  218. If your forget the command line arguments for one of the
  219. above, type:
  220.  
  221.   perl <scriptfile>
  222.  
  223. and it will tell you what command line arguments are needed.
  224.  
  225. =head2 Building HTML
  226.  
  227. Building HTML for main perl is doine using the script
  228. makehtml.pl. It requires no command line arguemtns because it
  229. gets all its information from Config.pm.
  230.  
  231. Individual html files can be built using the normal pod2html
  232. script by Tom Christiansen. Building html from directories
  233. and trees is not otherwise supported.
  234.  
  235. =head1 AUTHOR
  236.  
  237. David (pete) Grove
  238. email: pete@ActiveState.com
  239.  
  240. =head1 FIRM
  241.  
  242. ActiveState Tool Corp.
  243. Professional Tools for Perl Programmers
  244.  
  245. =cut
  246.  
  247. #####################################################################
  248. package HtmlHelp;
  249.  
  250. #####################################################################
  251. use Pod::WinHtml;               # My hack of TC's Pod::Html
  252. use Config;
  253. use File::Copy;
  254. use File::Basename;
  255. use File::Path;
  256.  
  257. #####################################################################
  258. # Variables
  259. my $CLEANUP = 1;
  260. my $MAKE_HTML_FOR_HHELP = 0;
  261. my $FULLTEXTSEARCH = 1;
  262. my $LIB = $Config{'privlib'};
  263. $LIB =~ s{\\}{/}g;
  264. my $SITELIB = $Config{'sitelib'};
  265. my $HTMLHELP = $LIB; $HTMLHELP =~ s{(\\|/)lib}{/HtmlHelp}i;
  266. my $COMPILER = "$LIB/HtmlHelp/hhc.exe";
  267. my $HTML = $LIB; $HTML =~ s{(\\|/)lib}{/Html}i;
  268. my $TEMP = "$HTMLHELP/Temp";
  269. my $MERGE_PACKAGES = 0;
  270.  
  271. #####################################################################
  272. # Function PreDeclarations
  273. sub RunCompiler;
  274. sub MakeHelpFromPod;
  275. sub MakeHelpFromPodDir;
  276. sub MakeHelpFromDir;
  277. sub MakePerlHtml;
  278. sub MakePerlHtmlIndexCaller;
  279. sub MakePerlHtmlIndex;
  280. sub GetHtmlFilesFromTree;
  281. sub MakePerlHelp;
  282. sub MakePerlHelpMain;
  283. sub MakeHelpFromPodTree;
  284. sub MakeHtmlTree;
  285. sub MakeHelpFromTree;
  286. sub GetHtmlFileTreeList;
  287. sub MakeHelpFromHash;
  288. sub MakeModuleTreeHelp;
  289. sub MakeHelp;
  290. sub BackSlash;
  291. sub ExtractFileName;
  292. sub ExtractFilePath;
  293. sub MakePackageMainFromSingleDir;
  294. sub MakePackageMain;
  295. sub MakePackages;
  296. sub CopyDirStructure;
  297. sub GetFileListForPackage;
  298. sub CreateHHP;
  299. sub CreateHHC;
  300. sub CreateHHCFromHash;
  301. sub InsertMainToc_Temporary;
  302.  
  303. #####################################################################
  304. # FUNCTION      RunCompiler
  305. # RECEIVES      Project file to compile
  306. # RETURNS       None
  307. # SETS          None
  308. # EXPECTS       $COMPILER, hhc and hhp files should be there
  309. # PURPOSE       Runs the HtmlHelp compiler to create a chm file
  310. sub RunCompiler {
  311.     my $projfile = BackSlash(shift);
  312.     my $compiler = BackSlash($COMPILER);
  313.  
  314.     print "Trying \"$compiler $projfile\"\n";
  315.     qx($compiler $projfile);
  316. }
  317.  
  318. #####################################################################
  319. # FUNCTION      MakeHelpFromPod
  320. # RECEIVES      Helpfile (no path), Working directory, Output
  321. #               directory (path for chm file), Files to include
  322. # RETURNS       Results from running MakeHelp
  323. # SETS          None
  324. # EXPECTS       None
  325. # PURPOSE       Takes pod/pm files, turns them into html, and then
  326. #               into Htmlhelp files.
  327. sub MakeHelpFromPod {
  328.     my ($helpfile, $workdir, $outdir, @podfiles) = @_;
  329.     my $htmlfiles;
  330.     my $htmlfile;
  331.     my $podfile;
  332.  
  333.     foreach $podfile (@podfiles) {
  334.     $podfile =~ s{\\}{/}g;
  335.         $htmlfile = $podfile;
  336.         $htmlfile =~ s{(^/]*)\....?$}{$1\.html};
  337.         push(@htmlfiles, $htmlfile);
  338.         pod2html("--infile=$podfile", "--outfile=$htmlfile");
  339.     }
  340.  
  341.     @htmlfiles = grep{-e $_} @htmlfiles;
  342.  
  343.     unless(@htmlfiles) {
  344.         $! = "No html files were created";
  345.         return 0;
  346.     }
  347.  
  348.     return MakeHelp($helpfile, $workdir, $outdir, @htmlfiles);
  349. }
  350.  
  351. #####################################################################
  352. # FUNCTION      MakeHelpFromPodDir
  353. # RECEIVES      Helpfile (no extension), Working directory, Output
  354. #               directory (for the Helpfile), Directory to translate
  355. # RETURNS       1|0
  356. # SETS          None
  357. # EXPECTS       None
  358. # PURPOSE       Takes a directory's worth of pod/pm files and turns
  359. #               them into html and then a single chm file
  360. sub MakeHelpFromPodDir {
  361.     my ($helpfile, $workdir, $outdir, $fromdir) = @_;
  362.     my @podfiles;
  363.     my $htmlfile;
  364.     my @htmlfiles;
  365.  
  366.     if(opendir(DIR,$fromdir)) {
  367.         @podfiles = grep {/(\.pod)|(\.pm)/i} readdir(DIR);
  368.         if(@podfiles) {
  369.             foreach $podfile (@podfiles) {
  370.                 $htmlfile = $podfile;
  371.                 $htmlfile =~ s{(\.pm)|(\.pod)$}{\.html}i;
  372.                 $htmlfile = "$workdir/$htmlfile";
  373.                 push(@htmlfiles, $htmlfile);
  374.  
  375.                 pod2html("--infile=$fromdir/$podfile", "--outfile=$htmlfile");
  376.             }
  377.  
  378.             @htmlfiles = grep {-e $_} @htmlfiles;
  379.  
  380.             MakeHelp($helpfile, $workdir, $outdir, @htmlfiles);
  381.         } else {
  382.             $! = "No files to be made from $fromdir";
  383.             return 0;
  384.         }
  385.     } else {
  386.         $! = "Could not open directory $fromdir";
  387.         return 0;
  388.     }
  389.  
  390.     unlink @htmlfiles if $CLEANUP;
  391.  
  392.     1;
  393. }
  394.  
  395. #####################################################################
  396. # FUNCTION      MakeHelpFromDir
  397. # RECEIVES      Helpfile (no extension), Working directory, Output
  398. #               directory (for Helpfile), Dir of html files for input
  399. # RETURNS       1|0
  400. # SETS          None
  401. # EXPECTS       None
  402. # PURPOSE       Takes a directory's worth of html files and binds
  403. #               them all into a chm file
  404. sub MakeHelpFromDir {
  405.     my ($helpfile, $workdir, $outdir, $fromdir) = @_;
  406.     my @files;
  407.  
  408.     if(opendir(DIR,$fromdir)) {
  409.         @files = map {"$fromdir/$_"} sort(grep {/\.html?/i} readdir(DIR));
  410.         closedir(DIR);
  411.         if(@files) {
  412.             MakeHelp($helpfile, $workdir, $outdir, @files);
  413.         } else {
  414.             $! = "No files to be made from $fromdir";
  415.             return 0;
  416.         }
  417.     } else {
  418.         $! = "Could not open directory $fromdir";
  419.         return 0;
  420.     }
  421.  
  422.     1;
  423. }
  424.  
  425. #####################################################################
  426. # FUNCTION      MakePerlHtml
  427. # RECEIVES      None
  428. # RETURNS       None
  429. # SETS          None
  430. # EXPECTS       $HTML, $LIB, $SITELIB
  431. # PURPOSE       Creates html files from pod for the entire perl
  432. #               system, and creates the main toc file.
  433. sub MakePerlHtml {
  434.     MakeHtmlTree($LIB, "$HTML/lib", 1);
  435.     MakeHtmlTree($SITELIB, "$HTML/lib/site", 2);
  436.     MakePerlHtmlIndex("$HTML/lib", "$HTML/perltoc.html");
  437. }
  438.  
  439. #####################################################################
  440. # FUNCTION      MakePerlHtmlIndexCaller
  441. # RECEIVES      None
  442. # RETURNS       None
  443. # SETS          None
  444. # EXPECTS       $HTML
  445. # PURPOSE       Caller for MakePerlHtmlIndex. Using this function
  446. #               releases the caller from the responsibility of
  447. #               feeding params to MakePerlHtmlIndex, which this
  448. #               library gets automagically from Config.pm
  449. sub MakePerlHtmlIndexCaller {
  450.     #
  451.     # Changed this to reflect the "single index file" idea
  452.     #
  453.     return MakePerlHtmlIndex("$HTML/lib", "$HTML/perltoc.html");
  454.     #return MakePerlHtmlIndex("$HTML/lib", "$HTML/maintoc.html");
  455. }
  456.  
  457. #####################################################################
  458. # FUNCTION      MakePerlHtmlIndex
  459. # RECEIVES      Base directory to look in, $index file to create
  460. # RETURNS       1 | 0
  461. # SETS          None
  462. # EXPECTS       None
  463. # PURPOSE       Creates the main html index for the perl system. This
  464. #               is called by ppm after installing a package.
  465. sub MakePerlHtmlIndex {
  466.     my ($basedir, $indexfile) = @_;
  467.     my %files;
  468.     my $file;
  469.     my $file_cmp;
  470.     my $dir;
  471.     my $dir_cmp;
  472.     my $dir_to_print;
  473.     my $dir_html_root;
  474.     my $counter;
  475.     my $file_to_print;
  476.     my $sitedir;
  477.     my $libdir;
  478.     my $temp;
  479.  
  480.  
  481.     # Get a list of all the files in the tree, list refs keyed by dir.
  482.     # These files are under c:/perl/html/lib because they have
  483.     # already been generated.
  484.  
  485.     # normalize to forward slashes (NEVER use backslashes in URLs!)
  486.     $basedir =~ s{\\}{/}g;
  487.     unless(%files = GetHtmlFilesFromTree($basedir)) {
  488.         return 0;
  489.     }
  490.  
  491.     # Start the html document
  492.     unless(open(HTML, ">$indexfile")) {
  493.         $! = "Couldn't write to $indexfile\n";
  494.         return 0;
  495.     }
  496.     print HTML <<'EOT';
  497. <HTML>
  498. <HEAD>
  499. <TITLE>Perl Help System Index</TITLE>
  500. <BASE TARGET="PerlDoc">
  501. </HEAD>
  502. <LINK REL="STYLESHEET" HREF="win32prk.css" TYPE="text/css">
  503. <STYLE>
  504.     BODY {font-size : 8.5pt;}
  505.     P {font-size : 8.5pt;}
  506. </STYLE>
  507. <BODY>
  508. EOT
  509.  
  510.     foreach $dir (keys %files) {
  511.         foreach $file (@{$files{$dir}}) {
  512.             $file_cmp = $file;
  513.             $file_cmp =~ s/\.html?$//i;
  514.             if(exists $files{"$dir/$file_cmp"}) {
  515.                 push(@{$files{"$dir/$file_cmp"}}, "$file_cmp/$file");
  516.                 @{$files{$dir}} = grep {$_ ne $file} @{$files{$dir}};
  517.             }
  518.         }
  519.     }
  520.  
  521.     # Merge the different directories if duplicate directories
  522.     # exist for lib and site. Effectively this removes lib/site
  523.     # from existence, and prepends "site" onto the file name for
  524.     # future reference. This way there is only one folder per
  525.     # heading, but I can still tell when to use "site" in
  526.     # making a html link.
  527.     $libdir = "$HTML/lib";
  528.     $sitedir = "$HTML/lib/site";
  529.     push(@{$files{$libdir}}, map {"site/$_"} @{$files{$sitedir}});
  530.     delete $files{$sitedir};
  531.     foreach $dir (keys %files) {
  532.         if($dir =~ m{/site/}i) {
  533.             $dir_cmp = $dir;
  534.             $dir_cmp =~ s{(/lib/)site/}{$1}i;
  535.             push(@{$files{$dir_cmp}}, map {"site/$_"} @{$files{$dir}});
  536.             delete $files{$dir};
  537.         }
  538.     }
  539.  
  540.     InsertMainToc_Temporary();
  541.  
  542.     print HTML <<EOT;
  543.       <img id="Foldergif_63" src="folder.gif">  
  544.       <b><a name="CorePerlFAQ">Core Perl FAQ</a><BR>
  545.       </b> 
  546. EOT
  547.  
  548.     foreach $file (@{$files{"$libdir/Pod"}}) {
  549.     $file_to_print = $file;
  550.     $file_to_print =~ s{\.html$}{}i;
  551.     next unless $file_to_print =~ m{^(perlfaq\d*)$};
  552.     print HTML <<EOT;
  553.    
  554. <img id="Pagegif_63" src="page.gif"> 
  555. <a href="./lib/Pod/$file_to_print.html">
  556. $file_to_print
  557. </a><BR>
  558. EOT
  559.     }
  560.  
  561.     print HTML <<EOT;
  562.       <img id="Foldergif_63" src="folder.gif">  
  563.       <b><a name="CorePerlDocs">Core Perl Docs</a><BR>
  564.       </b> 
  565. EOT
  566.  
  567.     foreach $file (@{$files{"$libdir/Pod"}}) {
  568.     $file_to_print = $file;
  569.     $file_to_print =~ s{\.html$}{}i;
  570.     next unless $file_to_print =~ m{^(perl[a-z0-9]*)$};
  571.     next if $file_to_print =~ /^perlfaq/;
  572.     print HTML <<EOT;
  573.    
  574. <img id="Pagegif_63" src="page.gif"> 
  575. <a href="./lib/Pod/$file_to_print.html">
  576. $file_to_print
  577. </a><BR>
  578. EOT
  579.     }
  580.  
  581.     print HTML <<EOT;
  582.     </p><hr>
  583.     <h4><a name="ModuleDocs">Module Docs</a></h4>
  584.     <p>
  585. EOT
  586.  
  587.     foreach $dir (sort  { uc($a) cmp uc($b) } keys(%files)) {
  588.  
  589.         $counter++;
  590.         $dir_to_print = $dir;
  591.  
  592.         # get just the directory starting with lib/
  593.         $dir_to_print =~ s{.*/(lib/?.*$)}{$1}i;
  594.  
  595.         # change slashes to double colons
  596.         $dir_to_print =~ s{/}{::}g;
  597.  
  598.         # kill extra stuff lib and site
  599.         $dir_to_print =~ s{lib::}{}i;
  600.  
  601.         # Don't want to see lib:: and lib::site::
  602.         $dir_to_print =~ s{(.*)(/|::)$}{$1};
  603.         if($dir_to_print =~ m{^lib(/site)?$}i) {
  604.             $dir_to_print = 'Root Libraries';
  605.         }
  606.  
  607.  
  608.         print HTML <<EOT;
  609.  
  610. <!-- -------------------------------------------- $dir -->
  611. <SPAN 
  612.   id="Dir_${counter}"
  613. >
  614. <b>
  615. <img id="Foldergif_${counter}" src="folder.gif"> 
  616. $dir_to_print<BR>
  617. </b></SPAN>
  618. <SPAN 
  619.    id="Files_${counter}"
  620. >
  621. EOT
  622.         if (@{$files{$dir}}) {
  623.             foreach $file (sort { $c = $a;
  624.                                   $d = $b;
  625.                                   $c =~ s{^site/}{}i;
  626.                                   $d =~ s{^site/}{}i;
  627.                                   uc($c) cmp uc($d) } (@{$files{$dir}}))
  628.         {
  629.                 $file_to_print = $file;
  630.                 $file_to_print =~ s{\.html?}{}i;
  631.         # skip perlfunc.pod etc.
  632.         next if $file_to_print =~ m{^perl[a-z0-9]*$};
  633.                 $dir_html_root = $dir;
  634.                 if ($file_to_print =~ m{^site/[^/]*$}i) {
  635.                     $dir_html_root =~ s{(lib/)}{$1site/}i;
  636.                     $dir_html_root =~ s{/lib$}{/lib/site}i;
  637.                     $file_to_print =~ s{^site/}{}i;
  638.                     $file =~ s{^site/}{}i;
  639.                 }
  640.         elsif ($file_to_print =~ m{^site/(.*)/}i) {
  641.                     $temp = $1;
  642.  
  643.                     # Get rid of the site
  644.                     $dir_html_root =~ s{(lib/)}{$1site/}i;
  645.                     $dir_html_root =~ s{/lib$}{/lib/site}i;
  646.                     $file_to_print =~ s{^site/}{}i;
  647.                     $file =~ s{^site/}{}i;
  648.  
  649.                     # Get rid of the additional directory
  650.                     $file_to_print =~ s{^[^/]*/}{}i;
  651.                     $file =~ s{^[^/]*/}{}i;
  652.                     $dir_html_root =~ s{/$temp/?}{}i;
  653.                 }
  654.         elsif ($file_to_print =~ m{^(.*)/}) {
  655.                     $temp = $1;
  656. #                    $file_to_print =~ s{^[^/]/?}{}i;
  657. #                    $file =~ s{^[^/]/?}{}i;
  658.                     $file_to_print =~ s{^.*?/}{}i;
  659.                     $file =~ s{^.*?/}{}i;
  660.                     $dir_html_root =~ s{/$temp/?}{}i;
  661.                 }
  662.                 $dir_html_root =~ s{.*/lib$}{lib}i;
  663.                 $dir_html_root =~ s{.*/(lib/.*)}{$1}i;
  664.                 $dir_html_root =~ s{lib/\.\./html/}{}i;
  665.                 print HTML <<EOT;
  666.    
  667. <img id="Pagegif_${counter}" src="page.gif"> 
  668. <a href="$dir_html_root/$file">
  669. $file_to_print
  670. </a><BR>
  671. EOT
  672.             }
  673.         }
  674.     else {
  675.             print HTML "   \n";
  676.             print HTML "No pod / html<BR>\n";
  677.         }
  678.         print HTML "</SPAN>\n";
  679.     }
  680.     print HTML "</p>\n";
  681.  
  682.     # Close the file
  683.     print HTML "</BODY>\n";
  684.     print HTML "</HTML>\n";
  685.     close HTML;
  686.  
  687.     return 1;
  688. }
  689.  
  690.  
  691. #####################################################################
  692. # FUNCTION      InsertMainToc_Temporary
  693. # RECEIVES      None
  694. # RETURNS       None
  695. # SETS          None
  696. # EXPECTS       HTML must be an open file handls
  697. # PURPOSE       Temporary (interim) function to hard code the content
  698. #               of the main toc into a single, merged toc
  699. sub InsertMainToc_Temporary {
  700.     print HTML <<'END_OF_MAIN_TOC';
  701.     <p><a href="http://www.ActiveState.com"><img src="aslogo.gif" border="0"></a></p>
  702.     <p><img src="pinkbullet.gif" width="10" height="10"> <a href="#ActivePerlDocs" target="TOC"><b>ActivePerl Docs</b></a><br>
  703.       <img src="pinkbullet.gif" width="10" height="10"> <a href="#GettingStarted" target="TOC"><b>Getting 
  704.       Started</b></a><b><br>
  705.       <img src="pinkbullet.gif" width="10" height="10"> <a href="#ActivePerlComponents" target="TOC">ActivePerl 
  706.       Components</a><br>
  707.       <img src="pinkbullet.gif" width="10" height="10"> <a href="#ActivePerlFAQ" target="TOC">ActivePerl 
  708.       FAQ</a><br>
  709.       <img src="pinkbullet.gif" width="10" height="10"> <a href="#CorePerlFAQ" target="TOC">Core 
  710.       Perl FAQ</a><br>
  711.       <img src="pinkbullet.gif" width="10" height="10"> <a href="#CorePerlDocs" target="TOC">Core 
  712.       Perl Docs</a><br>
  713.       <img src="pinkbullet.gif" width="10" height="10"> <a href="#ModuleDocs" target="TOC">Module 
  714.       Docs</a></b></p>
  715.     <hr>
  716.     <h4><a name="ActivePerlDocs">ActivePerl Docs</a></h4>
  717.     <p><b><img id="Foldergif_60" src="folder.gif">  <a name="GettingStarted">Getting 
  718.       Started</a></b><BR>
  719.           <img id="Pagegif_60" src="page.gif">  <a href="perlmain.html"> 
  720.       Welcome</a><BR>
  721.           <img id="Pagegif_60" src="page.gif">  <a href="./Perl-Win32/release.htm"> 
  722.       Release Notes </a><BR>
  723.           <img id="Pagegif_60" src="page.gif">  <a href="./Perl-Win32/install.htm"> 
  724.       Install Notes </a><BR>
  725.           <img id="Pagegif_60" src="page.gif">  <a href="./Perl-Win32/readme.htm"> 
  726.       Readme<br>
  727.       </a>    <img id="Pagegif_60" src="page.gif">  <a href="./Perl-Win32/dirstructure.html"> 
  728.       Dir Structure</a><br>
  729.       <b> <img id="Foldergif_61" src="folder.gif" alt="Instructions and sample scripts for using PerlScript">  
  730.       <a name="ActivePerlComponents">ActivePerl Components</a><BR>
  731.       </b>
  732.           <img id="Pagegif_61" src="page.gif">  <a href="./Perl-Win32/description.html"> 
  733.       Overview</a><BR>
  734.           <img id="Pagegif_61" src="page.gif">  <a href="PerlScript.html"> 
  735.       Using PerlScript </a><BR>
  736.           <img id="Pagegif_61" src="page.gif">  <a href="../eg/ie3examples/index.htm"> 
  737.       PerlScript Examples </a><BR>
  738.       <b> </b>    <img id="Pagegif_68" src="page.gif">  <a href="PerlISAPI.html"> 
  739.       Using Perl for ISAPI </a><BR>
  740.           <img id="Pagegif_68" src="page.gif">  <a href="./Perl-Win32/perlwin32faq2.html"> 
  741.       Perl for ISAPI FAQ </a><BR>
  742.       <b> </b>    <img id="Pagegif_69" src="page.gif">  <a href="./Perl-Win32/perlwin32faq11.html"> 
  743.       Using PPM</a><br>
  744.           <img id="Pagegif_68" src="page.gif">  <a href="./lib/site/Pod/PerlEz.html">
  745.       PerlEZ</a><BR>
  746.       <b><img id="Foldergif_62" src="folder.gif" alt="FAQ for using Perl on Win95/NT">  
  747.       <a name="ActivePerlFAQ">ActivePerl FAQ</a><BR>
  748.       </b>     <img id="Pagegif_62" src="page.gif">  <a href="./Perl-Win32/perlwin32faq.html"> 
  749.       Introduction </a><BR>
  750.           <img id="Pagegif_62" src="page.gif">  <a href="./Perl-Win32/perlwin32faq1.html"> 
  751.       Availability & Install </a><BR>
  752.           <img id="Pagegif_62" src="page.gif">  <a href="./Perl-Win32/perlwin32faq2.html"> 
  753.       Perl for ISAPI</a><BR>
  754.           <img id="Pagegif_62" src="page.gif">  <a href="./Perl-Win32/perlwin32faq3.html"> 
  755.       Docs & Support </a><BR>
  756.           <img id="Pagegif_62" src="page.gif">  <a href="./Perl-Win32/perlwin32faq4.html"> 
  757.       Windows 95/NT </a><BR>
  758.           <img id="Pagegif_62" src="page.gif">  <a href="./Perl-Win32/perlwin32faq5.html"> 
  759.       Quirks </a><BR>
  760.           <img id="Pagegif_62" src="page.gif">  <a href="./Perl-Win32/perlwin32faq6.html"> 
  761.       Web Server Config</a><BR>
  762.           <img id="Pagegif_62" src="page.gif">  <a href="./Perl-Win32/perlwin32faq7.html"> 
  763.       Web programming </a><BR>
  764.           <img id="Pagegif_62" src="page.gif">  <a href="./Perl-Win32/perlwin32faq8.html"> 
  765.       Programming </a><BR>
  766.           <img id="Pagegif_62" src="page.gif">  <a href="./Perl-Win32/perlwin32faq9.html"> 
  767.       Modules & Samples</a><BR>
  768.           <img id="Pagegif_62" src="page.gif">  <a href="./Perl-Win32/perlwin32faq10.html"> 
  769.       Embedding & Extending</a><BR>
  770.           <img id="Pagegif_62" src="page.gif">  <a href="./Perl-Win32/perlwin32faq11.html"> 
  771.       Using PPM</a><BR>
  772.           <img id="Pagegif_62" src="page.gif">  <a href="./Perl-Win32/perlwin32faq12.html"> 
  773.       Using OLE with Perl</a><BR>
  774. END_OF_MAIN_TOC
  775. }
  776.  
  777. #####################################################################
  778. # FUNCTION      GetHtmlFilesFromTree (recursive)
  779. # RECEIVES      Base directory to look in
  780. # RETURNS       List of html files
  781. # SETS          None
  782. # EXPECTS       None
  783. # PURPOSE       Searches an entire for html files, returns a list of
  784. #               html files found including path information
  785. sub GetHtmlFilesFromTree {
  786.     my $basedir = shift;
  787.     my @dirs;
  788.     my @htmlfiles;
  789.     my %ret;
  790.  
  791.     unless(opendir(DIR, $basedir)) {
  792.         $! = "Can't read from directory $basedir\n";
  793.         return 0;
  794.     }
  795.     @files = readdir(DIR);
  796.     closedir(DIR);
  797.  
  798.     @dirs = grep {-d "$basedir/$_" and /[^.]$/} @files;
  799.     @htmlfiles = grep {/\.html?$/i} @files;
  800.  
  801.     foreach $dir (@dirs) {
  802.         unless(%ret = (%ret, GetHtmlFilesFromTree("$basedir/$dir"))) {
  803.             return 0;
  804.         }
  805.     }
  806.  
  807.     %ret = (%ret, $basedir => \@htmlfiles);
  808. }
  809.  
  810. #####################################################################
  811. # FUNCTION      MakePerlHelp
  812. # RECEIVES      None
  813. # RETURNS       1 | 0
  814. # SETS          None
  815. # EXPECTS       None
  816. # PURPOSE       Creates html help for the perl system. This is the
  817. #               html help core build. If MAKE_HTML_FOR_HHELP is set
  818. #               to a true vale, then it builds the help from POD,
  819. #               otherwise it depends on the pod being there already.
  820. sub MakePerlHelp {
  821.     if($MAKE_HTML_FOR_HHELP) {
  822.         unless(MakeHelpFromPodTree($HTMLHELP, $HTMLHELP, $LIB, "$HTML/lib")) {
  823.             return 0;
  824.         }
  825.         unless(MakeHelpFromPodTree($HTMLHELP, $HTMLHELP, $SITELIB,
  826.                    "$HTML/lib/site")) {
  827.             return 0;
  828.         }
  829.     } else {
  830.         unless(MakeHelpFromTree($HTMLHELP, $HTMLHELP, "$HTML/lib")) {
  831.             return 0;
  832.         }
  833.     }
  834.  
  835.     unless(MakePerlHelpMain) {
  836.         return 0;
  837.     }
  838.  
  839.     # This handles MakePerlHtml too, since we've created all the html
  840.     unless(MakePerlHtmlIndex("$HTML/lib", "$HTML/perltoc.html")) {
  841.         return 0;
  842.     }
  843.  
  844.     return 1;
  845. }
  846.  
  847. #####################################################################
  848. # FUNCTION      MakePerlHelpMain;
  849. # RECEIVES      None
  850. # RETURNS       None
  851. # SETS          None
  852. # EXPECTS       None
  853. # PURPOSE       Creates the main perl helpfile from all the little
  854. #               helpfiles already created.
  855. sub MakePerlHelpMain {
  856.     my @files;
  857.  
  858.     print "Generating main library helpfile\n";
  859.  
  860.     unless(opendir(DIR, $HTMLHELP)) {
  861.         $! = "Directory $HTMLHELP could not be read\n";
  862.         return 0;
  863.     }
  864.  
  865.     unless(-e "$HTMLHELP/default.htm") {
  866.         copy("$HTML/libmain.html", "$HTMLHELP/default.htm");
  867.     }
  868.  
  869.     @files = grep {/\.hhc/i} readdir(DIR);
  870.     closedir(DIR);
  871.  
  872.     $CLEANUP=0;
  873.     $MERGE_PACKAGES = 1;
  874.  
  875.     MakeHelp("libmain.chm", $HTMLHELP, $HTMLHELP, @files);
  876.     
  877.     $CLEANUP = 1;
  878.     $MERGE_PACKAGES = 0;
  879.  
  880.     return 1;
  881. }
  882.  
  883. #####################################################################
  884. # FUNCTION      MakeHelpFromPodTree
  885. # RECEIVES      Working directory, Output directory, Source Diretory,
  886. #               HtmlOutput Directory
  887. # RETURNS       0 | 1
  888. # SETS          None
  889. # EXPECTS       None
  890. # PURPOSE       Takes a tree's worth of pod and turns them first
  891. #               into html and then into htmlhelp.
  892. sub MakeHelpFromPodTree {
  893.     my ($workdir, $outdir, $fromdir, $htmldir) = @_;
  894.  
  895.     unless(MakeHtmlTree($fromdir, $htmldir)) {
  896.         return 0;
  897.     }
  898.     
  899.     unless(MakeHelpFromTree($workdir, $outdir, $htmldir)) {
  900.         return 0;
  901.     }
  902.  
  903. #   if(opendir(DIR, $outdir)) {
  904. #       unlink(map {"$outdir/$_"} grep {/\.hhp/i} readdir(DIR));
  905. #       closedir(DIR);
  906. #   } else {
  907. #       warn "Could not clean up project files in $outdir\n";
  908. #   }
  909.  
  910.     return 1;
  911. }
  912.  
  913. #####################################################################
  914. # FUNCTION      MakeHtmlTree
  915. # RECEIVES      Source Directory, Html Output Directory
  916. # RETURNS       0 | 1
  917. # SETS          None
  918. # EXPECTS       None
  919. # PURPOSE       Makes a tree's worth of html from a tree's worth
  920. #               of pod.
  921. sub MakeHtmlTree {
  922.     my ($fromdir, $htmldir, $depth) = @_;
  923.     my @files;
  924.     my @podfiles;
  925.     my @dirs;
  926.     my $podfile;
  927.     my $htmlfile;
  928.     my $dir;
  929.     my $css = '../' x$depth . 'win32prk.css';
  930.  
  931.     # Get list of files and directories to process
  932.     $fromdir =~ s{\\}{/}g;
  933.     if(!-d $fromdir) {
  934.         $! = "Directory $fromdir does not exist\n";
  935.         return 0;
  936.     }
  937.     unless(opendir(DIR, $fromdir)) {
  938.         $! = "Directory $fromdir couldn't be read\n";
  939.         return 0;
  940.     }
  941.     @files = readdir(DIR);
  942.     closedir(DIR);
  943.  
  944.     @podfiles = map {"$fromdir/$_"} grep {/\.pod$|\.pm$/i} @files;
  945.     @dirs = grep {-d "$fromdir/$_" and /[^.]$/} @files;
  946.  
  947.     if(@podfiles) {
  948.         # Create the copy directory
  949.         if(!-d $htmldir) {
  950.             unless(mkpath($htmldir)) {
  951.                 $! = "Directory $htmldir could not be created\n";
  952.                 return 0;
  953.             }
  954.         }
  955.         
  956.         foreach $podfile (@podfiles) {
  957.             $htmlfile = $podfile;
  958.             $htmlfile =~ s{.*/(.*)}{$1};
  959.             $htmlfile =~ s{\.pod|\.pm$}{.html}i;
  960.             $htmlfile = "$htmldir/$htmlfile";
  961.             unlink($htmlfile) if (-e $htmlfile);
  962.             pod2html("--infile=$podfile", "--outfile=$htmlfile", "--css=$css");
  963.         }
  964.     }
  965.        ++$depth;
  966.     foreach $dir (@dirs) {
  967.         MakeHtmlTree("$fromdir/$dir", "$htmldir/$dir", $depth);
  968.     }
  969.  
  970.     return 1;
  971. }
  972.  
  973. #####################################################################
  974. # FUNCTION      MakeHelpFromTree
  975. # RECEIVES      Working directory, Output directory, Source directory
  976. # RETURNS       0 | 1
  977. # SETS          None
  978. # EXPECTS       None
  979. # PURPOSE       Creates html help from a tree's worth of html
  980. sub MakeHelpFromTree {
  981.     my ($workdir, $outdir, $fromdir) = @_;
  982.     my %files;
  983.     my $file;
  984.     my $key;
  985.     my $file_root;
  986.  
  987.     $fromdir =~ s{\\}{/}g;
  988.     unless(%files = GetHtmlFileTreeList($fromdir, $fromdir)) {
  989.         return 0;
  990.     }
  991.  
  992.     $file_root = $fromdir;
  993.     $file_root =~ s{(.*)/$}{$1};
  994.  
  995.     foreach $key (sort(keys(%files))) {
  996.         $file = $key;
  997.         $file = substr($key, length($file_root));
  998.         $file =~ s{^/}{};
  999.         $file =~ s{/}{-}g;
  1000.         $file =~ s{ }{}g;
  1001.         if($file eq "") {
  1002.             if($file_root =~ /lib$/i) {
  1003.                 $file = "lib";
  1004.             } else {
  1005.                 $file = "lib-site";
  1006.             }
  1007.         } elsif ($file_root =~ /lib$/i) {
  1008.             $file = "lib-" . $file;
  1009.         } elsif ($file_root =~ /site$/i) {
  1010.             $file = "lib-site-" . $file;
  1011.         }
  1012.         $file .= ".chm";
  1013.         unless(MakeHelp("$file", $workdir, $outdir, map {"$key/$_"} @{$files{$key}})) {
  1014.             return 0;
  1015.         }
  1016.     }
  1017.  
  1018.     return 1;
  1019. }
  1020.  
  1021. #####################################################################
  1022. # FUNCTION      GetHtmlFileTreeList (recursive)
  1023. # RECEIVES      Original root (from first call), Root (successive)
  1024. # RETURNS       Hash of files
  1025. # SETS          None
  1026. # EXPECTS       None
  1027. # PURPOSE       Get a list of html files throughout a tree
  1028. sub GetHtmlFileTreeList {
  1029.     my $origroot = shift;
  1030.     my $root = shift;
  1031.     my @files;
  1032.     my @htmlfiles;
  1033.     my @dirs;
  1034.     my $dir;
  1035.     my %ret;
  1036.  
  1037.     $origroot =~ s{\\}{/}g;
  1038.     $root =~ s{\\}{/}g;
  1039.     unless(opendir(DIR, $root)) {
  1040.         $! = "Can't open directory $root\n";
  1041.         return undef;
  1042.     }    
  1043.     @files = readdir(DIR);
  1044.     @dirs = grep {-d "$root/$_" and /[^.]$/} @files;
  1045.     @htmlfiles = grep {/\.html?/i} @files;
  1046.     closedir(DIR);
  1047.  
  1048.     %ret = ($root => \@htmlfiles) if @htmlfiles;
  1049.  
  1050.     foreach $dir (@dirs) {
  1051.         unless(%ret = (%ret, GetHtmlFileTreeList($origroot, "$root/$dir"))) {
  1052.             return undef;
  1053.         }
  1054.     }
  1055.  
  1056.     return %ret;
  1057. }
  1058.  
  1059. #####################################################################
  1060. # FUNCTION      MakeHelpFromHash
  1061. # RECEIVES      Helpfile name, working directory, output directory,
  1062. #               and a hash containing the html files to process and
  1063. #               their titles
  1064. # RETURNS       0 | 1
  1065. # SETS          None
  1066. # EXPECTS       None
  1067. # PURPOSE       Create a helpfile from a hash rather than from a
  1068. #               simple list of html files, to have better control
  1069. #               over the file titles. This function is unused and
  1070. #               may take some work to get it to work right.
  1071. sub MakeHelpFromHash {
  1072.     my ($helpfile, $workdir, $outdir, %htmlfiles) = @_;
  1073.     my $tocfile;
  1074.     my $projfile;
  1075.  
  1076.     die("MakeHelpFromHash() is not completely implemented\n");
  1077.  
  1078.     $tocfile = $helpfile;
  1079.     $tocfile =~ s/\.chm/.hhc/i;
  1080.     $tocfile = "$workdir/$tocfile";
  1081.  
  1082.     $projfile = $helpfile;
  1083.     $projfile =~ s/\.chm/.hhp/i;
  1084.     $projfile = "$workdir/$projfile";
  1085.  
  1086.     $helpfile = "$outdir/$helpfile";
  1087.  
  1088.     unless(CreateHHP($helpfile, $projfile, $tocfile, keys(%htmlfiles))) {
  1089.         return 0;
  1090.     }
  1091.     unless(CreateHHCFromHash($helpfile, $tocfile, %htmlfiles)) {
  1092.         return 0;
  1093.     }
  1094.  
  1095.     RunCompiler($helpfile);
  1096.  
  1097.     1;
  1098. }
  1099.  
  1100. #####################################################################
  1101. # FUNCTION      MakeModuleTreeHelp
  1102. # RECEIVES      Directory to start from, regex mask for that dir
  1103. # RETURNS       1 | 0
  1104. # SETS          None
  1105. # EXPECTS       The directories to be right
  1106. # PURPOSE       Create help from a tree of pod files for packages
  1107. sub MakeModuleTreeHelp {
  1108.     my ($fromdir, $mask) = @_;
  1109.     my @files;
  1110.     my @htmlfiles;
  1111.     my @podfiles;
  1112.     my @dirs;
  1113.     my $helpfile;
  1114.     my $podfile;
  1115.     my $htmlfile;
  1116.     my $dir;
  1117.  
  1118.     $fromdir =~ s{\\}{/}g;
  1119.     print "Creating help files for $fromdir\n";
  1120.  
  1121.     # Create the html for the directory
  1122.     unless(opendir(DIR, $fromdir)) {
  1123.         $! = "Can't read from directory $fromdir";
  1124.         return 0;
  1125.     }
  1126.     @files = readdir(DIR);
  1127.     closedir(DIR);
  1128.     @podfiles = map {"$fromdir/$_"} grep {/\.pm/i or /\.pod/i} @files;
  1129.     foreach $podfile (@podfiles) {
  1130.         $htmlfile = $podfile;
  1131.         $htmlfile =~ s/\.(pm|pod)$/.html/i;
  1132.         pod2html("--infile=$podfile", "--outfile=$htmlfile");
  1133.     }
  1134.  
  1135.     # Create the htmlhelp for the directory
  1136.     $CLEANUP = 0;
  1137.     @htmlfiles = map {"$fromdir/$_"} grep {/\.html?/i} @files;
  1138.     if(@htmlfiles) {
  1139.         $helpfile = $fromdir;
  1140.         $helpfile =~ s{$mask}{}i;
  1141.         $helpfile =~ s{/}{-}g;
  1142.         $helpfile .= ".chm";
  1143.         MakeHelp($helpfile, $fromdir, $fromdir, @htmlfiles);
  1144.     }
  1145.  
  1146.     # Recurse
  1147.     @dirs = map {"$fromdir/$_"} grep {-d and /[^.]$/} @files;
  1148.     foreach $dir (@dirs) {
  1149.         unless(CreateModuleTreeHelp("$fromdir/$dir")) {
  1150.             return 0;
  1151.         }
  1152.     }
  1153.  
  1154.     return 1;
  1155. }
  1156.  
  1157. #####################################################################
  1158. # FUNCTION      MakeHelp
  1159. # RECEIVES      Helpfile (without drive and path), Working Directory,
  1160. #               Output Directory, and a list of files to include
  1161. #               in the helpfile
  1162. # RETURNS       None
  1163. # SETS          None
  1164. # EXPECTS       None
  1165. # PURPOSE       Create help from a list of html files. Everything in
  1166. #               this library comes through here eventually.
  1167. sub MakeHelp {
  1168.     my ($helpfile, $workdir, $outdir, @htmlfiles) = @_;
  1169.     my $longtocfile;
  1170.     my $longprojfile;
  1171.     my $longhelpfile;
  1172.     my $longouthelpfile;
  1173.     my $longouttocfile;
  1174.     my $libdir;
  1175.     my $tocfile;
  1176.     my $projfile;
  1177.  
  1178.     $libdir = ExtractFilePath($htmlfiles[0]);
  1179.  
  1180.     $tocfile = $helpfile;
  1181.     $tocfile =~ s/\.chm/.hhc/i;
  1182.     if ($libdir ne "") {
  1183.         $longtocfile = "$libdir/$tocfile";
  1184.     }
  1185.     else {
  1186.         $longtocfile = "$outdir/$tocfile";
  1187.     }
  1188.     $longouttocfile = "$outdir/$tocfile";
  1189.  
  1190.     $projfile = $helpfile;
  1191.     $projfile =~ s/\.chm/.hhp/i;
  1192.     if ($libdir ne "") {
  1193.         $longprojfile = "$libdir/$projfile";
  1194.     }
  1195.     else {
  1196.         $longprojfile = "$outdir/$projfile";
  1197.     }
  1198.  
  1199.     if ($libdir ne "") {
  1200.         $longhelpfile = "$libdir/$helpfile";
  1201.     }
  1202.     else {
  1203.         $longhelpfile = "$outdir/$helpfile";
  1204.     }
  1205.     $longouthelpfile = "$outdir/$helpfile";
  1206.  
  1207.     print "----- CREATING HELP FILE $longouthelpfile -----\n";
  1208.  
  1209.     # put in the default document
  1210.     if ($libdir eq "") {
  1211.         unshift(@htmlfiles, "$HTMLHELP/default.htm");
  1212.     }
  1213.  
  1214.     unless(CreateHHP($longhelpfile, $longprojfile, $longtocfile, @htmlfiles)) {
  1215.         return 0;
  1216.     }
  1217.     unless(CreateHHC($longhelpfile, $longtocfile, @htmlfiles)) {
  1218.         return 0;
  1219.     }
  1220.  
  1221.     return 0 if (!-x $COMPILER);
  1222.     RunCompiler($longhelpfile);
  1223.  
  1224.     if($libdir ne "") {
  1225.         if($longhelpfile ne $longouthelpfile) {
  1226.             copy($longhelpfile, $longouthelpfile);
  1227.             copy($longtocfile, $longouttocfile);
  1228.         }
  1229.     }
  1230.  
  1231.     # temporary for when i want to see what it's doing
  1232. #   $CLEANUP = 0;
  1233.  
  1234.     if($CLEANUP) {
  1235.         unlink $longhelpfile, $longtocfile, $longprojfile;
  1236.     }
  1237.  
  1238.     1;
  1239. }
  1240.  
  1241. #####################################################################
  1242. # FUNCTION      BackSlash
  1243. # RECEIVES      string containing a path to convert
  1244. # RETURNS       converted string
  1245. # SETS          none
  1246. # EXPECTS       none
  1247. # PURPOSE       Internally, perl works better if we're using a
  1248. #               front slash in paths, so I don't care what I'm
  1249. #               using. But externally we need to keep everything as
  1250. #               backslashes. This function does that conversion.
  1251. sub BackSlash {
  1252.     my $in = shift;
  1253.     $in =~ s{/}{\\}g;
  1254.     return $in;
  1255. }
  1256.  
  1257. #####################################################################
  1258. # FUNCTION      ExtractFileName
  1259. # RECEIVES      FileName with (drive and) path
  1260. # RETURNS       FileName portion of the file name
  1261. # SETS          None
  1262. # EXPECTS       None
  1263. # PURPOSE       Gives the file name (anything after the last slash)
  1264. #               from a given file and path
  1265. sub ExtractFileName {
  1266.     my $in = shift;
  1267.     $in =~ s/.*(\\|\/)(.*)/$2/;
  1268.     $in;
  1269. }
  1270.  
  1271. #####################################################################
  1272. # FUNCTION      ExtractFilePath
  1273. # RECEIVES      Full file and path name
  1274. # RETURNS       Path without the file name (no trailing slash)
  1275. # SETS          None
  1276. # EXPECTS       None
  1277. # PURPOSE       Returns the path portion of a path/file combination,
  1278. #               not including the last slash.
  1279. sub ExtractFilePath {
  1280.     my $in = shift;
  1281.     if($in =~ /\\|\//) {
  1282.         $in =~ s/(.*)(\\|\/)(.*)/$1/;
  1283.     } else {
  1284.         $in = "";
  1285.     }
  1286.     $in;
  1287. }
  1288.  
  1289. #####################################################################
  1290. # FUNCTION      MakePackageMainFromSingleDir
  1291. # RECEIVES      Package helpfile directory, helpfile to create
  1292. # RETURNS       1 | 0
  1293. # SETS          None
  1294. # EXPECTS       None
  1295. # PURPOSE       Creates the package helpfile from the directory of
  1296. #               package helpfiles. Creates the master.
  1297. sub MakePackageMainFromSingleDir {
  1298.     my $package_helpfile_dir = shift;
  1299.     my $helpfile = shift;
  1300.     my $helpfile_dir;
  1301.     my @hhcfiles;
  1302.  
  1303.     $helpfile_dir = ExtractFilePath($helpfile);
  1304.     $helpfile = ExtractFileName($helpfile);
  1305.  
  1306.     unless(opendir(DIR, $package_helpfile_dir)) {
  1307.         $! = "Couldn't read from package directory $package_helpfile_dir";
  1308.         return 0;
  1309.     }
  1310.     @hhcfiles = grep {/\.hhc$/i} readdir(DIR);
  1311.     closedir(DIR);
  1312.  
  1313.     $CLEANUP = 0;
  1314.     unless(MakeHelp($helpfile, $helpfile_dir, $helpfile_dir, @hhcfiles)) {
  1315.         return 0;
  1316.     }
  1317.  
  1318.     1;
  1319. }
  1320.  
  1321. #####################################################################
  1322. # FUNCTION      MakePackageMain
  1323. # RECEIVES      Packages directory (contains packages which contain
  1324. #               blib directories), helpfile name to create (include
  1325. #               drive and path information)
  1326. # RETURNS       1 | 0
  1327. # SETS          None
  1328. # EXPECTS       None
  1329. # PURPOSE       For the packages build of HtmlHelp, this function
  1330. #               combines all the little packages into one chm
  1331. #               file linked to all the little ones per module.
  1332. sub MakePackageMain {
  1333.     my $package_root_dir = shift;
  1334.     my $helpfile = shift;
  1335.     my $helpfile_dir;
  1336.     my @files;
  1337.     my @dirs;
  1338.     my @dir;
  1339.     my @hhcfiles;
  1340.  
  1341.     $helpfile_dir = ExtractFilePath($helpfile);
  1342.     $helpfile = ExtractFileName($helpfile);
  1343.  
  1344.     unless(opendir(DIR, $package_root_dir)) {
  1345.         $! = "Couldn't read from package directory $package_root_dir";
  1346.         return 0;
  1347.     }
  1348.     @files = readdir(DIR);
  1349.     closedir(DIR);
  1350.  
  1351.     @dirs = map {"$package_root_dir/$_"} grep {-d "$package_root_dir/$_" and /[^.]/} @files;
  1352.  
  1353.     foreach $dir (@dirs) {
  1354.         if(opendir(DIR, "$dir/blib/HtmlHelp")) {
  1355.             @files = readdir(DIR);
  1356.             closedir(DIR);
  1357.             @hhcfiles = (@hhcfiles, grep {/\.hhc$/i} @files);
  1358.         } else {
  1359.             warn "Couldn't read / didn't add $dir/blib/HtmlHelp";
  1360.         }
  1361.     }
  1362.  
  1363.     $CLEANUP = 0;
  1364.     unless(MakeHelp($helpfile, $helpfile_dir, $helpfile_dir, @hhcfiles)) {
  1365.         return 0;
  1366.     }
  1367.  
  1368.     1;
  1369. }
  1370.  
  1371. #####################################################################
  1372. # FUNCTION      MakePackages
  1373. # RECEIVES      Name of directory containing the package dirs, which
  1374. #               package directories in turn contain blib dirs.
  1375. # RETURNS       None
  1376. # SETS          Creates Html and HtmlHelp within the package dirs
  1377. # EXPECTS       None, but there should be some pm files in blib, but
  1378. #               it ignores it if there isn't
  1379. # PURPOSE       Creates Html and HtmlHelp within the package dirs. We
  1380. #               decided that we don't want to build the packages at
  1381. #               the same time as the main htmlhelp, so this was
  1382. #               needed to build them (Murray) at a different time and
  1383. #               merge them in.
  1384. sub MakePackages {
  1385.     my $package_root_dir = shift;
  1386.     my (@files) = @_;
  1387.     my $package_root_dir_mask;
  1388.     my @package_dirs;
  1389.     my $package_dir;
  1390.     my @file;
  1391.     my @dirs;
  1392.     my $package_file;
  1393.     my $podfile;
  1394.     my $htmlfile;
  1395.     my @package_file_list;
  1396.     my @helphtmlfiles;
  1397.     my $htmlfilecopy;
  1398.     my $helpfile;
  1399.  
  1400.     $CLEANUP = 0;
  1401.  
  1402.     $package_root_dir =~ s{\\}{/}g;
  1403.     $package_root_dir_mask = $package_root_dir;
  1404.  
  1405.     if (!defined @files) {
  1406.         unless(opendir(DIR, $package_root_dir)) {
  1407.             $! = "Directory could not be opened $package_root_dir";
  1408.             return 0;
  1409.         }
  1410.         @files = readdir(DIR);
  1411.         closedir(DIR);
  1412.     }
  1413.  
  1414.     @dirs = grep {-d "$package_root_dir/$_" and /[^.]$/} @files;
  1415.     @package_dirs = map {"$package_root_dir/$_"} @dirs;
  1416.  
  1417.     foreach $package_dir (@package_dirs) {
  1418.         @helphtmlfiles = ();
  1419.  
  1420.         next if (!-d "$package_dir/blib");
  1421.  
  1422.         print "Making help for $package_dir\n";
  1423.  
  1424.         # Make room for the stuff
  1425.         unless(-d "$package_dir/blib/HtmlHelp") {
  1426.             unless(mkpath("$package_dir/blib/HtmlHelp")) {
  1427.                 $! = "Directory could not be created $package_dir/blib/HtmlHelp";
  1428.                 return 0;
  1429.             }
  1430.         }
  1431.         unless(-d "$package_dir/blib/Html") {
  1432.             unless(mkpath("$package_dir/blib/Html")) {
  1433.                 $! = "Directory could not be created $package_dir/blib/Html";
  1434.                 return 0;
  1435.             }
  1436.         }
  1437.         unless(-d "$package_dir/blib/Html/lib") {
  1438.             unless(mkpath("$package_dir/blib/Html/lib")) {
  1439.                 $! = "Directory could not be created $package_dir/blib/Html/lib";
  1440.                 return 0;
  1441.             }
  1442.         }
  1443.         unless(-d "$package_dir/blib/Html/lib/site") {
  1444.             unless(mkpath("$package_dir/blib/Html/lib/site")) {
  1445.                 $! = "Directory could not be created $package_dir/blib/Html/lib/site";
  1446.                 return 0;
  1447.             }
  1448.         }
  1449.  
  1450.         # Make the structure under the html
  1451.         unless(CopyDirStructure("$package_dir/blib/lib", "$package_dir/blib/Html/lib/site")) {
  1452.             return 0;
  1453.         }
  1454.  
  1455.         # Get a list of all the files to be worked with
  1456.         @package_file_list = GetFileListForPackage("$package_dir/blib/lib");
  1457.  
  1458.         foreach $file (@package_file_list) {
  1459.             print "   ... found $file\n";
  1460.         }
  1461.  
  1462.         unless(@package_file_list) {
  1463.             print "   Nothing to do for this package\n";
  1464.             next;
  1465.         }
  1466.  
  1467.         # Make the html
  1468.         foreach $package_file (@package_file_list) {
  1469.             unless(-d "$package_dir/blib/temp") {
  1470.                 unless(mkpath("$package_dir/blib/temp")) {
  1471.                     $! = "Directory could not be created $package_dir/blib/temp";
  1472.                     return 0;
  1473.                 }
  1474.             }
  1475.             $htmlfile = $package_file;
  1476.             $htmlfile =~ s/\.(pm|pod)$/.html/i;
  1477.             $htmlfile =~ s{/blib/lib/}{/blib/Html/lib/site/}i;
  1478.             pod2html("--infile=$package_file", "--outfile=$htmlfile");
  1479.             if (-e $htmlfile) {
  1480.                 unless(-d "$package_dir/blib/temp") {
  1481.                     unless(mkpath("$package_dir/blib/temp")) {
  1482.                         $! = "Directory could not be created $package_dir/blib/temp";
  1483.                         return 0;
  1484.                     }
  1485.                 }
  1486.                 
  1487.                 $htmlfilecopy = $htmlfile;
  1488.                 $htmlfilecopy =~ s{.*/blib/html/}{}i;
  1489.                 $htmlfilecopy =~ s{/}{-}g;
  1490.  
  1491.                 copy($htmlfile, "$package_dir/blib/temp/$htmlfilecopy");
  1492.                 push(@helphtmlfiles, "$package_dir/blib/temp/$htmlfilecopy");
  1493.             }
  1494.         }
  1495.  
  1496.         # Make the htmlhelp
  1497.         $helpfile = basename($package_dir);
  1498. #       $helpfile =~ s{$package_root_dir_mask/?}{};
  1499.         $helpfile .= ".chm";
  1500.         $helpfile = "pkg-" . $helpfile;
  1501.         unless(MakeHelp($helpfile, "$package_dir/blib/temp",
  1502.             "$package_dir/blib/temp", @helphtmlfiles))
  1503.     {
  1504.             return 0;
  1505.         }
  1506.         if (-e "$package_dir/blib/temp/$helpfile") {
  1507.             copy("$package_dir/blib/temp/$helpfile",
  1508.          "$package_dir/blib/HtmlHelp/$helpfile");
  1509.  
  1510.             $hhcfile = $helpfile;
  1511.             $hhcfile =~ s/\.chm$/.hhc/i;
  1512.             if (-e "$package_dir/blib/temp/$hhcfile") {
  1513.                 copy("$package_dir/blib/temp/$hhcfile",
  1514.              "$package_dir/blib/HtmlHelp/$hhcfile");
  1515.             }
  1516.         else {
  1517.                 warn("$package_dir/blib/temp/$hhcfile not found, "
  1518.              ."file will not be included");
  1519.             }
  1520.         }
  1521.     else {
  1522.             warn("No help file was generated for "
  1523.          ."$package_dir/blib/temp/$helpfile");
  1524.         }
  1525.  
  1526.         # Clean up the mess from making helpfiles, temp stuff and that
  1527.         if (-d "$package_dir/blib/temp") {
  1528.             if (opendir(DIR, "$package_dir/blib/temp")) {
  1529.                 unlink(map {"$package_dir/blib/temp/$_"}
  1530.                grep {-f "$package_dir/blib/temp/$_"} readdir(DIR));
  1531.                 closedir(DIR);
  1532.                 unless (rmdir("$package_dir/blib/temp")) {
  1533.                     warn "Couldn't rmdir temp dir $package_dir/blib/temp\n";
  1534.                 }
  1535.             }
  1536.         else {
  1537.                 warn "Couldn't read/remove temp dir $package_dir/blib/temp\n";
  1538.             }
  1539.         }
  1540.     }
  1541.  
  1542.     1;
  1543. }
  1544.  
  1545. #####################################################################
  1546. # FUNCTION      CopyDirStructure
  1547. # RECEIVES      From Directory, To Directory
  1548. # RETURNS       1 | 0
  1549. # SETS          None
  1550. # EXPECTS       None
  1551. # PURPOSE       Copies the structure of the dir tree at and below
  1552. #               the Source Directory (fromdir) to the Target
  1553. #               Directory (todir). This does not copy files, just
  1554. #               the directory structure.
  1555. sub CopyDirStructure {
  1556.     my ($fromdir, $todir) = @_;
  1557.     my @files;
  1558.     my @dirs;
  1559.     my $dir;
  1560.  
  1561.     unless(opendir(DIR, $fromdir)) {
  1562.         $! = "Couldn't read from directory $fromdir";
  1563.         return 0;
  1564.     }
  1565.     @files = readdir(DIR);
  1566.     @dirs = grep {
  1567.         -d "$fromdir/$_" and /[^.]$/ and $_ !~ /auto$/i
  1568.     } @files;
  1569.     closedir(DIR);
  1570.  
  1571.     foreach $dir (@dirs) {
  1572.  
  1573.         #
  1574.         # I could make it so that it only creates the directory if
  1575.         # it has pod in it, but what about directories below THAT
  1576.         # if it DOES have pod in it. That would be skipped. May want
  1577.         # to do some kind of lookahead. Cutting out the auto more
  1578.         # or less cuts out the problem though, right?
  1579.         #
  1580.  
  1581.         unless(-e "$todir/$dir") {
  1582.             unless(mkpath("$todir/$dir")) {
  1583.                 $! = "Directory could not be created $todir/$dir";
  1584.                 return 0;
  1585.             }
  1586.         }
  1587.         unless(CopyDirStructure("$fromdir/$dir", "$todir/$dir")) {
  1588.             return 0;
  1589.         }
  1590.     }
  1591.  
  1592.     1;
  1593. }
  1594.  
  1595. #####################################################################
  1596. # FUNCTION      GetFileListForPackage (recursive)
  1597. # RECEIVES      Root directory
  1598. # RETURNS       List of pod files contained in directories under root
  1599. # SETS          None
  1600. # EXPECTS       None
  1601. # PURPOSE       For the packages build, this function searches a
  1602. #               directory for pod files, and all directories through
  1603. #               the tree beneath it. It returns the complete path
  1604. #               and file name for all the pm or pod files it finds.
  1605. sub GetFileListForPackage {
  1606.     my ($root) = @_;
  1607.     my @podfiles;
  1608.     my @dirs;
  1609.     my $dir;
  1610.  
  1611.     unless(opendir(DIR, $root)) {
  1612.         $! = "Can't read from directory $root";
  1613.         return undef;
  1614.     }
  1615.     @files = readdir(DIR);
  1616.     closedir(DIR);
  1617.  
  1618.     @podfiles = map {
  1619.         "$root/$_"
  1620.     } grep {
  1621.         /\.pm/i or /\.pod/i
  1622.     } @files;
  1623.     
  1624.     @dirs = map {
  1625.         "$root/$_"
  1626.     } grep {
  1627.         -d "$root/$_" and /[^.]$/ and $_ !~ /auto$/i
  1628.     } @files;
  1629.     
  1630.     foreach $dir (@dirs) {
  1631.         @podfiles = (@podfiles, GetFileListForPackage("$dir"))
  1632.     }
  1633.  
  1634.     @podfiles;
  1635. }
  1636.  
  1637. #####################################################################
  1638. # FUNCTION      CreateHHP
  1639. # RECEIVES      help file name, project file name, toc file name,
  1640. #               and a list of files to include
  1641. # RETURNS       1|0 for success
  1642. # SETS          none
  1643. # EXPECTS       none
  1644. # PURPOSE       Creates the project file for the html help project.
  1645. sub CreateHHP {
  1646.     my ($helpfile, $projfile, $tocfile, @files) = @_;
  1647.     my $file;
  1648.     my $chmfile;
  1649.     my $first_html_file;
  1650.     my ($shorthelpfile, $shortprojfile, $shorttocfile);
  1651.     my ($shortfirstfile, $shortfile);
  1652.  
  1653.     my @htmlfiles = grep {/\.html?$/i} @files;
  1654.     my @hhcfiles  = grep {/\.hhc$/i}   @files;
  1655.  
  1656.     $shorthelpfile = ExtractFileName($helpfile);
  1657.     $shortprojfile = ExtractFileName($projfile);
  1658.     $shorttocfile =  ExtractFileName($tocfile);
  1659.  
  1660.     $first_html_file = $htmlfiles[0];
  1661.     unless(defined $first_html_file) {
  1662.         warn "No default html file for $backhelp\n";
  1663.     }
  1664.     $shortfirstfile = ExtractFileName($first_html_file);
  1665.  
  1666.     print "Creating $shortprojfile\n";
  1667.  
  1668.     unless(open(HHP, ">$projfile")) {
  1669.         $! = "Could not write project file";
  1670.         return 0;
  1671.     }
  1672.     print HHP <<EOT;
  1673. [OPTIONS]
  1674. Compatibility=1.1
  1675. Compiled file=$shorthelpfile
  1676. Contents file=$shorttocfile
  1677. Display compile progress=Yes
  1678. EOT
  1679.     if ($FULLTEXTSEARCH) {
  1680.         print HHP "Full-text search=Yes\n";
  1681.     }
  1682.     print HHP <<EOT;
  1683. Language=0x409 English (United States)
  1684. Default topic=$shortfirstfile
  1685.  
  1686.  
  1687. [FILES]
  1688. EOT
  1689.     foreach $file (@htmlfiles) {
  1690.         $shortfile = ExtractFileName($file);
  1691.         print HHP "$shortfile\n";
  1692.         print "   added $shortfile\n";
  1693.     }
  1694.  
  1695.     if(@hhcfiles) {
  1696.         print HHP "\n";
  1697.         print HHP "[MERGE FILES]\n";
  1698.         foreach $file (@hhcfiles) {
  1699.             $chmfile = $file;
  1700.             $chmfile =~ s/\.hhc$/.chm/i;
  1701.             $shortfile = ExtractFileName($chmfile);
  1702.             print HHP "$shortfile\n";
  1703.             print "   added $shortfile\n";
  1704.         }
  1705.         if($MERGE_PACKAGES) {
  1706.             print HHP "packages.chm\n";
  1707.             print "   ---> MERGED PACKAGES.CHM\n";
  1708.         }
  1709.     }
  1710.  
  1711.     close(HHP);
  1712.  
  1713.     return 1;
  1714. }
  1715.  
  1716. #####################################################################
  1717. # FUNCTION      CreateHHC
  1718. # RECEIVES      Helpfile name, TOC file name (HHC), list of files
  1719. # RETURNS       0 | 1
  1720. # SETS          None
  1721. # EXPECTS       None
  1722. # PURPOSE       Creates the HHC (Table of Contents) file for the
  1723. #               htmlhelp file to be created.
  1724. # NOTE          This function is used (and abused) for every piece
  1725. #               of the htmlhelp puzzle, so any change for one thing
  1726. #               can break something totally unrelated. Be careful.
  1727. #               This was the result of rapidly changing spex. In
  1728. #               general, it's used for:
  1729. #                   @ Creating helpfiles from pod/pm
  1730. #                   @ Creating helpfiles from html
  1731. #                   @ Creating helpfiles from chm's and hhc's
  1732. #                   @ Creating child helpfiles from modules
  1733. #                   @ Creating main helpfiles
  1734. #                   @ Creating helpfile for core build
  1735. #                   @ Creating main for core build
  1736. #                   @ Creating package helpfiles for packages build
  1737. #                   @ Creating package main for package build
  1738. #                   @ General Htmlhelp file building other than AS
  1739. sub CreateHHC {
  1740.     my ($helpfile, $tocfile, @files) = @_;
  1741.     my $file;
  1742.     my $title;
  1743.     my $shorttoc;
  1744.     my $shorthelp;
  1745.     my $shortfile;
  1746.     my $backfile;
  1747.     my @libhhcs;
  1748.     my @sitehhcs;
  1749.     my @otherhhcs;
  1750.  
  1751.     $helpfile =~ s{\\}{/}g;
  1752.     $tocfile =~ s{\\}{/}g;
  1753.     $shorttoc = ExtractFileName($tocfile);
  1754.     $shorthelp = ExtractFileName($helpfile);
  1755.  
  1756.     print "Creating $shorttoc\n";
  1757.     
  1758.     unless(open(HHC, ">$tocfile")) {
  1759.         $! = "Could not write contents file";
  1760.         return 0;
  1761.     }
  1762.     print HHC <<'EOT';
  1763. <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
  1764. <HTML>
  1765. <HEAD>
  1766. <!-- Sitemap 1.0 -->
  1767. </HEAD>
  1768. <BODY>
  1769. <OBJECT type="text/site properties">
  1770.     <param name="ImageType" value="Folder">
  1771. </OBJECT>
  1772. <UL>
  1773. EOT
  1774.  
  1775.     foreach $file (grep {/\.html?$/i} @files) {
  1776.         # don't want default.htm in the toc file
  1777.         next if $file =~ /default\.html?$/i;
  1778.  
  1779.     $file =~ s{\\}{/}g;
  1780.         $title = $file;
  1781.         $title =~ s{\.html$}{}i;
  1782.         $title =~ s{.*/(.*)}{$1};
  1783.  
  1784.         # Section added for packages build
  1785.         # Note: this is an abuse of regexes but needed for all cases
  1786.         $title =~ s/^pkg-//i;
  1787. #       $title =~ s{(.*lib)$}{$1/}i;
  1788.         $title =~ s{^lib-site-}{lib/site/}i;
  1789.         $title =~ s{^lib-}{lib/}i;
  1790.         $title =~ s{^site}{site/}i;
  1791.         $title =~ s{^site-}{site/}i;
  1792. #       $title =~ s{([^2])-([^x])}{${1}::${2}}ig;
  1793.         $title =~ s{Win32-(?!x86)}{Win32::}ig;
  1794.  
  1795. #$backfile = BackSlash($file);
  1796.         $shortfile = ExtractFileName($backfile);
  1797.  
  1798.         print "   adding ${shorthelp}::/${shortfile}\n";
  1799.  
  1800.  
  1801.         print HHC <<EOT;
  1802.     <LI> <OBJECT type="text/sitemap">
  1803.         <param name="Name" value="$title">
  1804.         <param name="Local" value="${shorthelp}::/${shortfile}">
  1805.         </OBJECT>
  1806. EOT
  1807.     }
  1808.  
  1809.     foreach $file (sort(grep {/\.hhc$/i} @files)) {
  1810.         if($file =~ /^lib-site-/i) {
  1811.             push(@sitehhcs, $file);
  1812.         } elsif($file =~ /lib-site\.hhc/i) {
  1813.             unshift(@sitehhcs, $file);
  1814.         } elsif($file =~ /^lib-/i) {
  1815.             push(@libhhcs, $file);
  1816.         } elsif($file =~ /lib\.hhc/i) {
  1817.             unshift(@libhhcs, $file);
  1818.         } else {
  1819.             push(@otherhhcs, $file);
  1820.         }
  1821.     }
  1822.  
  1823.     #
  1824.     # The Lib merge files
  1825.     #
  1826.     if(@libhhcs) {
  1827.         print HHC <<EOT;
  1828. <LI> <OBJECT type="text/sitemap">
  1829. <param name="Name" value="Core Libraries">
  1830. </OBJECT>
  1831. <UL>
  1832. EOT
  1833.         foreach $file (@libhhcs) {
  1834.         $file =~ s{\\}{/}g;
  1835.             next if uc($shorttoc) eq uc($file);
  1836.     
  1837.             # Note: this is an abuse of regexes but needed for all cases
  1838.             $title = $file;                         
  1839.             $title =~ s{^pkg-}{}i;
  1840.             $title =~ s{\.hhc$}{}i;
  1841.             $title =~ s{(.*lib)$}{$1/}i;
  1842.             $title =~ s{^lib-site-}{lib/site/}i;
  1843.             $title =~ s{^lib-}{lib/}i;
  1844.             $title =~ s{^site}{site/}i;
  1845.             $title =~ s{^site-}{site/}i;
  1846. #           $title =~ s{([^2])-([^x])}{${1}::${2}}ig;
  1847.             $title =~ s{Win32-(?!x86)}{Win32::}ig;
  1848.  
  1849.             if ($title =~ m{^lib/$}i) { $title = "Main Libraries" }
  1850.             $title =~ s{^lib/}{}i;
  1851.  
  1852. #            $backfile = BackSlash($file);
  1853.             $shortfile = ExtractFileName($backfile);
  1854.  
  1855.             print "   merging ${shortfile}\n";
  1856.  
  1857.             print HHC <<EOT;
  1858.     <LI> <OBJECT type="text/sitemap">
  1859.         <param name="Name" value="$title">
  1860.         </OBJECT>
  1861.     <OBJECT type="text/sitemap">
  1862.         <param name="Merge" value="${shortfile}">
  1863.         </OBJECT>
  1864. EOT
  1865.         }
  1866.         print HHC "</UL>\n";
  1867.     }
  1868.  
  1869.     #
  1870.     # The site merge files
  1871.     #
  1872.     if(@sitehhcs) {
  1873.         print HHC <<'EOT';
  1874. <!--Beginning of site libraries-->
  1875. <LI> <OBJECT type="text/sitemap">
  1876. <param name="Name" value="Site Libraries">
  1877. </OBJECT>
  1878. <UL>
  1879. EOT
  1880.  
  1881.         foreach $file (@sitehhcs) {
  1882.         $file =~ s{\\}{/}g;
  1883.             next if uc($shorttoc) eq uc($file);
  1884.  
  1885.             # Note: this is an abuse of regexes but needed for all cases
  1886.             $title = $file;                         
  1887.             $title =~ s{^pkg-}{}i;
  1888.             $title =~ s{\.hhc$}{}i;
  1889.             $title =~ s{(.*lib)$}{$1/}i;
  1890.             $title =~ s{^lib-site-}{lib/site/}i;
  1891.             $title =~ s{^lib-}{lib/}i;
  1892.             $title =~ s{^site}{site/}i;
  1893.             $title =~ s{^site-}{site/}i;
  1894. #           $title =~ s{([^2])-([^x])}{${1}::${2}}ig;
  1895.             $title =~ s{Win32-(?!x86)}{Win32::}ig;
  1896.  
  1897.             if ($title =~ m{^lib/site$}i) { $title = "Main Libraries" }
  1898.             $title =~ s{^lib/site/}{}i;
  1899.  
  1900. #            $backfile = BackSlash($file);
  1901.             $shortfile = ExtractFileName($backfile);
  1902.  
  1903.             print "   merging ${shortfile}\n";
  1904.  
  1905.             print HHC <<EOT
  1906.     <LI> <OBJECT type="text/sitemap">
  1907.         <param name="Name" value="$title">
  1908.         </OBJECT>
  1909.     <OBJECT type="text/sitemap">
  1910.         <param name="Merge" value="${shortfile}">
  1911.         </OBJECT>
  1912. EOT
  1913.         }
  1914.         print HHC "</UL>\n";
  1915.  
  1916.         #
  1917.         # quick fix: plop in the packages file
  1918.         #
  1919.         if($MERGE_PACKAGES) {
  1920.             print HHC <<EOT;
  1921. <OBJECT type="text/sitemap">
  1922. <param name="Merge" value="packages.hhc">
  1923. </OBJECT>
  1924. EOT
  1925.         }
  1926.  
  1927.         print HHC "<!--End of site libraries-->\n";
  1928.     }
  1929.  
  1930.     #
  1931.     # All the rest of the merge files
  1932.     #
  1933.     if(@otherhhcs) {
  1934.         foreach $file (@otherhhcs) {
  1935.         $file =~ s{\\}{/}g;
  1936.             next if uc($shorttoc) eq uc($file);
  1937.     
  1938.             # Note: this is an abuse of regexes but needed for all cases
  1939.             $title = $file;                         
  1940.             $title =~ s{^pkg-}{}i;
  1941.             $title =~ s{\.hhc$}{}i;
  1942.             $title =~ s{(.*lib)$}{$1/}i;
  1943.             $title =~ s{^lib-site-}{lib/site/}i;
  1944.             $title =~ s{^lib-}{lib/}i;
  1945.             $title =~ s{^site}{site/}i;
  1946.             $title =~ s{^site-}{site/}i;
  1947. #           $title =~ s{([^2])-([^x])}{${1}::${2}}ig;
  1948.             $title =~ s{Win32-(?!x86)}{Win32::}ig;
  1949.  
  1950. #            $backfile = BackSlash($file);
  1951.             $shortfile = ExtractFileName($backfile);
  1952.  
  1953.             print "   merging ${shortfile}\n";
  1954.  
  1955.             print HHC <<EOT;
  1956.     <LI> <OBJECT type="text/sitemap">
  1957.         <param name="Name" value="$title">
  1958.         </OBJECT>
  1959.     <OBJECT type="text/sitemap">
  1960.         <param name="Merge" value="${shortfile}">
  1961.         </OBJECT>
  1962. EOT
  1963.         }
  1964.     }
  1965.  
  1966.  
  1967.     # Close up shop and go home
  1968.     print HHC "</UL>\n";
  1969.     print HHC "</BODY></HTML>\n";
  1970.     close(HHC);
  1971.  
  1972.     1;
  1973. }
  1974.  
  1975. #####################################################################
  1976. # FUNCTION      CreateHHCFromHash
  1977. # RECEIVES      Helpfile, HHC filename, and assoc array of files
  1978. #               where keys are files and values are file titles
  1979. # RETURNS       1|0
  1980. # SETS          None
  1981. # EXPECTS       None
  1982. # PURPOSE       Same as CreateHHC but allows for direct control over
  1983. #               the file titles
  1984. sub CreateHHCFromHash {
  1985.     my ($helpfile, $tocfile, %files) = @_;
  1986.     my $file;
  1987.     my $title;
  1988.     my $shorttoc;
  1989.     my $shorthelp;
  1990.     my $backfile;
  1991.  
  1992.     $shorttoc = $tocfile;
  1993.     $shorttoc =~ s{.*/(.*)}{$1};
  1994.  
  1995.     $shorthelp = $helpfile;
  1996.     $shorthelp =~ s{.*/(.*)}{$1};
  1997.  
  1998.     print "Creating $shorttoc\n";
  1999.  
  2000.     unless(open(HHC, ">$tocfile")) {
  2001.         $! = "Could not write contents file";
  2002.         return 0;
  2003.     }
  2004.     print HHC <<'EOT';
  2005. <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
  2006. <HTML>
  2007. <HEAD>
  2008. <!-- Sitemap 1.0 -->
  2009. </HEAD>
  2010. <BODY>
  2011. <OBJECT type="text/site properties">
  2012.     <param name="ImageType" value="Folder">
  2013. </OBJECT>
  2014. <UL>
  2015. EOT
  2016.     while (($file,$title) = each %files) {
  2017.         next unless $file =~ /\.html?/i;
  2018. #        $backfile = BackSlash($file);
  2019.         print HHC <<EOT;
  2020.     <LI> <OBJECT type="text/sitemap">
  2021.         <param name="Name" value="$title">
  2022.         <param name="Local" value="$backfile">
  2023.         </OBJECT>
  2024. EOT
  2025.     }
  2026.     while (($file,$title) = each %files) {
  2027.         next if uc($shorttoc) eq uc($file);
  2028.         next unless $file =~ /\.hhc/i;
  2029. #        $backfile = BackSlash($file);
  2030.         print HHC <<EOT;
  2031.     <LI> <OBJECT type="text/sitemap">
  2032.         <param name="Name" value="$title">
  2033.         </OBJECT>
  2034.     <OBJECT type="text/sitemap">
  2035.         <param name="Merge" value="$backfile">
  2036.         </OBJECT>
  2037. EOT
  2038.     }
  2039.     print HHC "</UL>\n";
  2040.     print HHC "</BODY></HTML>\n";
  2041.     close(HHC);
  2042.  
  2043.     1;
  2044. }
  2045.  
  2046. #####################################################################
  2047. # DO NOT REMOVE THE FOLLOWING LINE, IT IS NEEDED TO LOAD THIS LIBRARY
  2048. 1;
  2049.