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 |
||||||
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 | |
||||||
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__ |