ptkFAQ
view release on metacpan or search on metacpan
etc/tomc_pod2html.shar view on Meta::CPAN
X $podfile = ""; # read from stdin by default
X @podpath = (); # list of directories containing library pods.
X $podroot = "."; # filesystem base directory from which all
X # relative paths in $podpath stem.
X $recurse = 1; # recurse on subdirectories in $podpath.
X $verbose = 0; # not verbose by default
X $doindex = 1; # non-zero if we should generate an index
X $listlevel = 0; # current list depth
X @listitem = (); # stack of HTML commands to use when a =item is
X # encountered. the top of the stack is the
X # current list.
X @listdata = (); # similar to @listitem, but for the text after
X # an =item
X @listend = (); # similar to @listitem, but the text to use to
X # end the list.
X $ignore = 1; # whether or not to format text. we don't
X # format text until we hit our first pod
X # directive.
X $netscape = 0; # whether or not to use netscape directives.
X $top = 1; # true if we are at the top of the doc. used
X # to prevent the first <HR> directive.
X
X undef $opt_help if defined $opt_help;
X
X # parse the command-line parameters
X $result = GetOptions( qw(
X flush
X help
X htmlroot=s
X index!
X infile=s
X libpods=s
X netscape!
X outfile=s
X podpath=s
X podroot=s
X norecurse
X recurse!
X title=s
X verbose
X ));
X usage("invalid parameters") if not $result;
X parse_command_line();
X
X
X # set some variables to their default values if necessary
X $podfile = "-" unless $podfile; # stdin
X $htmlfile = "-" unless $htmlfile; # stdout
X $htmlroot = "" if $htmlroot eq "/"; # so we don't get a //
X
X
X %pages = (); # associative array used to find the location
X # of pages referenced by L<> links.
X %sections = (); # sections within this page
X %items = (); # associative array used to find the location
X # of =item directives referenced by C<> links
X
X
X # read the pod a paragraph at a time
X warn "Scanning for sections in input file(s)\n" if $verbose;
X $/ = "";
X open(POD, "<$podfile")
X || die "$0: cannot open $podfile file for input: $!\n";
X @poddata = <POD>;
X close(POD);
X
X
X # scan the pod for =head[1-6] directives and build an index
X $index = scan_headings(\%sections, @poddata);
X
X
X # open the output file
X open(HTML, ">$htmlfile")
X || die "$0: cannot open $htmlfile file for output: $!\n";
X
X # put a title in the HTML file
X $podfile =~ /^(.*)\.pod$/;
X $title = ($podfile eq "-" ? 'No Title' : $1) unless defined $title;
X print HTML <<END_OF_HEAD;
X <HTML>
X
X <HEAD>
X <TITLE>$title</TITLE>
X </HEAD>
X
X <BODY>
X
END_OF_HEAD
X
X # load a cache of %pages and %items if possible. $tests will be
X # non-zero if successful.
X $tests = 0;
X if (-f $dircache && -f $itemcache) {
X warn "scanning for item cache\n" if $verbose;
X $tests = find_cache($dircache, $itemcache, $podpath, $podroot,
X \%pages, \%items);
X }
X
X
X # if we didn't succeed in loading the cache then we must (re)build
X # %pages and %items.
X if (!$tests) {
X warn "scanning directories in pod-path\n" if $verbose;
X scan_podpath($podroot, $recurse, \%pages, \%items);
X }
X
X
X # scan the pod for =item directives
X scan_items("", \%items, @poddata);
X
X
X # put an index at the top of the file. note, if $doindex is 0 we
X # still generate an index, but surround it with an html comment.
X # that way some other program can extract it if desired.
X $index =~ s/--+/-/g;
X print HTML "<!-- INDEX BEGIN -->\n";
X print HTML "<!--\n" unless $doindex;
X print HTML "$index";
X print HTML "-->\n" unless $doindex;
X print HTML "<!-- INDEX END -->\n\n";
X print HTML "<HR>\n" if $doindex;
etc/tomc_pod2html.shar view on Meta::CPAN
warn "\@ignore\t= @ignore\n" if $debug;
foreach $dir (@podpath) {
# installdir($dir, $recurse, $podroot, \@splitdirs, \@ignore);
}
X
X
# now go through and create master indices for each pod we split
foreach $dir ((@splithead,@splititem)) {
X $dir =~ /^(.*)(\.pod|\.pm)$/sm;
warn "creating index $htmldir/$1.html\n";
X create_index("$htmldir/$1.html", "$htmldir/$1");
}
X
##############################################################################
X
X
sub usage {
X warn "$0: @_\n" if @_;
X die $usage;
}
X
X
sub parse_command_line {
X usage() if defined $opt_help;
X $opt_help = ""; # make -w shut up
X
X # list of directories
X @podpath = split(":", $opt_podpath) if defined $opt_podpath;
X
X # lists of files
X @splithead = split(",", $opt_splithead) if defined $opt_splithead;
X @splititem = split(",", $opt_splititem) if defined $opt_splititem;
X @libpods = split(",", $opt_libpods) if defined $opt_libpods;
X
X $htmldir = $opt_htmldir if defined $opt_htmldir;
X $htmlroot = $opt_htmlroot if defined $opt_htmlroot;
X $podroot = $opt_podroot if defined $opt_podroot;
X $splitpod = $opt_splitpod if defined $opt_splitpod;
X
X $recurse = $opt_recurse if defined $opt_recurse;
X $debug = $opt_debug if defined $opt_debug;
}
X
X
sub create_index {
X my($html, $dir) = @_;
X my(@files, @filedata, @index, $file);
X
X # get the list of .html files in this directory
X opendir(DIR, $dir) ||
X die "$0: error opening directory $dir for reading: $!\n";
X @files = grep(/\.html$/, readdir(DIR));
X closedir(DIR);
X
X open(HTML, ">$html") ||
X die "$0: error opening $html for output: $!\n";
X
X # for each .html file in the directory, extract the index
X # embedded in the file and throw it into the big index.
X foreach $file (@files) {
X $/ = "";
X
X open(IN, "<$dir/$file") ||
X die "$0: error opening $dir/$file for input: $!\n";
X @filedata = <IN>;
X close(IN);
X
X @index = grep(/<!-- INDEX BEGIN -->.*<!-- INDEX END -->/s,
X @filedata);
X for (@index) {
X s/<!-- INDEX BEGIN -->(\s*<!--)(.*)(-->\s*)<!-- INDEX END -->/$2/s;
X s,#,$dir/$file#,g;
X print HTML "$_\n";
X #print HTML "$_\n<P><HR><P>\n";
X }
X }
X
X close(HTML);
}
X
X
sub split_on_head {
X my($podroot, $htmldir, $splitdirs, $ignore, @splithead) = @_;
X my($pod, $dirname, $filename);
X
X # split the files specified in @splithead on =head[1-6] pod directives
X warn "splitting files by head.\n" if $debug && $#splithead >= 0;
X foreach $pod (@splithead) {
X # figure out the directory name and filename
X $pod =~ s,^([^/]*)$,/$1,;
X $pod =~ m,(.*?)/(.*?)(\.pod)?$,;
X $dirname = $1;
X $filename = "$2.pod";
X
X # since we are splitting this file it shouldn't be converted.
X push(@$ignore, "$podroot/$dirname/$filename");
X
X # split the pod
X splitpod("$podroot/$dirname/$filename", "$podroot/$dirname", $htmldir,
X $splitdirs);
X }
}
X
X
sub split_on_item {
X my($podroot, $splitdirs, $ignore, @splititem) = @_;
X my($pwd, $dirname, $filename);
X
X warn "splitting files by item.\n" if $debug && $#splititem >= 0;
X $pwd = getcwd();
X foreach $pod (@splititem) {
X # figure out the directory to split into
X $pod =~ s,^([^/]*)$,/$1,;
X $pod =~ m,(.*?)/(.*?)(\.pod)?$,;
X $dirname = "$1/$2";
X $filename = "$2.pod";
X
X # since we are splitting this file it shouldn't be converted.
X push(@$ignore, "$podroot/$dirname.pod");
X
X # split the pod
X push(@$splitdirs, "$podroot/$dirname");
X if (! -d "$podroot/$dirname") {
X mkdir("$podroot/$dirname", 0755) ||
X die "$0: error creating directory $podroot/$dirname: $!\n";
X }
X chdir("$podroot/$dirname") ||
X die "$0: error changing to directory $podroot/$dirname: $!\n";
X system("splitpod", "../$filename");
X }
X chdir($pwd);
}
X
X
#
# splitpod - splits a .pod file into several smaller .pod files
# where a new file is started each time a =head[1-6] pod directive
# is encountered in the input file.
#
sub splitpod {
X my($pod, $poddir, $htmldir, $splitdirs) = @_;
X my(@poddata, @filedata, @heads);
X my($file, $i, $j, $prevsec, $section, $nextsec);
X
X warn "splitting $pod\n" if $debug;
X
X # read the file in paragraphs
X $/ = "";
X open(SPLITIN, "<$pod") ||
X die "$0: error opening $pod for input: $!\n";
X @filedata = <SPLITIN>;
X close(SPLITIN) ||
X die "$0: error closing $pod: $!\n";
X
X # restore the file internally by =head[1-6] sections
X @poddata = ();
X for ($i = 0, $j = -1; $i <= $#filedata; $i++) {
X $j++ if ($filedata[$i] =~ /^\s*=head[1-6]/);
X $poddata[$j] = "" unless defined $poddata[$j];
X $poddata[$j] .= "\n$filedata[$i]" if $j >= 0;
X }
X
X # create list of =head[1-6] sections so that we can rewrite
X # L<> links as necessary.
X %heads = ();
X foreach $i (0..$#poddata) {
X $heads{htmlize($1)} = 1 if $poddata[$i] =~ /=head[1-6]\s+(.*)/;
X }
X
X # create a directory of a similar name and store all the
X # files in there
X $pod =~ s,.*/(.*),$1,; # get the last part of the name
X $dir = $pod;
X $dir =~ s/\.pod//g;
X push(@$splitdirs, "$poddir/$dir");
X mkdir("$poddir/$dir", 0755) ||
X die "$0: could not create directory $poddir/$dir: $!\n"
X unless -d "$poddir/$dir";
X
X $poddata[0] =~ /^\s*=head[1-6]\s+(.*)/;
X $section = "";
X $nextsec = $1;
X
X # for each section of the file create a separate pod file
X for ($i = 0; $i <= $#poddata; $i++) {
X # determine the "prev" and "next" links
X $prevsec = $section;
X $section = $nextsec;
X if ($i < $#poddata) {
X $poddata[$i+1] =~ /^\s*=head[1-6]\s+(.*)/;
X $nextsec = $1;
X } else {
X $nextsec = "";
X }
X
X # determine an appropriate filename (this must correspond with
X # what pod2html will try and guess)
X # $poddata[$i] =~ /^\s*=head[1-6]\s+(.*)/;
X $file = "$dir/" . htmlize($section) . ".pod";
X
X # create the new .pod file
X warn "\tcreating $poddir/$file\n" if $debug;
X open(SPLITOUT, ">$poddir/$file") ||
X die "$0: error opening $poddir/$file for output: $!\n";
X $poddata[$i] =~ s,L<([^<>]*)>,
X defined $heads{htmlize($1)} ? "L<$dir/$1>" : "L<$1>"
X ,ge;
X print SPLITOUT $poddata[$i]."\n\n";
( run in 0.951 second using v1.01-cache-2.11-cpan-364913b4093 )