ASNMTAP
67 results

 view release on metacpan or  search on metacpan

lib/ASNMTAP/Asnmtap/Applications/CGI.pm  view on Meta::CPAN 


                                                      DBPERFPARSE  => [ qw($PERFPARSEVERSION $PERFPARSECONFIG $PERFPARSEDATABASE $PERFPARSEHOST $PERFPARSEPORT $PERFPARSEUSERNAME $PERFPARSEPASSWORD ) ],
                                                      DBREADONLY   => [ qw($SERVERNAMEREADONLY $SERVERPORTREADONLY $SERVERUSERREADONLY $SERVERPASSREADONLY ) ],
                                                      DBREADWRITE  => [ qw($SERVERNAMEREADWRITE $SERVERPORTREADWRITE $SERVERUSERREADWRITE $SERVERPASSREADWRITE ) ],
                                                      DBTABLES     => [ qw($SERVERTABLCATALOG $SERVERTABLCLLCTRDMNS $SERVERTABLCOMMENTS $SERVERTABLCOUNTRIES $SERVERTABLCRONTABS $SERVERTABLDISPLAYDMNS $SERVERTABLDISPLAYGRPS $SERVERTABLENVIRONMENT $SER...
													  
                                                      REPORTS      => [ qw(%COLORS %COLORSPIE %COLORSRRD %COLORSTABLE %ICONS %QUARTERS

                                                                           &create_sql_query_events_from_range_year_month
                                                                           &create_sql_query_from_range_SLA_window
                                                                           &get_sql_startDate_sqlEndDate_numberOfDays_test) ] );

  @ASNMTAP::Asnmtap::Applications::CGI::EXPORT_OK   = ( @{ $ASNMTAP::Asnmtap::Applications::CGI::EXPORT_TAGS{ALL} } );

  $ASNMTAP::Asnmtap::Applications::CGI::VERSION     = do { my @r = (q$Revision: 3.002.003$ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r };
}

# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
# Public subs = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

sub user_session_and_access_control;

# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

sub do_action_DBI;
sub error_trap_DBI;
sub check_record_exist;
sub create_sql_query_events_from_range_year_month;
sub create_sql_query_from_range_SLA_window;

# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

sub get_title;
sub get_sql_crontab_scheduling_report_data;
sub get_sql_startDate_sqlEndDate_numberOfDays_test;

# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

sub create_combobox_from_keys_and_values_pairs;
sub create_combobox_from_DBI;
sub create_combobox_multiple_from_DBI;

sub record_navigation_table;
sub record_navigation_bar;
sub record_navigation_bar_alpha;

# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
# Public subs without TAGS  = = = = = = = = = = = = = = = = = = = = = = =
# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
# Common variables  = = = = = = = = = = = = = = = = = = = = = = = = = = =
# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

sub user_session_and_access_control {
  my ($sessionControl, $level, $cgi, $pagedir, $pageset, $debug, $htmlTitle, $subTitle, $queryString) = @_;

  my ($errorUserAccessControl, $sessionID, $userType, $cfhOld, $cfhNew, $password);
  $sessionID = '';

  if (! $sessionControl or ( $ENV{REMOTE_ADDR} eq $REMOTE_ADDR and $ENV{HTTP_HOST} =~ /^${REMOTE_HOST}(:\d+)?/ )) {
    ($cfhOld) = $|; $cfhNew = select (STDOUT); $| = 1;
    print $cgi->header;
    $| = $cfhOld; select ($cfhNew);
    return ("", 0, 0, 0, 0, 1, 1, $errorUserAccessControl, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, $subTitle);
    #  --> ($sessionID, $iconAdd, $iconDelete, $iconDetails, $iconEdit, $iconQuery, $iconTable,
    #       $errorUserAccessControl, $CremoteUser, $CremoteAddr, $CremoteNetmask, $CgivenName, $CfamilyName,
    #       $Cemail, $Cpassword, $CuserType, $Cpagedir, $Cactivated, $CkeyLanguage, $subTitle)
  }

  sub setAccessControlParameters {
    my ($level, $pagedir, $pageset, $debug, $cgi, $session, $sessionID, $subTitle, $queryString) = @_;

    my $logonRequestLogoff = ($cgi->param('logonRequest') or "logon");

    if ( $logonRequestLogoff ne 'logoff' ) {
      if ( $session->param('~logged-in') ) {
        $subTitle .= "&nbsp;&nbsp;<a href=\"" .$ENV{SCRIPT_NAME}. "?pagedir=$pagedir&amp;pageset=$pageset&amp;debug=$debug&amp;CGISESSID=$sessionID&amp;logonRequest=logoff\"><IMG SRC=\"$IMAGESURL/logoff.jpg\" title=\"Logoff " .$session->param('remote...
      } else {
        $session->param('remoteUser', $ENV{REMOTE_USER}) if ($ENV{REMOTE_USER});
      }
    } else {
      if ( $debug eq 'T' and defined $queryString ) {
        # standard code to parse HTTP query parameters
        my %query = map { my($k, $v) = split(/=/) } split(/&/, $queryString);
        while (my ($key, $value) = each(%query)) { print "$key=$value<br>\n"; }
      }
    }

    return ($subTitle);
  }

  if ( $level eq 'guest' or $level eq 'member' ) {
    $sessionID = $cgi->cookie('asnmtap-root-cgisess') || $cgi->param("CGISESSID") || undef;
  } else {
    $sessionID = $cgi->param("CGISESSID") || undef;
  }

  use CGI::Session;
  my $session = CGI::Session->new ('driver:File;serializer:Default;id:MD5', $sessionID, {Directory=>"$CGISESSPATH"});
  $sessionID = $session->id();

  if ( $level eq 'guest' or $level eq 'member' ) {
    my $cookieID = ( defined $sessionID ) ? $sessionID : '1';
    my $domain = ( ( $ENV{REMOTE_ADDR} eq $REMOTE_ADDR and $ENV{HTTP_HOST} =~ /^${REMOTE_HOST}(:\d+)?/ ) ? $REMOTE_HOST : $HTTPSSERVER );
    my $cgiCookieOutRootCgisess = $cgi->cookie(-name=>'asnmtap-root-cgisess', -value=>"$cookieID", -expires=>'+10h', -path=>"$HTTPSURL/cgi-bin", -domain=>"$domain", -secure=>'0');
    ($cfhOld) = $|; $cfhNew = select (STDOUT); $| = 1;
    print $cgi->header(-cookie=>$cgiCookieOutRootCgisess);
    $| = $cfhOld; select ($cfhNew);
  } else {
    ($cfhOld) = $|; $cfhNew = select (STDOUT); $| = 1;
    print $cgi->header;
    $| = $cfhOld; select ($cfhNew);
  }

  my $logonRequestLogoff = ($cgi->param('logonRequest') or "logon");

  if ( $session->param('~logged-in') and $logonRequestLogoff ne 'logoff' ) {
    my $TuserType = (defined $session->param('userType')) ? $session->param('userType') : 0;
    my $Tpagedir  = (defined $session->param('pagedir'))  ? $session->param('pagedir')  : '<NIHIL>';
    my $accessGranted = 0;

    my ($Rpagedir, undef) = split (/\//, $pagedir, 2);

    if ($level eq 'sadmin') {                   # Server Administrator
      $accessGranted = 1 if ($TuserType == 8);
    } elsif ($level eq 'admin') {               # Administrator
      $accessGranted = 1 if ($TuserType >= 4);
    } elsif ($level eq 'moderator') {           # Moderator
      $accessGranted = 1 if ($TuserType >= 2);
    } elsif ($level eq 'member') {              # Member
      $accessGranted = 1 if ($TuserType >= 1 and $pagedir ne '<NIHIL>' and ($Tpagedir =~ /\/$Rpagedir\//));
    } else {                                    # Guest
      $accessGranted = 1 if ($pagedir ne '<NIHIL>' and ($Tpagedir =~ /\/$Rpagedir\//));
    }

    $subTitle = setAccessControlParameters( $level, $pagedir, $pageset, $debug, $cgi, $session, $sessionID, $subTitle, $queryString );
    return ($sessionID, $session->param('iconAdd'), $session->param('iconDelete'), $session->param('iconDetails'), $session->param('iconEdit'), $session->param('iconQuery'), $session->param('iconTable'), $errorUserAccessControl, $session->param('remo...

    print_header (*STDOUT, $pagedir, $pageset, $htmlTitle, $subTitle, 3600, '', 'F', '', $sessionID);
    $errorUserAccessControl = "You don\'t have enough permissions!";
    print "<br>\n<table WIDTH=\"100%\" border=0><tr><td class=\"HelpPluginFilename\">\n<font size=\"+1\">$errorUserAccessControl</font>\n</td></tr></table>\n<br>\n";
    return ("", 0, 0, 0, 0, 1, 1, $errorUserAccessControl, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, $subTitle);
  }

  $session->param('~logged-in', 0);
  $session->param('ASNMTAP', 'LEXY');
  $session->param('iconAdd',      0);
  $session->param('iconDelete',   0);
  $session->param('iconDetails',  0);
  $session->param('iconEdit',     0);
  $session->param('iconQuery',    1);
  $session->param('iconTable',    1);

  if ($level eq 'sadmin') {                     # Server Administrator
    $session->expire('+15m');                   # expire after 15 minutes
    $userType = 8;
  } elsif ($level eq 'admin') {                 # Administrator
    $session->expire('+30m');                   # expire after 30 minutes
    $userType = 4;
  } elsif ($level eq 'moderator') {             # Moderator
    $session->expire('+1h');                    # expire after 1 hour
    $userType = 2;
  } elsif ($level eq 'member') {                # Member
    $session->expire('+10h');                   # expire after 10 hours
    $userType = 1;
  } else {                                      # Guest
    $session->expire('+10h');                   # expire after 10 hours
    $userType = 0;
  }

  my $logonRequest = ($cgi->param('logonRequest') or "logonView");
  
  if( $logonRequest eq "logonView" or $logonRequest eq "logonCheck" ) {
    my $logonPassword  = ($cgi->param('logonPassword')     or undef);
    my $logonTimestamp = ($cgi->param('logonTimestamp')    or undef);
    my $loginTrials    = ($session->param('~login-trials') or 0);

    if ( $loginTrials >= 3 ) {
      $errorUserAccessControl = "You failed 3 times in a row.<br>Your session is blocked.<br>Please contact us with the details of your action";
    } elsif( $logonRequest eq "logonCheck" ) {
      my ($CremoteUser, $CremoteAddr, $CremoteNetmask, $CgivenName, $CfamilyName, $Cemail, $Cpassword, $CuserType, $Cpagedir, $Cactivated, $CkeyLanguage);
      $CremoteUser = ($cgi->param('remoteUser') or undef);
      $session->param('remoteUser', $CremoteUser) if (defined $CremoteUser);
      $CuserType = 0;

      if (defined $CremoteUser and defined $logonPassword and defined $logonTimestamp) {
        my $rv = 1;

        if (defined $CremoteUser) {
          my ($dbh, $sth, $sql);
          $dbh = DBI->connect("dbi:mysql:$DATABASE:$SERVERNAMEREADWRITE:$SERVERPORTREADWRITE", "$SERVERUSERREADWRITE", "$SERVERPASSREADWRITE" ) or $rv = error_trap_DBI(*STDOUT, "Cannot connect to the database", $debug, $pagedir, $pageset, $htmlTitle,...

          if ($dbh and $rv) {
            $sql = "select remoteAddr, remoteNetmask, givenName, familyName, email, password, userType, pagedir, activated, keyLanguage from $SERVERTABLUSERS where catalogID = '$CATALOGID' and remoteUser = '$CremoteUser'";
            $sth = $dbh->prepare( $sql ) or $rv = error_trap_DBI(*STDOUT, "Cannot dbh->prepare: $sql", $debug, $pagedir, $pageset, $htmlTitle, 'Logon', 3600, '', $sessionID);
            $sth->execute() or $rv = error_trap_DBI(*STDOUT, "Cannot sth->execute: $sql", $debug, $pagedir, $pageset, $htmlTitle, 'Logon', 3600, '', $sessionID) if $rv;

            if ( $rv ) {
              if ($sth->rows) {
                ($CremoteAddr, $CremoteNetmask, $CgivenName, $CfamilyName, $Cemail, $Cpassword, $CuserType, $Cpagedir, $Cactivated, $CkeyLanguage) = $sth->fetchrow_array() or $rv = error_trap_DBI(*STDOUT, "Cannot $sth->fetchrow_array: $sql", $debug, ...

                if ( $rv ) {
                  $errorUserAccessControl = "Remote User '$CremoteUser' not yet activated." if ($Cactivated != 1);
                } else {
                  $errorUserAccessControl = "Problems with retreiving data from the MySQL database.";
                }
              } else {
                $errorUserAccessControl = "Remote User '$CremoteUser' invalid.";
              }

              $sth->finish() or $rv = error_trap_DBI(*STDOUT, "Cannot sth->finish: $sql", $debug, $pagedir, $pageset, $htmlTitle, 'Logon', 3600, '', $sessionID) if $rv;
            } else {
              $errorUserAccessControl = "Problems with a MySQL database statement.";
            }
          } else {
            $errorUserAccessControl = "Problems with the MySQL database.";
	      }
        } else {
          $errorUserAccessControl = "Remote User missing.";
        }

        my $currentTime = time();
		
        if (defined $errorUserAccessControl) {
          $errorUserAccessControl .= "<br>Please contact us with the details of your action.";

          unless ( $rv ) {
            print "<br>\n<table WIDTH=\"100%\" border=0><tr><td class=\"HelpPluginFilename\">\n<font size=\"+1\">$errorUserAccessControl</font>\n</td></tr></table>\n<br>\n";
            return ("", 0, 0, 0, 0, 1, 1, $errorUserAccessControl, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, $subTitle);
          }
        } elsif ( $Cpassword ne $logonPassword ) {
          $errorUserAccessControl = "Bad password";
        } elsif( $logonTimestamp > $currentTime or $logonTimestamp < ($currentTime - 300) ) {
          $errorUserAccessControl = "Time stamp invalid";
        } else {
          if ( $ENV{REMOTE_ADDR} ) {
            if ( $CremoteAddr ne '' ) {
              use NetAddr::IP;
              my $netmask = (int($CremoteNetmask) or 32);
              my $ipAddr  = NetAddr::IP->new($ENV{REMOTE_ADDR});
              my $ipRange = NetAddr::IP->new("$CremoteAddr/$netmask");
              $errorUserAccessControl = "IP Address Forbidden." unless ( $ipRange->contains ( $ipAddr ) );
            }
          }

          $errorUserAccessControl = "You don't have enough permissions!" if ( $userType > int($CuserType) );

		  unless ( defined $errorUserAccessControl ) {
            my $accessGranted = 0;

            my ($Rpagedir, undef) = split (/\//, $pagedir, 2);

            if ($level eq 'sadmin') {                   # Server Administrator
              $accessGranted = 1 if ($CuserType == 8);
            } elsif ($level eq 'admin') {               # Administrator
              $accessGranted = 1 if ($CuserType >= 4);
            } elsif ($level eq 'moderator') {           # Moderator
              $accessGranted = 1 if ($CuserType >= 2);
            } elsif ($level eq 'member') {              # Member
              $accessGranted = 1 if ($CuserType >= 1 and $pagedir ne '<NIHIL>' and ($Cpagedir =~ /\/$Rpagedir\//));
            } else {                                    # Guest
              $accessGranted = 1 if ($pagedir ne '<NIHIL>' and ($Cpagedir =~ /\/$Rpagedir\//));
            }

            $errorUserAccessControl = "You are onto the wrong place to be!" unless ( $accessGranted );

  		    unless ( defined $errorUserAccessControl ) {
              $session->param('~logged-in',   1);
              $session->clear(['~login-trials']);

              if ( $CuserType eq "8" ) {      # Server Administrator
                $session->param('iconAdd',      1);
                $session->param('iconDelete',   1);
                $session->param('iconEdit',     1);
                $session->param('iconDetails',  1);
              } elsif ( $CuserType eq "4" ) { # Administrator
                $session->param('iconAdd',      1);
                $session->param('iconEdit',     1);
                $session->param('iconDetails',  1);
              } elsif ( $CuserType eq "2" ) { # Moderator
                $session->param('iconEdit',     1);
                $session->param('iconDetails',  1);
              } elsif ( $CuserType eq "1" ) { # Member
                $session->param('iconDetails',  1);
              } elsif ( $CuserType ne "0" ) { # Guest
                $errorUserAccessControl = "You are onto the wrong place to be!";
              }

              $session->param('iconQuery',    1);
              $session->param('iconTable',    1);

              $session->param('remoteUser',    $CremoteUser);
              $session->param('remoteAddr',    $CremoteAddr);
              $session->param('remoteNetmask', $CremoteNetmask);
              $session->param('givenName',     $CgivenName);
              $session->param('familyName',    $CfamilyName);
              $session->param('email',         $Cemail);
              $session->param('keyLanguage',   $CkeyLanguage);
              $session->param('password',      $Cpassword);
              $session->param('userType',      $CuserType);
              $session->param('pagedir',       $Cpagedir);
              $session->param('activated',     $Cactivated);
            }
          }
        }

        $password = $Cpassword;
      } else {
        $errorUserAccessControl = "Remote User, Password and/or Time stamp are missing";
      }
    }

    if (defined $errorUserAccessControl) {
      $logonRequest = "logonView";
      my $trials = $session->param('~login-trials') || 0;
      $session->param('~login-trials', ++$trials);

      if ( $debug eq 'T' and defined $queryString ) {
        my %query = map { my($k, $v) = split(/=/) } split(/&/, $queryString);
        while (my ($key, $value) = each(%query)) { print "$key=$value<br>\n"; }
        print "&lt;$password&gt; " if (defined $password);
        print "&lt;$logonPassword&gt;<br>\n";
      }
    }

    if( $logonRequest eq "logonView" ) {
      $logonTimestamp = time();
      print_header (*STDOUT, $pagedir, $pageset, $htmlTitle, 'Logon', 3600, '', 'F', "<script language=\"JavaScript1.2\" type=\"text/javascript\" src=\"$HTTPSURL/md5.js\"></script>", $sessionID);
      print "<br>\n<table WIDTH=\"100%\" border=0><tr><td class=\"HelpPluginFilename\">\n<font size=\"+1\">$errorUserAccessControl</font>\n</td></tr></table>\n<br>\n" if ( defined $errorUserAccessControl );

      print <<HTML;
<script language="JavaScript1.2" type="text/javascript">
function validateForm() {
  // The password must contain at least 1 number, at least 1 lower case letter, and at least 1 upper case letter.
  var objectRegularExpressionPasswordFormat = /\^[\\w|\\W]*(?=[\\w|\\W]*\\d)(?=[\\w|\\W]*[a-z])(?=[\\w|\\W]\*[A-Z])[\\w|\\W]*\$/;

  if ( document.usac.remoteUser.value == null || document.usac.remoteUser.value == '' ) {
    document.usac.remoteUser.focus();
    alert('Please enter a remote user!');
    return false;
  }

  if ( document.usac.logonPassword.value == null || document.usac.logonPassword.value == '' ) {
    document.usac.logonPassword.focus();
    alert('Please enter a password!');
    return false;
  } else {
    if ( ! objectRegularExpressionPasswordFormat.test(document.usac.logonPassword.value) ) {
      document.usac.logonPassword.focus();
      alert('Please re-enter password: Bad password format!');
      return false;
    }

    document.usac.logonPassword.value = hex_md5(document.usac.logonPassword.value);
  }

  return true;
}
</script>
<br>
<form action="$ENV{SCRIPT_NAME}" method="post" name="usac" onSubmit="return validateForm();">
  <input type="hidden" name="pagedir"        value="$pagedir">
  <input type="hidden" name="pageset"        value="$pageset">
  <input type="hidden" name="debug"          value="$debug">
  <input type="hidden" name="CGISESSID"      value="$sessionID">
  <input type="hidden" name="logonRequest"   value="logonCheck">
  <input type="hidden" name="logonTimestamp" value="$logonTimestamp">
HTML

      if ( defined $queryString ) {
        my %query = map { my($k, $v) = split(/=/) } split(/&/, $queryString);
        while (my ($key, $value) = each(%query)) { print "<input type=\"hidden\" name=\"$key\" value=\"$value\">\n"; }
      }

      print <<HTML;
  <table border="0" cellspacing="0" cellpadding="0">
    <tr><td><b>Remote User: </b></td><td>
      <input type="text" name="remoteUser" value="" size="15" maxlength="15">
    </td></tr><tr><td><b>Password: </b></td><td>
      <input type="password" name="logonPassword" value="" size="15" maxlength="32">&nbsp;&nbsp;The password must contain at least 1 number, at least 1 lower case letter, and at least 1 upper case letter.
    </td></tr><tr align="left"><td align="right"><br><input type="submit" value="Logon"></td><td><br><input type="reset" value="Reset"></td></tr>
  </table>
</form>
<br>
HTML

      $errorUserAccessControl = $logonRequest;
    }
  } elsif( $logonRequest eq "logoff" ) {
    print_header (*STDOUT, $pagedir, $pageset, $htmlTitle, "Logoff", 3600, '', 'F', '', $sessionID);
    $errorUserAccessControl = "Logged off remote user: " .$session->param('givenName'). " " .$session->param('familyName');
    print "<br>\n<h1 align=\"center\">$errorUserAccessControl</h1>\n";
    $session->delete();
    return ("", 0, 0, 0, 0, 1, 1, $errorUserAccessControl, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, $subTitle);
  }

  $subTitle = setAccessControlParameters( $level, $pagedir, $pageset, $debug, $cgi, $session, $sessionID, $subTitle, $queryString );
  return ($sessionID, $session->param('iconAdd'), $session->param('iconDelete'), $session->param('iconDetails'), $session->param('iconEdit'), $session->param('iconQuery'), $session->param('iconTable'), $errorUserAccessControl, $session->param('remote...
}

# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

sub do_action_DBI {
  my ($rv, $dbh, $sql, $pagedir, $pageset, $htmlTitle, $subTitle, $sessionID, $debug) = @_;

  my $sth = $dbh->prepare( $sql ) or $rv = error_trap_DBI(*STDOUT, "Cannot dbh->prepare: $sql", $debug, $pagedir, $pageset, $htmlTitle, $subTitle, 3600, '', $sessionID);
  $sth->execute() or $rv = error_trap_DBI(*STDOUT, "Cannot sth->execute: $sql", $debug, $pagedir, $pageset, $htmlTitle, $subTitle, 3600, '', $sessionID) if $rv;
  my $numberRecordsIntoQuery = ($rv) ? $sth->fetchrow_array() : 0;
  $sth->finish() or $rv = error_trap_DBI(*STDOUT, "Cannot sth->finish: $sql", $debug, $pagedir, $pageset, $htmlTitle, $subTitle, 3600, '', $sessionID) if $rv;

  return ($rv, $numberRecordsIntoQuery);
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub error_trap_DBI {
  my ($HTML, $error_message, $debug, $pagedir, $pageset, $htmlTitle, $subTitle, $refresh, $onload, $sessionID) = @_;

  my $subject = "$htmlTitle / error_trap_DBI: " . get_datetimeSignal();
  my $message = get_datetimeSignal() . "\npagedir   : $pagedir\npageset   : $pageset\nhtml title: $htmlTitle\n\nerror message:\n$error_message\n\n--> ERROR: $DBI::err ($DBI::errstr)\n";
  my $returnCode = sending_mail ( $SERVERLISTSMTP, $SENDEMAILTO, $SENDMAILFROM, $subject, $message, $debug );
  print "Problem sending email to the '$APPLICATION' server administrators\n" unless ( $returnCode );

  if ( $refresh == 0 ) {
    return (0, $error_message, "DBI Error: $DBI::err", "DBI String: $DBI::errstr");
  } elsif ( $refresh == -1 ) {
    print "<H1>DBI Error:</H1>\n", $error_message, "\n<br><br>ERROR: $DBI::err ($DBI::errstr)\n<BR>";
    return 0;
  } else {
    print_header ($HTML, $pagedir, $pageset, $htmlTitle, $subTitle, $refresh, $onload, 'F', '', $sessionID);
    print "<H1>DBI Error:</H1>\n", $error_message, "\n<br><br>ERROR: $DBI::err ($DBI::errstr)\n<BR>";
    return 0;
  }
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub check_record_exist {
  my ($rv, $dbh, $sql, $titleTXT, $keyTXT, $nameTXT, $matchingRecords, $pagedir, $pageset, $htmlTitle, $subTitle, $sessionID, $debug) = @_;

  my ($key, $title);
  my $sth = $dbh->prepare( $sql ) or $rv = error_trap_DBI(*STDOUT, "Cannot dbh->prepare: $sql", $debug, $pagedir, $pageset, $htmlTitle, $subTitle, 3600, '', $sessionID);
  $sth->execute() or $rv = error_trap_DBI(*STDOUT, "Cannot sth->execute: $sql", $debug, $pagedir, $pageset, $htmlTitle, $subTitle, 3600, '', $sessionID) if $rv;
  $sth->bind_columns( \$key, \$title ) or $rv = error_trap_DBI(*STDOUT, "Cannot sth->bind_columns: $sql", $debug, $pagedir, $pageset, $htmlTitle, $subTitle, 3600, '', $sessionID) if $rv;

  if ( $rv ) {
    if ( $sth->rows ) {
      $matchingRecords .= "<h1>$titleTXT:</h1><table><tr><th>$keyTXT</th><th>$nameTXT</th></tr>";
      while( $sth->fetch() ) { $matchingRecords .= "<tr><td>" .encode_html_entities('K', $key). "</td><td>" .encode_html_entities('T', $title). "</td></tr>"; }
      $matchingRecords .= "</table>\n";
    }

    $sth->finish() or $rv = error_trap_DBI(*STDOUT, "Cannot sth->finish: $sql", $debug, $pagedir, $pageset, $htmlTitle, $subTitle, 3600, '', $sessionID);
  }

  return ($rv, $matchingRecords);
}



( run in 1.339 second using v1.01-cache-2.11-cpan-437f7b0c052 )