#!/usr/bin/perl -w -T
# -T removed so I can glob
use strict;

my $base = "/home/httpd/html/imagetest";

my @proc_dirs = ( ["misc_dectapes", "/mnt/wing/ftproot/images"],
                  ["misc_floppy", "/mnt/wing/ftproot/images"]);
#my @proc_dirs =  ("misc_dectapes", "/mnt/wing/ftproot/images");
#my @proc_dirs =  ("misc_dectapes", "two");

open OUT,"> $base/index.shtml" or die "unable to open output";

start_html(\*OUT, "PDP-8 Media Images");
print OUT "The following are directories which contain images of PDP-8 ";
print OUT "media which you can browse.  Not all files are in this web version, ";
print OUT "see <a href='ftp://ftp.pdp8.net'>ftp.pdp8.net</a> for all files\n";

print OUT "<p>";
my $ref;
for $ref (@proc_dirs) {
#   print "@$ref[0] - @$ref[1] \n";
   proc_dir(\*OUT, @$ref[0], @$ref[1], $base);
}

footer(\*OUT, 1);
close OUT;
exit;

sub proc_dir() {
   my ($out, $name, $path) = @_;
   my (@info, @dir, %dirhash);
   my $tmp;
   my $cgi = "/cgi-bin";

   open INFO,"< $path/$name/README" or die "unable to open $path/$name/README $!\n";
   open OUT2,"> $base/$name.shtml" or die "unable to open output $!\n";
   start_html(\*OUT2, "PDP-8 File list for $name");

   my $format = <INFO>; chomp($format);
   $format = substr($format, 2);
   if ($format =~ m/OS\/8/) {
      $cgi = $cgi . "/os8_html";
   } elsif ($format =~ m/DIAL/) {
      $cgi = $cgi . "/dial_html";
   } else {
      print "Can't find type in format $format\n";
   }
   print OUT2 "$format<br>\n";
   while ($tmp = <INFO>) {
      chomp($tmp);
      if ($tmp eq "") {
         last;
      }
      $tmp = substr($tmp,2);
      push @info, $tmp;
      print OUT2 "$tmp<br>\n";
   } 
   print $out "<a href='$name.shtml'>$name</a> $info[0]<br>\n";

   print OUT2 "<br>\n";
   #@dir = glob("$path/$name/*");
   opendir DIR, "$path/$name" or die "Unable to open dir $!";
   @dir = readdir DIR;
   closedir DIR;
   my $ref;
   for $ref (@dir) {
      #print "dir $ref\n";
      if ($ref ne "README" && $ref ne "." && $ref ne "..") {
         $dirhash{$ref} = 1;
      }
   }

   while ($tmp = <INFO>) {
      chomp $tmp;
      if ($tmp ne "") {
         my ($fn, $desc);
         ($fn, $desc) = split / /, $tmp, 2;
         if (!defined($desc)) {
            $desc = "";
         }

         $desc = strip($desc);
         #print "fn $fn desc $desc\n";
         print OUT2 "<a href='$cgi?fn=$name/$fn&act=dir'>$fn</a> $desc<br>\n";
         if ($dirhash{$fn}) {
            $dirhash{$fn} = 0;
         } else {
            print "File $fn not found in directory listing for $name\n";
         }
      }
   }
   my ($key, $value);
   while (($key, $value) = each %dirhash) {
      if ($value != 0) {
         print "File $key not found in README for $name\n";
      }
   }

   footer(\*OUT2, 1);
   close OUT2;
}

sub footer() {
   my ($out, $level) = @_;
#   print $out '<P> <HR WIDTH="100%">';
#   print $out '<p>Feel free to contact me, David Gesswein <A HREF="mailto:djg@pdp8.net">djg@pdp8.net</A> with any questions, comments on the web site, or you want to donate equipment, documentation, software etc. to this project.&nbsp; I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation.&nbsp; <BR><BR><A HREF="/query_docs/query.shtml">PDP-8 Documents home</a><BR><A HREF="/index.shtml">PDP-8 Home Page</a> <BR><A HREF="/sitemap.shtml">PDP-8 Site Map</a>';
   if ($level == 1) {
      print $out "<!--#include virtual='../footer_l1.shtml' -->\n";
   } elsif ($level == 2) {
      print $out "<!--#include virtual='../../footer_l2.shtml' -->\n";
   }
   print $out "</body></html>\n";
}

sub start_html() {
   my ($out, $title) = @_;
   print $out "<!doctype html public \"-//w3c//dtd html 4.0 transitional//en\"> <html> <head> <title>$title</title> <meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\"> </head> <body>\n";
   print $out "<center>$title</center><br>\n";
}

#########################
#Remove leading/trailing blanks
sub strip {
        my @parms = @_;
        for (@parms) {
        if ($_) {
                s/\s+$//;
		s/^\s+//; 
        }
        }
        return wantarray ? @parms : $parms[0];
}
