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