#!/opt/local/bin/perl
#
# Script to edit any of the Division section whiteboards
# Access to script via browser is restricted to members of the dma unix security group
#with .htacc file.
use strict;
use warnings;

# First things first.  If I can't figure out who you are, you're outta here.
my $editor;
if ( exists( $ENV{REMOTE_USER} ) ) {
    ($editor) = $ENV{REMOTE_USER} =~ m/(m[1|3][[:alpha:]]{3}\d{2})/i;
}
($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 Jonathan Crane.\n
I stopped ";

#Uh, second things second!
#what groups is the user in?
#Assumption:  first group in list is default group.
my $groups = `id -Gn $editor`;

#If I can't determine what groups you're in, like an angry ump,
#I'm throwing you out of the game
$? && die "id cmd failed w/ code $?\n can't tell what groups you're in; I have to stop";
##########################################################################################
#Modules/Pragmas
##########################################################################################
use CGI qw/:all *table'/;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use DBI;
use Readonly;
##########################################################################################
#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;
Readonly my @GROUPS => split /\s+/, $groups;

#start the rest from scratch
Readonly my $VERSION   => '1.0b';
Readonly my $WIN_TITLE => "Division of Morganic Affairs Whiteboard "
  . $VERSION;    # This is the window title
Readonly my $SUBTITLE_1 =>
  "Morganic Affairs";    # text that appears in the header in smaller text (span)
Readonly my $SUBTITLE_2 =>
  "Whiteboard";          #This is the text that appears in the header in the biggest text
Readonly my $DB_FILE             => "/dma/lib/www/wb/wb/wbtest";
Readonly my $TABLE               => 'wbmain';
Readonly my $EDIT_BUTTON_NAME    => 'editbutton';
Readonly my $TEXT_AREA_NAME      => 'noteedit';                  #Note Edit Text Area Name
Readonly my $TO_MAIN_BUTTON_NAME => 'backto';
Readonly my $TO_MAIN_MSG         => 'MA Division whiteboard';
my $netac = 80;    #"Note Edit Text Area Columns!"
my $netar = 10;    #"Note Edit Text Area Rows!"
Readonly my $COMMIT => 'commitbutton';    #"Note Edit Commit Button Name!"
my $cbn = 'Cancel';                       #"Cancel Button Name!"
Readonly my $CLEAR => 'Clear';            #Clear 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

#Column name words are separated by underscores
Readonly my $PRIV_U => 'Private_';
Readonly my $PRIV   => 'private';

#Content Note
my $cn =
  "Members of the dma security group can view all content not explicitly marked as $PRIV";
my $tablestyle = {
    -cellpadding => 1,
    -cellspacing => 1,
    -border      => 2,
    -frame       => 'box',
    -align       => 'center'
};
my $pam1 = "<font size='+1'><b>$PRIV area</b></font><br/>
(only members of the section security group can view and edit the data below)<br/>";

#"Private Area Message 1"
my $pam2     = "<font size='+1'><b>End $PRIV area</b></font>";
my %sections = (
    " DMA" => 'dma',
    FST    => 'dma/fst',
    MRA    => 'dma/mra',
    BKS    => 'bks',
    MSU    => 'dma/msu',
    FMA    => 'dma/fma',
    FOMC   => 'dma/FOMC'
);
my @dcols =
  ( "Name", "User_ID", "Note", "Last_Edit" );    #default columns for select statements

#The following two regexps lifted from Jeff Friedl's "Mastering Regular Expressions,"
#2nd ed, p. 206 with slight mods
my $hnr = qr/  #"Host Name Regex
(?: [a-z0-9] (?:[-a-z0-9]*[a-z0-9])? \. )+ # sub domains
# Now ending .com, etc.
(?: com\b
    | edu\b
    | biz\b
    | org\b
    | gov\b
    | in(?:t|fo)\b # .int or .info
    | mil\b
    | net\b
    | name\b
    | museum\b
    | coop\b
    | aero\b
    | [a-z][a-z]\b # two-letter country codes
)/x;
my $pr = qr{ #Path Regex--using braces since there's a slash in it.
(?:
     /
     # The rest are heuristics for what seems to work well
     [^.!,?;"'<>()\[\]{}\s\x7F-\xFF]*
     (?:
        [.!,?]+  [^.!,?;"'<>()\[\]{}\s\x7F-\xFF]+
     )*
)?}x;
my $lr = qr{\b
# Match the leading part (proto://hostname, or just hostname)
(?:
    # ftp://, http://, or https:// leading part
    (?:ftp|https?)://[-\w]+(?:\.\w[-\w]*)+
  |
    # or, try to find a hostname with our more specific sub-expression
    #made the parens that enclose the proto part capturing so we can test for
            #participation of $2 in the substitution later 
    ($hnr)
)
# Allow an optional port number
(?: : \d+ )?
# The rest of the URL is optional, and begins with /, and is represented by $pr
$pr
}x;
Readonly my $LEAVE_CAL_URL  => '/cgi-bin/dma/LEAVEcal/calendar.pl';
Readonly my $LEAVE_CAL_TEXT => 'MA Leave Calendar';
##########################################################################################
#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)interpreted by the browser
    $text = escapeHTML($text);

    #Second, turn the line breaks from the text in the text
    #area into HTML <br/> tags for proper display
    #in the table
    $text =~ s/\r/<br\/>/g;

    #Third, linkify URLs
    $text =~ s!($lr)!($2)?"<a href='http://$1'>$1</a>":"<a href='$1'>$1</a>"!ge;

    #returning a value allows you to use it in assignment, etc.
    return $text;
} ## end sub fixtextforbrowser
##########################################################################################
#the program actually starts here
##########################################################################################
print header();

#for debugging; unfortunately, we have to do it after we print a header so it goes here.
warningsToBrowser(1);
print start_html( -style => { 'src' => "$css" }, -title => "$WIN_TITLE" );
print "<div id='masthead'>";
print "<h3 align='center'>";
my @la;
foreach my $s ( sort keys(%sections) ) {
    push @la, a( { -href => "/$sections{$s}" }, "$s HOME" );
}
my $homes = join( " |", @la );
print $homes;
my @pipes;
my $pos;
while ( $homes =~ m/\|/g ) {
    push @pipes, pos($homes) - 1;
}
my $numps = scalar(@pipes);
my $ptr   = $numps - int( $numps / 2 );
substr( $homes, $pipes[$ptr], 1, br() );

#print $homes;
print "</h3>";
print h1(
    $SUBTITLE_2,
    span( { -class => 'subtitle' },    $SUBTITLE_1 ),
    span( { -class => 'versioninfo' }, "version $VERSION" )
);
print "</div>";
print '<div id="main" align="center">';
print a( { -href => $LEAVE_CAL_URL, }, $LEAVE_CAL_TEXT );

#print Dump( param() );
print start_form();

#looks like this stuff should get done no matter what (at this stage anyway)
my $dbh = DBI->connect( "dbi:SQLite:dbname=$DB_FILE", "", "" ) || die $DBI::errstr;

#We kind of pre-check here to see if we need to update the DB, but this part doesn't
#do any printing.
if ( param($COMMIT) ) {

    #web user has commited a change to someone's note
    #no printing in this block unless we're debugging
    local $\ = "<br/>\n";

    #Here we have to deal with the special cases of peoples' names
    #containing apostrophes/single quotes
    my $rawname = param($COMMIT);
    my $i1 = index( $rawname, " " );    #Index of first space (right after 'Commit');
         #Index of LAST apostrophe--peoples' names can have apostrophes in them!
         #I hope no one's name ever contains the string below!
    my $i2 = index( $rawname, "'s " );
    my $uname = substr( $rawname, $i1 + 1, $i2 - ( $i1 + 1 ) );
    my $note  = param($TEXT_AREA_NAME);

    #set "Tracking Info"--OK to use <br/> because it's only ever stored and displayed
    my $ti = localtime( time() ) . "<br/>$editor";
    my ( $priv, $priv_u ) = ( q{}, q{} );
    if ( $rawname =~ $PRIV ) {
        $priv_u = $PRIV_U;
        $priv   = $PRIV;
    }
    my $ss = "update $TABLE set ${priv_u}Note=?, Last_${priv_u}Edit = ? where Name = ?";
    my $num_rows_affected = $dbh->do( $ss, undef, ( $note, $ti, $uname ) )
      || die $dbh->errstr;
    if ( $num_rows_affected == 0 ) {
        warn "Hey!  No rows updated!";
    }

    #Now let's vacuum the database since a change has been made; could be
    #an addition or could be a deletion.
    #Keeps the DB file from growing larger than necessary.
    #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 the user to the section view rather
    #than the main view so they can view their handiwork
    $ss = "select Section from $TABLE where Name = ?";
    my $href = $dbh->selectall_hashref( $ss, 'Section', undef, $uname )
      || die $dbh->errstr;

    #(that's going to be a hash with one key)
    my @sec = keys(%$href);

    #Make sure we got a row back!
    if ( !scalar @sec ) {
        warn "select statement returned no rows!  Selected on name '$uname'.";
    }

    #This is a dummy param to get us back to the section view
    #it's used before reload so no need for a hidden field to make it persist past the
    #next submit/reload
    param( -name => $sbn, -value => "View $sec[0]'s whiteboard" );
} ## end if ( param($COMMIT) )
##########################################################################################
#OK so default view is your section view.  That's !param--first opening of the page
#so if that's not true, we check to see if it's an 'explicit' request to see a section
#whiteboard.  If so, we also make sure it's not after pressing the "clear" button
#on the edit note screen.
if ( !param() || ( param($sbn) && !param($CLEAR) ) ) {

    #am I in this group? not right now, we'll decide in an if statement later
    my $insider = 0;
    my $sec;

    #if we're here because someone pressed a button to
    #view the page, extract the necessary info
    if ( 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, q{ } );    #Index of first space (right after Edit);
        my $i2     = index( $rawsec, q{'} );    #Index of first (and only) apostrophe
                                                #Could well be coming in upper case
        $sec = lc( substr( $rawsec, $i1 + 1, $i2 - ( $i1 + 1 ) ) );
    } ## end if ( param($sbn) )
    else {

        #use the user's default group
        $sec = $GROUPS[0];
    }
    print b("<font size='+3'>$sec</font>"), br(), "section whiteboard";
    print br();

    #Another button to get web user back to main page (more
    #easily seen when notes make table go past bottom of screen)
    print submit( -name => $TO_MAIN_BUTTON_NAME, -value => $TO_MAIN_MSG );

    #Now construct the SQL statement
    my $ss = 'select '
      . join( ",", @dcols )
      . " from $TABLE where Section = ? order by length(User_ID), User_ID";

    #print $ss;
    my $aref   = $dbh->selectall_arrayref( $ss, undef, $sec ) || die $dbh->errstr;
    my @header = @dcols;

    #this is the "big if"
    if ( $groups =~ /(^|\s+)$sec($|\s+)/ ) {
        push @header, "Edit";
        $insider = 1;
    }
    foreach (@header) {
        s/_/ /g;
    }
    print start_table($tablestyle);
    print Tr( th( \@header ) );
    foreach my $user ( @{$aref} ) {

        #we have to do this so if people type <b> or whatever it doesn't mess things up
        #AND to then properly display line breaks
        $user->[2] = fixtextforbrowser( $user->[2] );

        #this is the "big if" here
        if ($insider) {
            $user->[ scalar(@$user) ] =
              submit( -name => $EDIT_BUTTON_NAME, -value => "Edit $user->[1]'s note", );
        }
        print Tr( { -align => 'center', -valign => 'top' }, td($user) );
    } ## end foreach my $user ( @{$aref} )
    print end_table();
    print submit( -name => $TO_MAIN_BUTTON_NAME, -value => $TO_MAIN_MSG );
    if ($insider) {
        print hr( { -size => 3 } );
        print $pam1;

        #columns for private data
        my @pcols = ( "Name", "User_ID", "Private_Note", "Last_Private_Edit" );
        $ss = 'select '
          . join( ",", @pcols )
          . " from $TABLE where Section = ? order by length(User_ID), User_ID";
        my $aref = $dbh->selectall_arrayref( $ss, undef, $sec ) || die $dbh->errstr;
        print start_table($tablestyle);
        my @phead = ( @pcols, "Edit" );
        foreach (@phead) {
            s/_/ /g;
        }
        print Tr( th( \@phead ) );
        foreach my $user ( @{$aref} ) {
            $user->[2] = fixtextforbrowser( $user->[2] );
            $user->[ scalar(@$user) ] = submit(
                -name  => $EDIT_BUTTON_NAME,
                -value => "Edit $user->[1]'s $PRIV note",
            );
            print Tr( { -align => 'center', -valign => 'top' }, td($user) );
        }
        print end_table();
        print submit( -name => $TO_MAIN_BUTTON_NAME, -value => $TO_MAIN_MSG );
        print br();
        print $pam2;

        #print hr({-color=>'black'});
    } ## end if ($insider)
} ## end if ( !param() || ( param($sbn) && !param($CLEAR) ) )
elsif ( param($TO_MAIN_BUTTON_NAME) ) {

    #Default main page with just the general notes for each section;
    #general 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();
    my $ss = "select "
      . join( ",", @dcols )
      . " from $TABLE where Name like '%General' order by length(Section), Section, Name";

    #print "The select statement is !!$ss!!";
    my $aref = $dbh->selectall_arrayref($ss) || die $dbh->errstr;
    print start_table($tablestyle);
    my @header = ( @dcols, "Section Whiteboard" );

    #Column names are separated by underscores in DB, convert them to spaces for display
    foreach (@header) {
        s/_/ /g;
    }
    print Tr( 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->[2] = fixtextforbrowser( $user->[2] );

        #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 whiteboard" );
        print Tr( { -align => 'center', -valign => 'top' }, td($user) );
    } ## end foreach my $user (@$aref)
    print end_table();
} ## end elsif ( param($TO_MAIN_BUTTON_NAME) )
elsif ( param($EDIT_BUTTON_NAME) ) {

    #Someone wants to edit someone's note.
    #no table so no header here
    my $rawuid = param($EDIT_BUTTON_NAME);
    my $i1     = index( $rawuid, " " );      #Index of first space (right after Edit);
                                             #Index of end of m1 ID
    my $i2     = index( $rawuid, "'s " );
    my $uid = substr( $rawuid, $i1 + 1, $i2 - ( $i1 + 1 ) );
    my ( $priv, $priv_u ) = ( q{}, q{} );
    if ( $rawuid =~ $PRIV ) {
        $priv_u = $PRIV_U;
        $priv   = $PRIV;
    }
    my $st = "select Name, ${priv_u}Note, User_ID, Section from $TABLE where User_ID = ?";
    my $href = $dbh->selectall_hashref( $st, "User_ID", undef, $uid ) || die $dbh->errstr;
    my $uname = $href->{$uid}->{Name};

    #this here was problematic
    print "You are editing the";
    if ( $priv ne q{} ) {
        print b($priv);
    }
    print "note that will be displayed on the Morganic Affairs whiteboard for";
    print h3($uname);

    #This gets all but the first and last single-quotes, hard-coded into query below
    my $inlist = join( "','", @GROUPS );
    my $note   = $href->{$uid}->{"${priv_u}Note"};

    #If user hit the "Clear" button, we need to clear BOTH $note AND the
    #textarea param due to its "stickiness"
    if ( param($CLEAR) ) {

        #print "You hit the Clear button!";
        $note = '';
        param( $TEXT_AREA_NAME, '' );
    }
    print textarea(
        -name    => $TEXT_AREA_NAME,
        -default => $note,
        -rows    => $netar,
        -columns => $netac
    );

    #just putting in an h1 gives the same spacing as "<br><br>", which is more cumbersome.
    print h1(
        submit( $CLEAR, $CLEAR ),
        submit( -name => $COMMIT, -value => "Commit ${uname}'s $priv note" ),
        submit( $cbn, $cbn )
    );

    #This is a dummy param to get us back to the section view if the user cancels
    #(works the similarly to the
    #same line at the end of the conditional block for if the Commit button was pressed)
    print hidden( -name => $sbn, -value => "View $href->{$uid}->{Section}'s whiteboard" );

    #Another hidden field, necessary for the "Clear" button
    print hidden( -name => $EDIT_BUTTON_NAME, -value => "Edit ${uid}'s $priv note" );

    #Note that the noteeditbutton param ($TEXT_AREA_NAME) will also be passed,
    #but the $COMMIT (commit button) won't
    #So no database changes will be made!
} ## end elsif ( param($EDIT_BUTTON_NAME) )
print end_form();
print "<div id='footer' align='center'>";
$dbh->disconnect() || die $dbh->errstr;
my $mtime = localtime( ( stat "$0" )[9] );
{
    local $\ = "<br/>\n";
    print hr(), "Script modified $mtime";
    print "Created and maintained by Terry Tate, Office Linebacker";
    print b($cn);
    print "</div>";
    print "</div>";
}
print end_html();