htmlhelp.pm

ARM上的如果你对底层感兴趣

    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;

    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;
    unless(opendir(DIR, "$fromdir")) {
        $! = "Can't read from directory $fromdir";
        return 0;
    }
    @files = readdir(DIR);
    closedir(DIR);
    @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
    unless(opendir(DIR, "$fromdir")) {
        $! = "Can't read from directory $fromdir";
        return 0;
    }
    @files = readdir(DIR);
    closedir(DIR);
    @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 BackSlash($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_mask = $package_root_dir;
    $package_root_dir_mask =~ s/\\/\\\\/g;
#   $package_root_dir_mask =~ s/\//\/\//g;

    if (!defined @files) {
        unless(opendir(DIR, $package_root_dir)) {
            $! = "Directory could not be opened $package_root_dir";
            return 0;