#!/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 checkbox_files.cgi from the URL and try again.
##############################################################################









































#   $0 [ dir=<directory> ] [ ignore=<suffix,suffix,suffix> ]
# Produce a checkbox list of files for <directory>.
# If no directory, do current directory.
# Must have r and x perms on the directory.
# Directory must contain a generally-writable .tmp directory;
# will not produce a list unles .tmp/. exists in <directory>.
#
# Apache suexec notes:
#  - suexec is automatically used for public_html CGI scripts
#  - suexec will not be used for a 1.3 virtual domain unless the
#    User and Group are given in the VirtualHosts section in
#    /etc/httpd/conf/vhosts/Vhosts.conf
#  - suexec will not be used for a 2.x virtual domain unless the
#    SuexecUserGroup is given in the VirtualHosts section in
#    /etc/httpd/conf/vhosts/Vhosts.conf
#  - if suexec is used in a virtual domain, the compiled-in docroot
#    inside suexec must be a prefix of the virtual domain docroot
#    (it usually isn't - this is a real pain - some versions of suexec
#    are built with "/" as the compiled-in docroot to get around this)
#  - cgi scripts cannot be symlinks if suexec is used; links are OK
# idallen@idallen.ca

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

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

# This happens when defaults() clears the form!
# Put back $dir from the arg list.
#
#if( @ARGV <= 0 ){
#	$dir = $ENV{QUERY_STRING} || '';
#	print "DEBUG resetting dir '$dir'\n";
#	$dir =~ s/dir=//;
#	param('dir',$dir);
#}

# Optional: comma-separated list of what suffixes to ignore.
# ignore=html,cgi,sh,etc
# Don't use this - use the .hidden.txt file instead
#
if ( param('ignore') ) {
	$ignore = param('ignore');
	$ignore =~ s/,/|/;
	$ignore =~ s/.*/\\.($&)\$/;
	# print "DEBUG ignore='$ignore'\n";
} else {
	$ignore = '\.(cgi)$';
}

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

# 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
    $realdir = param('realdir');
    unless ( $realdir ) {
	    $realdir = $dir;
	    ($idallen) = $realdir =~ /~(idallen\w*)/;
	    if ( $idallen ) {
		if ( -d "/home/$idallen/public_html" ) {
		    $realdir =~ s|/~idallen\w*|/home/$idallen/public_html|;
		}
	    } elsif ( -d '/homepages/27/d89455221/htdocs' ) {
		$realdir =~ s|/~u35482050|/homepages/27/d89455221/htdocs|;
	    } 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 a list of hidden files not to be shown in this directory
my @hidden = ();
if ( open(F,'<.hidden.txt') ){
    @hidden = <F>;
    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;
}


# 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/:: ;

# 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
# print start_html('-title'=>$shortcwd);
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'=>'
	          .list { white-space: nowrap }
		  table { border-collapse: collapse ;
		          background-color: #eee;
			  border: 0.5em groove black ;
			  border-radius: 1em ; 
			  margin: auto;
		  }
		  th, td { border: 0.1em solid black ;
		           border-right-style: none;
		           border-left-style: none;
		           white-space: nowrap ;
		           padding-left: 0.5em ;
		           padding-right: 0.5em ;
		  }
		  th {
		      background-color: #ccc ;
		      border-right-style: dotted;
		      border-left-style: dotted;
		  }
		  .number { text-align: right;  }
		  .daymon { color: green }
	      '},
    '-head'=>[
	Link({'-rel'=>'shortcut icon',
	    '-href'=>'/favicon.ico',
	    '-type'=>'image/x-icon'}),
	meta({'-http_equiv'=>'Content-Type','-content'=>'text/html; charset=utf-8'})
    ]
);

print h1("Date+Sort in $shortcwd");

print p(a({'-style'=>'top: 0; position: absolute','-href'=>'.'},'&nbsp;'));
# div nest this to stop it from being taken for a navbar by CSS
print div(ul({'-style'=>'
	    float: right;
	    font-variant: small-caps;
	    margin: 0;
	    '},
    li(a({'-href'=>'..'},'Up to ',b('Course Home Page'))),
    li(a({'-href'=>'indexcgi.cgi'},'Course Notes by ',b('Category'))),
));


# print "DEBUG [$root] [$shortcwd]\n<PRE>";
# system('printenv');

unless (
	$cwd =~ m+/(alleni|idallen\w*)/public_html/.+
	||
	$cwd =~ m+/homepages/27/d89455221/htdocs/.+
	||
	$cwd =~ m+/d2/pictures/.+
	||
	$cwd =~ m+/idallen\w*/algonquin/(cst|dat)..../.+
	) {
	print h1($savedir);
	print h2($realdir);
	print h3($cwd) unless $realdir eq $cwd;
	print p("This directory is not a public Ian Allen Web directory.\n");
	print p("The pathname is not under a built-in list.\n");
	print end_html();
	exit 1;
}

$savedir = $dir;

# Browsable dirs must have a .tmp in them; otherwise, this script might
# browse any directories owned by the user.
#
unless ( -r '.' && -x _ && -e '.tmp/.' ) {
	print h1($savedir);
	print h2($realdir);
	print h3($cwd) unless $realdir eq $cwd;
	print p("Directory $cwd does not permit browsing.\n<PRE>");
	system("id;pwd;ls -ld . .tmp");
	print end_html();
	exit 1;
}

$download = param('download');
@selectfiles = param('selectfiles');

unless ( $download && @selectfiles ) {
	# FIRST Menu
	#  Present a list of files and let users check off which ones
	#  they want to download.
	#  Runs unless user has pushed "download" and has non-empty
	#  list of selected files.
	#  Set "download" and "selectfiles" parameters.
	#
	opendir(DIR,".") or die "Cannot open '.': $!";
	# @files = sort grep { /^[^.]/ && -f && ! /^index.(cgi|html?)$/i} readdir(DIR);
	@files = sort grep { /^[^.]/ && -f && -r } readdir(DIR);
	@files = grep { ! /$ignore/oi } @files if $ignore;
	@files = grep { ! ishidden($_) } @files;
	closedir DIR;
	#print "DEBUG @files<br>\n";

	@checkboxes = checkbox_group(
		'-name'=>'selectfiles',
		'-values'=>\@files,
		'-nolabels'=>'1',
		'-linebreak'=>'1',
		);
	$sort = param('sort') || 'Dmtime';
	$mostrecent = 0;
	$mostfile = 'UNKNOWN';
	$countcheckboxes = 0;   # count of files that can be checked
	foreach ( @files ) {
		my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
                      $atime,$mtime,$ctime,$blksize,$blocks)
			    = stat;
		$commasize = commify($size);
		$mostrecent = $mtime, $mostfile = $_
			if $mostrecent < $mtime;
		# put the field we want to sort by into $sortby, see below
		# append the name to the sort key so that things with the
		# same size or time are also sorted by name
		$sortby = lc($_);  # sort by case-insensitive name
		$sortproc = '{$a cmp $b}';
		if ( $sort eq 'Dname' ){
			$sortby = lc($_);  # sort by case-insensitive name
			$sortproc = '{$b cmp $a}';
		} elsif ( $sort eq 'Amtime' ) {
			$sortby = sprintf("%010d",$mtime) . $_;
			$sortproc = '{$a cmp $b}';
		} elsif ( $sort eq 'Dmtime' ) {
			$sortby = sprintf("%010d",$mtime) . $_;
			$sortproc = '{$b cmp $a}';
		} elsif ( $sort eq 'Asize' ) {
			$sortby = sprintf("%010d",$size) . $_;
			$sortproc = '{$a cmp $b}';
		} elsif ( $sort eq 'Dsize' ) {
			$sortby = sprintf("%010d",$size) . $_;
			$sortproc = '{$b cmp $a}';
		}
		# Only make a checkbox for plain text files.
		$cb = shift @checkboxes;
		if ( /\.(txt|asm|c|pl|log|cgi|java)$/i ) {
			++$countcheckboxes;
		} else {
			$cb = '&nbsp;';
		}
		# push the field we want to sort by first in a comment
		push(@rows,"<!--$sortby-->"
			. th($cb)
			. td({'-class'=>'date'},strftime("%Y <span class=\"daymon\">%m-%d</span> %H:%M",localtime($mtime)))
			. td({'-class'=>'filename'}, a({href=>$dir.CGI->escape($_)},$_))
			. td({'-class'=>'number'},"$commasize ")
			);
	}

	# Only show download words and buttons if there is something
	# that can be downloaded.
	#
	$h1download = '';
	$selecttitle = '';
	if ( $countcheckboxes ) {
		$h1download = ', or select text files for concatenation and download';
		$selecttitle = "Select<br>Text";
	}

	print h2({'-style'=>'padding-left: 1em; max-width: 65%'},"Browse$h1download");
	# print "DEBUG [", param('download'), "]\n";



	if ( $download && $countcheckboxes && @selectfiles <= 0 ) {
	    	print p(strong("You must select some files before you can download"));
	    	print p(strong("Use the Select buttons beside the file names"));
	}
	if ( @rows ) {
		$date = localtime($mostrecent);
		print p({'-style'=>'clear: both; margin-left: 1em'},"Most recently updated file:",
			tt("&nbsp;".b($mostfile)."&nbsp;",b($date)));
		@rows = eval "sort $sortproc \@rows";
	}

	print start_form;
	print p(hidden('-name'=>'hidden','-value'=>$$));
	print p(hidden('-name'=>'dir','-value'=>$dir));
	print p(hidden('-name'=>'ignore','-value'=>$ignore));
	print p(hidden('-name'=>'realdir','-value'=>$realdir));
	&DoSubmit if $countcheckboxes;
	@buttons = qw(Aname Dname Asize Dsize Amtime Dmtime);
	@buttonlabels{@buttons} = qw(Sort Reverse-Sort S R Sort Rev);
	@printlabels{@buttons} = (
		'Ascending Name',
		'Reverse Name',
		'Ascending Size',
		'Reverse Size',
		'Ascending Date Modified',
		'Reverse Date Modified',
		);
	@radio = radio_group(
		'-name'=>'sort',
		'-default'=>$sort,
		'-values'=>\@buttons,
		'-labels'=>\%buttonlabels,
		'-onClick'=>"submit()",
		);
	# we style this in the <head> section
	print table(caption(big(strong('Sorted by:',$printlabels{$sort})),br,
		    i("Select a Sort/Reverse Button to change the sort order")),
		Tr(""
			.th({'-class'=>'list'}, $selecttitle)
			.th({'-class'=>'list'}, "Last Modified<br>", $radio[4], $radio[5] )
			.th({'-class'=>'list'}, "File Name<br>", $radio[0], $radio[1] )
			.th({'-class'=>'list'}, "Bytes<br>", $radio[2], $radio[3] )
		    ),
		    Tr(\@rows)
		);
	&DoSubmit if $countcheckboxes;
	print end_form;
} else {
	# SECOND Menu
	#  Called to handle the selected items.
	#
	print h1("Link to selected files for download");
	@selectfiles = param('selectfiles');
	die "Cannot find any files\n  " unless @selectfiles;
	$hidden = param('hidden') || die;
	print p(tt("@selectfiles"));
	#die "Cannot download; cannot find writable '.tmp': $!\n  "
	#	unless -w '.tmp/.';
	$out = ".tmp/cgi_$hidden";
	# remove previous files with this root
	unlink <$out*>;
	# generate a new file name every time, so that browser
	# caching doesn't display an old page
	$out .= "_$$.txt";
	open(OUT,">$out")
		or die "id($<,$>) Cannot open '$dir$out': $!";
	foreach $f (@selectfiles) {
		open(IN,"<$f")
			or die "Cannot open '$dir$f': $!";
		my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
                      $atime,$mtime,$ctime,$blksize,$blocks)
			    = stat(IN);
		$date = localtime($mtime);
		print OUT ")---------- $f -- $date ----------\n";
		print OUT <IN>;
		close IN;
	}
	close OUT or die "Cannot close '$dir$out': $!";
	print h2("Right-click on the link and select 'Save'");
	print p("The concatenated text file is in Unix format,",
		"using ASCII newline line-end terminators.");
	print p("Open it with VI, WRITE, or WORDPAD.",
		"Windows NOTEPAD will not display it correctly.");
	print a({href=>"$dir$out"},"Download Concatenated Selected Files");
}

print '
<pre id="signature"><code><b>Author:</b>
| Ian! D. Allen  -  idallen@idallen.ca  -  Ottawa, Ontario, Canada
| Home Page: http://idallen.com/   Contact Improv: http://contactimprov.ca/
| College professor (Free/Libre GNU+Linux) at: http://teaching.idallen.com/
| Defend digital freedom:  http://eff.org/  and have fun:  http://fools.ca/
</code></pre>
';

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

print '
<div id="footer">
  <p>
    Web hosting under Free / Open Source software: GNU/Linux/Apache/PHP.
    Webmaster: <a href="http://idallen.com/">Ian!&nbsp;D.&nbsp;Allen</a>
  </p>
  <p>
    <a href="http://www.arachnoid.com/freezone/">
      <img class="middle wide"
        src="common/freezone1.jpg"
        alt="Internet Free Zone Level 1 logo"
        width="440" height="40"></a>
      Support
	  <a href="http://www.arachnoid.com/freezone/">free and non-commercial</a>
		Internet.
  </p>
  <p>
      <a href="http://validator.w3.org/check?uri=referer"><img
	  class="middle"
	    src="http://www.w3.org/Icons/valid-html401" title="Validate HTML"
	    alt="Valid HTML 4.01 Strict" height="31" width="88"></a>
     <a href="http://jigsaw.w3.org/css-validator/check/referer">
        <img class="middle" width="88" height="31"
            src="http://jigsaw.w3.org/css-validator/images/vcss"
            alt="Valid CSS!" title="Validate CSS">
    </a>

    <a href="http://www.anybrowser.org/campaign/">
    <img class="middle" src="common/anybrowser3.gif" alt="Any Browser logo" width="88" height="31"></a>
    Online materials should be viewable in
      <a href="http://www.anybrowser.org/campaign/">Any Browser</a>.
  </p>
  <p>
    <!-- Creative Commons License -->
    <a href="http://creativecommons.org/licenses/by-nc-sa/2.5/ca/">

	<img class="middle" alt="Creative Commons License logo"
    src="common/somerights.gif" width="88" height="31"></a>
    This work is licensed under a
	<a href="http://creativecommons.org/licenses/by-nc-sa/2.5/ca/">Creative Commons License</a>.
    <!-- /Creative Commons License -->
    <!--
    <rdf:RDF xmlns="http://web.resource.org/cc/"
	xmlns:dc="http://purl.org/dc/elements/1.1/"
	xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">
    <Work rdf:about="http://idallen.com/ web pages">
    <license rdf:resource="http://creativecommons.org/licenses/by-nc-sa/2.5/ca/">
    </Work>
    </rdf:RDF>
    -->
  </p>
  <p>
    <a href="http://www.catb.org/hacker-emblem/"><img
	class="middle" src="common/glider.png"
	alt="Hacker Ideals Emblem"></a>
    <a href="http://www.catb.org/jargon/html/H/hacker.html">The real
	definition of Hacker</a>

    </p>
</div><!-- /footer -->
';


print end_html();

exit 0;

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

# Print the list of submit buttons.
#
sub DoSubmit {
        # XXX This doesn't seem to be a problem today.
	# Need a dummy first submit button so that when the JavaScript
	# submit() is called, 'download' doesn't have a value.
	# Is this a bug?
	# defaults() clears even the passed query string!
	# This makes it useless for a CGI that takes arguments.
	print p(
		# submit('-name'=>'dummy','-value'=>''),
		submit('-name'=>'download','-value'=>'Download Concatenated Selected Files'),
		reset('Undo current changes')
		);
}