#!/usr/bin/perl -w ############################################################################## # IF YOU SEE THIS SCRIPT INSTEAD OF AN INDEX it is because the web server # on this machine is misconfigured and does not execute Perl CGI scripts # properly. Simply delete the indexcgi.cgi from the URL and try again. ############################################################################## # $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 -no_xhtml/; use CGI::Carp qw/fatalsToBrowser/; use Time::Local; open(STDERR,">&STDOUT"); use Cwd; # Print and flush the header so that subsequent error messages are visible. # for XHTML this utf-8 also affects the http-equiv produced by start_html # $| = 1; print header('-charset'=>'utf-8'); $| = 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/:: ; # Calculate the end of term, based on the directory name. # We take the term name as start and add 3 months and 30 days to it. # Flag with class="finished" if the term is over. my ($year,$term) = $shortcwd =~ /\/([9012]\d)([wsf])\//; my $finished = ''; my $endsec = ''; my $dateheader = ''; if ( defined($term) ) { $year = $year + (($year > 90) ? 1900 : 2000); my $month = -1; $dateheader = "Winter $year - January to April $year", $month = 1-1 if $term eq 'w'; $dateheader = "Spring $year - May to August $year", $month = 5-1 if $term eq 's'; $dateheader = "Fall $year - September to December $year", $month = 9-1 if $term eq 'f'; if ( $month >= 0 ) { $endsec = timelocal(0,0,0,30,$month+3,$year); if ( time > $endsec ) { $finished = 'finished'; } } } # if DTD is XHTML let CGI produce the correct http-equiv; don't specify it here # if DTD is just HTML, you have to specify it here # The .indexcgilist style mimics the 
 style in ianstyles003.css
print start_html(
    '-dtd'=>'-//W3C//DTD HTML 4.01//EN',  # STRICT
    '-title'=>$shortcwd,
    '-author'=>"Ian! D. Allen idallen\@idallen.ca",
    '-style'=>{'-src'=>['common/ianstyles002.css','common/ianstyles003.css'],
               '-code'=>'.indexcgilist { white-space: nowrap;
	                         overflow: auto; /* CSS2 */
	                         overflow-x: auto; /* CSS3 */
	                         overflow-y: visible; /* CSS3 */
				 background-color: #eeeedd;
				 border: 0.1em solid #ddddaa;
				 border-radius: 0.5em;
				 margin-left: 1em;
				 padding-left: 1em;
	       }'},
    '-head'=>[
	Link({'-rel'=>'shortcut icon',
	    '-href'=>'/favicon.ico',
	    '-type'=>'image/x-icon'}),
	meta({'-http_equiv'=>'Content-Type','-content'=>'text/html; charset=utf-8'})
    ],
    '-class'=>"$finished TERM-$year$term END-$endsec"

);

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

# get a list of hidden files not to be shown in this directory
my @hidden = ();
if ( open(F,'<.hidden.txt') ){
    @hidden = ;
    chomp @hidden;
    close F;
}

# search the list of hidden files and return 1 if found
sub ishidden {
    foreach my $f ( @hidden ) {
	return 1 if $f eq $_[0];
    }
    return 0;
}

# If an HTML file exists, don't display the .txt file
sub HTMLpriority {
    foreach my $f ( grep { /\.html?$/ } @_ ) {
	$f =~ /^(.*)\.html?$/;
	@_ = grep { ! /^$1.txt$/i } @_;
    }
    return @_;
}

opendir(DIR,".") or die "Cannot open '.': $!";
my @files = sort grep {
	/^[^.]/ && -f && ! /^index.(cgi|php|html?)$/i && ! /\.cgi$/
	    && ! ishidden($_)
    } 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; # delete the array (not the hash)

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

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

my @worksheets = grep { /worksheet\d\d/i } keys %files;
delete @files{@worksheets};

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

my @exercises = grep { /^(2011Fall.*\.(odt|pdf)|project\d+|lab\d+|assignment\d+|exercise|lab\d+exercise)|(lab\d\d(ans)?.(odt|pdf)$)/i } keys %files;
delete @files{@exercises};

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

# Todd Kelly CST8177 13W files use two digits
my @todd = ();
if ( $shortcwd =~ /cst8177\/13w/i ) {
    @todd = grep { /\d\d-.+\.(pdf|txt)$/i } keys %files;
    delete @files{@todd};
}

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

my @cppprogs = grep { /\.(C|cc|cxx|cpp|c\+\+|java)(\.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 { /^(old_*)?(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|mp[12345]|mkv|flv|webm|jpg|png)$/i } keys %files;
delete @files{@datafiles};

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

# pluck off all the course out line files, then delete the generic name
my @courseoutline = grep { /(course_outline|20\d\d-20\d\d_\w\w\w\d\d\d\d)\.pdf$/i } keys %files;
delete @files{@courseoutline};
@courseoutline = grep { ! /^course_outline\.pdf$/i } @courseoutline;

# collect up all the misc wordprocessing stuff left over
# but don't collect things with leading three digists (course notes)
# but don't collect things with two digists (course notes)
my @outlinerr = grep {
           /\.(pdf|doc|wpd|odt|ods)$/i
	|| /^text_errata/i
	|| /^timeline/i
	|| /^lab_access/i
	|| /schedule.txt$/i
	|| /^student_support/i
    } keys %files;
@outlinerr = grep { ! /^\d\d\d_.*\.pdf$/i } @outlinerr; # not this one
@outlinerr = grep { ! /^\d\d\w?-.*\.pdf$/i } @outlinerr; # not this one
delete @files{@outlinerr};

# The files left over are the main course notes
my @left = keys %files;
@left = &HTMLpriority(@left);

# print the big Pandoc top title header
print div(
    {'-id'=>'header'},
    h1({'-class'=>'title'},"Index of $shortcwd"),
    h2({'-class'=>'author'},"Ian! D. Allen - idallen\@idallen.ca - www.idallen.com"),
    h3({'-class'=>'date'},$dateheader)
);
print ul(
    li(a({'-href'=>'..'},'Up to Course Home Page')),
    li(a({'-href'=>'.'},'Raw Directory Index')),
);

# blatant kludge to put the same ID that attaches "This Term Is Finished"
# when the term is over - see ianstyles002.css
print p(
    {'-id'=>'midrightblock','-style'=>'float: none; width: 100%; padding: 0; margin: 0;'},
);

if ( @shellscripts || @allprogs || @perlscripts ) {
	print div <
NOTE:

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.



EOF
}

# concatenate all the output into str, collecting anchors as we go
my @anchors = ();   # GLOBAL - &Sort will fill this in
my $str = '';
# specifying 'sortmod' will sort by modify time, otherwise by file name
$str .= &Show("Weekly Class Notes",'nosort',@weeknotes) if @weeknotes;
$str .= &Show("Todd Kelley Class Notes",'nosort',@todd) if @todd;
$str .= &Show("JCL Examples and Homework",'sortmod',@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 (for hand-in)",'nosort',@exercises) if @exercises;
$str .= &Show("Worksheets (not for hand-in)",'nosort',@worksheets) if @worksheets;
$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",'nosort',@courseoutline) if @courseoutline;
$str .= &Show("Miscellaneous",'nosort',@outlinerr) if @outlinerr;
$str .= &Show("VI Text Editor Notes",'nosort',@review) if @review;
$str .= &Show("Quizzes, Tests, and Exams",'nosort',@tests) if @tests;
$str .= &Show("Optional Material",'sortmod',@optional) if @optional;
$str .= &Show("Data Files (binary)",'sortmod',@datafiles) if @datafiles;
$str .= &Show("Important Notes (chronological order)",'sortmod',@left) if @left;

# print the collected @anchors list of jump down links
#
# print h2("Jump down to:");

# put  tags around all the anchors and make in to a list
#
@anchors = map { a({href=>'#'.&NameAnchor($_)},$_) } @anchors;

# double-div this UL to avoid "Table of Contents" CSS
print div({'-id'=>'TOC'},
    ul(li(\@anchors)),
);


# print the entire main content of the page here
#
print $str;

# space the footer down a bit
print p("");

print '';

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/ /\ /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
}

# &Show( title, flag, @filenames )
# flag can be "sortmod" to sort by modify time then file name,
# otherwise sort only by file name
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|c)$/i ) {
			# 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
			while($l1 = ){
			    next if $l1 =~ /^#!\/bin/;
			    last if $l1 =~ /[a-zA-Z]{3}/;
			}
		    	($filetitle,$l3) = ;
			$filetitle = $l1 if !defined($filetitle) || $filetitle =~ /^[^a-zA-Z]*$/;
			if ( $filetitle ) {
				$filetitle =~ s/^[-!;\s*#\\<>]+//;
				$filetitle =~ s/[-!;\s*#\\<>]+$//;
				$filetitle =~ s@^//\** *@@;
			}
		} elsif ( /\.(html?)$/i ) {
		    	# find the  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
			}
		} elsif ( /\.odt$/i ) {
			# xml_grep --text_only "text:h[@text:outline-level="1"]" -
			# my $str = `2>&1 unzip -p '$_' meta.xml | 2>&1 xmlindent -f -nbe | 2>&1 grep -e '<dc:title>' -e '<dc:subject>'`;
			my $str1 = ` 2>&1 unzip -p '$_' meta.xml | 2>&1 sed -n -e 's;</dc:subject>.*\$;;' -e 's;^.*<dc:title>;;' -e 's;</dc:title><dc:subject>; - ;p' `;
		    	my $str2 = ` 2>&1 unzip -p '$_' content.xml | 2>&1 sed -n -e 's/text:outline-level="1">/<XYZZY>/p' | 2>&1 sed -n -e 's;^.*<XYZZY>;;' -e 's;<.*\$;;p' `;
			$filetitle = "$str1; $str2";
		} else {
			my $buf;
		    	my $n = read F,$buf,4096;
		    	$filetitle = '';
			$filetitle = $1 if $buf && $buf =~ /Subject:\s+(.+)/;
		}
		close F;

		$filetitle =~ s/\s+/ /g;
		$filetitle =~ s/^\s+|\s+$//g;
		$filetitle = substr($filetitle,0,100);
		push(@lines,[ $mtime, $size, $filetitle, $_ ]);
	}
	if ( $flag eq 'sortmod' ) {
	    	# 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
	#
	# 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);
	my $headstr = '';
	$headstr .= div(a({'-name'=>$escstr},""));
	$headstr .= h1({'-style'=>'padding-left: 1em'},$title);

	my $liststr = '';
	foreach ( @lines ) {
	    	my($mtime,$size,$filetitle,$name) = @$_;
		# my $commasize = commify($size);
		$liststr .= &Date($mtime);
		$liststr .= tt(" " x 2);
		$escstr = CGI->escape($name);
		$escstr = "$dir/$escstr" if $dir;
		$liststr .= a({href=>$escstr},tt($name));
		$liststr .= " " x 3;
		$liststr .= b(i(CGI->escapeHTML($filetitle)));
		$liststr .= br;
	}
	return $headstr . div({'-class'=>'indexcgilist'},$liststr) . "\n";
}