#!/opt/local/bin/perl
#
# Script to edit any of the division whiteboards
# Access is controlled to members of the dma unix security group with 
+.htacc file.
#
# Uses a SQLite database which is synced to data from Postgres by anot
+her script, sync.pl, which runs regularly
# in cron.
######################################################################
+#######################
# 9/25/06 Changing values of edit buttons to include m1 ID of user (Us
+erID), not name, for more uniformity in
# size of buttons in last column of table (when section is editable) T
+TT
# Also added "Cancel" button at note editing phase.
# Another idea is to eliminate the "section" column when viewing a sec
+ton's whiteboard.  DONE TTT 9/25/06
######################################################################
+#######################
# First things first.  If I can't figure out who you are, you're outta
+ here.
my $editor;
if (exists($ENV{REMOTE_USER}) && $ENV{REMOTE_USER} =~ m/(m[1|3][[:alph
+a:]]{3}\d{2})/i) {
  $editor = $1;
}
($editor) || die "I cannot determine who you are; therefore, you can't
+ access this area.\n
If you feel you are receiving this message mistakenly, please contact 
+Terrence Tate.\n I stopped ";
#Uh, second things second!
#what groups is the user in?
#Assumption:  first group in list is default group.
#(I don't think I ended up using this but useful for if we want to mak
+e the default view the person's default group
#Instead of the Division main view.
my $groups = `id -Gn $editor`;
#If I can't determine what groups you're in, like an angry ump, I'm th
+rowing you out of the game
$? && die " 'id' command failed with exit code $?\n I can't determine 
+what groups you're in so I have to stop";

######################################################################
+#######################
#Modules/Pragmas
######################################################################
+#######################
#to please the Perl gods, who speak through the monks at PM ;)
use strict;
#following three are for debugging--turn off for production.
#(first two can clog up the web log; last isn't of as much consequence
+ if left uncommented)
#use warnings;
#use diagnostics -verbose;    #Produces verbose warning diagnostics
use Data::Dumper;
#use autouse; #Postpones load of modules until a function is used
use CGI qw/:all *table'/;
use CGI::Carp qw(fatalsToBrowser);
use DBI;
#Doesn't seem to need this
#use DBD::SQLite;

######################################################################
+#######################
#some "global" variables (note we already set two, $editor and $groups
+, in the preliminary steps)
######################################################################
+#######################
#DBI->trace(15);  # for debugging
$\ = "\n";    #for prettier source HTML
#finish setting the stuff from before
chomp $groups;
my @groups = split /\s+/, $groups;
#start the rest from scratch
my $tw = "(beta version)"; #"Test Wording!"
my $title  = "Division of Morganic Affairs Whiteboard ".$tw; # This is
+ the window title
my $title1 = "Morganic Affairs"; # This is the text that appears in th
+e header in smaller text (span)
my $title2 = "Whiteboard";  #This is the text that appears in the head
+er in the biggest text
my $dbfile = "/dma/lib/www/wb/wb/whiteboard";
my $table  = 'wbmain';
my $ebn    = 'editbutton';                                            
+#"Edit Button Name!"
my $netan  = 'noteedit';                                              
+#"Note Edit Text Area Name!"
my $netac  = 80;                                                      
+#"Note Edit Text Area Columns!"
my $netar  = 10;                                                      
+#"Note Edit Text Area Rows!"
my $necbn  = 'commitbutton';                                          
+#"Note Edit Commit Button Name!"
my $cbn    = 'Cancel';                                                
+#"Cancel Button Name!"
my $sbn    = 'sectionbutton';                                         
+#by now I hope you can guess.
my $css    = '/dma/wb/wb/wb.css';                                 #the
+ stylesheet we'll be using
my $cn = "All members of the dma unix security group can view the info
+rmation on this page"; #Content Note

my @colors;

for (my $i = 0; $i <= 3; $i++) {

  my ($rand,$x);
  my @hex;

  for ($x = 0; $x < 3; $x++) {
    $rand = rand(255);
    $hex[$x] = sprintf ("%x", $rand);
    if ($rand < 9) {
      $hex[$x] = "0" . $hex[$x];
    }
    if ($rand > 9 && $rand < 16) {
      $hex[$x] = "0" . $hex[$x];
    }
  }
  $colors[$i] = "\#" . $hex[0] . $hex[1] . $hex[2];
}

######################################################################
+#######################
#subs (OK. sub)
######################################################################
+#######################
sub fixtextforbrowser {
  #assume just one argument (hey, this is _my_ program, after all!)
  my $text = $_[0];
  #first, escape whatever stuff is in the string that might be (mis)in
+terpreted by the browser
  $text = escapeHTML($text);
  #Second, turn the line breaks from the text in the text area into HT
+ML <br> tags for proper display
  #in the table
  #oops, didn't have the g at the end at first--of course users might 
+want more than one line break!
  $text =~ s/\r/<br>/g;
  #returning a value allows you to use it in assignment, etc.
  return $text;
} ## end sub fixtextforbrowser

######################################################################
+#######################
#the program actually starts here
######################################################################
+#######################
#looks like this stuff should get done no matter what (at this stage a
+nyway) TTT 9/18/06
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", "", "") || die $DB
+I::errstr;
print header();
#for debugging; unfortunately, we have to do it after we print a heade
+r so it goes here.
#warningsToBrowser(1);
print start_html(-style => {'src' => "$css"}, -title => "$title");
print "<div id='masthead' style ='background: $colors[0]; color: $colo
+rs[1]; border-color: black;'>";
print h3(a({-style =>"color: $colors[2];",-href => "/dma"}, "DMA HOME"
+));
print h1("$title2", span($title1));
print "</div>";
print '<div id="main" align="center"> <font face="Georgia">';
print start_form();
print b($tw);
#print "<div align='center'>";
if (param($necbn)) {
  #web user has commited a change to someone's note
  #below is for debugging; does no harm uncommented since there's no p
+rinting in this block unless we're debugging
  local $\ = "<br>\n";
  #Here we have to deal with the special cases of peoples' names conta
+ining apostrophes/single quotes
  my $rawname = param($necbn);
  my $i1      = index($rawname, " ");    #Index of first space (right 
+after 'Edit');
  #Index of LAST apostrophe--peoples' names can have apostrophes in th
+em!
  #I hope no one's name ever contains the string below!
  my $i2 = index($rawname, "'s note");
  my $uname = substr($rawname, $i1 + 1, $i2 - ($i1 + 1));
  $uname =~ s/'/''/g;                      #for those special cases wh
+ere the user's name has an apostrophe.
  my $note = param($netan);
  #print "note is +$note+";
  $note =~ s/'/''/g;
  #print "note is +$note+";
  #print " raw: $note <br> escaped: ", escapeHTML($note), "<br>";# une
+scaped: ",unescapeHTML($note), "<br>";
  #set "Tracking Info"--OK to use <br> because it's only ever stored a
+nd displayed
  my $ti = localtime(time()) . "<br>$editor";
  my $ss = "update $table set Note='$note', Last_Edit = '$ti' where Na
+me = '$uname'";    #"SQL Statement!"
  $dbh->do($ss) || die $dbh->errstr;
  #Now let's vacuum the database since a change has been made; could b
+e an addition or could be a deletion.
  #Keeps the DB file from growing larger than necessary.  TTT 9/26/06
  #maybe dying here is a little extreme?
  $dbh->do("VACUUM") || die $dbh->errstr;
  #have to do this little bit because it makes more sense to return th
+e user to the section view rather
  #than the main view so they can view their handiwork
  $ss = "select Section from wbmain where Name = '$uname'";
  my $href = $dbh->selectall_hashref($ss, 'Section') || die $dbh->errs
+tr;
  #(that's going to be a hash with one key)
  my @sec = keys(%$href);
  #print Dumper($href);
  #print "select statement was $ss.";
  #print 'you just updated the note for $uname to read:';
  #print '@@@',fixtextforbrowser(param($netan)),'@@@.';
  #print "The SQL statement used was:";
  #print "@@@",fixtextforbrowser($ss),"@@@.";

  #shortcut to get us back to section page (not main page)
  #The name could well stop at the apostrophe but this is OK.
  #Also, we didn't uppercase the section mnemonic because it gets lowe
+rcased later.
  #This is a dummy param to get us back to the section view
  #it's used before reload to no need for a hidden field to make it pe
+rsist past the next submit/reload
  param(-name => $sbn, -value => "View $sec[0]'s whiteboard");
}## end if (param($necbn))
if (!param($ebn) && !param($sbn)) {
  #Default main page with just the general notes for each section; gen
+eral note for MA (program direction) section
  #is main note for all of MA Division
  #Create some space between the masthead and the table
  print br(), p();
  my $dgroup = $groups[0];
  my $aref   =
    $dbh->selectall_arrayref(
    "select * from $table where Name like '%General' order by length(S
+ection), Section, Name")
    || die $dbh->errstr;
  #commented table options  -width => '85%',
  print start_table({-cellpadding => 1, -cellspacing => 1, -border => 
+2, -frame => 'box'});
  my $headref = $dbh->selectall_arrayref("PRAGMA table_info($table)") 
+|| die $dbh->errstr;
  my @header;
  foreach my $col (@{$headref}) {
    push @header, $col->[1];
  }
  push @header, "Section whiteboard";
  print th(\@header);
  foreach my $user (@$aref) {
    #we do this so if people type <b> or whatever in the note it doesn
+'t mess things up
    #AND to properly display line breaks in the note
    $user->[3] = fixtextforbrowser($user->[3]);
    #The default page is just a listing of sections so we're "pushing"
+ submit buttons for viewing each of the sections
    $user->[ scalar(@$user) ] = submit($sbn, "View $user->[1]'s whiteb
+oard");
    print Tr({-align => 'center',-valign => 'top'}, td($user));
  }
  print end_table();
} ## end if (!param($ebn) && !param($sbn))
#Section view is probably more common than editing someone's note so i
+t comes next in the order
elsif (param($sbn)) {
  #user wants to view a specific section web page,
  #or just edited a person's Note,
  #or just canceled out of editing a person's note
  #and is back to page for that person's section
  my $rawsec = param($sbn);                                           
+ #the "Raw" section name
  my $i1     = index($rawsec, " ");                                  #
+Index of first space (right after Edit);
  my $i2     = index($rawsec, "'");                                  #
+Index of first (and only) apostrophe
  my $sec    = lc(substr($rawsec, $i1 + 1, $i2 - ($i1 + 1)));    #Coul
+d well be coming in upper case
  print h1("$sec section whiteboard");
  #Another button to get web user back to main page (more easily seen 
+when notes make table go past bottom of screen)
  print h6(submit(-name => "dummy", -value => "Back to MA Division whi
+teboard"));
  my $info2 = $dbh->selectall_arrayref("PRAGMA table_info($table)") ||
+ die $dbh->errstr;
  my @cols;
  foreach my $colref (@$info2) {
    #this little conditional eliminates the Section column from the se
+lect statement and thus the table
    ($colref->[1] ne 'Section') && push @cols, $colref->[1];
  }
  my @header = @cols;
  #Now construc
  my $ss = 'select ' . join(",", @cols) . " from $table where Section 
+= '$sec' order by length(UserID)";
  #print $ss;
  my $aref = $dbh->selectall_arrayref($ss) || die $dbh->errstr;
  #my @header = &getcols;
  #this is the "big if" here
  if ($groups =~ /(^|\s+)$sec($|\s+)/) {
    push @header, "Edit";
  }
  print start_table({-cellpadding => 1, -cellspacing => 1, -border => 
+2, -frame => 'box'});
  print "<col span=2><col align='left'><col span=2>";
  print th(\@header);
  foreach my $user (@{$aref}) {
    #we have to do this so if people type <b> or whatever it doesn't m
+ess things up
    #AND to then properly display line breaks
    #Now that we are excluding the Section column in the section view,
+ the note is index #2, not #3.  TTT 9/25/06
    $user->[2] = fixtextforbrowser($user->[2]);
    #$user->[3] =~ s/\r/<br>/g;#yeah?
    #Now the default page is just a listing of sections so we're not p
+ushing submit buttons, but links
    #this is the "big if" here
    if ($groups =~ /(^|\s+)$sec($|\s+)/) {
      #this used to be "Edit $user->[0]'s note" for user name but chan
+ging to m1 id as per comment at top TTT 9/25/06
      $user->[ scalar(@$user) ] =
        submit(-name => $ebn, -value => "Edit $user->[1]'s note", -ali
+gn => 'center');    #{-align=>'center'},
    }
    print Tr({-align => 'center',-valign => 'top'}, td($user));
  } ## end foreach my $user (@{$aref})
  print end_table();
  print h1(submit(-name => "dummy", -value => "Back to MA Division whi
+teboard"));
} ## end elsif (param($sbn))  [ if (!param($ebn) && !param($sbn))
elsif (param($ebn)) {
  #Someone wants to edit someone's note.
  #no table so no header here
  #Changing this to sniff the UserID out of the $
  my $rawuid = param($ebn);
  my $i1     = index($rawuid, " ");                 #Index of first sp
+ace (right after Edit);
  #Index of LAST apostrophe--oops, peoples' names can have apostrophes
+ in them!
  #I hope no one's name ever contains the string below!
  #Now it doesn't matter since we're going by m1 id, which never has a
+postrophes, but it doesn't hurt
  #(much) TTT 9/25/06
  my $i2 = index($rawuid, "'s note");
  my $uid = substr($rawuid, $i1 + 1, $i2 - ($i1 + 1));
  #now we have to do the select before this part to get the Name for t
+he UserID we just got!
  #Added UserID to the select so I can key off that in the resulting h
+ash; added Section so I can use that
  #to get back to Section page if Cancel button is hit.  TTT 9/25/06
  my $st    = "select Name, Note, UserID, Section from $table where Us
+erID = '$uid'";
  my $href  = $dbh->selectall_hashref($st, "UserID") || die $dbh->errs
+tr;
  my $uname = $href->{$uid}->{Name};
  print h4("You are editing the note that will be displayed on the con
+tingency whiteboard for");
  print h1($uname);
  #This gets all but the first and last single-quotes, hard-coded into
+ query below
  my $inlist = join("','", @groups);
  #print "Select statement is:$st<br>";
  #print "select statement:<br>^$st^<br>returned:";
  #print Dumper(%$href);
  my $note = $href->{$uid}->{Note};
  print textarea(-name => $netan, -default => $note, -rows => $netar, 
+-columns => $netac);
  #just putting in an h1 gives the same spacing as "<br><br>", which i
+s more cumbersome.
  print h1(submit(-name => $necbn, -value => "Commit ${uname}'s note")
+, submit($cbn,$cbn));
  #put in a clear button? submit('Clear','Clear'), TTT 9/26/06
  #This is a dummy param to get us back to the section view if the use
+r cancels (works the similarly to the
  #same line at the end of the conditional block for if the Commit but
+ton was pressed) TTT 9/25/06
  print hidden(-name => $sbn, -value => "View $href->{$uid}->{Section}
+'s whiteboard");
  #Note that the noteeditbutton param ($netan) will also be passed, bu
+t the $necbn commit button won't
  #So no database changes will be made!
} ## end elsif (param($ebn))  [ if (!param($ebn) && !param($sbn))
print end_form();
print "<div id='footer' align='center'>";
$dbh->disconnect() || die $dbh->errstr;
my $mtime = localtime((stat "$0")[9]);
local $\ = br();
print hr(), font({-size => '-1'}), "Script modified $mtime";
print "Created and maintained by Terrence Tate";
print b($cn);
print a({href=>"wb.pl"},"Back to same old colors");
print "</div>";    #closing the main div with align=center
#print Dump();
print end_html();
[download]