htmlhelp.pm

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

        }
        @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(mkdir("$package_dir/blib/HtmlHelp", 0666)) {
                $! = "Directory could not be created $package_dir/blib/HtmlHelp";
                return 0;
            }
        }
        unless(-d "$package_dir/blib/Html") {
            unless(mkdir("$package_dir/blib/Html", 0666)) {
                $! = "Directory could not be created $package_dir/blib/Html";
                return 0;
            }
        }
        unless(-d "$package_dir/blib/Html/lib") {
            unless(mkdir("$package_dir/blib/Html/lib", 0666)) {
                $! = "Directory could not be created $package_dir/blib/Html/lib";
                return 0;
            }
        }
        unless(-d "$package_dir/blib/Html/lib/site") {
            unless(mkdir("$package_dir/blib/Html/lib/site", 0666)) {
                $! = "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(mkdir("$package_dir/blib/temp", 0666)) {
                    $! = "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(mkdir("$package_dir/blib/temp", 0666)) {
                        $! = "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(mkdir("$todir/$dir", 0666)) {
                $! = "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";
    }
    $first_html_file = BackSlash($first_html_file);
    $shortfirstfile = ExtractFileName($first_html_file);

    print "Creating $shortprojfile\n";

    unless(open(HHP, ">$projfile")) {
        $! = "Could not write project file";
        return 0;
    }
    print HHP "[OPTIONS]\n";
    print HHP "Compatibility=1.1\n";
    print HHP "Compiled file=$shorthelpfile\n";
    print HHP "Contents file=$shorttocfile\n";
    print HHP "Display compile progress=Yes\n";
    if($FULLTEXTSEARCH) {
        print HHP "Full-text search=Yes\n";
    }
    print HHP "Language=0x409 English (United States)\n";
    print HHP "Default topic=$shortfirstfile\n";
    print HHP "\n\n";
    print HHP "[FILES]\n";
    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;

    $shorttoc = ExtractFileName($tocfile);
    $shorthelp = ExtractFileName($helpfile);

    print "Creating $shorttoc\n";
    
    unless(open(HHC, ">$tocfile")) {
        $! = "Could not write contents file";
        return 0;
    }
    print HHC "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">\n";
    print HHC "<HTML>\n";
    print HHC "<HEAD>\n";
    print HHC "<!-- Sitemap 1.0 -->\n";
    print HHC "</HEAD>\n";
    print HHC "<BODY>\n";
    print HHC "<OBJECT type=\"text/site properties\">\n";
    print HHC "\t<param name=\"ImageType\" value=\"Folder\">\n";
    print HHC "</OBJECT>\n";
    print HHC "<UL>\n";
    foreach $file (grep {/\.html?$/i} @files) {
        # don't want default.htm in the toc file
        next if $file =~ /default\.html?$/i;

        $title = $file;
        $title =~ s/\.html$//i;
        $title =~ s/\//\\/g;
        $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;