in reply to A CGI whiteboard in Perl
Greetings, esteemed monks!
Here's the code for the most recent version, which took way too long to do. I've cut out most of the big blocks of comments and run it through perltidy. I know what's best for my setup isn't best for your eyes so suggestions welcomed (I use line length of 90--recommended is 80, and for some reason PM's default is 70. Check out your Display Settings node to adjust, if desired).Any and all suggestions welcome.#!/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 uni +x 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 Na +me!" 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 usi +ng #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 explicit +ly 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 Regula +r 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 t +est 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 represent +ed 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 heade +r 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 a +nyway) 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 thi +s 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 a +fter 'Commit'); #Index of LAST apostrophe--peoples' names can have apostrophe +s 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 store +d 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 '$u +name'."; } #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 openin +g 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 "cl +ear" 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 statemen +t 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 nam +e my $i1 = index( $rawsec, q{ } ); #Index of first space +(right after Edit); my $i2 = index( $rawsec, q{'} ); #Index of first (and o +nly) 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_MS +G ); #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 $use +r->[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_MS +G ); 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($us +er) ); } print end_table(); print submit( -name => $TO_MAIN_BUTTON_NAME, -value => $TO_MAI +N_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(Secti +on), 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 do +esn'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 "push +ing" #submit buttons for viewing each of the sections $user->[ scalar(@$user) ] = submit( $sbn, "View $user->[1]'s w +hiteboard" ); 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 (ri +ght 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 whitebo +ard for"; print h3($uname); #This gets all but the first and last single-quotes, hard-coded in +to 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 t +he #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 n +ote" ), submit( $cbn, $cbn ) ); #This is a dummy param to get us back to the section view if the u +ser cancels #(works the similarly to the #same line at the end of the conditional block for if the Commit b +utton was pressed) print hidden( -name => $sbn, -value => "View $href->{$uid}->{Secti +on}'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();
|
|---|