#!/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! idallen@idallen.ca

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)));

# 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 { /^(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 @allcprogs = ( @cprogs, @cppprogs );

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 @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 || @cprogs || @cppprogs || @perlscripts ) {
	print p <<EOF;
<div style="max-width: 60em">
The scripts and programs in this directory have had a ".txt" suffix added, to
make sure that they are treated as text when your browser downloads them.
You usually need to remove the ".txt" suffix to compile them.
</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("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("C and C++ Programs",'nosort',@allcprogs) if @allcprogs;
$str .= &Show("Course Outline / Lab Hours / Text Errata / Course Time Line",'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("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 ) {
	    	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)$/ ) {
		    	# 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>;
			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;
}