#####################################################################
# Library HtmlHelp.pm
# Title HtmlHelp.pm
# Version 1.0.2
# Author David Grove (pete) [pete@activestate.com]
# Company ActiveState Tool Corp. -
# Professional Tools for Perl Developers
#####################################################################
# Description Miscelaneous routines for working with Microsoft's
# HtmlHelp system.
#####################################################################
# REVISION HISTORY
#
# 1.0.0 First final release, went out with 502
# 1.0.1 Temporary, removed CSS insertion in favor of just
# adding a link to the css, since it's being built
# on the user's machine now; and temporarily added
# the hardcoded contents of the main toc to the
# built toc until I have time to build it codewise.
# 1.0.2 gsar Fixed much brokenness. Much ugliness remains.
=head1 TITLE
HtmlHelp.pm
=head1 SYNOPSIS
Routines to create HtmlHelp from HTML or POD source (including the
Pod in PM library files) using Microsoft's HtmlHelp compiler. This
creates the intermediate project files and from those creates the
htmlhelp windows 32-bit help files.
Along with this libaray comes a set of programs that can be used
either as-is or as examples for perl development. Each of the public
functions in this libray is represented by one such script.
=head1 USAGE
There are two "builds" of perl help, the core build (build for core
Perl and it's packages), and the packages build (build from a devel
directory of directories which contain blib directories to draw
upon). These are run by different people on different machines at
different times in different situations, so they are mostly separate
until the time comes within this module to actuall build the helpfiles.
There is also a build (html index) that works on the user's computer
after installing a new module.
For the core build
perl makehelp.pl
for the package build
perl makepackages.pl
for the html index build
perl makehtmlindex.pl
The functions in this module can also be called programmatically
=head1 FUNCTIONS
The individual functions that were designed with working with
html help files rather than the Perl htmlhelp documentation are
deprecated in favor of doing things with a single command. Some
of them need work in order to work again.
=over 4
=item MakeHelp
Turns a single html page into htmlhelp document.
=item MakeHelpFromDir
Turns a directory's worth of html pages into a single htmlhelp document.
=item MakeHelpFromTree
Turns a tree's worth of html pages into a single htmlhelp document.
=item MakeHelpFromHash
Creates an htmlhelp document where the labels on the folders are passed
into the program. Useful for labels like Tk::Whatsis::Gizmo to replace
the default ones looking like c:/perl/lib/site/Tk/Whatsis/Gizmo.
=item MakeHelpFromPod
Turns a single Pod or pm document into htmlhelp document.
=item MakeHelpFromPodDir
Turns a dir's worth of Pod or pm into a single htmlhelp document.
=item MakeHelpFromPodTree
Turns a tree's worth of Pod or pm into a single htmlhelp document.
=item MakeHelpFromPodHash
Like MaheHelpFromHash() but for Pod instead of html.
=item MakePerlHtmlIndex
Creates an HTML version of an index or TOC for perl help.
=item MakePerlHtml
Does everything for perl HTML works.
=back
=head1 CONFIG.PM
This library makes use of Config.pm to know where to get its stuff.
=head1 HHC.EXE
This library makes use of the HtmlHelp compiler by microsoft.
=head1 VARIABLES
=over4
=item $HtmlHelp::CSS
Determines the stylesheet to be used for the htmlhelp files. Default
is the ActiveState common stylesheet. This variable can be set to
an empty string to allow for just plain old HTML with nothing fancy.
Default is perl.css.
=item $HtmlHelp::COMPILER
Complete path and file name of the HtmlHelp compiler from Microsoft.
This is REQUIRED for this library to run. It defaults to it's install
directory within <lib>/HtmlHelp. Feel free to move this in $COMPILER
if you have the HtmlHelp workshop from Microsoft and you want to
use the compiler from a different location.
=item $HtmlHelp::FULLTEXTSEARCH
Whether to create full text search. Defaults to true.
=item $HtmlHelp::CLEANUP
Whether to clean up temporary files (and html files if building
from raw Pod) after building the htmlhelp. This can be useful,
for example, when you need to keep the intermediate files created
by the process for inclusion into a collective help file.
=back
=head1 TARGET AUDIENCE
Mostly this module is created for internal use for ActiveState Tool
Corp., but since it is a part of the standard distrib for Win32 Perl
then I expect it to be used or tried by the general public. However,
no support for this module is available for the public; and it may
be changed at any time.
=head1 INSTALLATION
First of all, this is designed for use with the Perl Resource
Kit. Use with other versions of perl should be considered
unsupported. Perl should be fully installed and configured to
use this thing
Next, Config.pm must be fully configured. Using Config.pm allows
me to program remotely for tools at ActiveState corporate office.
There were some early problems with Config.pm with the PRK and
build 500 of Perl for Win32. These need to be corrected to use
this library.
Perl needs to have $Config{privlib}/../Html and also
$Config{privlib}/../HtmlHelp to use this library. These should be
created before doing anything. Copy the html files and gif
files from this library to the Html directory. All other
files will be created during run.
Finally, copy all the files to $Config{privlib}/HtmlHelp, and the
file HtmlHelp.pm to $Config{privlib}. The former is the normal site
for the htmlhelp compiler (hhc.exe), and it is expected there.
To use this tool, you need to have the compiler's dll's installed
on your system. You should install the htmlhelp workshop from
microsoft for these. Otherwise you should get these dll's from
someone who has them. I think there's only one or two.
=head1 USAGE
=head2 Building HtmlHelp
Building HtmlHelp for main perl is done using the script
makehelp.pl. It requires no command line arguments because it
gets all its information from Config.pm.
Individual files are created as follows:
=over4
=item file2hhelp.pl for .html to .chm
=item dir2hhelp.pl for dir of .html to .chm
=item tree2hhelp.pl for tree of .html to .chm(s)
=item Pod2hhelp.pl for .Pod or .pm to .chm
=item Podd2hhelp.pl for dir of .Pod or .pm to .chm
=item Podt2hhelp.pl for tree of .Pod or .pm to .chm(s)
=back
If your forget the command line arguments for one of the
above, type:
perl <scriptfile>
and it will tell you what command line arguments are needed.
=head2 Building HTML
Building HTML for main perl is doine using the script
makehtml.pl. It requires no command line arguemtns because it
gets all its information from Config.pm.
Individual html files can be built using the normal pod2html
script by Tom Christiansen. Building html from directories
and trees is not otherwise supported.
=head1 AUTHOR
David (pete) Grove
email: pete@ActiveState.com
=head1 FIRM
ActiveState Tool Corp.
Professional Tools for Perl Programmers
=cut
#####################################################################
package HtmlHelp;
#####################################################################
use Pod::WinHtml; # My hack of TC's Pod::Html
use Config;
use File::Copy;
use File::Basename;
use File::Path;
#####################################################################
# Variables
my $CLEANUP = 1;
my $MAKE_HTML_FOR_HHELP = 0;
my $FULLTEXTSEARCH = 1;
my $LIB = $Config{'privlib'};
$LIB =~ s{\\}{/}g;
my $SITELIB = $Config{'sitelib'};
my $HTMLHELP = $LIB; $HTMLHELP =~ s{(\\|/)lib}{/HtmlHelp}i;
my $COMPILER = "$LIB/HtmlHelp/hhc.exe";
my $HTML = $LIB; $HTML =~ s{(\\|/)lib}{/Html}i;
my $TEMP = "$HTMLHELP/Temp";
my $MERGE_PACKAGES = 0;
#####################################################################
# Function PreDeclarations
sub RunCompiler;
sub MakeHelpFromPod;
sub MakeHelpFromPodDir;
sub MakeHelpFromDir;
sub MakePerlHtml;
sub MakePerlHtmlIndexCaller;
sub MakePerlHtmlIndex;
sub GetHtmlFilesFromTree;
sub MakePerlHelp;
sub MakePerlHelpMain;
sub MakeHelpFromPodTree;
sub MakeHtmlTree;
sub MakeHelpFromTree;
sub GetHtmlFileTreeList;
sub MakeHelpFromHash;
sub MakeModuleTreeHelp;
sub MakeHelp;
sub BackSlash;
sub ExtractFileName;
sub ExtractFilePath;
sub MakePackageMainFromSingleDir;
sub MakePackageMain;
sub MakePackages;
sub CopyDirStructure;
sub GetFileListForPackage;
sub CreateHHP;
sub CreateHHC;
sub CreateHHCFromHash;
sub InsertMainToc_Temporary;
#####################################################################
# FUNCTION RunCompiler
# RECEIVES Project file to compile
# RETURNS None
# SETS None
# EXPECTS $COMPILER, hhc and hhp files should be there
# PURPOSE Runs the HtmlHelp compiler to create a chm file
sub RunCompiler {
my $projfile = BackSlash(shift);
my $compiler = BackSlash($COMPILER);
print "Trying \"$compiler $projfile\"\n";
qx($compiler $projfile);
}
#####################################################################
# FUNCTION MakeHelpFromPod
# RECEIVES Helpfile (no path), Working directory, Output
# directory (path for chm file), Files to include
# RETURNS Results from running MakeHelp
# SETS None
# EXPECTS None
# PURPOSE Takes pod/pm files, turns them into html, and then
# into Htmlhelp files.
sub MakeHelpFromPod {
my ($helpfile, $workdir, $outdir, @podfiles) = @_;
my $htmlfiles;
my $htmlfile;
my $podfile;
foreach $podfile (@podfiles) {
$podfile =~ s{\\}{/}g;
$htmlfile = $podfile;
$htmlfile =~ s{(^/]*)\....?$}{$1\.html};
push(@htmlfiles, $htmlfile);
pod2html("--infile=$podfile", "--outfile=$htmlfile");
}
@htmlfiles = grep{-e $_} @htmlfiles;
unless(@htmlfiles) {
$! = "No html files were created";
return 0;
}
return MakeHelp($helpfile, $workdir, $outdir, @htmlfiles);
}
#####################################################################
# FUNCTION MakeHelpFromPodDir
# RECEIVES Helpfile (no extension), Working directory, Output
# directory (for the Helpfile), Directory to translate
# RETURNS 1|0
# SETS None
# EXPECTS None
# PURPOSE Takes a directory's worth of pod/pm files and turns
# them into html and then a single chm file
sub MakeHelpFromPodDir {
my ($helpfile, $workdir, $outdir, $fromdir) = @_;
my @podfiles;
my $htmlfile;
my @htmlfiles;
if(opendir(DIR,$fromdir)) {
@podfiles = grep {/(\.pod)|(\.pm)/i} readdir(DIR);
if(@podfiles) {
foreach $podfile (@podfiles) {
$htmlfile = $podfile;
$htmlfile =~ s{(\.pm)|(\.pod)$}{\.html}i;
$htmlfile = "$workdir/$htmlfile";
push(@htmlfiles, $htmlfile);
pod2html("--infile=$fromdir/$podfile", "--outfile=$htmlfile");
}
@htmlfiles = grep {-e $_} @htmlfiles;
MakeHelp($helpfile, $workdir, $outdir, @htmlfiles);
} else {
$! = "No files to be made from $fromdir";
return 0;
}
} else {
$! = "Could not open directory $fromdir";
return 0;
}
unlink @htmlfiles if $CLEANUP;
1;
}
#####################################################################
# FUNCTION MakeHelpFromDir
# RECEIVES Helpfile (no extension), Working directory, Output
# directory (for Helpfile), Dir of html files for input
# RETURNS 1|0
# SETS None
# EXPECTS None
# PURPOSE Takes a directory's worth of html files and binds
# them all into a chm file
sub MakeHelpFromDir {
my ($helpfile, $workdir, $outdir, $fromdir) = @_;
my @files;
if(opendir(DIR,$fromdir)) {
@files = map {"$fromdir/$_"} sort(grep {/\.html?/i} readdir(DIR));
closedir(DIR);
if(@files) {
MakeHelp($helpfile, $workdir, $outdir, @files);
} else {
$! = "No files to be made from $fromdir";
return 0;
}
} else {
$! = "Could not open directory $fromdir";
return 0;
}
1;
}
#####################################################################
# FUNCTION MakePerlHtml
# RECEIVES None
# RETURNS None
# SETS None
# EXPECTS $HTML, $LIB, $SITELIB
# PURPOSE Creates html files from pod for the entire perl
# system, and creates the main toc file.
sub MakePerlHtml {
MakeHtmlTree($LIB, "$HTML/lib", 1);
MakeHtmlTree($SITELIB, "$HTML/lib/site", 2);
MakePerlHtmlIndex("$HTML/lib", "$HTML/perltoc.html");
}
#####################################################################
# FUNCTION MakePerlHtmlIndexCaller
# RECEIVES None
# RETURNS None
# SETS None
# EXPECTS $HTML
# PURPOSE Caller for MakePerlHtmlIndex. Using this function
# releases the caller from the responsibility of
# feeding params to MakePerlHtmlIndex, which this
# library gets automagically from Config.pm
sub MakePerlHtmlIndexCaller {
#
# Changed this to reflect the "single index file" idea
#
return MakePerlHtmlIndex("$HTML/lib", "$HTML/perltoc.html");
#return MakePerlHtmlIndex("$HTML/lib", "$HTML/maintoc.html");
}
#####################################################################
# FUNCTION MakePerlHtmlIndex
# RECEIVES Base directory to look in, $index file to create
# RETURNS 1 | 0
# SETS None
# EXPECTS None
# PURPOSE Creates the main html index for the perl system. This
# is called by ppm after installing a package.
sub MakePerlHtmlIndex {
my ($basedir, $indexfile) = @_;
my %files;
my $file;
my $file_cmp;
my $dir;
my $dir_cmp;
my $dir_to_print;
my $dir_html_root;
my $counter;
my $file_to_print;
my $sitedir;
my $libdir;
my $temp;
# Get a list of all the files in the tree, list refs keyed by dir.
# These files are under c:/perl/html/lib because they have
# already been generated.
# normalize to forward slashes (NEVER use backslashes in URLs!)
$basedir =~ s{\\}{/}g;
unless(%files = GetHtmlFilesFromTree($basedir)) {
return 0;
}
# Start the html document
unless(open(HTML, ">$indexfile")) {
$! = "Couldn't write to $indexfile\n";
return 0;
}
print HTML <<'EOT';
<HTML>
<HEAD>
<TITLE>Perl Help System Index</TITLE>
<BASE TARGET="PerlDoc">
</HEAD>
<LINK REL="STYLESHEET" HREF="win32prk.css" TYPE="text/css">
<STYLE>
BODY {font-size : 8.5pt;}
P {font-size : 8.5pt;}
</STYLE>
<BODY>
EOT
foreach $dir (keys %files) {
foreach $file (@{$files{$dir}}) {
$file_cmp = $file;
$file_cmp =~ s/\.html?$//i;
if(exists $files{"$dir/$file_cmp"}) {
push(@{$files{"$dir/$file_cmp"}}, "$file_cmp/$file");
@{$files{$dir}} = grep {$_ ne $file} @{$files{$dir}};
}
}
}
# Merge the different directories if duplicate directories
# exist for lib and site. Effectively this removes lib/site
# from existence, and prepends "site" onto the file name for
# future reference. This way there is only one folder per
# heading, but I can still tell when to use "site" in
# making a html link.
$libdir = "$HTML/lib";
$sitedir = "$HTML/lib/site";
push(@{$files{$libdir}}, map {"site/$_"} @{$files{$sitedir}});
delete $files{$sitedir};
foreach $dir (keys %files) {
if($dir =~ m{/site/}i) {
$dir_cmp = $dir;
$dir_cmp =~ s{(/lib/)site/}{$1}i;
push(@{$files{$dir_cmp}}, map {"site/$_"} @{$files{$dir}});
delete $files{$dir};
}
}
InsertMainToc_Temporary();
print HTML <<EOT;
<img id="Foldergif_63" src="folder.gif">
<b><a name="CorePerlFAQ">Core Perl FAQ</a><BR>
</b>
EOT
foreach $file (@{$files{"$libdir/Pod"}}) {
$file_to_print = $file;
$file_to_print =~ s{\.html$}{}i;
next unless $file_to_print =~ m{^(perlfaq\d*)$};
print HTML <<EOT;
<img id="Pagegif_63" src="page.gif">
<a href="./lib/Pod/$file_to_print.html">
$file_to_print
</a><BR>
EOT
}
print HTML <<EOT;
<img id="Foldergif_63" src="folder.gif">
<b><a name="CorePerlDocs">Core Perl Docs</a><BR>
</b>
EOT
foreach $file (@{$files{"$libdir/Pod"}}) {
$file_to_print = $file;
$file_to_print =~ s{\.html$}{}i;
next unless $file_to_print =~ m{^(perl[a-z0-9]*)$};
next if $file_to_print =~ /^perlfaq/;
print HTML <<EOT;
<img id="Pagegif_63" src="page.gif">
<a href="./lib/Pod/$file_to_print.html">
$file_to_print
</a><BR>
EOT
}
print HTML <<EOT;
</p><hr>
<h4><a name="ModuleDocs">Module Docs</a></h4>
<p>
EOT
foreach $dir (sort { uc($a) cmp uc($b) } keys(%files)) {
$counter++;
$dir_to_print = $dir;
# get just the directory starting with lib/
$dir_to_print =~ s{.*/(lib/?.*$)}{$1}i;
# change slashes to double colons
$dir_to_print =~ s{/}{::}g;
# kill extra stuff lib and site
$dir_to_print =~ s{lib::}{}i;
# Don't want to see lib:: and lib::site::
$dir_to_print =~ s{(.*)(/|::)$}{$1};
if($dir_to_print =~ m{^lib(/site)?$}i) {
$dir_to_print = 'Root Libraries';
}
print HTML <<EOT;
<!-- -------------------------------------------- $dir -->
<SPAN
id="Dir_${counter}"
>
<b>
<img id="Foldergif_${counter}" src="folder.gif">
$dir_to_print<BR>
</b></SPAN>
<SPAN
id="Files_${counter}"
>
EOT
if (@{$files{$dir}}) {
foreach $file (sort { $c = $a;
$d = $b;
$c =~ s{^site/}{}i;
$d =~ s{^site/}{}i;
uc($c) cmp uc($d) } (@{$files{$dir}}))
{
$file_to_print = $file;
$file_to_print =~ s{\.html?}{}i;
# skip perlfunc.pod etc.
next if $file_to_print =~ m{^perl[a-z0-9]*$};
$dir_html_root = $dir;
if ($file_to_print =~ m{^site/[^/]*$}i) {
$dir_html_root =~ s{(lib/)}{$1site/}i;
$dir_html_root =~ s{/lib$}{/lib/site}i;
$file_to_print =~ s{^site/}{}i;
$file =~ s{^site/}{}i;
}
elsif ($file_to_print =~ m{^site/(.*)/}i) {
$temp = $1;
# Get rid of the site
$dir_html_root =~ s{(lib/)}{$1site/}i;
$dir_html_root =~ s{/lib$}{/lib/site}i;
$file_to_print =~ s{^site/}{}i;
$file =~ s{^site/}{}i;
# Get rid of the additional directory
$file_to_print =~ s{^[^/]*/}{}i;
$file =~ s{^[^/]*/}{}i;
$dir_html_root =~ s{/$temp/?}{}i;
}
elsif ($file_to_print =~ m{^(.*)/}) {
$temp = $1;
# $file_to_print =~ s{^[^/]/?}{}i;
# $file =~ s{^[^/]/?}{}i;
$file_to_print =~ s{^.*?/}{}i;
$file =~ s{^.*?/}{}i;
$dir_html_root =~ s{/$temp/?}{}i;
}
$dir_html_root =~ s{.*/lib$}{lib}i;
$dir_html_root =~ s{.*/(lib/.*)}{$1}i;
$dir_html_root =~ s{lib/\.\./html/}{}i;
print HTML <<EOT;
<img id="Pagegif_${counter}" src="page.gif">
<a href="$dir_html_root/$file">
$file_to_print
</a><BR>
EOT
}
}
else {
print HTML " \n";
print HTML "No pod / html<BR>\n";
}
print HTML "</SPAN>\n";
}
print HTML "</p>\n";
# Close the file
print HTML "</BODY>\n";
print HTML "</HTML>\n";
close HTML;
return 1;
}
#####################################################################
# FUNCTION InsertMainToc_Temporary
# RECEIVES None
# RETURNS None
# SETS None
# EXPECTS HTML must be an open file handls
# PURPOSE Temporary (interim) function to hard code the content
# of the main toc into a single, merged toc
sub InsertMainToc_Temporary {
print HTML <<'END_OF_MAIN_TOC';
<p><a href="http://www.ActiveState.com"><img src="aslogo.gif" border="0"></a></p>
<p><img src="pinkbullet.gif" width="10" height="10"> <a href="#ActivePerlDocs" target="TOC"><b>ActivePerl Docs</b></a><br>
<img src="pinkbullet.gif" width="10" height="10"> <a href="#GettingStarted" target="TOC"><b>Getting
Started</b></a><b><br>
<img src="pinkbullet.gif" width="10" height="10"> <a href="#ActivePerlComponents" target="TOC">ActivePerl
Components</a><br>
<img src="pinkbullet.gif" width="10" height="10"> <a href="#ActivePerlFAQ" target="TOC">ActivePerl
FAQ</a><br>
<img src="pinkbullet.gif" width="10" height="10"> <a href="#CorePerlFAQ" target="TOC">Core
Perl FAQ</a><br>
<img src="pinkbullet.gif" width="10" height="10"> <a href="#CorePerlDocs" target="TOC">Core
Perl Docs</a><br>
<img src="pinkbullet.gif" width="10" height="10"> <a href="#ModuleDocs" target="TOC">Module
Docs</a></b></p>
<hr>
<h4><a name="ActivePerlDocs">ActivePerl Docs</a></h4>
<p><b><img id="Foldergif_60" src="folder.gif"> <a name="GettingStarted">Getting
Started</a></b><BR>
<img id="Pagegif_60" src="page.gif"> <a href="perlmain.html">
Welcome</a><BR>
<img id="Pagegif_60" src="page.gif"> <a href="./Perl-Win32/release.htm">
Release Notes </a><BR>
<img id="Pagegif_60" src="page.gif"> <a href="./Perl-Win32/install.htm">
Install Notes </a><BR>
<img id="Pagegif_60" src="page.gif"> <a href="./Perl-Win32/readme.htm">
Readme<br>
</a> <img id="Pagegif_60" src="page.gif"> <a href="./Perl-Win32/dirstructure.html">
Dir Structure</a><br>
<b> <img id="Foldergif_61" src="folder.gif" alt="Instructions and sample scripts for using PerlScript">
<a name="ActivePerlComponents">ActivePerl Components</a><BR>
</b>
<img id="Pagegif_61" src="page.gif"> <a href="./Perl-Win32/description.html">
Overview</a><BR>
<img id="Pagegif_61" src="page.gif"> <a href="PerlScript.html">
Using PerlScript </a><BR>
<img id="Pagegif_61" src="page.gif"> <a href="../eg/ie3examples/index.htm">
PerlScript Examples </a><BR>
<b> </b> <img id="Pagegif_68" src="page.gif"> <a href="PerlISAPI.html">
Using Perl for ISAPI </a><BR>
<img id="Pagegif_68" src="page.gif"> <a href="./Perl-Win32/perlwin32faq2.html">
Perl for ISAPI FAQ </a><BR>
<b> </b> <img id="Pagegif_69" src="page.gif"> <a href="./Perl-Win32/perlwin32faq11.html">
Using PPM</a><br>
<img id="Pagegif_68" src="page.gif"> <a href="./lib/site/Pod/PerlEz.html">
PerlEZ</a><BR>
<b><img id="Foldergif_62" src="folder.gif" alt="FAQ for using Perl on Win95/NT">
<a name="ActivePerlFAQ">ActivePerl FAQ</a><BR>
</b> <img id="Pagegif_62" src="page.gif"> <a href="./Perl-Win32/perlwin32faq.html">
Introduction </a><BR>
<img id="Pagegif_62" src="page.gif"> <a href="./Perl-Win32/perlwin32faq1.html">
Availability & Install </a><BR>
<img id="Pagegif_62" src="page.gif"> <a href="./Perl-Win32/perlwin32faq2.html">
Perl for ISAPI</a><BR>
<img id="Pagegif_62" src="page.gif"> <a href="./Perl-Win32/perlwin32faq3.html">
Docs & Support </a><BR>
<img id="Pagegif_62" src="page.gif"> <a href="./Perl-Win32/perlwin32faq4.html">
Windows 95/NT </a><BR>
<img id="Pagegif_62" src="page.gif"> <a href="./Perl-Win32/perlwin32faq5.html">
Quirks </a><BR>
<img id="Pagegif_62" src="page.gif"> <a href="./Perl-Win32/perlwin32faq6.html">
Web Server Config</a><BR>
<img id="Pagegif_62" src="page.gif"> <a href="./Perl-Win32/perlwin32faq7.html">
Web programming </a><BR>
<img id="Pagegif_62" src="page.gif"> <a href="./Perl-Win32/perlwin32faq8.html">
Programming </a><BR>
<img id="Pagegif_62" src="page.gif"> <a href="./Perl-Win32/perlwin32faq9.html">
Modules & Samples</a><BR>
<img id="Pagegif_62" src="page.gif"> <a href="./Perl-Win32/perlwin32faq10.html">
Embedding & Extending</a><BR>
<img id="Pagegif_62" src="page.gif"> <a href="./Perl-Win32/perlwin32faq11.html">
Using PPM</a><BR>
<img id="Pagegif_62" src="page.gif"> <a href="./Perl-Win32/perlwin32faq12.html">
Using OLE with Perl</a><BR>
END_OF_MAIN_TOC
}
#####################################################################
# FUNCTION GetHtmlFilesFromTree (recursive)
# RECEIVES Base directory to look in
# RETURNS List of html files
# SETS None
# EXPECTS None
# PURPOSE Searches an entire for html files, returns a list of
# html files found including path information
sub GetHtmlFilesFromTree {
my $basedir = shift;
my @dirs;
my @htmlfiles;
my %ret;
unless(opendir(DIR, $basedir)) {
$! = "Can't read from directory $basedir\n";
return 0;
}
@files = readdir(DIR);
closedir(DIR);
@dirs = grep {-d "$basedir/$_" and /[^.]$/} @files;
@htmlfiles = grep {/\.html?$/i} @files;
foreach $dir (@dirs) {
unless(%ret = (%ret, GetHtmlFilesFromTree("$basedir/$dir"))) {
return 0;
}
}
%ret = (%ret, $basedir => \@htmlfiles);
}
#####################################################################
# FUNCTION MakePerlHelp
# RECEIVES None
# RETURNS 1 | 0
# SETS None
# EXPECTS None
# PURPOSE Creates html help for the perl system. This is the
# html help core build. If MAKE_HTML_FOR_HHELP is set
# to a true vale, then it builds the help from POD,
# otherwise it depends on the pod being there already.
sub MakePerlHelp {
if($MAKE_HTML_FOR_HHELP) {
unless(MakeHelpFromPodTree($HTMLHELP, $HTMLHELP, $LIB, "$HTML/lib")) {
return 0;
}
unless(MakeHelpFromPodTree($HTMLHELP, $HTMLHELP, $SITELIB,
"$HTML/lib/site")) {
return 0;
}
} else {
unless(MakeHelpFromTree($HTMLHELP, $HTMLHELP, "$HTML/lib")) {
return 0;
}
}
unless(MakePerlHelpMain) {
return 0;
}
# This handles MakePerlHtml too, since we've created all the html
unless(MakePerlHtmlIndex("$HTML/lib", "$HTML/perltoc.html")) {
return 0;
}
return 1;
}
#####################################################################
# FUNCTION MakePerlHelpMain;
# RECEIVES None
# RETURNS None
# SETS None
# EXPECTS None
# PURPOSE Creates the main perl helpfile from all the little
# helpfiles already created.
sub MakePerlHelpMain {
my @files;
print "Generating main library helpfile\n";
unless(opendir(DIR, $HTMLHELP)) {
$! = "Directory $HTMLHELP could not be read\n";
return 0;
}
unless(-e "$HTMLHELP/default.htm") {
copy("$HTML/libmain.html", "$HTMLHELP/default.htm");
}
@files = grep {/\.hhc/i} readdir(DIR);
closedir(DIR);
$CLEANUP=0;
$MERGE_PACKAGES = 1;
MakeHelp("libmain.chm", $HTMLHELP, $HTMLHELP, @files);
$CLEANUP = 1;
$MERGE_PACKAGES = 0;
return 1;
}
#####################################################################
# FUNCTION MakeHelpFromPodTree
# RECEIVES Working directory, Output directory, Source Diretory,
# HtmlOutput Directory
# RETURNS 0 | 1
# SETS None
# EXPECTS None
# PURPOSE Takes a tree's worth of pod and turns them first
# into html and then into htmlhelp.
sub MakeHelpFromPodTree {
my ($workdir, $outdir, $fromdir, $htmldir) = @_;
unless(MakeHtmlTree($fromdir, $htmldir)) {
return 0;
}
unless(MakeHelpFromTree($workdir, $outdir, $htmldir)) {
return 0;
}
# if(opendir(DIR, $outdir)) {
# unlink(map {"$outdir/$_"} grep {/\.hhp/i} readdir(DIR));
# closedir(DIR);
# } else {
# warn "Could not clean up project files in $outdir\n";
# }
return 1;
}
#####################################################################
# FUNCTION MakeHtmlTree
# RECEIVES Source Directory, Html Output Directory
# RETURNS 0 | 1
# SETS None
# EXPECTS None
# PURPOSE Makes a tree's worth of html from a tree's worth
# of pod.
sub MakeHtmlTree {
my ($fromdir, $htmldir, $depth) = @_;
my @files;
my @podfiles;
my @dirs;
my $podfile;
my $htmlfile;
my $dir;
my $css = '../' x$depth . 'win32prk.css';
# Get list of files and directories to process
$fromdir =~ s{\\}{/}g;
if(!-d $fromdir) {
$! = "Directory $fromdir does not exist\n";
return 0;
}
unless(opendir(DIR, $fromdir)) {
$! = "Directory $fromdir couldn't be read\n";
return 0;
}
@files = readdir(DIR);
closedir(DIR);
@podfiles = map {"$fromdir/$_"} grep {/\.pod$|\.pm$/i} @files;
@dirs = grep {-d "$fromdir/$_" and /[^.]$/} @files;
if(@podfiles) {
# Create the copy directory
if(!-d $htmldir) {
unless(mkpath($htmldir)) {
$! = "Directory $htmldir could not be created\n";
return 0;
}
}
foreach $podfile (@podfiles) {
$htmlfile = $podfile;
$htmlfile =~ s{.*/(.*)}{$1};
$htmlfile =~ s{\.pod|\.pm$}{.html}i;
$htmlfile = "$htmldir/$htmlfile";
unlink($htmlfile) if (-e $htmlfile);
pod2html("--infile=$podfile", "--outfile=$htmlfile", "--css=$css");
}
}
++$depth;
foreach $dir (@dirs) {
MakeHtmlTree("$fromdir/$dir", "$htmldir/$dir", $depth);
}
return 1;
}
#####################################################################
# FUNCTION MakeHelpFromTree
# RECEIVES Working directory, Output directory, Source directory
# RETURNS 0 | 1
# SETS None
# EXPECTS None
# PURPOSE Creates html help from a tree's worth of html
sub MakeHelpFromTree {
my ($workdir, $outdir, $fromdir) = @_;
my %files;
my $file;
my $key;
my $file_root;
$fromdir =~ s{\\}{/}g;
unless(%files = GetHtmlFileTreeList($fromdir, $fromdir)) {
return 0;
}
$file_root = $fromdir;
$file_root =~ s{(.*)/$}{$1};
foreach $key (sort(keys(%files))) {
$file = $key;
$file = substr($key, length($file_root));
$file =~ s{^/}{};
$file =~ s{/}{-}g;
$file =~ s{ }{}g;
if($file eq "") {
if($file_root =~ /lib$/i) {
$file = "lib";
} else {
$file = "lib-site";
}
} elsif ($file_root =~ /lib$/i) {
$file = "lib-" . $file;
} elsif ($file_root =~ /site$/i) {
$file = "lib-site-" . $file;
}
$file .= ".chm";
unless(MakeHelp("$file", $workdir, $outdir, map {"$key/$_"} @{$files{$key}})) {
return 0;
}
}
return 1;
}
#####################################################################
# FUNCTION GetHtmlFileTreeList (recursive)
# RECEIVES Original root (from first call), Root (successive)
# RETURNS Hash of files
# SETS None
# EXPECTS None
# PURPOSE Get a list of html files throughout a tree
sub GetHtmlFileTreeList {
my $origroot = shift;
my $root = shift;
my @files;
my @htmlfiles;
my @dirs;
my $dir;
my %ret;
$origroot =~ s{\\}{/}g;
$root =~ s{\\}{/}g;
unless(opendir(DIR, $root)) {
$! = "Can't open directory $root\n";
return undef;
}
@files = readdir(DIR);
@dirs = grep {-d "$root/$_" and /[^.]$/} @files;
@htmlfiles = grep {/\.html?/i} @files;
closedir(DIR);
%ret = ($root => \@htmlfiles) if @htmlfiles;
foreach $dir (@dirs) {
unless(%ret = (%ret, GetHtmlFileTreeList($origroot, "$root/$dir"))) {
return undef;
}
}
return %ret;
}
#####################################################################
# FUNCTION MakeHelpFromHash
# RECEIVES Helpfile name, working directory, output directory,
# and a hash containing the html files to process and
# their titles
# RETURNS 0 | 1
# SETS None
# EXPECTS None
# PURPOSE Create a helpfile from a hash rather than from a
# simple list of html files, to have better control
# over the file titles. This function is unused and
# may take some work to get it to work right.
sub MakeHelpFromHash {
my ($helpfile, $workdir, $outdir, %htmlfiles) = @_;
my $tocfile;
my $projfile;
die("MakeHelpFromHash() is not completely implemented\n");
$tocfile = $helpfile;
$tocfile =~ s/\.chm/.hhc/i;
$tocfile = "$workdir/$tocfile";
$projfile = $helpfile;
$projfile =~ s/\.chm/.hhp/i;
$projfile = "$workdir/$projfile";
$helpfile = "$outdir/$helpfile";
unless(CreateHHP($helpfile, $projfile, $tocfile, keys(%htmlfiles))) {
return 0;
}
unless(CreateHHCFromHash($helpfile, $tocfile, %htmlfiles)) {
return 0;
}
RunCompiler($helpfile);
1;
}
#####################################################################
# FUNCTION MakeModuleTreeHelp
# RECEIVES Directory to start from, regex mask for that dir
# RETURNS 1 | 0
# SETS None
# EXPECTS The directories to be right
# PURPOSE Create help from a tree of pod files for packages
sub MakeModuleTreeHelp {
my ($fromdir, $mask) = @_;
my @files;
my @htmlfiles;
my @podfiles;
my @dirs;
my $helpfile;
my $podfile;
my $htmlfile;
my $dir;
$fromdir =~ s{\\}{/}g;
print "Creating help files for $fromdir\n";
# Create the html for the directory
unless(opendir(DIR, $fromdir)) {
$! = "Can't read from directory $fromdir";
return 0;
}
@files = readdir(DIR);
closedir(DIR);
@podfiles = map {"$fromdir/$_"} grep {/\.pm/i or /\.pod/i} @files;
foreach $podfile (@podfiles) {
$htmlfile = $podfile;
$htmlfile =~ s/\.(pm|pod)$/.html/i;
pod2html("--infile=$podfile", "--outfile=$htmlfile");
}
# Create the htmlhelp for the directory
$CLEANUP = 0;
@htmlfiles = map {"$fromdir/$_"} grep {/\.html?/i} @files;
if(@htmlfiles) {
$helpfile = $fromdir;
$helpfile =~ s{$mask}{}i;
$helpfile =~ s{/}{-}g;
$helpfile .= ".chm";
MakeHelp($helpfile, $fromdir, $fromdir, @htmlfiles);
}
# Recurse
@dirs = map {"$fromdir/$_"} grep {-d and /[^.]$/} @files;
foreach $dir (@dirs) {
unless(CreateModuleTreeHelp("$fromdir/$dir")) {
return 0;
}
}
return 1;
}
#####################################################################
# FUNCTION MakeHelp
# RECEIVES Helpfile (without drive and path), Working Directory,
# Output Directory, and a list of files to include
# in the helpfile
# RETURNS None
# SETS None
# EXPECTS None
# PURPOSE Create help from a list of html files. Everything in
# this library comes through here eventually.
sub MakeHelp {
my ($helpfile, $workdir, $outdir, @htmlfiles) = @_;
my $longtocfile;
my $longprojfile;
my $longhelpfile;
my $longouthelpfile;
my $longouttocfile;
my $libdir;
my $tocfile;
my $projfile;
$libdir = ExtractFilePath($htmlfiles[0]);
$tocfile = $helpfile;
$tocfile =~ s/\.chm/.hhc/i;
if ($libdir ne "") {
$longtocfile = "$libdir/$tocfile";
}
else {
$longtocfile = "$outdir/$tocfile";
}
$longouttocfile = "$outdir/$tocfile";
$projfile = $helpfile;
$projfile =~ s/\.chm/.hhp/i;
if ($libdir ne "") {
$longprojfile = "$libdir/$projfile";
}
else {
$longprojfile = "$outdir/$projfile";
}
if ($libdir ne "") {
$longhelpfile = "$libdir/$helpfile";
}
else {
$longhelpfile = "$outdir/$helpfile";
}
$longouthelpfile = "$outdir/$helpfile";
print "----- CREATING HELP FILE $longouthelpfile -----\n";
# put in the default document
if ($libdir eq "") {
unshift(@htmlfiles, "$HTMLHELP/default.htm");
}
unless(CreateHHP($longhelpfile, $longprojfile, $longtocfile, @htmlfiles)) {
return 0;
}
unless(CreateHHC($longhelpfile, $longtocfile, @htmlfiles)) {
return 0;
}
return 0 if (!-x $COMPILER);
RunCompiler($longhelpfile);
if($libdir ne "") {
if($longhelpfile ne $longouthelpfile) {
copy($longhelpfile, $longouthelpfile);
copy($longtocfile, $longouttocfile);
}
}
# temporary for when i want to see what it's doing
# $CLEANUP = 0;
if($CLEANUP) {
unlink $longhelpfile, $longtocfile, $longprojfile;
}
1;
}
#####################################################################
# FUNCTION BackSlash
# RECEIVES string containing a path to convert
# RETURNS converted string
# SETS none
# EXPECTS none
# PURPOSE Internally, perl works better if we're using a
# front slash in paths, so I don't care what I'm
# using. But externally we need to keep everything as
# backslashes. This function does that conversion.
sub BackSlash {
my $in = shift;
$in =~ s{/}{\\}g;
return $in;
}
#####################################################################
# FUNCTION ExtractFileName
# RECEIVES FileName with (drive and) path
# RETURNS FileName portion of the file name
# SETS None
# EXPECTS None
# PURPOSE Gives the file name (anything after the last slash)
# from a given file and path
sub ExtractFileName {
my $in = shift;
$in =~ s/.*(\\|\/)(.*)/$2/;
$in;
}
#####################################################################
# FUNCTION ExtractFilePath
# RECEIVES Full file and path name
# RETURNS Path without the file name (no trailing slash)
# SETS None
# EXPECTS None
# PURPOSE Returns the path portion of a path/file combination,
# not including the last slash.
sub ExtractFilePath {
my $in = shift;
if($in =~ /\\|\//) {
$in =~ s/(.*)(\\|\/)(.*)/$1/;
} else {
$in = "";
}
$in;
}
#####################################################################
# FUNCTION MakePackageMainFromSingleDir
# RECEIVES Package helpfile directory, helpfile to create
# RETURNS 1 | 0
# SETS None
# EXPECTS None
# PURPOSE Creates the package helpfile from the directory of
# package helpfiles. Creates the master.
sub MakePackageMainFromSingleDir {
my $package_helpfile_dir = shift;
my $helpfile = shift;
my $helpfile_dir;
my @hhcfiles;
$helpfile_dir = ExtractFilePath($helpfile);
$helpfile = ExtractFileName($helpfile);
unless(opendir(DIR, $package_helpfile_dir)) {
$! = "Couldn't read from package directory $package_helpfile_dir";
return 0;
}
@hhcfiles = grep {/\.hhc$/i} readdir(DIR);
closedir(DIR);
$CLEANUP = 0;
unless(MakeHelp($helpfile, $helpfile_dir, $helpfile_dir, @hhcfiles)) {
return 0;
}
1;
}
#####################################################################
# FUNCTION MakePackageMain
# RECEIVES Packages directory (contains packages which contain
# blib directories), helpfile name to create (include
# drive and path information)
# RETURNS 1 | 0
# SETS None
# EXPECTS None
# PURPOSE For the packages build of HtmlHelp, this function
# combines all the little packages into one chm
# file linked to all the little ones per module.
sub MakePackageMain {
my $package_root_dir = shift;
my $helpfile = shift;
my $helpfile_dir;
my @files;
my @dirs;
my @dir;
my @hhcfiles;
$helpfile_dir = ExtractFilePath($helpfile);
$helpfile = ExtractFileName($helpfile);
unless(opendir(DIR, $package_root_dir)) {
$! = "Couldn't read from package directory $package_root_dir";
return 0;
}
@files = readdir(DIR);
closedir(DIR);
@dirs = map {"$package_root_dir/$_"} grep {-d "$package_root_dir/$_" and /[^.]/} @files;
foreach $dir (@dirs) {
if(opendir(DIR, "$dir/blib/HtmlHelp")) {
@files = readdir(DIR);
closedir(DIR);
@hhcfiles = (@hhcfiles, grep {/\.hhc$/i} @files);
} else {
warn "Couldn't read / didn't add $dir/blib/HtmlHelp";
}
}
$CLEANUP = 0;
unless(MakeHelp($helpfile, $helpfile_dir, $helpfile_dir, @hhcfiles)) {
return 0;
}
1;
}
#####################################################################
# FUNCTION MakePackages
# RECEIVES Name of directory containing the package dirs, which
# package directories in turn contain blib dirs.
# RETURNS None
# SETS Creates Html and HtmlHelp within the package dirs
# EXPECTS None, but there should be some pm files in blib, but
# it ignores it if there isn't
# PURPOSE Creates Html and HtmlHelp within the package dirs. We
# decided that we don't want to build the packages at
# the same time as the main htmlhelp, so this was
# needed to build them (Murray) at a different time and
# merge them in.
sub MakePackages {
my $package_root_dir = shift;
my (@files) = @_;
my $package_root_dir_mask;
my @package_dirs;
my $package_dir;
my @file;
my @dirs;
my $package_file;
my $podfile;
my $htmlfile;
my @package_file_list;
my @helphtmlfiles;
my $htmlfilecopy;
my $helpfile;
$CLEANUP = 0;
$package_root_dir =~ s{\\}{/}g;
$package_root_dir_mask = $package_root_dir;
if (!defined @files) {
unless(opendir(DIR, $package_root_dir)) {
$! = "Directory could not be opened $package_root_dir";
return 0;
}
@files = readdir(DIR);
closedir(DIR);
}
@dirs = grep {-d "$package_root_dir/$_" and /[^.]$/} @files;
@package_dirs = map {"$package_root_dir/$_"} @dirs;
foreach $package_dir (@package_dirs) {
@helphtmlfiles = ();
next if (!-d "$package_dir/blib");
print "Making help for $package_dir\n";
# Make room for the stuff
unless(-d "$package_dir/blib/HtmlHelp") {
unless(mkpath("$package_dir/blib/HtmlHelp")) {
$! = "Directory could not be created $package_dir/blib/HtmlHelp";
return 0;
}
}
unless(-d "$package_dir/blib/Html") {
unless(mkpath("$package_dir/blib/Html")) {
$! = "Directory could not be created $package_dir/blib/Html";
return 0;
}
}
unless(-d "$package_dir/blib/Html/lib") {
unless(mkpath("$package_dir/blib/Html/lib")) {
$! = "Directory could not be created $package_dir/blib/Html/lib";
return 0;
}
}
unless(-d "$package_dir/blib/Html/lib/site") {
unless(mkpath("$package_dir/blib/Html/lib/site")) {
$! = "Directory could not be created $package_dir/blib/Html/lib/site";
return 0;
}
}
# Make the structure under the html
unless(CopyDirStructure("$package_dir/blib/lib", "$package_dir/blib/Html/lib/site")) {
return 0;
}
# Get a list of all the files to be worked with
@package_file_list = GetFileListForPackage("$package_dir/blib/lib");
foreach $file (@package_file_list) {
print " ... found $file\n";
}
unless(@package_file_list) {
print " Nothing to do for this package\n";
next;
}
# Make the html
foreach $package_file (@package_file_list) {
unless(-d "$package_dir/blib/temp") {
unless(mkpath("$package_dir/blib/temp")) {
$! = "Directory could not be created $package_dir/blib/temp";
return 0;
}
}
$htmlfile = $package_file;
$htmlfile =~ s/\.(pm|pod)$/.html/i;
$htmlfile =~ s{/blib/lib/}{/blib/Html/lib/site/}i;
pod2html("--infile=$package_file", "--outfile=$htmlfile");
if (-e $htmlfile) {
unless(-d "$package_dir/blib/temp") {
unless(mkpath("$package_dir/blib/temp")) {
$! = "Directory could not be created $package_dir/blib/temp";
return 0;
}
}
$htmlfilecopy = $htmlfile;
$htmlfilecopy =~ s{.*/blib/html/}{}i;
$htmlfilecopy =~ s{/}{-}g;
copy($htmlfile, "$package_dir/blib/temp/$htmlfilecopy");
push(@helphtmlfiles, "$package_dir/blib/temp/$htmlfilecopy");
}
}
# Make the htmlhelp
$helpfile = basename($package_dir);
# $helpfile =~ s{$package_root_dir_mask/?}{};
$helpfile .= ".chm";
$helpfile = "pkg-" . $helpfile;
unless(MakeHelp($helpfile, "$package_dir/blib/temp",
"$package_dir/blib/temp", @helphtmlfiles))
{
return 0;
}
if (-e "$package_dir/blib/temp/$helpfile") {
copy("$package_dir/blib/temp/$helpfile",
"$package_dir/blib/HtmlHelp/$helpfile");
$hhcfile = $helpfile;
$hhcfile =~ s/\.chm$/.hhc/i;
if (-e "$package_dir/blib/temp/$hhcfile") {
copy("$package_dir/blib/temp/$hhcfile",
"$package_dir/blib/HtmlHelp/$hhcfile");
}
else {
warn("$package_dir/blib/temp/$hhcfile not found, "
."file will not be included");
}
}
else {
warn("No help file was generated for "
."$package_dir/blib/temp/$helpfile");
}
# Clean up the mess from making helpfiles, temp stuff and that
if (-d "$package_dir/blib/temp") {
if (opendir(DIR, "$package_dir/blib/temp")) {
unlink(map {"$package_dir/blib/temp/$_"}
grep {-f "$package_dir/blib/temp/$_"} readdir(DIR));
closedir(DIR);
unless (rmdir("$package_dir/blib/temp")) {
warn "Couldn't rmdir temp dir $package_dir/blib/temp\n";
}
}
else {
warn "Couldn't read/remove temp dir $package_dir/blib/temp\n";
}
}
}
1;
}
#####################################################################
# FUNCTION CopyDirStructure
# RECEIVES From Directory, To Directory
# RETURNS 1 | 0
# SETS None
# EXPECTS None
# PURPOSE Copies the structure of the dir tree at and below
# the Source Directory (fromdir) to the Target
# Directory (todir). This does not copy files, just
# the directory structure.
sub CopyDirStructure {
my ($fromdir, $todir) = @_;
my @files;
my @dirs;
my $dir;
unless(opendir(DIR, $fromdir)) {
$! = "Couldn't read from directory $fromdir";
return 0;
}
@files = readdir(DIR);
@dirs = grep {
-d "$fromdir/$_" and /[^.]$/ and $_ !~ /auto$/i
} @files;
closedir(DIR);
foreach $dir (@dirs) {
#
# I could make it so that it only creates the directory if
# it has pod in it, but what about directories below THAT
# if it DOES have pod in it. That would be skipped. May want
# to do some kind of lookahead. Cutting out the auto more
# or less cuts out the problem though, right?
#
unless(-e "$todir/$dir") {
unless(mkpath("$todir/$dir")) {
$! = "Directory could not be created $todir/$dir";
return 0;
}
}
unless(CopyDirStructure("$fromdir/$dir", "$todir/$dir")) {
return 0;
}
}
1;
}
#####################################################################
# FUNCTION GetFileListForPackage (recursive)
# RECEIVES Root directory
# RETURNS List of pod files contained in directories under root
# SETS None
# EXPECTS None
# PURPOSE For the packages build, this function searches a
# directory for pod files, and all directories through
# the tree beneath it. It returns the complete path
# and file name for all the pm or pod files it finds.
sub GetFileListForPackage {
my ($root) = @_;
my @podfiles;
my @dirs;
my $dir;
unless(opendir(DIR, $root)) {
$! = "Can't read from directory $root";
return undef;
}
@files = readdir(DIR);
closedir(DIR);
@podfiles = map {
"$root/$_"
} grep {
/\.pm/i or /\.pod/i
} @files;
@dirs = map {
"$root/$_"
} grep {
-d "$root/$_" and /[^.]$/ and $_ !~ /auto$/i
} @files;
foreach $dir (@dirs) {
@podfiles = (@podfiles, GetFileListForPackage("$dir"))
}
@podfiles;
}
#####################################################################
# FUNCTION CreateHHP
# RECEIVES help file name, project file name, toc file name,
# and a list of files to include
# RETURNS 1|0 for success
# SETS none
# EXPECTS none
# PURPOSE Creates the project file for the html help project.
sub CreateHHP {
my ($helpfile, $projfile, $tocfile, @files) = @_;
my $file;
my $chmfile;
my $first_html_file;
my ($shorthelpfile, $shortprojfile, $shorttocfile);
my ($shortfirstfile, $shortfile);
my @htmlfiles = grep {/\.html?$/i} @files;
my @hhcfiles = grep {/\.hhc$/i} @files;
$shorthelpfile = ExtractFileName($helpfile);
$shortprojfile = ExtractFileName($projfile);
$shorttocfile = ExtractFileName($tocfile);
$first_html_file = $htmlfiles[0];
unless(defined $first_html_file) {
warn "No default html file for $backhelp\n";
}
$shortfirstfile = ExtractFileName($first_html_file);
print "Creating $shortprojfile\n";
unless(open(HHP, ">$projfile")) {
$! = "Could not write project file";
return 0;
}
print HHP <<EOT;
[OPTIONS]
Compatibility=1.1
Compiled file=$shorthelpfile
Contents file=$shorttocfile
Display compile progress=Yes
EOT
if ($FULLTEXTSEARCH) {
print HHP "Full-text search=Yes\n";
}
print HHP <<EOT;
Language=0x409 English (United States)
Default topic=$shortfirstfile
[FILES]
EOT
foreach $file (@htmlfiles) {
$shortfile = ExtractFileName($file);
print HHP "$shortfile\n";
print " added $shortfile\n";
}
if(@hhcfiles) {
print HHP "\n";
print HHP "[MERGE FILES]\n";
foreach $file (@hhcfiles) {
$chmfile = $file;
$chmfile =~ s/\.hhc$/.chm/i;
$shortfile = ExtractFileName($chmfile);
print HHP "$shortfile\n";
print " added $shortfile\n";
}
if($MERGE_PACKAGES) {
print HHP "packages.chm\n";
print " ---> MERGED PACKAGES.CHM\n";
}
}
close(HHP);
return 1;
}
#####################################################################
# FUNCTION CreateHHC
# RECEIVES Helpfile name, TOC file name (HHC), list of files
# RETURNS 0 | 1
# SETS None
# EXPECTS None
# PURPOSE Creates the HHC (Table of Contents) file for the
# htmlhelp file to be created.
# NOTE This function is used (and abused) for every piece
# of the htmlhelp puzzle, so any change for one thing
# can break something totally unrelated. Be careful.
# This was the result of rapidly changing spex. In
# general, it's used for:
# @ Creating helpfiles from pod/pm
# @ Creating helpfiles from html
# @ Creating helpfiles from chm's and hhc's
# @ Creating child helpfiles from modules
# @ Creating main helpfiles
# @ Creating helpfile for core build
# @ Creating main for core build
# @ Creating package helpfiles for packages build
# @ Creating package main for package build
# @ General Htmlhelp file building other than AS
sub CreateHHC {
my ($helpfile, $tocfile, @files) = @_;
my $file;
my $title;
my $shorttoc;
my $shorthelp;
my $shortfile;
my $backfile;
my @libhhcs;
my @sitehhcs;
my @otherhhcs;
$helpfile =~ s{\\}{/}g;
$tocfile =~ s{\\}{/}g;
$shorttoc = ExtractFileName($tocfile);
$shorthelp = ExtractFileName($helpfile);
print "Creating $shorttoc\n";
unless(open(HHC, ">$tocfile")) {
$! = "Could not write contents file";
return 0;
}
print HHC <<'EOT';
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<HTML>
<HEAD>
<!-- Sitemap 1.0 -->
</HEAD>
<BODY>
<OBJECT type="text/site properties">
<param name="ImageType" value="Folder">
</OBJECT>
<UL>
EOT
foreach $file (grep {/\.html?$/i} @files) {
# don't want default.htm in the toc file
next if $file =~ /default\.html?$/i;
$file =~ s{\\}{/}g;
$title = $file;
$title =~ s{\.html$}{}i;
$title =~ s{.*/(.*)}{$1};
# Section added for packages build
# Note: this is an abuse of regexes but needed for all cases
$title =~ s/^pkg-//i;
# $title =~ s{(.*lib)$}{$1/}i;
$title =~ s{^lib-site-}{lib/site/}i;
$title =~ s{^lib-}{lib/}i;
$title =~ s{^site}{site/}i;
$title =~ s{^site-}{site/}i;
# $title =~ s{([^2])-([^x])}{${1}::${2}}ig;
$title =~ s{Win32-(?!x86)}{Win32::}ig;
#$backfile = BackSlash($file);
$shortfile = ExtractFileName($backfile);
print " adding ${shorthelp}::/${shortfile}\n";
print HHC <<EOT;
<LI> <OBJECT type="text/sitemap">
<param name="Name" value="$title">
<param name="Local" value="${shorthelp}::/${shortfile}">
</OBJECT>
EOT
}
foreach $file (sort(grep {/\.hhc$/i} @files)) {
if($file =~ /^lib-site-/i) {
push(@sitehhcs, $file);
} elsif($file =~ /lib-site\.hhc/i) {
unshift(@sitehhcs, $file);
} elsif($file =~ /^lib-/i) {
push(@libhhcs, $file);
} elsif($file =~ /lib\.hhc/i) {
unshift(@libhhcs, $file);
} else {
push(@otherhhcs, $file);
}
}
#
# The Lib merge files
#
if(@libhhcs) {
print HHC <<EOT;
<LI> <OBJECT type="text/sitemap">
<param name="Name" value="Core Libraries">
</OBJECT>
<UL>
EOT
foreach $file (@libhhcs) {
$file =~ s{\\}{/}g;
next if uc($shorttoc) eq uc($file);
# Note: this is an abuse of regexes but needed for all cases
$title = $file;
$title =~ s{^pkg-}{}i;
$title =~ s{\.hhc$}{}i;
$title =~ s{(.*lib)$}{$1/}i;
$title =~ s{^lib-site-}{lib/site/}i;
$title =~ s{^lib-}{lib/}i;
$title =~ s{^site}{site/}i;
$title =~ s{^site-}{site/}i;
# $title =~ s{([^2])-([^x])}{${1}::${2}}ig;
$title =~ s{Win32-(?!x86)}{Win32::}ig;
if ($title =~ m{^lib/$}i) { $title = "Main Libraries" }
$title =~ s{^lib/}{}i;
# $backfile = BackSlash($file);
$shortfile = ExtractFileName($backfile);
print " merging ${shortfile}\n";
print HHC <<EOT;
<LI> <OBJECT type="text/sitemap">
<param name="Name" value="$title">
</OBJECT>
<OBJECT type="text/sitemap">
<param name="Merge" value="${shortfile}">
</OBJECT>
EOT
}
print HHC "</UL>\n";
}
#
# The site merge files
#
if(@sitehhcs) {
print HHC <<'EOT';
<!--Beginning of site libraries-->
<LI> <OBJECT type="text/sitemap">
<param name="Name" value="Site Libraries">
</OBJECT>
<UL>
EOT
foreach $file (@sitehhcs) {
$file =~ s{\\}{/}g;
next if uc($shorttoc) eq uc($file);
# Note: this is an abuse of regexes but needed for all cases
$title = $file;
$title =~ s{^pkg-}{}i;
$title =~ s{\.hhc$}{}i;
$title =~ s{(.*lib)$}{$1/}i;
$title =~ s{^lib-site-}{lib/site/}i;
$title =~ s{^lib-}{lib/}i;
$title =~ s{^site}{site/}i;
$title =~ s{^site-}{site/}i;
# $title =~ s{([^2])-([^x])}{${1}::${2}}ig;
$title =~ s{Win32-(?!x86)}{Win32::}ig;
if ($title =~ m{^lib/site$}i) { $title = "Main Libraries" }
$title =~ s{^lib/site/}{}i;
# $backfile = BackSlash($file);
$shortfile = ExtractFileName($backfile);
print " merging ${shortfile}\n";
print HHC <<EOT
<LI> <OBJECT type="text/sitemap">
<param name="Name" value="$title">
</OBJECT>
<OBJECT type="text/sitemap">
<param name="Merge" value="${shortfile}">
</OBJECT>
EOT
}
print HHC "</UL>\n";
#
# quick fix: plop in the packages file
#
if($MERGE_PACKAGES) {
print HHC <<EOT;
<OBJECT type="text/sitemap">
<param name="Merge" value="packages.hhc">
</OBJECT>
EOT
}
print HHC "<!--End of site libraries-->\n";
}
#
# All the rest of the merge files
#
if(@otherhhcs) {
foreach $file (@otherhhcs) {
$file =~ s{\\}{/}g;
next if uc($shorttoc) eq uc($file);
# Note: this is an abuse of regexes but needed for all cases
$title = $file;
$title =~ s{^pkg-}{}i;
$title =~ s{\.hhc$}{}i;
$title =~ s{(.*lib)$}{$1/}i;
$title =~ s{^lib-site-}{lib/site/}i;
$title =~ s{^lib-}{lib/}i;
$title =~ s{^site}{site/}i;
$title =~ s{^site-}{site/}i;
# $title =~ s{([^2])-([^x])}{${1}::${2}}ig;
$title =~ s{Win32-(?!x86)}{Win32::}ig;
# $backfile = BackSlash($file);
$shortfile = ExtractFileName($backfile);
print " merging ${shortfile}\n";
print HHC <<EOT;
<LI> <OBJECT type="text/sitemap">
<param name="Name" value="$title">
</OBJECT>
<OBJECT type="text/sitemap">
<param name="Merge" value="${shortfile}">
</OBJECT>
EOT
}
}
# Close up shop and go home
print HHC "</UL>\n";
print HHC "</BODY></HTML>\n";
close(HHC);
1;
}
#####################################################################
# FUNCTION CreateHHCFromHash
# RECEIVES Helpfile, HHC filename, and assoc array of files
# where keys are files and values are file titles
# RETURNS 1|0
# SETS None
# EXPECTS None
# PURPOSE Same as CreateHHC but allows for direct control over
# the file titles
sub CreateHHCFromHash {
my ($helpfile, $tocfile, %files) = @_;
my $file;
my $title;
my $shorttoc;
my $shorthelp;
my $backfile;
$shorttoc = $tocfile;
$shorttoc =~ s{.*/(.*)}{$1};
$shorthelp = $helpfile;
$shorthelp =~ s{.*/(.*)}{$1};
print "Creating $shorttoc\n";
unless(open(HHC, ">$tocfile")) {
$! = "Could not write contents file";
return 0;
}
print HHC <<'EOT';
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<HTML>
<HEAD>
<!-- Sitemap 1.0 -->
</HEAD>
<BODY>
<OBJECT type="text/site properties">
<param name="ImageType" value="Folder">
</OBJECT>
<UL>
EOT
while (($file,$title) = each %files) {
next unless $file =~ /\.html?/i;
# $backfile = BackSlash($file);
print HHC <<EOT;
<LI> <OBJECT type="text/sitemap">
<param name="Name" value="$title">
<param name="Local" value="$backfile">
</OBJECT>
EOT
}
while (($file,$title) = each %files) {
next if uc($shorttoc) eq uc($file);
next unless $file =~ /\.hhc/i;
# $backfile = BackSlash($file);
print HHC <<EOT;
<LI> <OBJECT type="text/sitemap">
<param name="Name" value="$title">
</OBJECT>
<OBJECT type="text/sitemap">
<param name="Merge" value="$backfile">
</OBJECT>
EOT
}
print HHC "</UL>\n";
print HHC "</BODY></HTML>\n";
close(HHC);
1;
}
#####################################################################
# DO NOT REMOVE THE FOLLOWING LINE, IT IS NEEDED TO LOAD THIS LIBRARY
1;