my $flock = 1;    # set to true to flock
my $timeout = 10; # set to number of seconds before flock timeout

....

if ($flock) {
   my $count = 0;
   until (flock FILE, LOCK_SH) {
      sleep 1;
      DieNice("Can't lock file '$file': $!\n") if ++$count >= $timeout;
   }
}

##</code><code>##

$mode       =~ tr#a-z_##cd;   # untaint that param!

##</code><code>##

if ( $mode =~ /^([a-z_]+)_go$/ ) {
    $page   = $1 or die "no page given!";

##</code><code>##

open FILE, ">>$file" or die "Can't append to $file, Perl says $!\n";

##</code><code>##

sub main {

  my %dispatch = (
    upload  => \&upload,
    debug   => \&debug,
    DEFAULT => \&upload,
  );

  $draw->headers();
  $draw->html_start( { title => $title } );

  my $action = $cgi->param('action') || 'DEFAULT';
  my $do_sub = $dispatch{ $action };

  if ( $do_sub ) {
    &$do_sub();
  } else {
    warn "[warn] Invalid action: [$action]";
    die "[die] You can't make me do that!\n";
  }

  $draw->html_end();
}

##</code><code>##

sub main {

    $draw->headers();
    $draw->html_start( { title => $title } );
    if ($cgi->param('action') eq 'debug'){
       &debug;
    }
    else { 
       &upload; 
    }
    $draw->html_end();
}

##</code><code>##

sub DieNice {

    my $message = shift;
    my ($package, $file, $line) = caller();
    my $user_message = "Sorry, the system is currently unable to process your request<br>\n";
    $user_message .= "due to routine maintenance. Please try again later. Our Apologies\n";
    $message = Unindent <<"    MESSAGE";
    A fatal die was trapped by the $scriptname die nice routine, details:
    Time:          $datetime
    List name:     $list_name
    Script name:   $scriptname
    Package:       $package
    File:          $file
    Line Number:   $line
    Error Message: $message
    MESSAGE
    &TellUser($user_message);   # the bullshit message!
    &WarnAdmin($message);       # the real facts!
  exit;
}

sub WarnAdmin {

    my $message = shift;
    my $name = "Administrator";
    my $email = $our_email;
    &EmailUser ($name, $email, $message);
  return;
}

sub Unindent {

    my $unindent = shift;
    $unindent =~ s/^[ \t]+//gm;
  return $unindent;
}