_________________________________________________________________________________

I like computer programming because it's like Legos for the mind.

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;
[download]

Usually, if you're going to use "strict" and "warnings" then you'd put them right at the top of the file so that that they cover as much of your code as possible.

And if you're commenting out 'use warnings' because it "can clog up the web log", then I'd be concerned that there are still some potential problems in your code. It should be possible to get code to run constantly without filling your web log with warnings. You should run with 'use warnings' turned on and track down and fix all of the warnings that you get.

--
<http://dave.org.uk>

"The first rule of Perl club is you do not talk about Perl club."
-- Chip Salzenberg

Hi.

I must admit, I do have the options on as a default, but just turned them off because I am upgrading the app. You're right, if anything they should be ON for regular production, and for debugging at the command line. OFF when I am doing lots of changing and testing via the web interface. I'll change the comments to suit.

I will also put the strict pragma first.

Thanks,
T.

_________________________________________________________________________________

I like computer programming because it's like Legos for the mind.

in $ENV{REMOTE_USER} =~ m/(m[1|3][[:alpha:]]{3}\d{2})/i do you really mean to match an 'm' followed by one of '1', '|' or '3', or should it be m/(m[13]...?

Generally use statements should go at the top of the file - that is effectively their scope in any case and it makes them easier to find. Strictures should always be on and at the very top of the file of course.

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

is more Perlish as:

for my $i (0..3) {
[download]

  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];
}
[download]

can be replaced by:

  $hex[$_] = sprintf "%02x", rand(255) for 0..2;
[download]

In fact the whole colour generation loop could be replaced by:

$color[$_] = sprintf "#%02x%02x%02x", rand 255, rand 255, rand 255 for
+ 0..4;
[download]

In general the code would be easier to read with fewer comments. At least use a little vertical white space to make it easier to find sections of code. It's not so bad if you are using a syntax highlighting editor, but otherwise some of the code is simply impossible to see.

---

DWIM is Perl's answer to Gödel

GP, thanks for your comments, and sorry for the long delay in replying. It looks like the random color thing, while I think it is cool, is not going to fly here. It's still good to learn different ways of coding the functionality. I must admit I still go the for '(my $i=0; $i < $somearbitratyval; $i++)' route. I will strive to work 'for my $i (0..$somearbval)' into future code. That's two dots and not an ellipsis, right?

_________________________________________________________________________________

I like computer programming because it's like Legos for the mind.

_________________________________________________________________________________

I like computer programming because it's like Legos for the mind.

Greetings, esteemed monks!

#!/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();
[download]