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