$HTTPversion = '1.1' unless defined $HTTPversion; print V "HTMLdir.pm: HTTPversion='$HTTPversion'\n" if $main::V>1; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # This routine reads a directory and produces a simplified html # # listing. But you might want to reformat it in some other way that's # # more useful for your application. We do the work in a child process # # and return with F open to the pipe from the child. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # sub HTMLdir { local(*F,$d) = @_; local(@files,$f,@st,$mt,*DIR); if ($child = open(F,'-|')) { # Parent. $URLhdr = 1; # Warn caller of HTML headers. return 1; # Parent returns the open file. } # Child reads the directory. if (opendir(DIR,$d)) { print V "HTMLdir: Producing HTML headers.\n" if $V>2; select STDOUT; print "HTTP/$HTTPversion 200 OK\n"; print "Server: HTMLdir.pm\n"; if (@st = stat($d)) { $mt = gmtime($st[9]); print "Last-Modified: $mt GMT\n"; } print "Content-Type: text/html\n\n"; print "
\n"; print " Name\n"; @files = readdir(DIR); closedir DIR; for $f (sort @files) { if (-d "$d/$f") { if ($f eq '.') { # Ignore self reference. } elsif ($f eq '..') { # Perent reference. ($p = $d) =~ s"/[^/]+/+$"/"; print "\n"; print " Parent directory\n"; } else { print " $f/\n"; } } else { print " $f\n"; } } exit 0; } print V "HTMLdir: Can't open directory \"$d\" ($!)\n" if $V>0; exit $!; } 1;