#!/usr/bin/perl

# precut -- scan an HTML file, extract PRE .. /PRE blocks into
#           separate files, and replace with a <include = "fname">
#           tag

# use strict ;
use File::Basename;
use FileCache;
fileparse_set_fstype();

my ($file) = "";

if (!defined $ARGV[0]) {
    &usage && die;
}

foreach $file (@ARGV) {
    my ($base, $path, $ext) = fileparse($file, ("\.mhtml", "\.html", "\.htm"));
    if (! (-d $path && -r _ && -w _ && -x _ && -o _) ) {
        print "Can't operate on files in $path\n",
              "skipping $base\n";
        next;
    }
   burst($base, $path, $ext);
}
exit 0;

#----------- support routines


sub usage {
    print "precut <file1> <file2> ... <filen>\n",
          "Scans an HTML file or files, extracts PRE .. /PRE blocks into\n",
          "separate files, and replaces them with a <include = \"fname\">\n",
          "tag.\n\n",
          "No parameters available.\n\n";
}


sub burst {
    my ($file, $dir, $ext) = @_;
    my ($burstlevel)       = 0;
    my ($burstcount)       = 0;
    my ($i)                = 0;
    my ($workspace)        = "";
    my ($srcname)          = "";
    my ($HANDLE)           = "";
    my (@hstack)           = ();

    chdir ($dir)                       || die "Failed to chdir($dir)\n";
    open (IN, "<${file}${ext}")        || die "Failed to open <$file$ext\n";
    my (@buffer) = (<IN>);
    close (IN);
    $srcname = "$file$ext";
    rename ($srcname, "$srcname.bak");
    $srcname = "$file$ext";
    cacheout $srcname;
    print STDOUT "opened $srcname\n";
    for ($i = 0; $i <= $#buffer; $i++) {
        $workspace = $buffer[$i];
        if ($workspace =~ /<PRE>/i ) {
            $burstlevel++;
            $burstcount++;
            print $srcname $`;
            $workspace = $';
            push (@hstack, $srcname);
            my ($newsrcname) = $srcname  . "." . "$burstcount";
            print $srcname "\n<P><PRE><include \"$newsrcname\"></PRE><P>\n";
            $srcname = $newsrcname;
            cacheout $srcname;
            print STDOUT "new file: $srcname\n";
            print $srcname $';
        } elsif ($workspace =~ /<\/PRE>/i ) {
            $burstlevel--;
            print $srcname $`;
            close $srcname;
            print STDOUT "closed $srcname;\n";
            $srcname = pop(@hstack);
            cacheout $srcname;
            print STDOUT "reopened $srcname;\n";
        } else {
            print $srcname $workspace;
        }
    }
    close $srcname;
    if (($#hstack > 0 ) || ($burstlevel > 0)) {
        print "\nDANGER: unmatched <PRE>..</PRE> combination detected!\n";
    }
}