File Coverage

blib/lib/Pod/HtmlHelp.pm
Criterion Covered Total %
statement 18 787 2.2
branch 0 260 0.0
condition 0 6 0.0
subroutine 6 34 17.6
pod 2 2 100.0
total 26 1089 2.3


line stmt bran cond sub pod time code
1             # $File: //member/autrijus/Pod-HtmlHelp/HtmlHelp.pm $ $Author: autrijus $
2             # $Revision: #2 $ $Change: 672 $ $DateTime: 2002/08/16 18:51:54 $
3              
4             =head1 NAME
5              
6             Pod::HtmlHelp - Interface with Microsoft's HtmlHelp system
7              
8             =head1 SYNOPSIS
9              
10             use Pod::HtmlHelp;
11             pod2chm([options]);
12              
13             =head1 DESCRIPTION
14              
15             This module creates HtmlHelp from HTML or POD source (including the
16             Pod in PM library files) using Microsoft's HtmlHelp compiler. This
17             creates the intermediate project files and from those creates the
18             htmlhelp windows 32-bit help files.
19              
20             =head1 FUNCTIONS
21              
22             The individual functions that were designed with working with
23             html help files rather than the Perl htmlhelp documentation are
24             deprecated in favor of doing things with a single command. Some
25             of them need work in order to work again.
26              
27             =over 4
28              
29             =item MakeHelp
30              
31             Turns a single html page into htmlhelp document.
32              
33             =item MakeHelpFromDir
34              
35             Turns a directory's worth of html pages into a single htmlhelp document.
36              
37             =item MakeHelpFromTree
38              
39             Turns a tree's worth of html pages into a single htmlhelp document.
40              
41             =item MakeHelpFromHash
42              
43             Creates an htmlhelp document where the labels on the folders are passed
44             into the program. Useful for labels like Tk::Whatsis::Gizmo to replace
45             the default ones looking like c:/perl/lib/site/Tk/Whatsis/Gizmo.
46              
47             =item MakeHelpFromPod
48              
49             Turns a single Pod or pm document into htmlhelp document.
50              
51             =item MakeHelpFromPodDir
52              
53             Turns a dir's worth of Pod or pm into a single htmlhelp document.
54              
55             =item MakeHelpFromPodTree
56              
57             Turns a tree's worth of Pod or pm into a single htmlhelp document.
58              
59             =item MakeHelpFromPodHash
60              
61             Like MaheHelpFromHash() but for Pod instead of html.
62              
63             =item MakePerlHtmlIndex
64              
65             Creates an HTML version of an index or TOC for perl help.
66              
67             =item MakePerlHtml
68              
69             Does everything for perl HTML works.
70              
71             =back
72              
73             =head1 CONFIG.PM
74              
75             This library makes use of Config.pm to know where to get its stuff.
76              
77             =head1 HHC.EXE
78              
79             This library makes use of the HtmlHelp compiler by microsoft.
80              
81             =head1 VARIABLES
82              
83             =over 4
84              
85             =item $HtmlHelp::CSS
86              
87             Determines the stylesheet to be used for the htmlhelp files. Default
88             is the ActiveState common stylesheet. This variable can be set to
89             an empty string to allow for just plain old HTML with nothing fancy.
90              
91             Default is perl.css.
92              
93             =item $HtmlHelp::COMPILER
94              
95             Complete path and file name of the HtmlHelp compiler from Microsoft.
96             This is REQUIRED for this library to run. It defaults to it's install
97             directory within /HtmlHelp. Feel free to move this in $COMPILER
98             if you have the HtmlHelp workshop from Microsoft and you want to
99             use the compiler from a different location.
100              
101             =item $HtmlHelp::FULLTEXTSEARCH
102              
103             Whether to create full text search. Defaults to true.
104              
105             =item $HtmlHelp::CLEANUP
106              
107             Whether to clean up temporary files (and html files if building
108             from raw Pod) after building the htmlhelp. This can be useful,
109             for example, when you need to keep the intermediate files created
110             by the process for inclusion into a collective help file.
111              
112             =back
113              
114             =head1 HISTORY
115              
116             =over 4
117              
118             =item 1.0.0 pete
119              
120             First final release, went out with (ActiveState Perl) 502
121              
122             =item 1.0.1 pete
123              
124             Temporary, removed CSS insertion in favor of just adding a link to the
125             css, since it's being built on the user's machine now; and temporarily
126             added the hardcoded contents of the main toc to the built toc until I
127             have time to build it codewise.
128              
129             =item 1.0.2 gsar
130              
131             Fixed much brokenness. Much ugliness remains.
132              
133             =item 1.1 autrijus
134              
135             Adapted for pod2chm use.
136              
137             =back
138              
139             =cut
140              
141             #####################################################################
142              
143             package Pod::HtmlHelp;
144             $Pod::HtmlHelp::VERSION = '1.1';
145              
146             #####################################################################
147 1     1   848 use Config;
  1         2  
  1         40  
148 1     1   913 use File::Copy;
  1         3008  
  1         71  
149 1     1   8 use File::Basename;
  1         1  
  1         97  
150 1     1   5 use File::Path;
  1         2  
  1         50  
151 1     1   5 use Pod::WinHtml;
  1         2  
  1         253  
152              
153             #####################################################################
154             # Variables
155             my $CLEANUP = 1;
156             my $MAKE_HTML_FOR_HHELP = 0;
157             my $FULLTEXTSEARCH = 1;
158             my $LIB = $Config{'privlib'}; $LIB =~ s{\\}{/}g;
159             my $SITELIB = $Config{'sitelib'};
160             my $HTMLHELP = $LIB; $HTMLHELP =~ s{(\\|/)lib}{/HtmlHelp}i;
161             my $COMPILER = "$LIB/HtmlHelp/hhc.exe";
162             my $HTML = $LIB; $HTML =~ s{(\\|/)lib}{/Html}i;
163             my $TEMP = "$HTMLHELP/Temp";
164             my $MERGE_PACKAGES = 0;
165              
166             #####################################################################
167             # Function PreDeclarations
168 1         58 use subs qw{
169             RunCompiler MakeHelpFromPod MakeHelpFromPodDir MakeHelpFromDirMakePerlHtml
170             MakePerlHtmlIndexCaller MakePerlHtmlIndex GetHtmlFilesFromTree MakePerlHelp
171             MakePerlHelpMain MakeHelpFromPodTree MakeHtmlTree MakeHelpFromTree
172             GetHtmlFileTreeList MakeHelpFromHash MakeModuleTreeHelp MakeHelp BackSlash
173             ExtractFileName ExtractFilePath MakePackageMainFromSingleDir
174             MakePackageMain MakePackages CopyDirStructure GetFileListForPackage
175             CreateHHP CreateHHC CreateHHCFromHash
176 1     1   921 };
  1         25  
177              
178             #####################################################################
179             # FUNCTION RunCompiler
180             # RECEIVES Project file to compile
181             # RETURNS None
182             # SETS None
183             # EXPECTS $COMPILER, hhc and hhp files should be there
184             # PURPOSE Runs the HtmlHelp compiler to create a chm file
185             sub RunCompiler {
186 0     0     my $projfile = BackSlash(shift);
187 0           my $compiler = BackSlash($COMPILER);
188              
189 0           print "Trying \"$compiler $projfile\"\n";
190 0           qx($compiler $projfile);
191             }
192              
193             #####################################################################
194             # FUNCTION MakeHelpFromPod
195             # RECEIVES Helpfile (no path), Working directory, Output
196             # directory (path for chm file), Files to include
197             # RETURNS Results from running MakeHelp
198             # SETS None
199             # EXPECTS None
200             # PURPOSE Takes pod/pm files, turns them into html, and then
201             # into Htmlhelp files.
202             sub MakeHelpFromPod {
203 0     0     my ($helpfile, $workdir, $outdir, @podfiles) = @_;
204 0           my $htmlfiles;
205             my $htmlfile;
206 0           my $podfile;
207              
208 0           foreach $podfile (@podfiles) {
209 0           $podfile =~ s{\\}{/}g;
210 0           $htmlfile = $podfile;
211 0           $htmlfile =~ s{(^/]*)\....?$}{$1\.html};
212 0           push(@htmlfiles, $htmlfile);
213 0           pod2html("--infile=$podfile", "--outfile=$htmlfile");
214             }
215              
216 0           @htmlfiles = grep{-e $_} @htmlfiles;
  0            
217              
218 0 0         unless(@htmlfiles) {
219 0           $! = "No html files were created";
220 0           return 0;
221             }
222              
223 0           return MakeHelp($helpfile, $workdir, $outdir, @htmlfiles);
224             }
225              
226             #####################################################################
227             # FUNCTION MakeHelpFromPodDir
228             # RECEIVES Helpfile (no extension), Working directory, Output
229             # directory (for the Helpfile), Directory to translate
230             # RETURNS 1|0
231             # SETS None
232             # EXPECTS None
233             # PURPOSE Takes a directory's worth of pod/pm files and turns
234             # them into html and then a single chm file
235             sub MakeHelpFromPodDir {
236 0     0     my ($helpfile, $workdir, $outdir, $fromdir) = @_;
237 0           my @podfiles;
238             my $htmlfile;
239 0           my @htmlfiles;
240              
241 0 0         if(opendir(DIR,$fromdir)) {
242 0           @podfiles = grep {/(\.pod)|(\.pm)/i} readdir(DIR);
  0            
243 0 0         if(@podfiles) {
244 0           foreach $podfile (@podfiles) {
245 0           $htmlfile = $podfile;
246 0           $htmlfile =~ s{(\.pm)|(\.pod)$}{\.html}i;
247 0           $htmlfile =~ s|.*/||;
248 0           $htmlfile = "$workdir/$htmlfile";
249 0           push(@htmlfiles, $htmlfile);
250              
251 0           pod2html("--infile=$fromdir/$podfile", "--outfile=$htmlfile");
252             }
253              
254 0           @htmlfiles = grep {-e $_} @htmlfiles;
  0            
255              
256 0           MakeHelp($helpfile, $workdir, $outdir, @htmlfiles);
257             } else {
258 0           $! = "No files to be made from $fromdir";
259 0           return 0;
260             }
261             } else {
262 0           $! = "Could not open directory $fromdir";
263 0           return 0;
264             }
265              
266 0 0         unlink @htmlfiles if $CLEANUP;
267              
268 0           1;
269             }
270              
271             #####################################################################
272             # FUNCTION MakeHelpFromDir
273             # RECEIVES Helpfile (no extension), Working directory, Output
274             # directory (for Helpfile), Dir of html files for input
275             # RETURNS 1|0
276             # SETS None
277             # EXPECTS None
278             # PURPOSE Takes a directory's worth of html files and binds
279             # them all into a chm file
280             sub MakeHelpFromDir {
281 0     0 1   my ($helpfile, $workdir, $outdir, $fromdir) = @_;
282 0           my @files;
283              
284 0 0         if(opendir(DIR,$fromdir)) {
285 0           @files = map {"$fromdir/$_"} sort(grep {/\.html?/i} readdir(DIR));
  0            
  0            
286 0           closedir(DIR);
287 0 0         if(@files) {
288 0           MakeHelp($helpfile, $workdir, $outdir, @files);
289             } else {
290 0           $! = "No files to be made from $fromdir";
291 0           return 0;
292             }
293             } else {
294 0           $! = "Could not open directory $fromdir";
295 0           return 0;
296             }
297              
298 0           1;
299             }
300              
301             #####################################################################
302             # FUNCTION MakePerlHtml
303             # RECEIVES None
304             # RETURNS None
305             # SETS None
306             # EXPECTS $HTML, $LIB, $SITELIB
307             # PURPOSE Creates html files from pod for the entire perl
308             # system, and creates the main toc file.
309             sub MakePerlHtml {
310 0     0 1   MakeHtmlTree($LIB, "$HTML/lib", 1);
311 0           MakeHtmlTree($SITELIB, "$HTML/lib/site", 2);
312 0           MakePerlHtmlIndex("$HTML/lib", "$HTML/perltoc.html");
313             }
314              
315             #####################################################################
316             # FUNCTION MakePerlHtmlIndexCaller
317             # RECEIVES None
318             # RETURNS None
319             # SETS None
320             # EXPECTS $HTML
321             # PURPOSE Caller for MakePerlHtmlIndex. Using this function
322             # releases the caller from the responsibility of
323             # feeding params to MakePerlHtmlIndex, which this
324             # library gets automagically from Config.pm
325             sub MakePerlHtmlIndexCaller {
326             #
327             # Changed this to reflect the "single index file" idea
328             #
329 0     0     return MakePerlHtmlIndex("$HTML/lib", "$HTML/perltoc.html");
330             #return MakePerlHtmlIndex("$HTML/lib", "$HTML/maintoc.html");
331             }
332              
333             #####################################################################
334             # FUNCTION MakePerlHtmlIndex
335             # RECEIVES Base directory to look in, $index file to create
336             # RETURNS 1 | 0
337             # SETS None
338             # EXPECTS None
339             # PURPOSE Creates the main html index for the perl system. This
340             # is called by ppm after installing a package.
341             sub MakePerlHtmlIndex {
342 0     0     my ($basedir, $indexfile) = @_;
343 0           my %files;
344             my $file;
345 0           my $file_cmp;
346 0           my $dir;
347 0           my $dir_cmp;
348 0           my $dir_to_print;
349 0           my $dir_html_root;
350 0           my $counter;
351 0           my $file_to_print;
352 0           my $sitedir;
353 0           my $libdir;
354 0           my $temp;
355              
356              
357             # Get a list of all the files in the tree, list refs keyed by dir.
358             # These files are under c:/perl/html/lib because they have
359             # already been generated.
360              
361             # normalize to forward slashes (NEVER use backslashes in URLs!)
362 0           $basedir =~ s{\\}{/}g;
363 0 0         unless(%files = GetHtmlFilesFromTree($basedir)) {
364 0           return 0;
365             }
366              
367             # Start the html document
368 0 0         unless(open(HTML, ">$indexfile")) {
369 0           $! = "Couldn't write to $indexfile\n";
370 0           return 0;
371             }
372 0           print HTML <<'EOT';
373            
374            
375             Perl Help System Index
376            
377            
378            
379            
383            
384             EOT
385              
386 0           foreach $dir (keys %files) {
387 0           foreach $file (@{$files{$dir}}) {
  0            
388 0           $file_cmp = $file;
389 0           $file_cmp =~ s/\.html?$//i;
390 0 0         if(exists $files{"$dir/$file_cmp"}) {
391 0           push(@{$files{"$dir/$file_cmp"}}, "$file_cmp/$file");
  0            
392 0           @{$files{$dir}} = grep {$_ ne $file} @{$files{$dir}};
  0            
  0            
  0            
393             }
394             }
395             }
396              
397             # Merge the different directories if duplicate directories
398             # exist for lib and site. Effectively this removes lib/site
399             # from existence, and prepends "site" onto the file name for
400             # future reference. This way there is only one folder per
401             # heading, but I can still tell when to use "site" in
402             # making a html link.
403 0           $libdir = "$HTML/lib";
404 0           $sitedir = "$HTML/lib/site";
405 0           push(@{$files{$libdir}}, map {"site/$_"} @{$files{$sitedir}});
  0            
  0            
  0            
406 0           delete $files{$sitedir};
407 0           foreach $dir (keys %files) {
408 0 0         if($dir =~ m{/site/}i) {
409 0           $dir_cmp = $dir;
410 0           $dir_cmp =~ s{(/lib/)site/}{$1}i;
411 0           push(@{$files{$dir_cmp}}, map {"site/$_"} @{$files{$dir}});
  0            
  0            
  0            
412 0           delete $files{$dir};
413             }
414             }
415              
416 0           InsertMainToc_Temporary();
417              
418 0           print HTML <
419              
420             Core Perl FAQ
421            
422             EOT
423              
424 0           foreach $file (@{$files{"$libdir/Pod"}}) {
  0            
425 0           $file_to_print = $file;
426 0           $file_to_print =~ s{\.html$}{}i;
427 0 0         next unless $file_to_print =~ m{^(perlfaq\d*)$};
428 0           print HTML <
429                
430              
431            
432             $file_to_print
433            
434             EOT
435             }
436              
437 0           print HTML <
438              
439             Core Perl Docs
440            
441             EOT
442              
443 0           foreach $file (@{$files{"$libdir/Pod"}}) {
  0            
444 0           $file_to_print = $file;
445 0           $file_to_print =~ s{\.html$}{}i;
446 0 0         next unless $file_to_print =~ m{^(perl[a-z0-9]*)$};
447 0 0         next if $file_to_print =~ /^perlfaq/;
448 0           print HTML <
449                
450              
451            
452             $file_to_print
453            
454             EOT
455             }
456              
457 0           print HTML <
458            


459            

Module Docs

460            

461             EOT
462              
463 0           foreach $dir (sort { uc($a) cmp uc($b) } keys(%files)) {
  0            
464              
465 0           $counter++;
466 0           $dir_to_print = $dir;
467              
468             # get just the directory starting with lib/
469 0           $dir_to_print =~ s{.*/(lib/?.*$)}{$1}i;
470              
471             # change slashes to double colons
472 0           $dir_to_print =~ s{/}{::}g;
473              
474             # kill extra stuff lib and site
475 0           $dir_to_print =~ s{lib::}{}i;
476              
477             # Don't want to see lib:: and lib::site::
478 0           $dir_to_print =~ s{(.*)(/|::)$}{$1};
479 0 0         if($dir_to_print =~ m{^lib(/site)?$}i) {
480 0           $dir_to_print = 'Root Libraries';
481             }
482              
483              
484 0           print HTML <
485              
486            
487            
488             id="Dir_${counter}"
489             >
490            
491              
492             $dir_to_print
493            
494            
495             id="Files_${counter}"
496             >
497             EOT
498 0 0         if (@{$files{$dir}}) {
  0            
499 0           foreach $file (sort { $c = $a;
  0            
  0            
500 0           $d = $b;
501 0           $c =~ s{^site/}{}i;
502 0           $d =~ s{^site/}{}i;
503 0           uc($c) cmp uc($d) } (@{$files{$dir}}))
504             {
505 0           $file_to_print = $file;
506 0           $file_to_print =~ s{\.html?}{}i;
507             # skip perlfunc.pod etc.
508 0 0         next if $file_to_print =~ m{^perl[a-z0-9]*$};
509 0           $dir_html_root = $dir;
510 0 0         if ($file_to_print =~ m{^site/[^/]*$}i) {
    0          
    0          
511 0           $dir_html_root =~ s{(lib/)}{$1site/}i;
512 0           $dir_html_root =~ s{/lib$}{/lib/site}i;
513 0           $file_to_print =~ s{^site/}{}i;
514 0           $file =~ s{^site/}{}i;
515             }
516             elsif ($file_to_print =~ m{^site/(.*)/}i) {
517 0           $temp = $1;
518              
519             # Get rid of the site
520 0           $dir_html_root =~ s{(lib/)}{$1site/}i;
521 0           $dir_html_root =~ s{/lib$}{/lib/site}i;
522 0           $file_to_print =~ s{^site/}{}i;
523 0           $file =~ s{^site/}{}i;
524              
525             # Get rid of the additional directory
526 0           $file_to_print =~ s{^[^/]*/}{}i;
527 0           $file =~ s{^[^/]*/}{}i;
528 0           $dir_html_root =~ s{/$temp/?}{}i;
529             }
530             elsif ($file_to_print =~ m{^(.*)/}) {
531 0           $temp = $1;
532             # $file_to_print =~ s{^[^/]/?}{}i;
533             # $file =~ s{^[^/]/?}{}i;
534 0           $file_to_print =~ s{^.*?/}{}i;
535 0           $file =~ s{^.*?/}{}i;
536 0           $dir_html_root =~ s{/$temp/?}{}i;
537             }
538 0           $dir_html_root =~ s{.*/lib$}{lib}i;
539 0           $dir_html_root =~ s{.*/(lib/.*)}{$1}i;
540 0           $dir_html_root =~ s{lib/\.\./html/}{}i;
541 0           print HTML <
542                
543              
544            
545             $file_to_print
546            
547             EOT
548             }
549             }
550             else {
551 0           print HTML "   \n";
552 0           print HTML "No pod / html
\n";
553             }
554 0           print HTML "\n";
555             }
556 0           print HTML "

\n";
557              
558             # Close the file
559 0           print HTML "\n";
560 0           print HTML "\n";
561 0           close HTML;
562              
563 0           return 1;
564             }
565              
566              
567             #####################################################################
568             # FUNCTION GetHtmlFilesFromTree (recursive)
569             # RECEIVES Base directory to look in
570             # RETURNS List of html files
571             # SETS None
572             # EXPECTS None
573             # PURPOSE Searches an entire for html files, returns a list of
574             # html files found including path information
575             sub GetHtmlFilesFromTree {
576 0     0     my $basedir = shift;
577 0           my @dirs;
578             my @htmlfiles;
579 0           my %ret;
580              
581 0 0         unless(opendir(DIR, $basedir)) {
582 0           $! = "Can't read from directory $basedir\n";
583 0           return 0;
584             }
585 0           @files = readdir(DIR);
586 0           closedir(DIR);
587              
588 0 0         @dirs = grep {-d "$basedir/$_" and /[^.]$/} @files;
  0            
589 0           @htmlfiles = grep {/\.html?$/i} @files;
  0            
590              
591 0           foreach $dir (@dirs) {
592 0 0         unless(%ret = (%ret, GetHtmlFilesFromTree("$basedir/$dir"))) {
593 0           return 0;
594             }
595             }
596              
597 0           %ret = (%ret, $basedir => \@htmlfiles);
598             }
599              
600             #####################################################################
601             # FUNCTION MakePerlHelp
602             # RECEIVES None
603             # RETURNS 1 | 0
604             # SETS None
605             # EXPECTS None
606             # PURPOSE Creates html help for the perl system. This is the
607             # html help core build. If MAKE_HTML_FOR_HHELP is set
608             # to a true vale, then it builds the help from POD,
609             # otherwise it depends on the pod being there already.
610             sub MakePerlHelp {
611 0 0   0     if($MAKE_HTML_FOR_HHELP) {
612 0 0         unless(MakeHelpFromPodTree($HTMLHELP, $HTMLHELP, $LIB, "$HTML/lib")) {
613 0           return 0;
614             }
615 0 0         unless(MakeHelpFromPodTree($HTMLHELP, $HTMLHELP, $SITELIB,
616             "$HTML/lib/site")) {
617 0           return 0;
618             }
619             } else {
620 0 0         unless(MakeHelpFromTree($HTMLHELP, $HTMLHELP, "$HTML/lib")) {
621 0           return 0;
622             }
623             }
624              
625 0 0         unless(MakePerlHelpMain) {
626 0           return 0;
627             }
628              
629             # This handles MakePerlHtml too, since we've created all the html
630 0 0         unless(MakePerlHtmlIndex("$HTML/lib", "$HTML/perltoc.html")) {
631 0           return 0;
632             }
633              
634 0           return 1;
635             }
636              
637             #####################################################################
638             # FUNCTION MakePerlHelpMain;
639             # RECEIVES None
640             # RETURNS None
641             # SETS None
642             # EXPECTS None
643             # PURPOSE Creates the main perl helpfile from all the little
644             # helpfiles already created.
645             sub MakePerlHelpMain {
646 0     0     my @files;
647              
648 0           print "Generating main library helpfile\n";
649              
650 0 0         unless(opendir(DIR, $HTMLHELP)) {
651 0           $! = "Directory $HTMLHELP could not be read\n";
652 0           return 0;
653             }
654              
655 0 0         unless(-e "$HTMLHELP/default.htm") {
656 0           copy("$HTML/libmain.html", "$HTMLHELP/default.htm");
657             }
658              
659 0           @files = grep {/\.hhc/i} readdir(DIR);
  0            
660 0           closedir(DIR);
661              
662 0           $CLEANUP=0;
663 0           $MERGE_PACKAGES = 1;
664              
665 0           MakeHelp("libmain.chm", $HTMLHELP, $HTMLHELP, @files);
666            
667 0           $CLEANUP = 1;
668 0           $MERGE_PACKAGES = 0;
669              
670 0           return 1;
671             }
672              
673             #####################################################################
674             # FUNCTION MakeHelpFromPodTree
675             # RECEIVES Working directory, Output directory, Source Diretory,
676             # HtmlOutput Directory
677             # RETURNS 0 | 1
678             # SETS None
679             # EXPECTS None
680             # PURPOSE Takes a tree's worth of pod and turns them first
681             # into html and then into htmlhelp.
682             sub MakeHelpFromPodTree {
683 0     0     my ($workdir, $outdir, $fromdir, $htmldir) = @_;
684              
685 0 0         unless(MakeHtmlTree($fromdir, $htmldir)) {
686 0           return 0;
687             }
688            
689 0 0         unless(MakeHelpFromTree($workdir, $outdir, $htmldir)) {
690 0           return 0;
691             }
692              
693             # if(opendir(DIR, $outdir)) {
694             # unlink(map {"$outdir/$_"} grep {/\.hhp/i} readdir(DIR));
695             # closedir(DIR);
696             # } else {
697             # warn "Could not clean up project files in $outdir\n";
698             # }
699              
700 0           return 1;
701             }
702              
703             #####################################################################
704             # FUNCTION MakeHtmlTree
705             # RECEIVES Source Directory, Html Output Directory
706             # RETURNS 0 | 1
707             # SETS None
708             # EXPECTS None
709             # PURPOSE Makes a tree's worth of html from a tree's worth
710             # of pod.
711             sub MakeHtmlTree {
712 0     0     my ($fromdir, $htmldir, $depth) = @_;
713 0           my @files;
714             my @podfiles;
715 0           my @dirs;
716 0           my $podfile;
717 0           my $htmlfile;
718 0           my $dir;
719 0           my $css = '../' x ($depth-1) . 'ebx.css';
720              
721             # Get list of files and directories to process
722 0           $fromdir =~ s{\\}{/}g;
723 0 0         if(!-d $fromdir) {
724 0           $! = "Directory $fromdir does not exist\n";
725 0           return 0;
726             }
727 0 0         unless(opendir(DIR, $fromdir)) {
728 0           $! = "Directory $fromdir couldn't be read\n";
729 0           return 0;
730             }
731 0           @files = readdir(DIR);
732 0           closedir(DIR);
733              
734 0           @podfiles = map {"$fromdir/$_"} grep {/\.pod$|\.pm$/i} @files;
  0            
  0            
735 0 0         @dirs = grep {-d "$fromdir/$_" and /[^.]$/} @files;
  0            
736              
737 0 0         if(@podfiles) {
738             # Create the copy directory
739 0 0         if(!-d $htmldir) {
740 0 0         unless(mkpath($htmldir)) {
741 0           $! = "Directory $htmldir could not be created\n";
742 0           return 0;
743             }
744             }
745            
746 0           foreach $podfile (@podfiles) {
747 0           $htmlfile = $podfile;
748 0           $htmlfile =~ s{.*/(.*)}{$1};
749 0           $htmlfile =~ s{\.pod|\.pm$}{.html}i;
750 0           $htmlfile = "$htmldir/$htmlfile";
751 0 0         unlink($htmlfile) if (-e $htmlfile);
752              
753 0           pod2html("--htmlroot=./".('../' x $depth), "--infile=$podfile", "--outfile=$htmlfile", "--css=$css");
754             }
755             }
756 0           ++$depth;
757 0           foreach $dir (@dirs) {
758 0           MakeHtmlTree("$fromdir/$dir", "$htmldir/$dir", $depth);
759             }
760              
761 0           return 1;
762             }
763              
764             #####################################################################
765             # FUNCTION MakeHelpFromTree
766             # RECEIVES Working directory, Output directory, Source directory
767             # RETURNS 0 | 1
768             # SETS None
769             # EXPECTS None
770             # PURPOSE Creates html help from a tree's worth of html
771             sub MakeHelpFromTree {
772 0     0     my ($workdir, $outdir, $fromdir) = @_;
773 0           my %files;
774             my $file;
775 0           my $key;
776 0           my $file_root;
777              
778 0           $fromdir =~ s{\\}{/}g;
779 0 0         unless(%files = GetHtmlFileTreeList($fromdir, $fromdir)) {
780 0           return 0;
781             }
782              
783 0           $file_root = $fromdir;
784 0           $file_root =~ s{(.*)/$}{$1};
785              
786 0           foreach $key (sort(keys(%files))) {
787 0           print "$key...\n";
788 0           $file = $key;
789 0           $file = substr($key, length($file_root));
790 0           $file =~ s{^/}{};
791 0           $file =~ s{/}{-}g;
792 0           $file =~ s{ }{}g;
793 0 0         if($file eq "") {
    0          
    0          
794 0 0         if($file_root =~ /lib$/i) {
795 0           $file = "lib";
796             } else {
797 0           $file = "lib-site";
798             }
799             } elsif ($file_root =~ /lib$/i) {
800 0           $file = "lib-" . $file;
801             } elsif ($file_root =~ /site$/i) {
802 0           $file = "lib-site-" . $file;
803             }
804 0           $file .= ".chm";
805              
806 0 0         unless(MakeHelp("$file", $workdir, $outdir, map {"$key/$_"} @{$files{$key}})) {
  0            
  0            
807 0           return 0;
808             }
809             }
810              
811 0           return 1;
812             }
813              
814             #####################################################################
815             # FUNCTION GetHtmlFileTreeList (recursive)
816             # RECEIVES Original root (from first call), Root (successive)
817             # RETURNS Hash of files
818             # SETS None
819             # EXPECTS None
820             # PURPOSE Get a list of html files throughout a tree
821             sub GetHtmlFileTreeList {
822 0     0     my $origroot = shift;
823 0           my $root = shift;
824 0           my @files;
825             my @htmlfiles;
826 0           my @dirs;
827 0           my $dir;
828 0           my %ret;
829              
830 0           $origroot =~ s{\\}{/}g;
831 0           $root =~ s{\\}{/}g;
832 0 0         unless(opendir(DIR, $root)) {
833 0           $! = "Can't open directory $root\n";
834 0           return undef;
835             }
836 0           @files = readdir(DIR);
837 0 0         @dirs = grep {-d "$root/$_" and /[^.]$/} @files;
  0            
838 0           @htmlfiles = grep {/\.html?/i} @files;
  0            
839 0           closedir(DIR);
840              
841 0 0         %ret = ($root => \@htmlfiles) if @htmlfiles;
842              
843 0           foreach $dir (@dirs) {
844 0 0         unless(%ret = (%ret, GetHtmlFileTreeList($origroot, "$root/$dir"))) {
845 0           return undef;
846             }
847             }
848              
849 0           return %ret;
850             }
851              
852             #####################################################################
853             # FUNCTION MakeHelpFromHash
854             # RECEIVES Helpfile name, working directory, output directory,
855             # and a hash containing the html files to process and
856             # their titles
857             # RETURNS 0 | 1
858             # SETS None
859             # EXPECTS None
860             # PURPOSE Create a helpfile from a hash rather than from a
861             # simple list of html files, to have better control
862             # over the file titles. This function is unused and
863             # may take some work to get it to work right.
864             sub MakeHelpFromHash {
865 0     0     my ($helpfile, $workdir, $outdir, %htmlfiles) = @_;
866 0           my $tocfile;
867             my $projfile;
868              
869 0           die("MakeHelpFromHash() is not completely implemented\n");
870              
871 0           $tocfile = $helpfile;
872 0           $tocfile =~ s/\.chm/.hhc/i;
873 0           $tocfile = "$workdir/$tocfile";
874              
875 0           $projfile = $helpfile;
876 0           $projfile =~ s/\.chm/.hhp/i;
877 0           $projfile = "$workdir/$projfile";
878              
879 0           $helpfile = "$outdir/$helpfile";
880              
881 0 0         unless(CreateHHP($helpfile, $projfile, $tocfile, keys(%htmlfiles))) {
882 0           return 0;
883             }
884 0 0         unless(CreateHHCFromHash($helpfile, $tocfile, %htmlfiles)) {
885 0           return 0;
886             }
887              
888 0           RunCompiler($helpfile);
889              
890 0           1;
891             }
892              
893             #####################################################################
894             # FUNCTION MakeModuleTreeHelp
895             # RECEIVES Directory to start from, regex mask for that dir
896             # RETURNS 1 | 0
897             # SETS None
898             # EXPECTS The directories to be right
899             # PURPOSE Create help from a tree of pod files for packages
900             sub MakeModuleTreeHelp {
901 0     0     my ($fromdir, $mask) = @_;
902 0           my @files;
903             my @htmlfiles;
904 0           my @podfiles;
905 0           my @dirs;
906 0           my $helpfile;
907 0           my $podfile;
908 0           my $htmlfile;
909 0           my $dir;
910              
911 0           $fromdir =~ s{\\}{/}g;
912 0           print "Creating help files for $fromdir\n";
913              
914             # Create the html for the directory
915 0 0         unless(opendir(DIR, $fromdir)) {
916 0           $! = "Can't read from directory $fromdir";
917 0           return 0;
918             }
919 0           @files = readdir(DIR);
920 0           closedir(DIR);
921 0 0         @podfiles = map {"$fromdir/$_"} grep {/\.pm/i or /\.pod/i} @files;
  0            
  0            
922 0           foreach $podfile (@podfiles) {
923 0           $htmlfile = $podfile;
924 0           $htmlfile =~ s/\.(pm|pod)$/.html/i;
925 0           pod2html("--infile=$podfile", "--outfile=$htmlfile");
926             }
927              
928             # Create the htmlhelp for the directory
929 0           $CLEANUP = 0;
930 0           @htmlfiles = map {"$fromdir/$_"} grep {/\.html?/i} @files;
  0            
  0            
931 0 0         if(@htmlfiles) {
932 0           $helpfile = $fromdir;
933 0           $helpfile =~ s{$mask}{}i;
934 0           $helpfile =~ s{/}{-}g;
935 0           $helpfile .= ".chm";
936 0           MakeHelp($helpfile, $fromdir, $fromdir, @htmlfiles);
937             }
938              
939             # Recurse
940 0 0         @dirs = map {"$fromdir/$_"} grep {-d and /[^.]$/} @files;
  0            
  0            
941 0           foreach $dir (@dirs) {
942 0 0         unless(CreateModuleTreeHelp("$fromdir/$dir")) {
943 0           return 0;
944             }
945             }
946              
947 0           return 1;
948             }
949              
950             #####################################################################
951             # FUNCTION MakeHelp
952             # RECEIVES Helpfile (without drive and path), Working Directory,
953             # Output Directory, and a list of files to include
954             # in the helpfile
955             # RETURNS None
956             # SETS None
957             # EXPECTS None
958             # PURPOSE Create help from a list of html files. Everything in
959             # this library comes through here eventually.
960             sub MakeHelp {
961 0     0     my ($helpfile, $workdir, $outdir, @htmlfiles) = @_;
962 0           my $longtocfile;
963             my $longprojfile;
964 0           my $longhelpfile;
965 0           my $longouthelpfile;
966 0           my $longouttocfile;
967 0           my $libdir;
968 0           my $tocfile;
969 0           my $projfile;
970              
971 0           print "makehelp: @_\n";
972 0           $libdir = ExtractFilePath($htmlfiles[0]);
973              
974 0           $tocfile = $helpfile;
975 0           $tocfile =~ s/\.chm/.hhc/i;
976 0 0         if ($libdir ne "") {
977 0           $longtocfile = "$libdir/$tocfile";
978             }
979             else {
980 0           $longtocfile = "$outdir/$tocfile";
981             }
982 0           $longouttocfile = "$outdir/$tocfile";
983              
984 0           $projfile = $helpfile;
985 0           $projfile =~ s/\.chm/.hhp/i;
986 0 0         if ($libdir ne "") {
987 0           $longprojfile = "$libdir/$projfile";
988             }
989             else {
990 0           $longprojfile = "$outdir/$projfile";
991             }
992              
993 0 0         if ($libdir ne "") {
994 0           $longhelpfile = "$libdir/$helpfile";
995             }
996             else {
997 0           $longhelpfile = "$outdir/$helpfile";
998             }
999 0           $longouthelpfile = "$outdir/$helpfile";
1000              
1001 0           print "----- CREATING HELP FILE $longouthelpfile -----\n";
1002              
1003             # put in the default document
1004 0 0         if ($libdir eq "") {
1005 0           unshift(@htmlfiles, "$HTMLHELP/default.htm");
1006             }
1007              
1008 0 0         unless(CreateHHP($longhelpfile, $longprojfile, $longtocfile, @htmlfiles)) {
1009 0           return 0;
1010             }
1011 0 0         unless(CreateHHC($longhelpfile, $longtocfile, @htmlfiles)) {
1012 0           return 0;
1013             }
1014            
1015 0           print "checking for $COMPILER\n";
1016              
1017 0 0         return 0 if (!-x $COMPILER);
1018 0           RunCompiler($longhelpfile);
1019              
1020 0 0         if($libdir ne "") {
1021 0 0         if($longhelpfile ne $longouthelpfile) {
1022 0           copy($longhelpfile, $longouthelpfile);
1023 0           copy($longtocfile, $longouttocfile);
1024             }
1025             }
1026              
1027             # temporary for when i want to see what it's doing
1028             # $CLEANUP = 0;
1029              
1030 0 0         if($CLEANUP) {
1031 0           unlink $longhelpfile, $longtocfile, $longprojfile;
1032             }
1033              
1034 0           1;
1035             }
1036              
1037             #####################################################################
1038             # FUNCTION BackSlash
1039             # RECEIVES string containing a path to convert
1040             # RETURNS converted string
1041             # SETS none
1042             # EXPECTS none
1043             # PURPOSE Internally, perl works better if we're using a
1044             # front slash in paths, so I don't care what I'm
1045             # using. But externally we need to keep everything as
1046             # backslashes. This function does that conversion.
1047             sub BackSlash {
1048 0     0     my $in = shift;
1049 0           $in =~ s{/}{\\}g;
1050 0           return $in;
1051             }
1052              
1053             #####################################################################
1054             # FUNCTION ExtractFileName
1055             # RECEIVES FileName with (drive and) path
1056             # RETURNS FileName portion of the file name
1057             # SETS None
1058             # EXPECTS None
1059             # PURPOSE Gives the file name (anything after the last slash)
1060             # from a given file and path
1061             sub ExtractFileName {
1062 0     0     my $in = shift;
1063 0           $in =~ s/.*(\\|\/)(.*)/$2/;
1064 0           $in;
1065             }
1066              
1067             #####################################################################
1068             # FUNCTION ExtractFilePath
1069             # RECEIVES Full file and path name
1070             # RETURNS Path without the file name (no trailing slash)
1071             # SETS None
1072             # EXPECTS None
1073             # PURPOSE Returns the path portion of a path/file combination,
1074             # not including the last slash.
1075             sub ExtractFilePath {
1076 0     0     my $in = shift;
1077 0 0         if($in =~ /\\|\//) {
1078 0           $in =~ s/(.*)(\\|\/)(.*)/$1/;
1079             } else {
1080 0           $in = "";
1081             }
1082 0           $in;
1083             }
1084              
1085             #####################################################################
1086             # FUNCTION MakePackageMainFromSingleDir
1087             # RECEIVES Package helpfile directory, helpfile to create
1088             # RETURNS 1 | 0
1089             # SETS None
1090             # EXPECTS None
1091             # PURPOSE Creates the package helpfile from the directory of
1092             # package helpfiles. Creates the master.
1093             sub MakePackageMainFromSingleDir {
1094 0     0     my $package_helpfile_dir = shift;
1095 0           my $helpfile = shift;
1096 0           my $helpfile_dir;
1097             my @hhcfiles;
1098              
1099 0           $helpfile_dir = ExtractFilePath($helpfile);
1100 0           $helpfile = ExtractFileName($helpfile);
1101              
1102 0 0         unless(opendir(DIR, $package_helpfile_dir)) {
1103 0           $! = "Couldn't read from package directory $package_helpfile_dir";
1104 0           return 0;
1105             }
1106 0           @hhcfiles = grep {/\.hhc$/i} readdir(DIR);
  0            
1107 0           closedir(DIR);
1108              
1109 0           $CLEANUP = 0;
1110 0 0         unless(MakeHelp($helpfile, $helpfile_dir, $helpfile_dir, @hhcfiles)) {
1111 0           return 0;
1112             }
1113              
1114 0           1;
1115             }
1116              
1117             #####################################################################
1118             # FUNCTION MakePackageMain
1119             # RECEIVES Packages directory (contains packages which contain
1120             # blib directories), helpfile name to create (include
1121             # drive and path information)
1122             # RETURNS 1 | 0
1123             # SETS None
1124             # EXPECTS None
1125             # PURPOSE For the packages build of HtmlHelp, this function
1126             # combines all the little packages into one chm
1127             # file linked to all the little ones per module.
1128             sub MakePackageMain {
1129 0     0     my $package_root_dir = shift;
1130 0           my $helpfile = shift;
1131 0           my $helpfile_dir;
1132             my @files;
1133 0           my @dirs;
1134 0           my @dir;
1135 0           my @hhcfiles;
1136              
1137 0           $helpfile_dir = ExtractFilePath($helpfile);
1138 0           $helpfile = ExtractFileName($helpfile);
1139              
1140 0 0         unless(opendir(DIR, $package_root_dir)) {
1141 0           $! = "Couldn't read from package directory $package_root_dir";
1142 0           return 0;
1143             }
1144 0           @files = readdir(DIR);
1145 0           closedir(DIR);
1146              
1147 0 0         @dirs = map {"$package_root_dir/$_"} grep {-d "$package_root_dir/$_" and /[^.]/} @files;
  0            
  0            
1148              
1149 0           foreach $dir (@dirs) {
1150 0 0         if(opendir(DIR, "$dir/blib/HtmlHelp")) {
1151 0           @files = readdir(DIR);
1152 0           closedir(DIR);
1153 0           @hhcfiles = (@hhcfiles, grep {/\.hhc$/i} @files);
  0            
1154             } else {
1155 0           warn "Couldn't read / didn't add $dir/blib/HtmlHelp";
1156             }
1157             }
1158              
1159 0           $CLEANUP = 0;
1160 0 0         unless(MakeHelp($helpfile, $helpfile_dir, $helpfile_dir, @hhcfiles)) {
1161 0           return 0;
1162             }
1163              
1164 0           1;
1165             }
1166              
1167             #####################################################################
1168             # FUNCTION MakePackages
1169             # RECEIVES Name of directory containing the package dirs, which
1170             # package directories in turn contain blib dirs.
1171             # RETURNS None
1172             # SETS Creates Html and HtmlHelp within the package dirs
1173             # EXPECTS None, but there should be some pm files in blib, but
1174             # it ignores it if there isn't
1175             # PURPOSE Creates Html and HtmlHelp within the package dirs. We
1176             # decided that we don't want to build the packages at
1177             # the same time as the main htmlhelp, so this was
1178             # needed to build them (Murray) at a different time and
1179             # merge them in.
1180             sub MakePackages {
1181 0     0     my $package_root_dir = shift;
1182 0           my (@files) = @_;
1183 0           my $package_root_dir_mask;
1184             my @package_dirs;
1185 0           my $package_dir;
1186 0           my @file;
1187 0           my @dirs;
1188 0           my $package_file;
1189 0           my $podfile;
1190 0           my $htmlfile;
1191 0           my @package_file_list;
1192 0           my @helphtmlfiles;
1193 0           my $htmlfilecopy;
1194 0           my $helpfile;
1195              
1196 0           $CLEANUP = 0;
1197              
1198 0           $package_root_dir =~ s{\\}{/}g;
1199 0           $package_root_dir_mask = $package_root_dir;
1200              
1201 0 0         if (!@files) {
1202 0 0         unless(opendir(DIR, $package_root_dir)) {
1203 0           $! = "Directory could not be opened $package_root_dir";
1204 0           return 0;
1205             }
1206 0           @files = readdir(DIR);
1207 0           closedir(DIR);
1208             }
1209              
1210 0 0         @dirs = grep {-d "$package_root_dir/$_" and /[^.]$/} @files;
  0            
1211 0           @package_dirs = map {"$package_root_dir/$_"} @dirs;
  0            
1212              
1213 0           foreach $package_dir (@package_dirs) {
1214 0           @helphtmlfiles = ();
1215              
1216 0 0         next if (!-d "$package_dir/blib");
1217              
1218 0           print "Making help for $package_dir\n";
1219              
1220             # Make room for the stuff
1221 0 0         unless(-d "$package_dir/blib/HtmlHelp") {
1222 0 0         unless(mkpath("$package_dir/blib/HtmlHelp")) {
1223 0           $! = "Directory could not be created $package_dir/blib/HtmlHelp";
1224 0           return 0;
1225             }
1226             }
1227 0 0         unless(-d "$package_dir/blib/Html") {
1228 0 0         unless(mkpath("$package_dir/blib/Html")) {
1229 0           $! = "Directory could not be created $package_dir/blib/Html";
1230 0           return 0;
1231             }
1232             }
1233 0 0         unless(-d "$package_dir/blib/Html/lib") {
1234 0 0         unless(mkpath("$package_dir/blib/Html/lib")) {
1235 0           $! = "Directory could not be created $package_dir/blib/Html/lib";
1236 0           return 0;
1237             }
1238             }
1239 0 0         unless(-d "$package_dir/blib/Html/lib/site") {
1240 0 0         unless(mkpath("$package_dir/blib/Html/lib/site")) {
1241 0           $! = "Directory could not be created $package_dir/blib/Html/lib/site";
1242 0           return 0;
1243             }
1244             }
1245              
1246             # Make the structure under the html
1247 0 0         unless(CopyDirStructure("$package_dir/blib/lib", "$package_dir/blib/Html/lib/site")) {
1248 0           return 0;
1249             }
1250              
1251             # Get a list of all the files to be worked with
1252 0           @package_file_list = GetFileListForPackage("$package_dir/blib/lib");
1253              
1254 0           foreach $file (@package_file_list) {
1255 0           print " ... found $file\n";
1256             }
1257              
1258 0 0         unless(@package_file_list) {
1259 0           print " Nothing to do for this package\n";
1260 0           next;
1261             }
1262              
1263             # Make the html
1264 0           foreach $package_file (@package_file_list) {
1265 0 0         unless(-d "$package_dir/blib/temp") {
1266 0 0         unless(mkpath("$package_dir/blib/temp")) {
1267 0           $! = "Directory could not be created $package_dir/blib/temp";
1268 0           return 0;
1269             }
1270             }
1271 0           $htmlfile = $package_file;
1272 0           $htmlfile =~ s/\.(pm|pod)$/.html/i;
1273 0           $htmlfile =~ s{/blib/lib/}{/blib/Html/lib/site/}i;
1274 0           pod2html("--infile=$package_file", "--outfile=$htmlfile");
1275 0 0         if (-e $htmlfile) {
1276 0 0         unless(-d "$package_dir/blib/temp") {
1277 0 0         unless(mkpath("$package_dir/blib/temp")) {
1278 0           $! = "Directory could not be created $package_dir/blib/temp";
1279 0           return 0;
1280             }
1281             }
1282            
1283 0           $htmlfilecopy = $htmlfile;
1284 0           $htmlfilecopy =~ s{.*/blib/html/}{}i;
1285 0           $htmlfilecopy =~ s{/}{-}g;
1286              
1287 0           copy($htmlfile, "$package_dir/blib/temp/$htmlfilecopy");
1288 0           push(@helphtmlfiles, "$package_dir/blib/temp/$htmlfilecopy");
1289             }
1290             }
1291              
1292             # Make the htmlhelp
1293 0           $helpfile = basename($package_dir);
1294             # $helpfile =~ s{$package_root_dir_mask/?}{};
1295 0           $helpfile .= ".chm";
1296 0           $helpfile = "pkg-" . $helpfile;
1297 0 0         unless(MakeHelp($helpfile, "$package_dir/blib/temp",
1298             "$package_dir/blib/temp", @helphtmlfiles))
1299             {
1300 0           return 0;
1301             }
1302 0 0         if (-e "$package_dir/blib/temp/$helpfile") {
1303 0           copy("$package_dir/blib/temp/$helpfile",
1304             "$package_dir/blib/HtmlHelp/$helpfile");
1305              
1306 0           $hhcfile = $helpfile;
1307 0           $hhcfile =~ s/\.chm$/.hhc/i;
1308 0 0         if (-e "$package_dir/blib/temp/$hhcfile") {
1309 0           copy("$package_dir/blib/temp/$hhcfile",
1310             "$package_dir/blib/HtmlHelp/$hhcfile");
1311             }
1312             else {
1313 0           warn("$package_dir/blib/temp/$hhcfile not found, "
1314             ."file will not be included");
1315             }
1316             }
1317             else {
1318 0           warn("No help file was generated for "
1319             ."$package_dir/blib/temp/$helpfile");
1320             }
1321              
1322             # Clean up the mess from making helpfiles, temp stuff and that
1323 0 0         if (-d "$package_dir/blib/temp") {
1324 0 0         if (opendir(DIR, "$package_dir/blib/temp")) {
1325 0           unlink(map {"$package_dir/blib/temp/$_"}
  0            
1326 0           grep {-f "$package_dir/blib/temp/$_"} readdir(DIR));
1327 0           closedir(DIR);
1328 0 0         unless (rmdir("$package_dir/blib/temp")) {
1329 0           warn "Couldn't rmdir temp dir $package_dir/blib/temp\n";
1330             }
1331             }
1332             else {
1333 0           warn "Couldn't read/remove temp dir $package_dir/blib/temp\n";
1334             }
1335             }
1336             }
1337              
1338 0           1;
1339             }
1340              
1341             #####################################################################
1342             # FUNCTION CopyDirStructure
1343             # RECEIVES From Directory, To Directory
1344             # RETURNS 1 | 0
1345             # SETS None
1346             # EXPECTS None
1347             # PURPOSE Copies the structure of the dir tree at and below
1348             # the Source Directory (fromdir) to the Target
1349             # Directory (todir). This does not copy files, just
1350             # the directory structure.
1351             sub CopyDirStructure {
1352 0     0     my ($fromdir, $todir) = @_;
1353 0           my @files;
1354             my @dirs;
1355 0           my $dir;
1356              
1357 0 0         unless(opendir(DIR, $fromdir)) {
1358 0           $! = "Couldn't read from directory $fromdir";
1359 0           return 0;
1360             }
1361 0           @files = readdir(DIR);
1362 0 0 0       @dirs = grep {
1363 0           -d "$fromdir/$_" and /[^.]$/ and $_ !~ /auto$/i
1364             } @files;
1365 0           closedir(DIR);
1366              
1367 0           foreach $dir (@dirs) {
1368              
1369             #
1370             # I could make it so that it only creates the directory if
1371             # it has pod in it, but what about directories below THAT
1372             # if it DOES have pod in it. That would be skipped. May want
1373             # to do some kind of lookahead. Cutting out the auto more
1374             # or less cuts out the problem though, right?
1375             #
1376              
1377 0 0         unless(-e "$todir/$dir") {
1378 0 0         unless(mkpath("$todir/$dir")) {
1379 0           $! = "Directory could not be created $todir/$dir";
1380 0           return 0;
1381             }
1382             }
1383 0 0         unless(CopyDirStructure("$fromdir/$dir", "$todir/$dir")) {
1384 0           return 0;
1385             }
1386             }
1387              
1388 0           1;
1389             }
1390              
1391             #####################################################################
1392             # FUNCTION GetFileListForPackage (recursive)
1393             # RECEIVES Root directory
1394             # RETURNS List of pod files contained in directories under root
1395             # SETS None
1396             # EXPECTS None
1397             # PURPOSE For the packages build, this function searches a
1398             # directory for pod files, and all directories through
1399             # the tree beneath it. It returns the complete path
1400             # and file name for all the pm or pod files it finds.
1401             sub GetFileListForPackage {
1402 0     0     my ($root) = @_;
1403 0           my @podfiles;
1404             my @dirs;
1405 0           my $dir;
1406              
1407 0 0         unless(opendir(DIR, $root)) {
1408 0           $! = "Can't read from directory $root";
1409 0           return undef;
1410             }
1411 0           @files = readdir(DIR);
1412 0           closedir(DIR);
1413              
1414 0           @podfiles = map {
1415 0 0         "$root/$_"
1416             } grep {
1417 0           /\.pm/i or /\.pod/i
1418             } @files;
1419            
1420 0           @dirs = map {
1421 0 0 0       "$root/$_"
1422             } grep {
1423 0           -d "$root/$_" and /[^.]$/ and $_ !~ /auto$/i
1424             } @files;
1425            
1426 0           foreach $dir (@dirs) {
1427 0           @podfiles = (@podfiles, GetFileListForPackage("$dir"))
1428             }
1429              
1430 0           @podfiles;
1431             }
1432              
1433             #####################################################################
1434             # FUNCTION CreateHHP
1435             # RECEIVES help file name, project file name, toc file name,
1436             # and a list of files to include
1437             # RETURNS 1|0 for success
1438             # SETS none
1439             # EXPECTS none
1440             # PURPOSE Creates the project file for the html help project.
1441             sub CreateHHP {
1442 0     0     my ($helpfile, $projfile, $tocfile, @files) = @_;
1443 0           my $file;
1444             my $chmfile;
1445 0           my $first_html_file;
1446 0           my ($shorthelpfile, $shortprojfile, $shorttocfile);
1447 0           my ($shortfirstfile, $shortfile);
1448              
1449 0           my @htmlfiles = grep {/\.html?$/i} @files;
  0            
1450 0           my @hhcfiles = grep {/\.hhc$/i} @files;
  0            
1451              
1452 0           $shorthelpfile = ExtractFileName($helpfile);
1453 0           $shortprojfile = ExtractFileName($projfile);
1454 0           $shorttocfile = ExtractFileName($tocfile);
1455              
1456 0           $first_html_file = $htmlfiles[0];
1457 0 0         unless(defined $first_html_file) {
1458 0           warn "No default html file for $backhelp\n";
1459             }
1460 0           $shortfirstfile = ExtractFileName($first_html_file);
1461              
1462 0           print "Creating $shortprojfile\n";
1463              
1464 0 0         unless(open(HHP, ">$projfile")) {
1465 0           $! = "Could not write project file";
1466 0           return 0;
1467             }
1468 0           print HHP <
1469             [OPTIONS]
1470             Compatibility=1.1
1471             Compiled file=$shorthelpfile
1472             Contents file=$shorttocfile
1473             Display compile progress=Yes
1474             EOT
1475 0 0         if ($FULLTEXTSEARCH) {
1476 0           print HHP "Full-text search=Yes\n";
1477             }
1478 0           print HHP <
1479             Language=0x409 English (United States)
1480             Default topic=$shortfirstfile
1481              
1482              
1483             [FILES]
1484             EOT
1485 0           foreach $file (@htmlfiles) {
1486 0           $shortfile = ExtractFileName($file);
1487 0           print HHP "$shortfile\n";
1488 0           print " added $shortfile\n";
1489             }
1490              
1491 0 0         if(@hhcfiles) {
1492 0           print HHP "\n";
1493 0           print HHP "[MERGE FILES]\n";
1494 0           foreach $file (@hhcfiles) {
1495 0           $chmfile = $file;
1496 0           $chmfile =~ s/\.hhc$/.chm/i;
1497 0           $shortfile = ExtractFileName($chmfile);
1498 0           print HHP "$shortfile\n";
1499 0           print " added $shortfile\n";
1500             }
1501 0 0         if($MERGE_PACKAGES) {
1502 0           print HHP "packages.chm\n";
1503 0           print " ---> MERGED PACKAGES.CHM\n";
1504             }
1505             }
1506              
1507 0           close(HHP);
1508              
1509 0           return 1;
1510             }
1511              
1512             #####################################################################
1513             # FUNCTION CreateHHC
1514             # RECEIVES Helpfile name, TOC file name (HHC), list of files
1515             # RETURNS 0 | 1
1516             # SETS None
1517             # EXPECTS None
1518             # PURPOSE Creates the HHC (Table of Contents) file for the
1519             # htmlhelp file to be created.
1520             # NOTE This function is used (and abused) for every piece
1521             # of the htmlhelp puzzle, so any change for one thing
1522             # can break something totally unrelated. Be careful.
1523             # This was the result of rapidly changing spex. In
1524             # general, it's used for:
1525             # @ Creating helpfiles from pod/pm
1526             # @ Creating helpfiles from html
1527             # @ Creating helpfiles from chm's and hhc's
1528             # @ Creating child helpfiles from modules
1529             # @ Creating main helpfiles
1530             # @ Creating helpfile for core build
1531             # @ Creating main for core build
1532             # @ Creating package helpfiles for packages build
1533             # @ Creating package main for package build
1534             # @ General Htmlhelp file building other than AS
1535             sub CreateHHC {
1536 0     0     my ($helpfile, $tocfile, @files) = @_;
1537 0           my $file;
1538             my $title;
1539 0           my $shorttoc;
1540 0           my $shorthelp;
1541 0           my $shortfile;
1542 0           my $backfile;
1543 0           my @libhhcs;
1544 0           my @sitehhcs;
1545 0           my @otherhhcs;
1546              
1547 0           $helpfile =~ s{\\}{/}g;
1548 0           $tocfile =~ s{\\}{/}g;
1549 0           $shorttoc = ExtractFileName($tocfile);
1550 0           $shorthelp = ExtractFileName($helpfile);
1551              
1552 0           print "Creating $shorttoc\n";
1553            
1554 0 0         unless(open(HHC, ">$tocfile")) {
1555 0           $! = "Could not write contents file";
1556 0           return 0;
1557             }
1558 0           print HHC <<'EOT';
1559            
1560            
1561            
1562            
1563            
1564            
1565            
1566            
1567            
1568            
1569             EOT
1570              
1571 0           foreach $file (grep {/\.html?$/i} @files) {
  0            
1572             # don't want default.htm in the toc file
1573 0 0         next if $file =~ /default\.html?$/i;
1574              
1575 0           $file =~ s{\\}{/}g;
1576 0           $title = $file;
1577 0           $title =~ s{\.html$}{}i;
1578 0           $title =~ s{.*/(.*)}{$1};
1579              
1580             # Section added for packages build
1581             # Note: this is an abuse of regexes but needed for all cases
1582 0           $title =~ s/^pkg-//i;
1583             # $title =~ s{(.*lib)$}{$1/}i;
1584 0           $title =~ s{^lib-site-}{lib/site/}i;
1585 0           $title =~ s{^lib-}{lib/}i;
1586 0           $title =~ s{^site}{site/}i;
1587 0           $title =~ s{^site-}{site/}i;
1588             # $title =~ s{([^2])-([^x])}{${1}::${2}}ig;
1589 0           $title =~ s{Win32-(?!x86)}{Win32::}ig;
1590              
1591             #$backfile = BackSlash($file);
1592 0           $shortfile = ExtractFileName($backfile);
1593              
1594 0           print " adding ${shorthelp}::/${shortfile}\n";
1595              
1596              
1597 0           print HHC <
1598            
  • 1599            
    1600            
    1601            
    1602             EOT
    1603             }
    1604              
    1605 0           foreach $file (sort(grep {/\.hhc$/i} @files)) {
      0            
    1606 0 0         if($file =~ /^lib-site-/i) {
        0          
        0          
        0          
    1607 0           push(@sitehhcs, $file);
    1608             } elsif($file =~ /lib-site\.hhc/i) {
    1609 0           unshift(@sitehhcs, $file);
    1610             } elsif($file =~ /^lib-/i) {
    1611 0           push(@libhhcs, $file);
    1612             } elsif($file =~ /lib\.hhc/i) {
    1613 0           unshift(@libhhcs, $file);
    1614             } else {
    1615 0           push(@otherhhcs, $file);
    1616             }
    1617             }
    1618              
    1619             #
    1620             # The Lib merge files
    1621             #
    1622 0 0         if(@libhhcs) {
    1623 0           print HHC <
    1624            
  • 1625            
    1626            
    1627            
    1628             EOT
    1629 0           foreach $file (@libhhcs) {
    1630 0           $file =~ s{\\}{/}g;
    1631 0 0         next if uc($shorttoc) eq uc($file);
    1632            
    1633             # Note: this is an abuse of regexes but needed for all cases
    1634 0           $title = $file;
    1635 0           $title =~ s{^pkg-}{}i;
    1636 0           $title =~ s{\.hhc$}{}i;
    1637 0           $title =~ s{(.*lib)$}{$1/}i;
    1638 0           $title =~ s{^lib-site-}{lib/site/}i;
    1639 0           $title =~ s{^lib-}{lib/}i;
    1640 0           $title =~ s{^site}{site/}i;
    1641 0           $title =~ s{^site-}{site/}i;
    1642             # $title =~ s{([^2])-([^x])}{${1}::${2}}ig;
    1643 0           $title =~ s{Win32-(?!x86)}{Win32::}ig;
    1644              
    1645 0 0         if ($title =~ m{^lib/$}i) { $title = "Main Libraries" }
      0            
    1646 0           $title =~ s{^lib/}{}i;
    1647              
    1648             # $backfile = BackSlash($file);
    1649 0           $shortfile = ExtractFileName($backfile);
    1650              
    1651 0           print " merging ${shortfile}\n";
    1652              
    1653 0           print HHC <
    1654            
  • 1655            
    1656            
    1657            
    1658            
    1659            
    1660             EOT
    1661             }
    1662 0           print HHC "\n";
    1663             }
    1664              
    1665             #
    1666             # The site merge files
    1667             #
    1668 0 0         if(@sitehhcs) {
    1669 0           print HHC <<'EOT';
    1670            
    1671            
  • 1672            
    1673            
    1674            
    1675             EOT
    1676              
    1677 0           foreach $file (@sitehhcs) {
    1678 0           $file =~ s{\\}{/}g;
    1679 0 0         next if uc($shorttoc) eq uc($file);
    1680              
    1681             # Note: this is an abuse of regexes but needed for all cases
    1682 0           $title = $file;
    1683 0           $title =~ s{^pkg-}{}i;
    1684 0           $title =~ s{\.hhc$}{}i;
    1685 0           $title =~ s{(.*lib)$}{$1/}i;
    1686 0           $title =~ s{^lib-site-}{lib/site/}i;
    1687 0           $title =~ s{^lib-}{lib/}i;
    1688 0           $title =~ s{^site}{site/}i;
    1689 0           $title =~ s{^site-}{site/}i;
    1690             # $title =~ s{([^2])-([^x])}{${1}::${2}}ig;
    1691 0           $title =~ s{Win32-(?!x86)}{Win32::}ig;
    1692              
    1693 0 0         if ($title =~ m{^lib/site$}i) { $title = "Main Libraries" }
      0            
    1694 0           $title =~ s{^lib/site/}{}i;
    1695              
    1696             # $backfile = BackSlash($file);
    1697 0           $shortfile = ExtractFileName($backfile);
    1698              
    1699 0           print " merging ${shortfile}\n";
    1700              
    1701 0           print HHC <
    1702            
  • 1703            
    1704            
    1705            
    1706            
    1707            
    1708             EOT
    1709             }
    1710 0           print HHC "\n";
    1711              
    1712             #
    1713             # quick fix: plop in the packages file
    1714             #
    1715 0 0         if($MERGE_PACKAGES) {
    1716 0           print HHC <
    1717            
    1718            
    1719            
    1720             EOT
    1721             }
    1722              
    1723 0           print HHC "\n";
    1724             }
    1725              
    1726             #
    1727             # All the rest of the merge files
    1728             #
    1729 0 0         if(@otherhhcs) {
    1730 0           foreach $file (@otherhhcs) {
    1731 0           $file =~ s{\\}{/}g;
    1732 0 0         next if uc($shorttoc) eq uc($file);
    1733            
    1734             # Note: this is an abuse of regexes but needed for all cases
    1735 0           $title = $file;
    1736 0           $title =~ s{^pkg-}{}i;
    1737 0           $title =~ s{\.hhc$}{}i;
    1738 0           $title =~ s{(.*lib)$}{$1/}i;
    1739 0           $title =~ s{^lib-site-}{lib/site/}i;
    1740 0           $title =~ s{^lib-}{lib/}i;
    1741 0           $title =~ s{^site}{site/}i;
    1742 0           $title =~ s{^site-}{site/}i;
    1743             # $title =~ s{([^2])-([^x])}{${1}::${2}}ig;
    1744 0           $title =~ s{Win32-(?!x86)}{Win32::}ig;
    1745              
    1746             # $backfile = BackSlash($file);
    1747 0           $shortfile = ExtractFileName($backfile);
    1748              
    1749 0           print " merging ${shortfile}\n";
    1750              
    1751 0           print HHC <
    1752            
  • 1753            
    1754            
    1755            
    1756            
    1757            
    1758             EOT
    1759             }
    1760             }
    1761              
    1762              
    1763             # Close up shop and go home
    1764 0           print HHC "\n";
    1765 0           print HHC "\n";
    1766 0           close(HHC);
    1767              
    1768 0           1;
    1769             }
    1770              
    1771             #####################################################################
    1772             # FUNCTION CreateHHCFromHash
    1773             # RECEIVES Helpfile, HHC filename, and assoc array of files
    1774             # where keys are files and values are file titles
    1775             # RETURNS 1|0
    1776             # SETS None
    1777             # EXPECTS None
    1778             # PURPOSE Same as CreateHHC but allows for direct control over
    1779             # the file titles
    1780             sub CreateHHCFromHash {
    1781 0     0     my ($helpfile, $tocfile, %files) = @_;
    1782 0           my $file;
    1783             my $title;
    1784 0           my $shorttoc;
    1785 0           my $shorthelp;
    1786 0           my $backfile;
    1787              
    1788 0           $shorttoc = $tocfile;
    1789 0           $shorttoc =~ s{.*/(.*)}{$1};
    1790              
    1791 0           $shorthelp = $helpfile;
    1792 0           $shorthelp =~ s{.*/(.*)}{$1};
    1793              
    1794 0           print "Creating $shorttoc\n";
    1795              
    1796 0 0         unless(open(HHC, ">$tocfile")) {
    1797 0           $! = "Could not write contents file";
    1798 0           return 0;
    1799             }
    1800 0           print HHC <<'EOT';
    1801            
    1802            
    1803            
    1804            
    1805            
    1806            
    1807            
    1808            
    1809            
    1810            
    1811             EOT
    1812 0           while (($file,$title) = each %files) {
    1813 0 0         next unless $file =~ /\.html?/i;
    1814             # $backfile = BackSlash($file);
    1815 0           print HHC <
    1816            
  • 1817            
    1818            
    1819            
    1820             EOT
    1821             }
    1822 0           while (($file,$title) = each %files) {
    1823 0 0         next if uc($shorttoc) eq uc($file);
    1824 0 0         next unless $file =~ /\.hhc/i;
    1825             # $backfile = BackSlash($file);
    1826 0           print HHC <
    1827            
  • 1828            
    1829            
    1830            
    1831            
    1832            
    1833             EOT
    1834             }
    1835 0           print HHC "\n";
    1836 0           print HHC "\n";
    1837 0           close(HHC);
    1838              
    1839 0           1;
    1840             }
    1841              
    1842             #####################################################################
    1843             # DO NOT REMOVE THE FOLLOWING LINE, IT IS NEEDED TO LOAD THIS LIBRARY
    1844             1;
    1845              
    1846             __END__