#!/usr/bin/perl -w

#
# A work queue for technology or any other sort of job-based scheduling.
# Impements priority handling and "super user" security.  Should be protected
# by web server via authentication.

use strict;
use File::MkTemp;
use Data::Dumper;
use CGI qw/:standard/;
use CGI::Carp qw(fatalsToBrowser);
use Fcntl ':flock';

my $QUEUE_DIR = "/usr/local/www/tech_queue_data";
my @SUPER_USERS = qw ( kelleyc vince );
my @EMAIL_ADDRESSES = qw ( kelleyc vince pager );
my $REMOTE_USER = $ENV{'REMOTE_USER'};
my $LOG_FILE = "/usr/local/www/tech_queue.log";

my $www = new CGI;
my @names = $www->param;
my %functions;
my $highlight = "";
parse_items (\%functions, @names);

print $www->header('text/html');
print $www->start_html(
		       -title => 'Technology Helper Queue',
		       -author => 'ink@inconnu.isu.edu',
		       -base => 'true',
		       -target => '_top',
		       -meta => undef,
		       -style => undef,
		       -BGCOLOR => 'white'
		      );
print "<h2>Technology Helper Queue</h3><br>\n";
print "<h3><a href=queue>[Click here to refresh list]</a></h3>\n";
print "<h3><a href=\"queue?log=1\">[Click here to see a partial log]</a></h3>";
print "<p>\n";

if ($functions{"Delete"}) {

   # delete an entry

   if (grep /$REMOTE_USER/, @SUPER_USERS) {

      my $filename = $functions{"Delete"};
      $filename =~ /([a-zA-Z]+)/;
      $filename = $1;
      log_me("TASK COMPLETED", $filename);
      unless (unlink ("$QUEUE_DIR/$filename")) {
	 spit_error ("Unable to unlink \"$QUEUE_DIR/$filename\" : $!");
      }
   }
   else {
      
      print "<H2>Sorry, you don't have permission to remove queue items.</H2>\n";
   }

}

elsif ($www->param('log')) {

   print "<PRE>\n";
   %ENV = ();
   print `/usr/bin/tail -50 $LOG_FILE`;
   print "</PRE>\n";

   print "<HR>\n";
   print $www->end_html();
   exit (0);

}

elsif ($www->param('Create')) {

   # create a new entry

   my $title = $www->param('Title');
   my $priority = $www->param('Priority');
   
   if (length($title) < 5) {
      
      spit_error ("The title needs to be at least 5 characters long.\n");

   }
   else {

      $priority += 0;  # force number
      if (($priority < 0) || ($priority > 9)) {
      
	 spit_error ("The priority must be between 0 and 9.\n");

      }
      else {
	 $highlight = new_entry($title, $priority, $REMOTE_USER);
	 log_me("TASK ADDED", $highlight);
      }
   }
}

elsif ($functions{'Promote'}) {

   # re-prioritize

   my $filename = $functions{'Promote'};

   change_priority($filename, -1);
   $highlight = $filename;
}

elsif ($functions{'Demote'}) {

   # re-prioritize

   my $filename = $functions{'Demote'};

   change_priority($filename, 1);
   $highlight = $filename;
}

elsif ($functions{'Edit'}) {

   # edit the title

   if (grep /$REMOTE_USER/, @SUPER_USERS) {

      my $filename = $functions{'Edit'};

      change_title($filename, $www->param("Title:$filename"));
      $highlight = $filename;
   }
   else {
      
      print "<H2>Sorry, you don't have permission to edit queue items.</H2>\n";
   }

}

# display current entries
my @items;
read_entries(\@items);
print $www->start_form( 
		       -method => "POST",
		       -action => "queue"
		      );
print "<TABLE border=1>\n";
print "<TR><TH>Priority</TH><TH>Title</TH><TH>Age</TH><TH>Author</TH>";
print "<TH>Delete</TH><TH>Promote</TH><TH>Demote</TH><TH>Edit</TH></TR>\n";

foreach my $item (@items) {

   # color highlight rows, based on certain criteria:  
   # green = hightlight row (just changed/edited this row)
   # red = priority is less than four
   if ($highlight eq $item->{'FILENAME'}) {
      print "<TR BGCOLOR=#C0FFC0>\n";
   }
   else {
      if ($item->{'PRIORITY'} < 4) {
	 print "<TR BGCOLOR=#FFC0C0>\n";
      }
      else {
	 print "<TR>\n";
      }
   }
   print "\t<TD>" . $item->{'PRIORITY'} . "</TD>\n";
   print "\t<TD>" . $item->{'TITLE'} . "</TD>\n";
   print "\t<TD>" . age($item->{'DATE'}) . "</TD>\n";
   print "\t<TD>" . $item->{'AUTHOR'} . "</TD>\n";
   print "\t<TD>" . $www->submit(
				 -name => "Delete:" . $item->{'FILENAME'},
				 -value => "Delete"
				) . "\n";
   print "\t<TD>" . $www->submit(
				 -name => "Promote:" . $item->{'FILENAME'},
				 -value => "Promote"
				) . "\n";
   print "\t<TD>" . $www->submit(
				 -name => "Demote:" . $item->{'FILENAME'},
				 -value => "Demote"
				) . "\n";
   print "\t<TD>" . $www->textfield( 
				    -name => 'Title:' . $item->{'FILENAME'},
				    -default => undef,
				    -override => 1,
				    -size => 30,
				    -maxlength => 80
				   );
   print $www->submit(
		      -name => "Edit:" . $item->{'FILENAME'},
		      -value => "Edit"
		     ) . "</TD></TR>\n";
}

print "</TABLE>\n";

print "<p><HR><p>\n";
print "<h3>Add a new entry</h3><p>";
print "<TABLE border=0>\n";
print "<TR><TD>Problem</TD><TD>";
print $www->textfield( 
		      -name => 'Title',
		      -default => undef,
		      -override => 1,
		      -size => 60,
		      -maxlength => 80
		     );
print "</TD></TR>\n";

print "<TR><TD>Priority (1 = 1st priority;  9 = 9th priority)<BR>\n";
print "Any priority less than 3 will send an immediate e-mail\n";
print "</TD><TD>";
print $www->textfield( 
		      -name => 'Priority',
		      -default => 9,
		      -override => 1,
		      -size => 1,
		      -maxlength => 1
		     );
print "</TD></TR>\n";

print "<TR><TD>Submitted By</TD><TD>$REMOTE_USER</TD></TR>\n";
print "</TABLE>\n";
print "\t<TD>" . $www->submit(
			      -name => "Create",
			      -value => "Create"
			     ) . "\n";


print $www->end_form();
print "<HR>\n";
print $www->end_html();
exit (0);

sub new_entry {

   my ($title, $priority, $author) = @_;

   my $filename = mktemp("tqXXXXXX", $QUEUE_DIR);
   my $tempfh = new IO::File "> $QUEUE_DIR/$filename";
   die "Unable to write $QUEUE_DIR/$filename : $!"
      unless (defined $tempfh);
   print $tempfh "TITLE = $title\n";
   print $tempfh "PRIORITY = $priority\n";
   print $tempfh "DATE = " . (time - 5) . "\n";
   print $tempfh "AUTHOR = $author\n";

   $tempfh->close;

   # send e-mail?
   if ($priority < 3) {
      my @env_saved = %ENV;
      %ENV = ();
      foreach my $person (@EMAIL_ADDRESSES) {
	 open EMAIL, "| /bin/mail -s URGENT '$person'" or die $!;
	 print EMAIL "\nThere has been a priority $priority item added ";
	 print EMAIL "to the technology queue:\n\n";
	 print EMAIL "\thttp://otc.isu.edu/queue\n\n";
	 print EMAIL "\tTITLE = $title\n\tAUTHOR = $author\n\n";
	 print EMAIL "Please fix as soon as possible!\n\n";
      }
      %ENV = @env_saved;
   }

   return $filename;

}

# order list by priority
sub read_entries {

   my $array = shift;

   opendir DIR, $QUEUE_DIR or die $!;

   # get list of all entries
   my ($dirent, %unsorted);
   while ($dirent = readdir(DIR)) {
      next if ($dirent =~ /^\./);
      open ENTRY, "$QUEUE_DIR/$dirent" or die $!;
      my @lines = <ENTRY>;
      close ENTRY;
      my $entry = un_serialize($dirent, @lines);
      push (@{$unsorted{$entry->{'PRIORITY'}}}, $entry);
   }

   # sort 'em by priority
   my @s_priority;
   foreach my $priority (sort numerically keys %unsorted) {
      foreach my $item (@{$unsorted{$priority}}) {
	 push @{$s_priority[$priority]}, $item;
      }
   }

   # sort 'em by time inside each priority
   foreach my $priority (sort numerically keys %unsorted) {
      my %time_unsorted = ();
      foreach my $entry (@{$unsorted{$priority}}) {
	 $time_unsorted{$entry->{DATE}} = $entry;
      }
      foreach my $date (sort numerically keys %time_unsorted) {
	 push @$array, $time_unsorted{$date};
      }
   }

   return;
}


sub numerically {

   $a <=> $b;

}

sub un_serialize {

   my $filename = shift;
   my $line;
   my $entry = { "FILENAME" => $filename };
   foreach $line (@_) {
      $line =~ s/\s+$//;
      my ($token, $data) = split (/\s+\=\s+/, $line);
      if ((defined $token) && (defined $data)) {
	 $entry->{$token} = $data;
      }
   }
   return $entry;
}


sub serialize {

   my $entry = shift;

   my ($token, @lines);
   foreach $token (sort keys %$entry) {
      push @lines, "$token = " . $entry->{$token};
   }

   return @lines;

}


sub age {

   my $utime = shift;

   my $ctime = time;

   my $delta = ($ctime - $utime);

   if ($delta > 0) {

      my ($days, $hours, $mins, $secs);
      $days = int ($delta / 86400);
      $delta -= ($days * 86400);
      $hours = int ($delta / 3600);
      $delta -= ($hours * 3600);
      $mins = int ($delta / 60);
      $delta -= ($mins * 60);
      $secs = $delta;
      if ($days != 1) {
	 return "$days Days $hours:$mins:$secs";
      }
      else {
	 return "$days Day $hours:$mins:$secs";
      }
   }
   else {
      return "Sometime in the future";
   }

}


sub parse_items {

   my $rhash = shift;
   
   foreach my $symbol (@_) {

      if (
	  ($symbol =~ /^Demote/) || 
	  ($symbol =~ /^Delete/) ||
	  ($symbol =~ /^Promote/) ||
	  ($symbol =~ /^Edit/)
	 )
       {
	 my ($key, $value) = split /:/, $symbol;
	 if ((defined $key) && (defined $value)) {
	    $rhash->{$key} = $value;
	 }
	 
      }
   }
}


sub change_title {

   my ($filename, $title) = @_;

   $filename =~ /([a-zA-Z]+)/;
   $filename = $1;

   unless (length($title) > 4) {
      spit_error("A new title must be at least 5 characters long.");
      return;
   }

   open ENTRY, "$QUEUE_DIR/$filename" or die $!;
   my @lines = <ENTRY>;
   close ENTRY;
   my $entry = un_serialize($filename, @lines);
   $entry->{'TITLE'} = $title;

   open ENTRY, ">$QUEUE_DIR/$filename" or die $!;
   flock (ENTRY, LOCK_EX);
   print ENTRY "TITLE = " . $entry->{'TITLE'} . "\n";
   print ENTRY "PRIORITY = " . $entry->{'PRIORITY'} . "\n";
   print ENTRY "DATE = " . $entry->{'DATE'} . "\n";
   print ENTRY "AUTHOR = " . $entry->{'AUTHOR'} . "\n";
   flock (ENTRY, LOCK_UN);
   close ENTRY;

   return;

}


sub change_priority {

   my ($filename, $increment) = @_;

   $filename =~ /([a-zA-Z]+)/;
   $filename = $1;

   open ENTRY, "$QUEUE_DIR/$filename" or die $!;
   my @lines = <ENTRY>;
   close ENTRY;
   my $entry = un_serialize($filename, @lines);
   $entry->{'PRIORITY'} += $increment;

   if (($entry->{'PRIORITY'} < 0) || 
       ($entry->{'PRIORITY'} > 9)) {
      spit_error("Priority cannot exceed 9 nor fall below 0.");
      return;
   }

   open ENTRY, ">$QUEUE_DIR/$filename" or die $!;
   flock (ENTRY, LOCK_EX);
   print ENTRY "TITLE = " . $entry->{'TITLE'} . "\n";
   print ENTRY "PRIORITY = " . $entry->{'PRIORITY'} . "\n";
   print ENTRY "DATE = " . $entry->{'DATE'} . "\n";
   print ENTRY "AUTHOR = " . $entry->{'AUTHOR'} . "\n";
   flock (ENTRY, LOCK_UN);
   close ENTRY;

   return;

}


sub spit_error {


   print "<h3><font color=#FF0505>";
   foreach my $line (@_) {
      print $line;
   }
   print "</font></h3>\n";

}


sub log_me {

   my $reason = shift;
   my $filename = shift;

   $filename =~ /([a-zA-Z]+)/;
   $filename = $1;

   open ENTRY, "$QUEUE_DIR/$filename" or die $!;
   my @lines = <ENTRY>;
   close ENTRY;
   my $entry = un_serialize($filename, @lines);

   my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
      localtime(time);

   open (LOG, ">>$LOG_FILE") || die $!;
   flock (LOG, LOCK_EX);
   $mon++;
   $year += 1900;
   print LOG "$reason on $mon/$mday/$year : ";
   print LOG $entry->{'TITLE'} . " by " . $REMOTE_USER . "\n";
   flock (LOG, LOCK_UN);
   close LOG

}