#!/usr/bin/perl -w
#   $0
# Organize an pretty-print the list of files in the current directory.
# You may need to set up .htaccess: Options Indexes ExecCGI FollowSymLinks
# -Ian! D. Allen - idallen@idallen.ca - www.idallen.com

use strict;

use CGI qw/:standard/;
use CGI::Carp qw/fatalsToBrowser/;
open(STDERR,">&STDOUT");
use Cwd;

# Print and flush the header so that subsequent error messages are visible.
#
$| = 1;
print header;
$| = 0;

# Find out in which directory we are operating
#
my $dir = param('dir');
my $realdir = '';

# If $dir is missing, assume current directory.
#
unless( $dir ){
        $dir = '';
	$realdir = '';
} else {
    # Remove zero or more trailing slashes and replace with one slash
    $dir =~ s|/*$|/|;

    # Fix up ~user directory references to be correct for NETSRV or my home
    my $realdir = param('realdir');
    unless ( $realdir ) {
            $realdir = $dir;
            if ( -d '/home/idallen/public_html' ) {
                $realdir =~ s|/~idallen|/home/idallen/public_html|;
            } elsif ( -d '/home/virtuals/idallen/idallen/public_html' ) {
                $realdir =~ s|/~idallen|/home/virtuals/idallen/idallen/public_ht
ml|;
                # iStop gives me a virtual domain; no need for ~idallen
                $dir =~ s|/~idallen||;
            } elsif ( -d '/thome/alleni/public_html' ) {
                $realdir =~ s|/~alleni|/thome/alleni/public_html|;
            } elsif ( -d '/export/home2/algu/alleni/public_html' ) {
                $realdir =~ s|/~alleni|/export/home2/algu/alleni/public_html|;
            }
    }
    chdir $realdir or die "Cannot chdir to '$realdir': $!\n";
}

# Get the name of the current directory.
# Isolate the pathname after the document root prefix and slash.
# Don't use &fastcwd - it may not get back to this directory.
#
my $cwd = &cwd || `pwd` || die "Uid $< $> cannot find working dir: $!\n ";
chomp($cwd);
my $root = $ENV{'DOCUMENT_ROOT'} || ".";
$root = "/thome/alleni/public_html/teaching"
        if $root eq "/usr/HTTPServer/htdocs/en_US";
my ($shortcwd) = $cwd =~ /$root\/(.*)/;
$shortcwd = $cwd unless $shortcwd;
$shortcwd =~ s/.*\/teaching\///;
# $shortcwd =~ s:/thome/alleni/public_html/teaching/:: ;

print start_html(
    '-title'=>$shortcwd,
    '-author'=>"Ian! D. Allen idallen\@idallen.ca",
    '-head'=>[
	Link({'-rel'=>'shortcut icon',
	    '-href'=>'/favicon.ico',
	    '-type'=>'image/x-icon'}),
	meta({'-http_equiv'=>'Content-Type', '-content'=>'text/html'})
    ]
);
print h1("Index of &nbsp;"
    . font({'-color'=>'red'},tt($shortcwd))
    . ' ' . a({href=>'.'},':'));

# Safety check.
#
unless ( -r '.' && -x _ ) {
	print h3($cwd);
	print p("Directory $cwd does not permit browsing.\n");
	print end_html();
	exit 1;
}

opendir(DIR,".") or die "Cannot open '.': $!";
my @files = sort grep {
	/^[^.]/ && -f && ! /^index.(cgi|php|html?)$/i && ! /\.cgi$/
    } readdir(DIR);
closedir DIR;
#print "DEBUG size of files is " . scalar @files;
#print "\n";
my %files;
@files{@files} = (1..@files);  # create hash slice
undef @files;

my @optional = grep { /^opt_/ } keys %files;
delete @files{@optional};

my @weeknotes = grep { /week\d\d.?notes/i } keys %files;
delete @files{@weeknotes};

my @exercises = grep { /^(project\d+|lab\d+|assignment\d+|exercise\d+|lab\d+exercise)/i } keys %files;
delete @files{@exercises};

my @assignments = grep { /assignment\d\d/i } keys %files;
delete @files{@assignments};

my @jcl = grep { /^(jcl(example|homework)\d)/i } keys %files;
delete @files{@jcl};

my @chapter = grep { /(chapter(\d\d|\d+-\d+)|appendix\w)/i } keys %files;
delete @files{@chapter};

my @cprogs = grep { /\.c(\.txt)?$/i } keys %files;
delete @files{@cprogs};

my @cppprogs = grep { /\.(C|cc|cxx|cpp|c\+\+)(\.txt)?$/i } keys %files;
delete @files{@cppprogs};

my @asmprogs = grep { /\.(asm|s)(\.txt)?$/i } keys %files;
delete @files{@asmprogs};

my @allprogs = ( @cprogs, @cppprogs, @asmprogs );

my @tests = grep { /^(practice.*test|term.*test|answer|solution|midterm|final.*exam)/i } keys %files;
delete @files{@tests};

my @perlscripts = grep { /\.pl(.txt)?$/i } keys %files;
delete @files{@perlscripts};

my @shellscripts = grep { /\.(sh|awk|sed)(\.txt)?$/i } keys %files;
delete @files{@shellscripts};

my @datafiles = grep { /\.(gz|tgz|bin|zip)$/i } keys %files;
delete @files{@datafiles};

my @review = ();
#my @review = grep { /^(intro\.html|vi_basics.txt)$/i } keys %files;
#delete @files{@review};

# collect up all the misc PDF left over
my @outlinerr = grep {
           /\.(pdf|doc|wpd)$/i
	|| /^text_errata/i
	|| /^timeline/i
	|| /^lab_access/i
	|| /schedule.txt$/i
	|| /^student_support/i
    } keys %files;
delete @files{@outlinerr};

my @left = keys %files;

if ( @shellscripts || @allprogs || @perlscripts ) {
	print p <<EOF;
<div style="max-width: 60em">
The scripts and programs in this directory may have had a ".txt" suffix
added, to make sure that they are treated as text when your browser
downloads them.  You may need to remove the ".txt" suffix to compile
or run them on your own computer.
</div>
EOF
}

# concatenate all the output into str, collecting anchors as we go
my @anchors = ();   # GLOBAL - &Sort will fill this in
my $str = '';
# specifying 'sort' will sort by modify time, otherwise by file name
$str .= &Show("Weekly Class Notes",'nosort',@weeknotes) if @weeknotes;
$str .= &Show("JCL Examples and Homework",'sort',@jcl) if @jcl;
$str .= &Show("Chapter Reading/Study Guides",'nosort',@chapter) if @chapter;
$str .= &Show("Important Notes (alphabetical order)",'nosort',@left) if @left;
$str .= &Show("Projects/Labs/Assignments/Exercises",'nosort',@exercises) if @exercises;
$str .= &Show("Assignments",'nosort',@assignments) if @assignments;
$str .= &Show("Shell Scripts",'nosort',@shellscripts) if @shellscripts;
$str .= &Show("Perl Scripts",'nosort',@perlscripts) if @perlscripts;
#$str .= &Show("C Programs",'nosort',@cprogs) if @cprogs;
#$str .= &Show("C++ Programs",'nosort',@cppprogs) if @cppprogs;
$str .= &Show("Program Source",'nosort',@allprogs) if @allprogs;
$str .= &Show("Course Outline / pdf,doc,wpd",'nosort',@outlinerr) if @outlinerr;
$str .= &Show("VI Text Editor Notes",'nosort',@review) if @review;
$str .= &Show("Tests and Exams (with Answers)",'sort',@tests) if @tests;
$str .= &Show("Optional Material",'sort',@optional) if @optional;
$str .= &Show("Data Files (binary)",'sort',@datafiles) if @datafiles;
$str .= &Show("Important Notes (chronological order)",'sort',@left) if @left;

# print the collected @anchors list of jump down links
#
print h2("Jump down to:");
foreach $a ( @anchors ) {
    print tt("&nbsp;" x 2);
    print (" * ");
    my $escstr = &NameAnchor($a);
    print a({href=>'#'.$escstr},$a);
    print br;
}

# print the entire rest of the page
#
print $str;

print end_html();
exit 0;

##############################################################################

sub commify {
	local $_ = shift;
	1 while s/(\d)(\d\d\d)\b/$1,$2/;
	return $_;
}

sub Date {
	my $d = scalar localtime($_[0]);
	$d =~ s/^\S+ //; # remove weekday
	$d =~ s/:\d\d / /; # remove seconds
	$d =~ s/ /\&nbsp;/g; # fix spacing
	return tt($d);
}

# make legal anchors out of random titles
#
sub NameAnchor {
    	my $str = shift;
	$str =~ s/\W/_/g;  # replace all non-word chars
	return 'X' . $str; # make sure it starts with a letter
}

# flag can be "sort" to sort by file name, otherwise sort by date
sub Show {
    	my($title,$flag,@array) = @_;
	my($l1,$filetitle,$l3);
	my @lines = ();

	foreach ( @array ) {
		next unless -s;
	    	warn "Cannot open '$_' for reading: $!\n"
			unless open(F,"<$_");
		my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
			$atime,$mtime,$ctime,$blksize,$blocks)
			    = stat F;
		if ( /\.(txt|sh|csh|pl|java)$/ ) {
			# read three lines from the file
		    	# the second line is the title line; pick it
			# delete HTTP comment prefix/suffix
			# delete JCL comment prefix/suffix
			# delete C++/Java comment prefix/suffix
		    	($l1,$filetitle,$l3) = <F>;
			$filetitle = $l1 if $filetitle =~ /^[^a-zA-Z]*$/;
			if ( $filetitle ) {
				$filetitle =~ s/^[-!;\s*#\\<>]+//;
				$filetitle =~ s/[-!;\s*#\\<>]+$//;
				$filetitle =~ s@^//\** *@@;
			}
		} elsif ( /\.(html?)$/ ) {
		    	# find the <title> line at the start;
			# delete HTTP comment prefix/suffix
		    	my $n = read F,$filetitle,4096;
			if ( $filetitle ) {
			    $filetitle =~ y/\n/ /; # strip newlines
			    if ( $filetitle =~ /<title>/i ) {
				$filetitle =~ s/.*<title>//i;
				$filetitle =~ s/<\/title>.*//i;
			    } else {
				$filetitle =~ s/<head>.*<\/head>/ /ig;
				$filetitle =~ s/<\/*(html|body)\b[^>]*>//ig;
				if ( $filetitle =~ /<h1>/i ) {
				    $filetitle =~ s/.*<h1>//i;
				    $filetitle =~ s/<.*//i;
				} elsif ( $filetitle =~ /<h2>/i ) {
				    $filetitle =~ s/.*<h2>//i;
				    $filetitle =~ s/<.*//i;
				} elsif ( $filetitle =~ /<h3>/i ) {
				    $filetitle =~ s/.*<h3>//i;
				    $filetitle =~ s/<.*//i;
				}
			    }
			    $filetitle =~ s/<\/*(font|strong|em|i|b|a)\b[^>]*>//ig;
			    $filetitle =~ s/<\/*(br|p)[^>]*>/ /ig; # strip para
			}
		} else {
		    	$filetitle = '';
		}
		close F;

		$filetitle =~ s/\s+/ /g;
		$filetitle =~ s/^\s+|\s+$//g;
		push(@lines,[ $mtime, $size, $filetitle, $_ ]);
	}
	if ( $flag eq 'sort' ) {
	    	# sort by modify time, most recent on top
		# second sort is by filename
	    	@lines =  sort {
		    $b->[0] <=> $a->[0] || $a->[3] cmp $b->[3]
		} @lines;
	} else {
	    	# sort by file name
	    	@lines =  sort { $a->[3] cmp $b->[3] } @lines;
	}

	# all the output is generated below here
	my $str = '';
	#
	# save a list of "jump down to" anchors to output at page top
	# put the page anchor inside a <div></div> 
	#
	push(@anchors,$title);
	my $escstr = &NameAnchor($title);
	$str .= div(a({name=>$escstr}));
	$str .= h2($title);
	foreach ( @lines ) {
	    	my($mtime,$size,$filetitle,$name) = @$_;
		# my $commasize = commify($size);
		$str .= tt("&nbsp;" x 2);
		$str .= &Date($mtime);
		$str .= tt("&nbsp;" x 2);
		$escstr = CGI->escape($name);
		$escstr = "$dir/$escstr" if $dir;
		$str .= a({href=>$escstr},tt($name));
		$str .= "&nbsp;" x 5;
		$str .= i(CGI->escapeHTML($filetitle));
		$str .= br;
	}
	return $str;
}