package ycold;
$__PACKAGE__::versionNumber = "6.12m";
# -----------------------------------------------------------------------
my $copyRight = "Copyright (c) 2021-2024 Daniel Blackman +1 510-910-9047 msg/text";
# -----------------------------------------------------------------------

use strict;
use warnings;
use utf8;
use threads;

my $webhost = 'wtf25.fun';
# fixes 'Can't locate object method "tid" via package "threads" at /usr/lib64/perl5/XSLoader.pm line 94.' caused by http_proxy/https_proxy environment variables (LWP module)
# eval'ing it for perls built without thread support (like Travis CI)
use Config;
if($Config{usethreads}){
    require threads;
    import threads;
}
#
use 5.006_001;
use Carp;
use Cwd 'abs_path';
use Fcntl ':flock';
use File::Basename;
use Getopt::Long qw(:config bundling);


# ----------------------------------------------------------------------------
my $contentTypeBannerSuppressed = 1; # when opening results file

my $basePath = '/usr/lib/cgi-bin/'; # actual working directory identified by environment
if (exists($ENV{CONTEXT_DOCUMENT_ROOT})) { $basePath = $ENV{CONTEXT_DOCUMENT_ROOT} . '/'; }
elsif (exists($ENV{'PWD'}))              { $basePath = $ENV{'PWD'} . '/'; }
if (exists($ENV{'PWD'}))              {  
  $main::cline{'processUploadedDatafiles'} = 'off';
  $main::cline{'processBFform'} = 'off';
} else {
  delete  $main::cline{'processUploadedDatafiles'};
}
#
my $volatile = '/dev/shm/'; # we should initialize the files in this directory, if necessary
if (exists($ENV{TEMP})) {
  $basePath                                = $ENV{TEMP} . '\\'; # a DOS commanded instance
}
# changed to false, dbb 1/20/2025, avoid 'Aw fuck'
if (1 == 0) {
  $volatile                                = $basePath;
  $main::cline{'ENABLED'}                  = 1; #  testing, since running under dos, right?
  $main::cline{'checkBoxControls'}         = 'off';
  $main::cline{'processUploadedDatafiles'} = 'off';
  $main::cline{'WarehouseSettings'}        = 'off';
} 
#
$main::cline{'dealWithAccessLog'} = 1;
#
if (!defined($basePath)) { 
  print(" @{[ %ENV ]} "); # interpolation trick
  exit; # dbb 12-31-24
  &main::BusyServer("We are so lost! No basePath"); # no return!
} # sometimes the basePath is not set

# we should be checking that all these paths are valid
my $partsPath      = $basePath . 'parts/';
my $archivesPath   = $basePath . 'archives/';
my $privatePath    = $basePath . 'private/';
my $skimmedPath    = $basePath . 'skimmed/';
my $oldstuffPath   = $basePath . 'oldstuff/';
my $txtfilesPath   = $basePath . 'oldstuff/txtfiles/';
my $tmpfilesPath   = $basePath . 'oldstuff/txtfiles/';
my $tmpPath        = $basePath . 'tmp/';
my $okDirectory    = 0;
my @somePaths      = ($basePath, $partsPath, $archivesPath, $privatePath, $skimmedPath, $oldstuffPath,
                         $txtfilesPath, $tmpfilesPath, $tmpPath, $volatile);
# umask = 0777;
for my $somePath (@somePaths) {
  if (-d $somePath) { $okDirectory++; } else { mkdir $somePath; }
} # for

my $varchive       = $basePath . 'archives/';   # location of archive files in system directory

my $xarchive       = "http:\/\/$webhost\/archives\/"; # location of archive files from the www
my $warchive       = '/archives/'; # location of archive files from the www

my $oneTime        = time();  # use this time-snapshot everywhere we need the current time, avoid a rare bug
my $oneFilename    = $oneTime;
my $oldLogFilename = $varchive . 't' . $oneFilename . '.tmp'; # a filespec
my $collisionCount = 0;
while (-e $oldLogFilename) {
  $collisionCount++;
  $oneFilename     = $oneTime . '-' . $collisionCount;
  $oldLogFilename  = $varchive . 't' . $oneFilename . '.tmp'; # a filespec
  if ($collisionCount > 9) {  &main::BusyServer("filename collisions!"); } # no return
} #  # if we cant find an unused filename, we die

my $webLogFilename = $warchive . 't' . $oneFilename . '.tmp'; # an url

my $targetDirectory = $archivesPath; # for deleting overweight files, a default that might be changed later
$main::cline{'xxENABLED'} = 1; # 0 throttles opening of files... not sure why I needed this, dbb 8-sept-2020

my $statefn        = 'state.txt';       # this is the file containing persistent variables as key-value pairs
my $databaseName   = 'kittykat';        # we should fetch this from dbinfo
my $dbDatabase     = "'$databaseName'"; # my $dbDatabase = 'dbb';
my $CHARSET        = 'utf8mb4';         # was latin1

# ----------------------------------------------------------------------------
my $resultsFilename =  'rresultts.html';

my $xlogfn         = $volatile . 'xlog.tmp';
my $resultsfn      = $volatile . $resultsFilename;
my $tmpfn          = '/dev/shm/access.log';

# ----------------------------------------------------------------------------
# requires view.css and view.js
my $thisURL        = 'localhost';
my $HTTPHOST       = 'HTTP_HOST';
if (exists($ENV{$HTTPHOST})) 
            { $thisURL = $ENV{$HTTPHOST} ; }
my $pageurl        = "http:\/\/$thisURL\/";
if (exists($ENV{HTTPS})) { $pageurl = "https:\/\/$thisURL"; }
my $form_numberIncrementFlag = 1;
my $userID         = 0;
my %formInfo; # put incoming form data here during initialization

my $dvx            = 'dvx0'; # marks logBug output
my $HTMLbody       = 0;
my $QHTMLopened    = 0;
my $HTMLopened     = 0;

my $xOpened        = 0; # true when XFILE has opened properly
# ----------------------------------------------------------------------------
#
# The XFILE is a uniquely-named log file for items that cannot or should not be rendered as html.
# we would look in XFILE for clues during debugging, linked to in the results linkband 'archives'
my $fileRWXmode = 0666;
if (exists($main::cline{'xxENABLED'})) {
  if (open XFILE, ">:utf8", $oldLogFilename) {
    chmod $fileRWXmode, $oldLogFilename;
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
    open STDERR, '>&XFILE'; # redirect error messages to log file
    $xOpened             = 1; # set the flag asserting that the XFILE opened properly
  } # error messages saved in log file, uniquely named for each instance of this script
  else {
    &main::BusyServer("Cannot open xlog! $oldLogFilename"); # no return!
    $main::cline{'XLOG'} = 1;
  } # XLOG for debugging dbb 7 Oct 2019
} # if xxENABLED
STDOUT->autoflush(1);

# ----------------------------------------------------------------------------
# --  Bug output subroutines send output to combinations of streams W R X --
# ----------------------------------------------------------------------------
# ----------   Stream   -------------- Bug subroutine ------------------------
#   W  -- users browser Window  -- b  c        s     u       W -- user-html
#   R  -- debug Results window  --    c  p  r  s  t          R -- results-html
#   X  -- debug results teXt    --             s  t     x    X -- xlog-text
# ----------------------------------------------------------------------------

  # ------------------------------------------------------------------------------
sub uBug { # print to STDOUT
  my $debugMessage = shift @_;
  if (defined($debugMessage)) {
    print STDOUT $debugMessage;
  } # while there is a message to be output
  else { print "no uBug message!"; }
} # uBug print to STDOUT

  # ------------------------------------------------------------------------------
sub xlogBug { # print to XFILE
  my $debugMessage = shift @_;
  if (defined($debugMessage)) {
    print XFILE $debugMessage . "\n" if ($xOpened);
    $debugMessage  = shift @_;
  } # while
} # xlogBug print to XFILE

  # ------------------------------------------------------------------------------
sub bBug {
  my $debugMessage = shift @_;   if (!defined($debugMessage)) { $debugMessage = 'Geez tBug'; }
  my $classdvx     = shift @_;
  my $somedvx      = $dvx;
  if (defined($classdvx)) { $somedvx = $classdvx; }
#
  if ($HTMLbody) {
    if (exists($ENV{'REMOTE_ADDR'})) {
      if (defined($classdvx)) {
        &uBug("\n<div class=\"$somedvx\">\n  $debugMessage\n</div>\n"); # STDOUT
      } else {
        &uBug($debugMessage); # STDOUT
      }
    } else {
      &uBug("$debugMessage"); # STDOUT
    }
  } 
  # else { &xlogBug(" JJJ $debugMessage \n"); }
} # bBug  -- add some extra html formatting to STDOUT, use an optional css class name

# ----------------------------------------------------------------------------
sub pBug {
  my $debugMessage = shift @_; 
  if (!defined($debugMessage)) { $debugMessage = 'Geez pBug'; }
  if ($HTMLopened) {
    if (!defined($main::qRelocat)) { print HTMLOUTPUT "$debugMessage\n"; }
  }
  if ($QHTMLopened) {
    print QOUTPUT "$debugMessage\n";
  }
} # pBug -- no extra html formatting to HTMLOUTPUT and QOUTPUT

# ----------------------------------------------------------------------------
sub rBug {
  my $debugMessage = shift @_;
  if (!defined($debugMessage)) { $debugMessage = 'Geez rBug'; }
  my $classdvx     = shift @_;
  my $somedvx      = $dvx;       if ($classdvx) { $somedvx = $classdvx; }
#
  if ($HTMLbody) {
    if (exists($ENV{'REMOTE_ADDR'})) {
      &pBug("<div class=\"$somedvx\">$debugMessage</div>\n"); # to HTMLOUTPUT and QOUTPUT
    } 
  } # if HTMLbody
} # rBug  -- add some extra html formatting, use an optional css class name

# ----------------------------------------------------------------------------
sub cBug {
  my $debugMessage = shift @_;
  if (!defined($debugMessage)) { $debugMessage = 'Geez cBug'; }
  my $classdvx     = shift @_;
  my $somedvx      = $dvx;       if ($classdvx) { $somedvx = $classdvx; }
#
  &bBug($debugMessage,$somedvx); # formatted to STDOUT
  &rBug($debugMessage,$somedvx); # formatted to HTMLOUTPUT and QOUTPUT
} # cBug

# ----------------------------------------------------------------------------
sub sBug {
  my $debugMessage = shift @_;
  if (!defined($debugMessage)) { $debugMessage = 'Geez sBug'; }
  my $classdvx     = shift @_;
  my $somedvx      = $dvx;       if ($classdvx) { $somedvx = $classdvx; }
#
  &cBug($debugMessage,   $somedvx); # formatted to STDOUT, HTMLOUTPUT, and QOUTPUT
  &xlogBug($debugMessage);
} # sBug -- output to XLOG, STDOUT, HTMLOUTPUT and QOUTPUT

# ----------------------------------------------------------------------------
sub tBug {
  my $debugMessage = shift @_;
  if (!defined($debugMessage)) { $debugMessage = 'Geez tBug'; }
  my $classdvx     = shift @_;
  my $somedvx      = $dvx;       if ($classdvx) { $somedvx = $classdvx; }
#
  &rBug($debugMessage,$somedvx);
  &xlogBug($debugMessage);
} # tBug -- output to XLOG, HTMLOUTPUT and QOUTPUT

  # ------------------------------------------------------------------------------
sub incrementCounter {
  my $result = 0; # we could have several items referenced as arguments
  for my $counterName (@_) {
    if (!exists($main::cline{$counterName})) { 
      $main::cline{$counterName} = 1;
    } 
    elsif ($main::cline{$counterName}) {
      $main::cline{$counterName}++;
    } # elsif
    else {
      $main::cline{$counterName} = 1;
    } # else
    $result = $main::cline{$counterName};
  } # for 
  return $result; # only the last counter value is returned
} # incrementCounter

  # ------------------------------------------------------------------------------
sub decrementCounter {
  my $result = 0; # we could have several items referenced as arguments
  for my $counterName (@_) {
    if (exists($main::cline{$counterName})) { 
      if ($main::cline{$counterName}) {
         $main::cline{$counterName}--;
        $result = $main::cline{$counterName};
      } else { delete $main::cline{$counterName}; } # else
    } # if counter exists, otherwise do nothing
  } # for each counter listed in arguments
  return $result; # only the last counter value is returned
} # decrementCounter

  # ------------------------------------------------------------------------------
sub StateMessage {
  my $ctr=0;
  my $msg = shift @_;
  &xlogBug("*****  StateMessage: ***** $msg");
  return; # debug dbb 2-27-2021
  for my $msg (@_) {
    $ctr++;
    my $msgID = &incrementCounter('StateMessageIndex');
    if    ($msgID eq 80) { $main::cline{'StateMessageZap'}=1; }
    elsif ($msgID > 99)  { $msgID=10; $main::cline{'StateMessageIndex'}=$msgID; }
    elsif ($msgID < 10)  { $msgID=10; $main::cline{'StateMessageIndex'}=$msgID; }
    my $itemID = 'StateMessage' . $msgID;
    $main::cline{$itemID} = $msg;
    &xlogBug("XF: $ctr $msg");
  } # for each message in argument list
} # StateMessage

  # ------------------------------------------------------------------------------
sub in(&@){
  local $_;
  my $code = shift;
  for( @_ ){ # sets $_
    if( $code->() ){      return 1;    }
  } # for
  return 0;
} # in

  # ------------------------------------------------------------------------------
# BEGIN {unshift @INC, '/home/pi/perl5/lib/perl5/arm-linux-gnueabihf-thread-multi-64int';}

  # ------------------------------------------------------------------------------
  # provides a repeating sequence of class ids, so display backgrounds change regularly
sub nextClass {
  my @classes = ('dvx6','dvx5','dvx4','dvx3','dvx7');
  if (defined($main::nextC)) {
    $main::nextC++;
    if ($main::nextC > $#classes) { $main::nextC = 0; }
  } else { $main::nextC = 0; }
  return $classes[$main::nextC];
} # nextClass

  # ------------------------------------------------------------------------------
sub reportHiLoRecentinfo {
  my $sensorName   = shift @_;
  my $xBug         = \&sBug;
  my $yBug         = shift @_;  if (defined($yBug)) { $xBug = $yBug; }
  my $maxName      = 'max'    . $sensorName;
  my $recName      = 'recent' . $sensorName;
  my $minName      = 'min'    . $sensorName;
  my $thisDVXclass = &nextClass;
  if (exists($main::cline{$maxName}))
       { $xBug->('Highest ' . $sensorName . '  '  . $main::cline{$maxName},$thisDVXclass); }
  if (exists($main::cline{$recName}))
       { $xBug->('Recent  ' . $sensorName . '  '  . $main::cline{$recName},$thisDVXclass); }
  if (exists($main::cline{$minName}))
       { $xBug->('Lowest  ' . $sensorName . '  '  . $main::cline{$minName},$thisDVXclass); }
} # reportHiLoRecentinfo

  # ------------------------------------------------------------------------------
my @ftpinfo;
my @zapQueue; # array of arrays, indexed by destftp, each a list of files to be moved
foreach my $i (0..4) { push @zapQueue,[]; }

my %unlinkThisFile;
sub uploadAudioFile {  # fetch user preferences, send audio data to streaming computer
  use Net::FTP;
  my $getFilename = shift @_;
  my $partName    = shift @_;
  my $destftp     = shift @_; # index into ftpinfo, selects upload destination
  if (!defined $destftp) { $destftp=0; }
  my $xBug        = \&xlogBug;
  my $privateFtpInfoFilespec = $privatePath . 'ftpinfo.txt';
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  if (open FTPFILE, "<",  $privateFtpInfoFilespec) {
	  # $xBug->("Opened the ftp info  file $privateFtpInfoFilespec");
    foreach my $infoitems (<FTPFILE>) {
      push @ftpinfo, [split(/,/,$infoitems)];
    } # foreach
    close FTPFILE;
  } else {
    $xBug->("loadA: No ftp info in $privateFtpInfoFilespec.");
    return;
  }
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  # if (!defined($partName)) { $partName='undefined part!'; }
  # else { $xBug->("loadA: $partName"); }
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  if (!defined($getFilename)) {
    if (exists($main::cline{'latestAudio'})) {
      $getFilename  = $main::cline{'latestAudio'};
      delete $main::cline{'latestAudio'};
    } # if
  }
  if (defined($getFilename)) {
    if (-e $getFilename) {
      push (@{$zapQueue[$destftp]},$getFilename);
      # $xBug->("upload Audio file $getFilename $someHost $username");
    }
  } else {
    $xBug->('loadA: nothing to do here, bob!');
  }
  $unlinkThisFile{$getFilename} = $destftp; # delete files with non-zero
} # uploadAudioFile

  # ------------------------------------------------------------------------------
sub assignUserIDfromCookie {
  my $xBug = \&StateMessage;
    my @cookies = shift @_;
    $main::cline{'UserID'} = 7777777; # default value, some problem with the cookie format
    for my $cookie (@cookies) {
      my ($name, $value) = split(/=/, $cookie);
      if (defined($value)) {
        if ($value =~ /^-?\d+$/)       { # integer value?
          if ((length($value) < 11) && (length($name) < 11)) {
            $main::cline{'UserID'} = $value;
            $xBug->("Cookie! $name $main::cline{'UserID'}");
          } # from cookie
          else { $xBug->("Not a real user id! $cookie\n"); }
        } else { $xBug->("$value cookie is not a user id! $cookie\n"); }
      } # user id sent by cookie
      else {  $xBug->("Value not defined! $cookie"); }
    } # for
} # assignUserIDfromCookie

  # ------------------------------------------------------------------------------
sub getUserIDfromCookie { # sets UserID if there is a cookie
  my $xBug      = \&StateMessage; # xlog, too
  if (exists($main::cline{'ZapCookie'})) {
    $xBug->("zapping Cookie!");
  } elsif (exists($ENV{'HTTP_COOKIE'})) {
    my @cookies = split(/; /, $ENV{'HTTP_COOKIE'});
    &assignUserIDfromCookie(@cookies);
  } # elsif cookie -- assigns UserID from command or cookie
  else {  $xBug->("No Cookie!"); }
} # getUserIDfromCookie

  # ------------------------------------------------------------------------------
sub determinePersistentVariableFilename { # called after ENV and Cookies are read
  &getUserIDfromCookie; # establish UserID, used to call up persistent state variables
  if (exists($main::cline{'UserID'})) {
    $statefn = "state" . $main::cline{'UserID'} . ".txt";
  }
    # + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  copy($statefn,'pstate.txt'); # for easier debugging dbb 3-20-2021
  chmod $fileRWXmode, 'pstate.txt';
} # determinePersistentVariableFilename

# ----------------------------------------------------------------------------
use MIME::Base64;
sub inlineTextImage {
  my $imagedata    = shift @_;
  my $imagemapData = shift @_;
  if (defined($imagedata)) {
    my $imgdata = "data:image/jpeg;base64,\n$imagedata";
    if (defined($imagemapData)) {
      return "<div><img usemap=\"\#inlineImageMap\" src=\"$imgdata\">$imagemapData</div>\n";
    } else {
      return "<div><img src=\"$imgdata\"></div>\n";
    } # else
  } # if defined imagedata
} # inlineTextImage

# ----------------------------------------------------------------------------
sub inlineImage {
  my $imageFilename = shift @_;
  if (defined($imageFilename)) {
    my $xBug = \&sBug;
    if (-e $imageFilename) {
      my $imagemapData  = shift @_;
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
      if (open IMAGEFILE, "$imageFilename") {
        binmode(IMAGEFILE);
        local $/=undef;
        my $imagedata = &MIME::Base64::encode_base64( <IMAGEFILE> );
        close IMAGEFILE;
        return &inlineTextImage($imagedata,$imagemapData);
      } else { return "Failed to open $imageFilename"; }
    } else {   return "$imageFilename not found!"; }
  } else {     return "imageFilename not defined!"; }
} # inlineImage

  # ------------------------------------------------------------------------------
sub checkDEBUGXIP {
  my $result  = 0; # false, unless proven otherwise
  if (exists($ENV{SHELL})) {
    $result   = 1;
  } elsif (exists($ENV{REMOTE_ADDR})) {
    if (exists($main::cline{'DDEBUGXIP'})) {
      $result = ($ENV{REMOTE_ADDR} eq $main::cline{'DDEBUGXIP'});
    } # if DEBUGXIP
  } # if REMOTE_ADDR
  return $result;
} # checkDEBUGXIP

# ----------------------------------------------------------------------------
sub showInlineImage {
  my $imageClineVariableName = shift @_;
  my $imagemapData           = shift @_;
  my $xBug                   = shift @_;
  $xBug = \&sBug;
  if (!defined($imagemapData)) { $xBug->("What, no imageMap?"); }
#
  if (defined($imageClineVariableName)) {
    if (exists($main::cline{$imageClineVariableName})) {
      my $fileName = $main::cline{$imageClineVariableName};
      if (-e $fileName) {
        $xBug->("Looking at $fileName");
        &bBug(&inlineImage($fileName,$imagemapData)); # output only to user, not results
      } # if
      else { $xBug->("No such file $fileName"); }
    } # if
    else { $xBug->("Not exists $imageClineVariableName"); }
  } # if
  else { $xBug->("Not defined imageClineVariableName"); }
} # showInlineImage

my $httpX = 0; # control of default setting

  # ------------------------------------------------------------------------------
sub enableButton {
  my $submitButtonText          = 'Enable';
  my $hiddenkey                 = 77;
  my $httpx                     = 'http://';
  if (exists($ENV{HTTPS}) || ($httpX)) { $httpx         = 'https://'; }
  my $action                    = $httpx . $ENV{'SERVER_NAME'} . '/';
  if (exists($main::cline{'ENABLED'})) {
    $hiddenkey                  = 78;
    $submitButtonText           = 'Disable';
    if (exists($main::cline{'hiddenButtonInfo'})) {
      if ($main::cline{'hiddenButtonInfo'} == 77) {
        $hiddenkey              = 78;
        $main::cline{'ENABLED'} = 998;
        $submitButtonText       = 'Enabled';
      } elsif ($main::cline{'hiddenButtonInfo'} == 78) {
        $hiddenkey              = 77;
        delete $main::cline{'ENABLED'};
        $submitButtonText       = 'Disabled';
      } elsif ($main::cline{'hiddenButtonInfo'} == 71) {
        $hiddenkey              = 72;
         $submitButtonText      = 'DISABLE';
      } else {
        $hiddenkey              = 71;
        $submitButtonText       = 'ENABLE';
      }
    } # if hiddenButtonInfo
  } else {
    if (exists($main::cline{'hiddenButtonInfo'})) {
      if ($main::cline{'hiddenButtonInfo'} == 77) {
        $hiddenkey              = 78;
        $main::cline{'ENABLED'} = 999;
        $submitButtonText       = 'Enabled';
      } elsif ($main::cline{'hiddenButtonInfo'} == 78) {
        $hiddenkey              = 77;
        delete $main::cline{'ENABLED'};
        $submitButtonText       = 'Disabled';
      } elsif ($main::cline{'hiddenButtonInfo'} == 71) {
        $hiddenkey              = 72;
         $submitButtonText      = 'DISABLE';
      } else {
        $hiddenkey              = 71;
        $submitButtonText       = 'ENABLE';
      }
    }
  }
  my $formspec = "action=\"$action\" method=\"post\"";
  my $submit1ButtonInfo = "<input type=\"submit\" value=\"$submitButtonText\" />\n    ";
  $submit1ButtonInfo   .= "<input type=\"hidden\" name=\"hiddenButtonInfo\" value=\"$hiddenkey\" />";
  &bBug("<!-- Hidden $hiddenkey -->\n  <form $formspec>\n    $submit1ButtonInfo\n  </form>",'dvx1');
  $main::cline{'ButtonState'} = $hiddenkey;
} # enableButton

  # ------------------------------------------------------------------------------
my $spareCode   = '';
sub spareCode {
  my $addThis   = shift @_;
  while (defined($addThis)) {
    $spareCode .= "\n" . $addThis;
    $addThis    = shift @_;
  } # while # # # # # # # # # # assumes shifting will eventually yield an undefined value
} # spareCode

  # ------------------------------------------------------------------------------
my $sourceLink; # a filespec

  # ----------------------------------------------------------------------------
sub linkBand {
  my $result        =  "<div>\n";
  my $httpx         = 'http://';
  if (exists($ENV{HTTPS}) || ($httpX)) { $httpx         = 'https://'; }
  my $action        = '';
  if (exists($main::cline{'SERVER_NAME'})) {
     $action        = $httpx . $ENV{'SERVER_NAME'};
  } # if
  my $archives      = $action . '/archives';
  $archives         =  '/archives'; # override dbb 2/4/2021
  if (exists($ENV{TEMP})) {
    $archives       =  $ENV{TEMP} . '\archives';  # override for DOS dbb 2/5/2021
    $webLogFilename = $archives . '\t' . $oneFilename . '.tmp'; # an url
  } # if

  $result   .=  "<a href=\"$webLogFilename\">XLOG</a>\n";
  $result   .=  " | ";
  $result   .=  "<a href=\"$action\">YCharlie</a>\n";
  $result   .=  " | ";
  if (exists($main::cline{'archiveChainLinkURL'}) && (0)) {
    $result .=  "<a href=\"$archives\/$main::cline{'archiveChainLinkURL'}\">Archives</a>\n";
    $result   .=  " | ";
  }
  $result   .=  "<a href=\"$archives\/$main::xxrtime\">Archived</a>\n";
  $result   .=  " | ";

  if (defined($sourceLink) && (&checkDEBUGXIP)) {
    $result .=  "<a href=\"$sourceLink\">$sourceLink</a>\n";
    $result .=  " | ";
  }
  $result   .=  "<a href=\"$archives\/$main::xxstime\">State</a>\n";
  $result   .=  " | ";

  $result   .=  "<a href=\"http://$webhost/webalizer\">Webalizer</a>\n";
  $result   .=  " | ";
  $result   .=  "<a href=\"$action?DELETE=ENABLED\">DISABLE</a>\n";
  $result   .=  " | ";
  $result   .=  "<a href=\"$action?ENABLED=$oneTime\&comment=$oneTime\">ENABLE</a>\n";
  $result   .=  " | ";
  $result   .=  "<a href=\"$action?DELETE=emailLastChecked\">Check Email</a>\n";
  for my $i (0..6) {
    my $bItext = "bI$i";
    if (exists($main::cline{'basicIndex'})) { if ($i == $main::cline{'basicIndex'}) {
      $bItext = "<B>$bItext</B>";
    } }
    $result .=  " | <a href=\"$action?basicIndex=$i\">$bItext</a>\n";
  } # for i
  if (exists($main::cline{'basicIndex'})) {
    $result .=  " | ";
    if (exists($main::cline{'basicAutoWebpage'})) {
      $result .=  "<a href=\"$action?DELETE=basicAutoWebpage\&basicIndex=$main::cline{'basicIndex'}\">STOP $main::cline{'basicIndex'}</a>\n";
    } else {
      $result .=  "<a href=\"$action?basicAutoWebpage=off\">AUTO $main::cline{'basicIndex'}</a>\n";
    }
  }

  $result .=  " | ";
  $result .=  "<a href=\"http://24.85.1.111\/\">DMZ</a>\n";
  $result .=  " | ";
  $result .=  "<a href=\"http://wtf25.fun\">wtf25</a>\n";
  $result .=  " | ";
  $result .=  "<a href=\"https://wtf25.fun\">wtf25-s</a>\n";
  $result .=  " | ";
  $result .=  "<a href=\"http://bitbanger.com\">BB</a>\n";
  $result .=  " | ";
  $result .=  "<a href=\"https://bitbanger.com\">BB-s</a>\n";
  $result .=  " | ";
  $result .=  "<a href=\"http://www.bitbanger.com\">wwwBB</a>\n";
  $result .=  " | ";
  $result .=  "<a href=\"https://www.bitbanger.com\">wwwBB-s</a>\n";
  $result .=  " | ";
  $result .=  "<a href=\"https://fatsodevelopment.godaddysites.com/\">fatso</a>\n";
  $result .=  " | ";
  my @files0 = glob('archives/b*.html');
  my $index0 = $#files0;
  my $file0 = $files0[$index0];
  if (defined($file0)) {
    $result            .=  "<A HREF=\"\/$file0\" title=\"$file0\">busy!</A>\n";
    $result .=  " | ";
  }

  if (exists($main::cline{'DEBUGIP'})) {
    $result .= 
      "<a href=\"$action?DELETE=DEBUGIP\&comment=deleted+debugip\"><B>DELETE DEBUGIP</B></A>\n";
  } elsif (&checkDEBUGXIP) {
    $result .= 
      "<a href=\"$action?DELETE=DEBUGXIP\&comment=deleted+debugip\"><B>DELETE DEBUGXIP</B></A>\n";
  } else {
    if (exists($ENV{REMOTE_ADDR})) {
      $result .=
        "<a href=\"$action?DEBUGXIP=$ENV{REMOTE_ADDR}\&comment=created+debugip\">DEBUGXIP</A>\n";
    } elsif (exists($ENV{SHELL})) {
      $result .=
        "<a href=\"$action?DEBUGXIP=$ENV{REMOTE_ADDR}\&comment=created+debugip\">DEBUGXIP</A>\n";
    } else {
      $result .=
        '<a href="rresultts.html">Results</A>' . "\n";
    }
  } # not DEBUGXIP
  $result .=  "</div>\n";
  return $result;
} # linkBand

  # ------------------------------------------------------------------------------
  # These are the kinds of document type headers that are generally acceptable.
  # We do this because we can.. and it might prove useful
sub documentType {
  my $didx = shift @_;
  $didx=0; # dbb 240404
  my @documentTypes = ('<!DOCTYPE HTML>',
   '<!DOCTYPE html>',
   '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">',
   '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">',
   '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd">',
   '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">',
   '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">',
   '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">',
   '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">',
   '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">');
  $didx %= ($#documentTypes + 1); # make sure the index is modulo the last type index+1
#  &xlogBug("docTypes count $#documentTypes");
  return $documentTypes[$didx];
} # documentType

# ----------------------------------------------------------------------------
my $CSSreference = 'basic.css';
use POSIX qw(strftime); # for strftime below
my $stringFormat    = "%a %b %e %H:%M:%S %Y";

  # ------------------------------------------------------------------------------
sub readableTimeString {
  my $thisTime        = shift @_; # convert this value to string,
                                  # else use the current time
  my $stringTime;
  if (defined($thisTime)) {                 # thisTime might be a 10-digit number embedded in a text string
    if ($thisTime =~ /([0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9])/) {
       my $thatTime   = $1;                     # so we extract the 10-digit number that would be a time
       $stringTime    = strftime $stringFormat, localtime($thatTime); # and convert to text
    } else {
       $stringTime    = 'I have no time for you!';
    }
  } else {
    $stringTime       = strftime $stringFormat, localtime; # use the current time
  }
  return $stringTime;
} # readableTimeString

my $version           = 'v0.00a';
# ----------------------------------------------------------------------------
sub someBanner {
  my $infoBanner                                          = shift @_; # optional title
  if    (exists($main::cline{'HOSTNAME'})) { $infoBanner .= ' ' . $main::cline{'HOSTNAME'}; }
  elsif (exists($ENV{'SCRIPT_NAME'}))      { $infoBanner .= ' ' . $ENV{'SCRIPT_NAME'}; }
  if (defined($main::versionNNumber))      { $infoBanner .= ' (' . $main::versionNNumber . ')'; }
  else                                     { $infoBanner .= ' ( * )'; }
  $infoBanner .= ' (ZZ)';

  $infoBanner                                            .= ' ' . $version;
  # $infoBanner                                            .= ' ' . $__PACKAGE__::versionNumber;
  if (exists($ENV{'SERVER_NAME'}))         { $infoBanner .= ' ' . $ENV{'SERVER_NAME'}; }
  my $now_string                                          = &readableTimeString;
  $infoBanner                                            .= ' ' . $now_string;
  return $infoBanner;
} # someBanner
my $defaultBanner = &someBanner; # write a banner to xlog, makes debugging easier
&xlogBug($defaultBanner);

# ----------------------------------------------------------------------------
my $outputText = '';

sub createResultsFilename {  $main::resultsFilename = 'q' . $oneFilename . '.html'; } # createFilename
&createResultsFilename; # added dbb 5-26-2020, changing way results.html is back-linked to archives
$main::cline{'archiveChainLinkURL'} = $main::resultsFilename; # establish link to archive file

sub createarchiveChainLinkURL {  $main::cline{'archiveChainLinkURL'} = 'c' . $oneFilename . '.html'; } # archiveChainLinkURL
&createarchiveChainLinkURL; # added dbb 7-13-2020
# $main::cline{'archiveChainLinkURL'} = $main::archiveChainLinkURL; # establish link to archive file

use File::Copy;

# ******* OUTPUT TO HTML RESULTS STARTS HERE ************************************
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
sub openQOUTPUT {
  my $xBug  = shift @_;
  if (defined($main::resultsFilename)) {
    my $qFilespec = $varchive . $main::resultsFilename;
    if (open QOUTPUT,">:utf8","$qFilespec") {
      $QHTMLopened = 1;
      chmod $fileRWXmode, $qFilespec;
      $xBug->(" - - - - -  - - - - -  - - - - -  - - - - -  - - - - -  - - - - -  - - - - -  - - - - -  - - - - -  - - - - -  - - - - - ");
      $xBug->("Open QHTML! $qFilespec");
    } else { $xBug->("failed to open QHTML $qFilespec"); }
  } else { $xBug->("failed to open QHTML: resultsFilename undefined"); }
} # openQOUTPUT

  # ------------------------------------------------------------------------------
sub reportVersionInfo {
  my $version    = shift @_;
  my $xBug       = shift @_;   if (!defined($xBug)) { $xBug = \&xlogBug; } # just in case we forget to include an argument
  my $result     = 'impossible result';
  my $now_string = &readableTimeString;
#
  my $scriptInfo;
  if    (exists($ENV{SCRIPT_NAME})) { $scriptInfo = $ENV{SCRIPT_NAME}; }
  elsif (exists($ENV{SERVER_NAME})) { $scriptInfo = $ENV{SERVER_NAME}; }
  if (!defined($scriptInfo)) { $scriptInfo = "No script info!"; }
#
  if (exists($main::cline{'docType'})) {
    my $version = $main::versionNNumber; # global
    if (defined($version)) {
      $result = "reportVersionInfo $__PACKAGE__::versionNumber $scriptInfo $version $now_string docType: $main::cline{'docType'}"; # XLOG
    } else {
      $result = "reportVersionInfo $__PACKAGE__::versionNumber $scriptInfo $now_string docType: $main::cline{'docType'}"; # XLOG
    }
  } else {
    $result   = "reportVersionInfo $__PACKAGE__::versionNumber $scriptInfo FFFFFF $now_string Undefined docType!"; # XLOG
  }
  $xBug->($result);
} # reportVersionInfo

  # ------------------------------------------------------------------------------
  # 
my $recurseFlag = 1; # lets writestate try to fix a problem and call itself to try again, once.
# 'basicIndex',
my @usualCounters = ('REFRESHCOUNTER','bfbotQuery','counter3','response4','selectResponseByHTTP_HOST',
'tempZZZa','tempZZZb','tempWWW','tempXXX','tempElse','bfbotQuery','bfBotQuery192',
'counter0','counter1','counter2','counter3',
'counterBasic','emails_Sent','form_number','response1','response2','response3','response4','response5',
'response6','response7','response8',
'station10','temp24','tempDefault',
'emailLastChecked','emailNotify',
'visitCounter','visitorNumber',); # list of global counters to be saved in counters.txt

  # ------------------------------------------------------------------------------
sub writestate {
  my $xBug = shift @_;     if (!defined($xBug)) { $xBug = \&xlogBug; } # just in case we forget to include an argument
  my $aBug = \&Nothing;
  $aBug->("entering writestate!");
  &StateMessage("writeState: basicIndex $main::cline{'basicIndex'}");
  my $fpCounters = 'counters.txt';
  my $fpState    = $statefn;
#
  if (-e $fpCounters) { $xBug->("writing $fpCounters"); }
#
  $aBug->("opening $fpCounters");
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  if   (open  GFILE,'> ' . $fpCounters) {
    $aBug->("opening $fpState");
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
    if   (open  TFILE,'> ' . $fpState) {
      chmod $fileRWXmode, $fpState;
      $aBug->("opened $fpState");
      $xBug->("writing $fpState");
      my @doNotSave = ('MAILID','QUERY_STRING','XDEBUG_SESSION_START','versionNNumber',
                       'comment','command','checkBox','disable',
                       'element_1_1a','element_1_2a','element_3a','a','content',
                       'delete','currentUserID','user_id','UserID','windowClose');
      foreach my $identifier (@doNotSave) { # these keys should not be saved, reasons vary
        if (exists($main::cline{$identifier})) { delete $main::cline{$identifier}; }
      } # foreach
      foreach my $pair (sort keys %main::cline) { # look at each key, decide where to save value
        my $counterFlag = 0; # set when we detect a cline item in the list of global counters
        foreach my $identifer (@usualCounters) {
          if ($identifer eq $pair) {
            $counterFlag = 1; # decision made...
            last; # drop out of search, as item was found to be in list of global counters
          } # we are deciding whether to write item to GFILE (global) or TFILE (user-specific)
        } # foreach counter
        if ($counterFlag) {
          print GFILE $pair . '=' . $main::cline{$pair} . "\n";
          $aBug->('G: ' . $pair . '=' . $main::cline{$pair});
        } # matched in usualCounters, this key-value pair saved in global list counters.txt
        else {
          print TFILE $pair . '=' . $main::cline{$pair} . "\n";
          $aBug->('T: ' . $pair . '=' . $main::cline{$pair});
        } # otherwise the key-value pair is specific to this user
      } # foreach
      close TFILE;
      chmod $fileRWXmode, $fpState;
    } # if open
    else {
      $xBug->("Write $fpState failed! $! ");
    } # else could not open TFILE
    close GFILE;
    chmod $fileRWXmode, $fpCounters;
  } # if open GFILE
  else { &xlogBug("Could not open $fpCounters"); } # else
  $aBug->("exiting writestate!");
} # writestate

# ----------------------------------------------------------------------------
sub htmlEnvTable {
  my $result = "<TABLE class=\"zagos\">";
  foreach my $item (sort keys %ENV) {
    if (exists($ENV{$item})) {
      if (defined($ENV{$item})) {
        $result .= "<TR><TD>$item</TD><TD> $ENV{$item} </TD></TR>\n";
      } else {
        $result .= "<TR><TD>$item</TD><TD> DDDDDDDD </TD></TR>\n";
      } # else
    } else {
      $result .= "<TR><TD>$item</TD><TD> CCCCCCC </TD></TR>\n";
    } # else
  } # for
  $result .=  "</TABLE>\n";
  $result .=  &linkBand;
  $result .=  "<TABLE class=\"yagos\">";
  foreach my $item (sort keys %main::cline) {
    $result .=  "<TR><TD>$item</TD><TD> $main::cline{$item} </TD></TR>\n";
  } # foreach
  $result .=  "</TABLE>\n";
  if (exists($formInfo{'form_id'})) {
    $result .=  "<TABLE class=\"zagos\">";
    foreach my $item (sort keys %formInfo) {
      $result .=  "<TR><TD>$item</TD><TD> $formInfo{$item} </TD></TR>\n";
    } # foreach
    $result .=  "</TABLE>\n";
  } # formInfo
  return $result;
} # htmlEnvTable

# ----------------------------------------------------------------------------
sub showEnvTable {
  my $result = &htmlEnvTable;
  &tBug(" OOOOO $result"); # debug 7-18-2020
  &bBug($result); # formatting to STDOUT
} # showEnvTable

use DBI; # this is the interface to the database
my %columnNameReference;

  # ------------------------------------------------------------------------------
sub NakedCheckBox {
  my $column            = shift @_;
  my $button            = shift @_;
  my $msg               = shift @_; if (!defined($msg)) { $msg = 'click here!'; }
  my $thisURL           = 'bitbanger.com'; # default for shell-called instances
  if (exists($ENV{'SERVER_NAME'})) { $thisURL = $ENV{'SERVER_NAME'}; }
  my $httpx         = 'http://';
  if (exists($ENV{HTTPS}) || ($httpX)) { $httpx         = 'https://'; }
  my $action            = $httpx . $thisURL . '/';
  my $formspec          = "action=\"$action\" method=\"post\"";
  my $title             = 'Good enough!';
  $formspec            .= " title=\"$title\"";
  my $onClick           = 'onclick="submit()"'; $onClick = '';
#
  if (!defined($column)) { $column = 'ButtonState'; } # arbitrary and probably never used
  my $hxitem            = '';
  if (exists($columnNameReference{$column})) {
    $hxitem             = $columnNameReference{$column};
  }
#
  my $checked           = '  ';
  if (defined($button)) {
    if (exists($main::cline{$button})) {
      if ($main::cline{$button} eq $column) { $checked = ' checked '; }
    } # if $button
  } # if button
  my $submit1ButtonInfo = "\n          <input type=\"checkbox\" name=\"$column\" $onClick title=\"$msg\"$checked/>$hxitem"; #  
#
  my $beltAndSuspenders = 0;
  while (defined ($column) && ($beltAndSuspenders++ < 10)) {
    if (defined ($button)) {
      $submit1ButtonInfo   .= "\n          <input type=\"hidden\"   name=\"$button\" value=\"$column\" />";
    } # if button
    $column             = shift @_;
    $button             = shift @_;
  } # while shifting
  my $formInfo          = "\n        <form $formspec>$submit1ButtonInfo\n        </form>\n";

  return $formInfo;
} # NakedCheckBox

  # ------------------------------------------------------------------------------
my $whereby                  = '';
my %wherebyHash; # keeps track of items referenced in whereby clause
my $groupby                  = ''; # "GROUP BY $primary";

  # ------------------------------------------------------------------------------
my $featureUtilityString = 'featureUtilityString';
sub  featureUtilityString {
    $featureUtilityString .= shift @_; # save the output to the global variable
} #  featureUtilityString

  # ------------------------------------------------------------------------------
sub whereBy {
  my $featureControlName  = shift @_;
  my $featureDescription  = shift @_;
  my $featureText         = shift @_;
  my $xBug                = shift @_;
  my $class               = shift @_;
  my $oneClick            = shift @_;
  &cBug("whereBy! ** $featureControlName ** $featureDescription ** $featureText");
} # whereBy

  # ------------------------------------------------------------------------------
sub groupBy {
  my $featureControlName  = shift @_;
  my $featureDescription  = shift @_;
  my $featureText         = shift @_;
  my $xBug                = shift @_;
  my $class               = shift @_;
  my $oneClick            = shift @_;
  &cBug("groupBy! + $featureControlName + $featureDescription + $featureText");
  if ($featureControlName =~ /item(COL[0-9][0-9]*)/) {
     $groupby = $1;
  }
} # groupBy

  # ------------------------------------------------------------------------------
sub countBy {
  my $featureControlName  = shift @_;
  my $featureDescription  = shift @_;
  my $featureText         = shift @_;
  my $xBug                = shift @_;
  my $class               = shift @_;
  my $oneClick            = shift @_;
  &cBug("countBy! $featureControlName $featureDescription $featureText");
} # countBy

  # ------------------------------------------------------------------------------
  # see 3180
my $labelId = 'justtheTablesMaam';
my $valueMarker = 'state';
sub checkboxToggle {
  my $hiddenkey            = 77;
  my $hitem                = shift @_; # featureControlName
  my $checkText            = shift @_; # featureDescription
  my $genericInformation   = 'Not much information about this control';
  my $specificInformation  = shift @_; # featureText
  if (!defined($specificInformation)) {  $specificInformation = 'nothing specific!'; }
  my $xBug                 = shift @_;  if (!defined($xBug))  { $xBug  = \&bBug; }
  my $class                = shift @_;  if (!defined($class)) { $class = 'dvx5'; }
  my $oneClick             = shift @_;  if (!defined($oneClick)) { $oneClick = 0; }
#
  &xlogBug("   hitem               $hitem");
  &xlogBug("   checkText           $checkText");
  &xlogBug("   specificInformation $specificInformation");
  &xlogBug("   class               $class");
  &xlogBug("   oneClick            $oneClick");

  my $onClickSubmit        = '';
  if (defined($oneClick)) {
    if ($oneClick) { $onClickSubmit = ' onclick="submit()"'; }
  } # if we want to suppress the small-form click-to-submit behavior, suppressed only when oneClick is defined non-zero.
#
  if (length($specificInformation)) { $genericInformation = $specificInformation; }
  my $checkState           = $valueMarker . $hitem;
  my $cenabled             = '';
  if ($checkText =~ /grouping/) {
    $cenabled              = ' disabled="disabled"';
  }
  my $httpx         = 'http://';
  if (exists($ENV{HTTPS})  || ($httpX)) { $httpx         = 'https://'; }
  my $action = $httpx . $ENV{'SERVER_NAME'} . "\/#$labelId";
  my $formspec = "action=\"$action\" id=\"$checkState\" method=\"post\" title=\"$genericInformation\" ";
  my $unhelpfulInformation = "hitem $hitem";
  my $spaces0Required      = 12;
  my $spaces1Required      = 22 - length($hitem);
  my $spaces2Required      = 32 - length($checkState);
  my $spaces3Required      = 27 - length($unhelpfulInformation);
  my $spaces0              = ' ' x $spaces0Required;
  my $spaces1              = ' ' x $spaces1Required;
  my $spaces2              = ' ' x $spaces2Required;
  my $spaces3              = ' ' x $spaces3Required;
  my $valuelInformation    = "$spaces1 value=\"$specificInformation\"";
#  my $checked              = "$spaces2 value=\"$hitem\" $onClickSubmit$spaces0 title=\"$unhelpfulInformation\" $spaces3$cenabled";
  my $checked              = "$spaces2  $onClickSubmit$spaces0 title=\"$unhelpfulInformation\" $spaces3$cenabled";
#
  if (exists($main::cline{$hitem})) {
    if ((exists($main::cline{$checkState}))) {
      if (($main::cline{$hitem} eq 'off')) {
        delete $main::cline{$hitem};
      }
      else { $checked     .= ' checked '; $main::cline{$hitem} = 'off'; }
      delete $main::cline{$checkState};
    } 
    else {   $checked     .= ' checked '; $main::cline{$hitem} = 'off'; }
  } # if
#
  my $submit1ButtonInfo    = "    <input type=\"hidden\"   name=\"$checkState\" $valuelInformation />\n";
#  my $submit1ButtonInfo    = '';
  $submit1ButtonInfo      .= "        <input type=\"checkbox\" name=\"$hitem\" $checked/>";
  $submit1ButtonInfo      .= $checkText; # if ($oneClick); # suppress text
  my $result;
  if ($oneClick) {
    $submit1ButtonInfo      .= "    <noscript><input type=\"submit\" value=\"x\"/>\</noscript>";
    $result = "<!-- Hidden $hitem -->\n  <form $formspec>\n    $submit1ButtonInfo\n  </form>";
  } else {
    $result = $submit1ButtonInfo;
  }
#  &xlogBug("    checkboxToggle          $result");
  $xBug->($result);
} # checkboxToggle

my %IPcountryHash; # we populate the hash from a file, or ask the datebase and save to file: known IP adresses with country info
  # ------------------------------------------------------------------------------
sub  featureManifestation {
  my $subroutineRef       = shift @_;
  my $featureControlName  = shift @_;
  my $featureDescription  = shift @_;
  my $featureText         = shift @_;
  my $xBug                = shift @_;
  my $class               = shift @_;
  my $oneClick            = shift @_;
  if ($featureDescription =~ /[0-9]*\.[0-9]*\.[0-9]*\.[0-9]*/) {
    my $feat = &rtrim($featureDescription);
    if (exists($IPcountryHash{$feat})) {
      my $title = $IPcountryHash{$feat};
      my $ft = "<A HREF=\"\\\" title=\"$title\">$feat</A>";
      $featureDescription = $ft;
    }
  }
  &checkboxToggle($featureControlName,$featureDescription,$featureText,$xBug,$class,$oneClick) if (exists($main::cline{'checkBoxControls'}));
  &$subroutineRef($featureControlName,$featureDescription,$featureText,$xBug,$class,$oneClick) if (exists($main::cline{$featureControlName}));
  return $featureUtilityString;
} # featureManifestation

  # ------------------------------------------------------------------------------
sub BuckNakedCheckBox {
  my $column              = shift @_;
  my $button              = shift @_;
  my $onClick             = 'onclick="submit()"'; $onClick = '';
  my $title               = "select $button $column";
#
  if (!defined($column)) { $column = 'ButtonState'; } # arbitrary and probably never used
  my $hxitem              = $column;
  if (exists($columnNameReference{$column})) {
    $hxitem               = $columnNameReference{$column};
  }
#
  my $checked             = '  ';
  my $buttonColumn        = $column; # just in case button is not defined
  if (defined($button)) {
    if (exists($main::cline{$button})) {
      $buttonColumn       = "$button$column";
      if ($main::cline{$button} eq $buttonColumn) { $checked = ' checked '; }
    } # if $button
  } # if button
#
  my $featureControlName  =  "item$column"; # $ColumnName;
  my $featureDescription  =  '';
  my $class               = 'dvx4';
  my $uItem               = $hxitem; 
  my $wItem               = &urldecode($uItem); # retain encoding at this point, treated as a value to be passed backed
  my $featureText         = $wItem;             # retain encoding at this point, treated as a value to be passed backed
  $featureUtilityString   = '';
  my $oneClick = 1; 
  &xlogBug("BuckNakedCheckBox $column $featureControlName, $featureDescription,
                                                $featureText"); # debug!
#  if (exists($main::cline{'oneClick'})) { $oneClick = $main::cline{'oneClick'}; }
  my $checkboxFeature     = &featureManifestation( \&groupBy, $featureControlName, $featureDescription,
                                                $featureText,\&featureUtilityString,$class,$oneClick);
  return $checkboxFeature;
} # BuckNakedCheckBox

  # ------------------------------------------------------------------------------
my $checkedColumn        = '999'; # global variable is touched when SQL refers to a TDWH column
sub headerTextRow {
    my $checkbox = \&BuckNakedCheckBox;
    my $outCtr           = 0;
    my $result           = '<TH>*</TH>';  # this column will have checkboxes
    for my $column (@_) {
      $outCtr++;                          # count this column
      if ($column eq 'count(*)') { next; }
      &xlogBug("headerTextRow $column");
      if (exists($columnNameReference{$column})) {
        my $aliasColumn  = $columnNameReference{$column};
        my $formInfo     = $checkbox->($column,'groupButtonInfo','wherebyButtonInfo');
        $result         .= "<TH>\n    $formInfo $aliasColumn  </TH>"; # the column header
        if ($formInfo =~ /checked/) {
          $checkedColumn = $outCtr;       # make a note of this column to global variable
        } # if
      } else {
        my $formInfo     = $checkbox->($column,'groupButtonInfo','wherebyButtonInfo');
        $result         .= "<TH>\n    $formInfo $column  </TH>"; # the column header
      } # else
    } # for
    $result             .= "<TH>*</TH>";
    my $endResult        = '      <TR>' . $result . '</TR>' . "\n";
    return $endResult;
} # headerTextRow

  # ------------------------------------------------------------------------------
sub urlencode {
  my $s = shift;
  $s =~ s/ /+/g;
  $s =~ s/([^A-Za-z0-9\+-])/sprintf("%%%02X", ord($1))/seg;
  return $s;
} # urlencode

# ----------------------------------------------------------------------------
my @queryResultFile; # a stack of results from sql inquiries
sub sendMysqlQuery {
  my $sql                      = shift @_;
  my $xBug                     = shift @_; if (!defined($xBug))       { $xBug = \&xlogBug; }
  my $noDecodeIt               = shift @_; if (!defined($noDecodeIt)) { $noDecodeIt = 0; }
  my $esql                     = $sql;
  my $validresult              = 0; # set when sql query return a non-null result
  my $result                   = '';
  my $qResult                  = '';
#
  if (!defined($main::dbConnected)) {
    $xBug->('Connect status not defined! ' . " " . $esql);
  }
#
  elsif (!$main::dbConnected) {
    $xBug->('Not connected! ' . $main::cline{'dbConnected'} . " " . $esql);
  } # if not connected to DB
#
  elsif (defined($sql) && defined($main::dbh)) {
    my @hItems;
    if ($sql =~ /SELECT (.*) FROM/) {
      @hItems = split(',',$1);
    #  does nothing, right now.
      # &xlogBug(" sendingSQL: selection => $1 \n   $sql");
    }
    $xBug->($esql); # xlog
    if ($checkedColumn        ne '999') { &bBug($esql,'dvx7'); }
    #
    my $sth = $main::dbh->prepare($sql);
    if (my $errstr = DBI->errstr) { $xBug->( "HEY 1 BUDDY! $errstr"); } # if
    #
    $sth->execute();
    if (my $errstr = DBI->errstr) { $xBug->( "HEY 2 BUDDY! $errstr <br> $esql"); return; } # undefined on purpose!
    #
    $result                             .= "  <TABLE class=\"zagos\">\n";
    my $headersInitialize                = 1;
    my $someCounter                      = 0;
    while (my @row = $sth->fetchrow_array) {
      $someCounter++;
      my $rowCtr = 'ROW';
      if ($someCounter < 10)            { $rowCtr .= '0'; }
      if ($someCounter < 100)           { $rowCtr .= '0'; }
      if ($someCounter < 1000)          { $rowCtr .= '0'; }
      if ($someCounter < 10000)         { $rowCtr .= '0'; }
      if ($someCounter < 100000)        { $rowCtr .= '0'; }
      $rowCtr                           .= $someCounter;
      if ($headersInitialize) { $result .= &headerTextRow(@hItems); $headersInitialize = 0; }
      $result                           .= "      <TR>";
      my $naked                          = &NakedCheckBox($rowCtr,'groupButtonInfo',"row number $someCounter");
      $result                           .= "<TD>$naked      </TD>";
      my $nakedValue = $rowCtr; # '0';
      my $outCtr     = 0;
      foreach my $item (@row) {
        $outCtr++;
        if (defined($item)) {
          my $ditem                      = &urldecode($item);
          $result                       .= "<TD>$ditem</TD>";
          if ($noDecodeIt) {
            $qResult                    .= "$item,"; # was ditem dbb 3-15-2021
          } else {
            $qResult                    .= "$ditem,"; # was ditem dbb 3-15-2021
          }
          if ($checkedColumn eq $outCtr) { $nakedValue = $ditem; }
        } else {
          $result                       .= "<TD></TD>"; # undefined contents
          $qResult                      .= 'empty,';
        } # else item not defined
      } # for each item
      my $nxked                          = &NakedCheckBox($nakedValue,'wherebyButtonInfo',"row number $someCounter");
      $result                           .= "<TD>$nxked      </TD>";
      $result                           .= "</TR>\n";
      $validresult                       = 1;
    } # while
    $result                             .=  "    </TABLE>";
    if ($checkedColumn        ne '999') { &bBug($esql,'dvx7'); }
  } # if sql
#
  else {
    &sBug("WTF? Failed to connect to mysql?");
    $main::cline{'nullSQLresult'} = &urlencode($sql);
  } # else
#
  if (!$validresult) { $result = ''; }
  else               { push (@queryResultFile,$qResult); } # else
#
  return $result;
} # sub sendMysqlQuery

  # ------------------------------------------------------------------------------
sub logSQLresults {
  my $resulting = shift @_;
  my $querycsv  = shift @_;
  my $xBug      = shift @_;
  my $enable    = shift @_;
  if (defined($resulting))     {
           chomp $resulting;
           # $xBug->("resulA + $resulting");
  } else { $xBug->("resulA X"); }
} # logSQLresults

# ----------------------------------------------------------------------------
my @tables;                                               # initialized in displayTDWHtables

  # ------------------------------------------------------------------------------
sub resetButton {
  my $submitButtonText = 'Reset WH';
  my $hiddenkey        = 71;
#
  if (exists($main::cline{'resetButtonInfo'})) {
    my $passedKey = $main::cline{'resetButtonInfo'};
    if ($passedKey eq 71) {
      $submitButtonText = 'Sure?';
      $hiddenkey = 72;
    }
    elsif ($passedKey eq 72) {
      &xlogBug("Resetting WH$passedKey!");
      my $resulting = &sendMysqlQuery("DROP TABLE TDALIAS;");
      my $rfsulting = &sendMysqlQuery( "DROP TABLE TDUPLOADS;");
      my @controlsToZap = ('f1filterfield.*','WarehouseSettings','XLSXOUTPUT',
            'DVX0','DVX1','DVX2','DVX6','DVX7',
            'selectHeaders','selectTDWHfilter',

            'MENTEE','MILANO','MOAN','ODY','PERKY','SEXSUGAR',
            'filterValue','checkBoxControls','processUploadedDatafiles');
      for my $citem (keys %main::cline) {
        if ($citem =~ /TDWH.*/) {
           if ($citem !~ /TDWH-/) {
             delete $main::cline{$citem};
           } # we don't zap counters, marked with '-'
        } # if
        else { 
          for my $control (@controlsToZap) {
            if ($citem =~ /$control/) {
               delete $main::cline{$citem};
            } # if
          } # for each control
        } # else
      } # for
#
      for my $hitem (@tables) {
        my $resulting = &sendMysqlQuery("DROP TABLE $hitem;");
        # &cBug($resulting);
      } # for
      $submitButtonText = 'Resetting WH';
      $hiddenkey = 71;
    } # if key is 72
    elsif ($passedKey eq 73) {
      &xlogBug("Reset WH$passedKey!\n");
      &xlogBug("$spareCode\n");
      $submitButtonText = 'Reset WH';
      $hiddenkey = 71;
    } # elsif
    delete $main::cline{'resetButtonInfo'};
  } # if
#
  my $httpx         = 'http://';
  if (exists($ENV{HTTPS})  || ($httpX)) { $httpx         = 'https://'; }
  my $action = $httpx . $ENV{'SERVER_NAME'} . '/';
  my $formspec          = "action=\"\$action\" method=\"post\"";
  $formspec            .= " title=\"Good enough!\"";
  my $submit1ButtonInfo = "<input type=\"submit\" value=\"$submitButtonText\">";
  $submit1ButtonInfo   .= "<input type=\"hidden\" name=\"resetButtonInfo\" value=\"$hiddenkey\" />";
  &bBug("<!-- Hidden $hiddenkey -->\n<form $formspec>$submit1ButtonInfo</form>\n");
#  $main::cline{'ResetButtonState'} = $hiddenkey;
} # resetButton

  # ------------------------------------------------------------------------------
my %whiteList; # initialized by processClineKeys
sub CountryList { # sets 'CountryOfOrigin'
  my $iquerycsv     = shift @_; # a string csv result of a database query
  my $xBug          = \&tBug;
  my $result        = -12;
#
  # $xBug->("CountryList $iquerycsv $result");
  if (exists($main::cline{'CountrywhiteList'})) {
    $main::cline{'CountryList'} = $main::cline{'CountrywhiteList'};
  }
  my @CountryList;
  if (exists($main::cline{'CountryList'})) {
    # $xBug->("CountryList: $main::cline{'CountryList'}");
    @CountryList = split(' ',$main::cline{'CountryList'});
  }
  else { $xBug->("No countrylist!"); }
  if ($#CountryList > -1) {
  #  push @CountryList,'bogon';
    if (in { $iquerycsv eq $_ } @CountryList) { $result = 0; }
  } else { $result = -4; } # empty whiteList means nobody is whitelisted
#      
  $xBug->("CountryList! $main::cline{'CountryOfOrigin'} - @CountryList - $result -");
  return $result;
} # whiteList

  # ------------------------------------------------------------------------------
# looks for ip addresses that are assigned to far away places
my $ExtractCountry=" 
      MID(REGEXP_SUBSTR( Content,'%22country%22%3A.%22[A-Z][A-Z]%22%2C%0A'),21,2) AS Smitty ";
sub checkIPisNotForeign {
  my $someIPaddress = shift @_;  if(!defined($someIPaddress)) { $someIPaddress = '0.0.0.0'; }
  my $xBug          = shift @_;  if(!defined($xBug)) { $xBug = \&xlogBug; }
  #  $xBug = \&Nothing;
  $xBug = \&tBug;
  $xBug->('  ----------------  checkIPisNotForeign   --------------- ');
  my $result        = 1; # unexpected result, not sure what it means
#
# SELECT MID(REGEXP_SUBSTR( Content,'%22country%22%3A.%22[A-Z][A-Z]%22%2C%0A'),21,2) ";
  my $isql  = "SELECT $ExtractCountry from SUBMITlog where sourceName like '$someIPaddress';";
  my $iresulting    = &sendMysqlQuery($isql,$xBug);
  my $iquerycsv     = pop @queryResultFile;
  if (defined($iresulting)) {
    if (defined($iquerycsv)) {
      $result       = 2; # IP is presumed not on whiteList
      $main::cline{'CountryOfOrigin'} = substr($iquerycsv,0,2);
#      &logSQLresults($iresulting, $main::cline{'CountryOfOrigin'}, $xBug);
      $result       = &CountryList($main::cline{'CountryOfOrigin'});
    } else {
      $result = -2; # IP not found
    } # else IP not found
  } else { $result = -3; } # defined
  $isql  = "SELECT $ExtractCountry from SUBMITlog where sourceName like '$someIPaddress';";
  $iresulting    = &sendMysqlQuery($isql,$xBug);
  $iquerycsv     = pop @queryResultFile;
  if (defined($iresulting)) {
    if (defined($iquerycsv)) {
      $result       = 2; # IP is presumed not on whiteList
      $main::cline{'CountryOfOrigin'} = substr($iquerycsv,0,2);
#      &logSQLresults($iresulting, $main::cline{'CountryOfOrigin'}, $xBug);
      $result       = &CountryList($main::cline{'CountryOfOrigin'});
    } else {
      $result = -2; # IP not found
    } # else IP not found
  } else { $result = -3; } # defined
  $xBug->("  ------- END ----  checkIPisNotForeign   -------- $result ------- ");
  return $result;
} # checkIPisNotForeign

# ----------------------------------------------------------------------------
my $IPcountryTag            = 'IPcountryTag';
$main::cline{$IPcountryTag} = 'ipCountries.txt';

# ----------------------------------------------------------------------------
#  BEGIN {unshift @INC, '/home/pi/perl5/lib/perl5';} # for claudia
  BEGIN {unshift @INC, '/usr/local/share/perl/5.20.2/CPAN';} # for gillian
  BEGIN {unshift @INC, '/usr/share/perl/5.28.1/CPAN';} # for francine:443
#  BEGIN {unshift @INC, '/home/pi/.cpan/build/libwww-perl-6.46-0/lib';}
#  BEGIN {unshift @INC, '/usr/lib/cgi-bin/libwww-perl-6.06/blib/lib';}
#  BEGIN {unshift @INC, '/root/.cpan/build/libwww-perl-6.52-0/lib';}
  BEGIN {unshift @INC, '/usr/local/share/perl/5.28.1';}
use LWP::UserAgent ();

# ----------------------------------------------------------------------------
sub fetchIPaddressInfo {
	&tBug(" ----------------- fetchIPaddressInfo ------------------");
  my $token                = '2dcd56c8f0a622';
  my $querycsv             = shift @_;
  my $someIPaddress        = shift @_; if(!defined($someIPaddress)) { $someIPaddress = '0.0.0.0'; }
  my $lastFlagPtr          = shift @_;
  my $goodGuyPtr           = shift @_;
  my $xBug                 = shift @_;  if(!defined($xBug)) { $xBug = \&tBug; }
  my $allok                = 1;
  my $result               = -8;
  my $trimmedIPaddress     = &rtrim($someIPaddress);
  if (defined($querycsv)) {
    $xBug->("fetchIPaddressInfo -------- $querycsv $someIPaddress --------------------------- ");
  } # defined querycsv
  else { $xBug->("fetchIPaddressInfo not defined $someIPaddress"); }
  if (exists($IPcountryHash{$trimmedIPaddress})) {
    $allok = 0;
    if (length($IPcountryHash{$trimmedIPaddress})  < 3) { $allok = 1; }
    $xBug->("WWW{$trimmedIPaddress}WWW$IPcountryHash{$trimmedIPaddress}WWW ($allok)");
  } # exists trimmedIPaddress
  else { $xBug->("Not exist in IPcountryHash $trimmedIPaddress"); }
  if ($allok) {
    my $someText;
    # my $scmd               = "curl ipinfo.io/$someIPaddress?token=$token > ipinfo.tmp";
    my $ipinfo             = "http://ipinfo.io/$someIPaddress?token=$token";
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
    if (my $ua = LWP::UserAgent->new) {
      my $secretAgent = "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7.5) Gecko/20041107 Firefox/1.0";
      $secretAgent =~ s/1.7.5/$__PACKAGE__::versionNumber/; # so I know my own request, if I ever see it
      $ua->agent($secretAgent);
      $ua->from('misterblackman@shaw.ca');
      $ua->timeout(10);
      $ua->env_proxy;
      $ua->cookie_jar({ file           => "cookies.txt", 
                        ignore_discard => 1, 
                        autosave       => 1 });
      $ua->env_proxy;
 
      my $response = $ua->get($ipinfo);
      my $dcontent = $response->decoded_content;
      $xBug->(" Awesome!  $ipinfo $dcontent");
      &recordItemSUBMITlog($main::cline{'HOSTNAME'},$someIPaddress,$dcontent,$xBug,&nextClass);
      $result = &checkIPisNotForeign($someIPaddress);
      $xBug->("checkIPisNot: $someIPaddress - $result"); # debug dbb 22-11-16
    } # if new
    else { $xBug->("Failed to create UserAgent! $! $^E"); }
  } # allok
  else {
    $$goodGuyPtr         = "skipping database update $someIPaddress";
    $result              = -10;
  } # else some problem
  $xBug->("fetchIPaddressInfo $result $! $$goodGuyPtr ");
	&tBug(" ----------------- END fetchIPaddressInfo $result ------------------");
  return $result;
} # fetchIPaddressInfo

  # ------------------------------------------------------------------------------
sub decideClass {
  my $tagline = shift @_; # find out if the text should have a class name, else assume default
  my $result = 'dvx0'; # default
  my %classPairs = (    "DVX1"  => "dvx1",    "DVX2"  => "dvx2",    "DVX3"  => "dvx3",
                        "DVX4"  => "dvx4",    "DVX5"  => "dvx5",    "DVX6"  => "dvx6",
                        "DVX7"  => "dvx7",    "DVX8"  => "dvx8",    "DVX9"  => "dvx9",
                        "DVX0"  => "dvx0",
  ); # text class applies to those tags found listed in the cline hash for that class
  my @classNames = keys %classPairs;
  for my $className (@classNames) { 
    if (exists($main::cline{$className})) {
      my @taglist = split(',',$main::cline{$className});
      for my $tagitem (@taglist) {
        if ($tagitem eq $tagline) { $result = $classPairs{$className}; }
      } # for
    } # if
  } # for
  return $result;
} # decideClass

  # ------------------------------------------------------------------------------
use File::Basename;
sub printdiv {
  my $filename  = shift @_;
  my $classname = shift @_; # ignored!
  my $tagline   = shift @_;
  my $result    = 0;
  my $path      = dirname $filename;
  my $name      = basename $filename;
  if ($tagline) {
    if (exists($main::cline{$tagline})) {
      $result = $main::cline{$tagline};
      print "<div class=\"dvx0\"><H3>TAG: $path $name $tagline $result</H3></div>\n" if (&checkDEBUGXIP);
      &decrementCounter($tagline);
      $classname = &decideClass($tagline);
      print "<div class=\"$classname\">";
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
      if (open DBFILE,$filename) {
        print <DBFILE>;
        close DBFILE;
        chmod $fileRWXmode, $filename;
      }
      print "</div>\n";
    } # if
  } else {
    print "<div class=\"dvx0\">";
    print "<H3>ALT: $tagline </H3>\n";
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
    if (open DBFILE,$filename) { print <DBFILE>; close DBFILE; }
    print "</div>\n";
  } # else
} # printdiv

  # ------------------------------------------------------------------------------
sub getCline {
  my $Carray  = shift @_;
  my $tagname = $Carray->[3];
  my $result  = 0;
#
  if (exists($main::cline{$tagname})) { $result = $main::cline{$tagname}; }
  return $result;
} # getCline

  # ------------------------------------------------------------------------------
sub Nothing {
} # Nothing

  # ------------------------------------------------------------------------------
sub tableAlreadyExists { # returns 0 if the table doesn't exist or any other error
  my $tablename = shift @_;
  my $database  = shift @_;
  my $xBug      = \&xlogBug; # X
  #  my $xBug = \&Nothing; # X
  if (defined($tablename)) {
    if (defined($database)) {
#      $xBug->("tableAlreadyExists $tablename $database");
      my $query    = "SELECT count(*) FROM information_schema.TABLES
                        WHERE (TABLE_SCHEMA = $database) AND (TABLE_NAME = '$tablename');";
      $xBug = \&Nothing; # suppress routine output
      my $result   = &sendMysqlQuery($query, $xBug);
      chomp $result;
      my $querycsv = pop @queryResultFile;
      &logSQLresults($result, $querycsv, $xBug);
      return $querycsv ne '0,';
    } else { $xBug->("Undefined Database $tablename"); }
  } else { $xBug->("Undefined Tabled Name"); }
  return 0;
} # tableAlreadyExists

  # ------------------------------------------------------------------------------
my $accessLogTableName = 'AccessLogs';
sub makesureHousekeepingTablesAreProperlySetUp { # returns 0 success, or 1 on any failure
  my $result = 1; # presume failure
  if (!defined($dbDatabase)) {
    &main::BusyServer("bailing out of makesureHousekeepingTablesAreProperlySetUp");
    return $result;
  }
  my $xBug = \&xlogBug;
  # $xBug->("makesure 0");
  my $sql       = "USE $databaseName;";
  my $resulting = &sendMysqlQuery($sql,$xBug);
  my $jinfo     = pop @queryResultFile;
  # if (defined($jinfo))     {  $xBug->("jinfo * $jinfo"); }     else { $xBug->("jinfo X"); }
  # if (defined($resulting)) {  $xBug->("resulB * $resulting"); } else { $xBug->("resulB X"); }
  if ((!defined($jinfo)) && (!defined($resulting))) {
#
    my $sql = "CREATE DATABASE $databaseName;";
    my $resulting = &sendMysqlQuery($sql);
    my $jinfo     = pop @queryResultFile;
    if (defined($jinfo))     {  $xBug->("jinfo - $jinfo"); }     else { $xBug->("jinfo X"); }
    if (defined($resulting)) {  $xBug->("resulC - $resulting"); } else { $xBug->("resulC X"); }
#
    $sql       = "USE $databaseName;";
    $resulting = &sendMysqlQuery($sql);
    $jinfo     = pop @queryResultFile;
    if (defined($jinfo))     {  $xBug->("jinfo + $jinfo"); }     else { $xBug->("jinfo X"); }
    if (defined($resulting)) {  $xBug->("resulD + $resulting"); } else { $xBug->("resulD X"); }
#
    $sql = "CREATE USER 'dbb'\@'\%' IDENTIFIED BY 'Coc3la';";
    $resulting = &sendMysqlQuery($sql);
    $jinfo     = pop @queryResultFile;
    if (defined($jinfo))     {  $xBug->("jinfo + $jinfo"); }     else { $xBug->("jinfo X"); }
    if (defined($resulting)) {  $xBug->("resulE + $resulting"); } else { $xBug->("resulE X"); }
#
    $sql = "CREATE USER 'chuck'\@'\%';";
    $resulting = &sendMysqlQuery($sql);
    $jinfo     = pop @queryResultFile;
    if (defined($jinfo))     {  $xBug->("jinfo + $jinfo"); }     else { $xBug->("jinfo X"); }
    if (defined($resulting)) {  $xBug->("resul1 + $resulting"); } else { $xBug->("resul1 X"); }
#
    $sql = "GRANT ALL PRIVILEGES ON * . * TO 'dbb'\@'\%';";
    $resulting = &sendMysqlQuery($sql);
    $jinfo     = pop @queryResultFile;
    if (defined($jinfo))     {  $xBug->("jinfo + $jinfo"); }     else { $xBug->("jinfo X"); }
    if (defined($resulting)) {  $xBug->("resul2 + $resulting"); } else { $xBug->("resul2 X"); }
#
    $sql = "GRANT ALL PRIVILEGES ON * . * TO 'chuck'\@'\%';";
    $resulting = &sendMysqlQuery($sql);
    $jinfo     = pop @queryResultFile;
    if (defined($jinfo))     {  $xBug->("jinfo + $jinfo"); }     else { $xBug->("jinfo X"); }
    if (defined($resulting)) {  $xBug->("resul3 + $resulting"); } else { $xBug->("resul3 X"); }
#
    $sql = "FLUSH PRIVILEGES;";
    $resulting = &sendMysqlQuery($sql);
    $jinfo     = pop @queryResultFile;
    if (defined($jinfo))     {  $xBug->("jinfo + $jinfo"); }     else { $xBug->("jinfo X"); }
    if (defined($resulting)) {  $xBug->("resul4 + $resulting"); } else { $xBug->("resul4 X"); }
#
  } # if we think we need to create the database
#
  if (!&tableAlreadyExists('TDUPLOADS',$dbDatabase)) {
    my $createUploadTable = "CREATE TABLE TDUPLOADS ( \n";
    $createUploadTable   .= "  `sourceFilename` varchar(255) DEFAULT '',\n";
    $createUploadTable   .= "  `tableName`      varchar(255) DEFAULT '',\n";
    $createUploadTable   .= "  `HeaderText`     varchar(255) DEFAULT '',\n";
    $createUploadTable   .= "  `startDate`      varchar(255) DEFAULT '',\n";
    $createUploadTable   .= "  `endDate`        varchar(255) DEFAULT '',\n";
    $createUploadTable   .= "  `tableType`      varchar(255) DEFAULT '',\n";
    $createUploadTable   .= "  `tstamp` timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,\n";
    $createUploadTable   .= "  `rstamp` timestamp \n";
    $createUploadTable   .=  ') ENGINE=MyISAM DEFAULT CHARSET=' . "$CHARSET ;\n";
    $xBug->("makesure 1");
    my $resulting = &sendMysqlQuery($createUploadTable);
    my $jinfo     = pop @queryResultFile;
    if (defined($jinfo))     {  $xBug->("jinfo + $jinfo"); }     else { $xBug->("jinfo X"); }
    if (defined($resulting)) {  $xBug->("resul5 + $resulting"); } else { $xBug->("resul5 X"); }
  } # if
  if (!&tableAlreadyExists($accessLogTableName,$dbDatabase)) {
    my $createAliasTable = "CREATE TABLE $accessLogTableName ( \n";
    $createAliasTable   .=   " `IPsource`        text,\n";
    $createAliasTable   .=   " `Extrastr`        text,\n";
    $createAliasTable   .=   " `Datestr`         varchar(36),\n";
    $createAliasTable   .=   " `Timezone`        varchar(5),\n";
    $createAliasTable   .=   " `Request`         text,\n";
    $createAliasTable   .=   " `HTTP`            text,\n";
    $createAliasTable   .=   " `Referer`         text,\n";
    $createAliasTable   .=   " `ResponseCode`    text,\n";
    $createAliasTable   .=   " `ResponseLength`  text,\n";
    $createAliasTable   .=   " `UserAgent`       text";
    $createAliasTable   .= ');';
    my $resulting = &sendMysqlQuery($createAliasTable,$xBug);
    my $jinfo     = pop @queryResultFile;
    if (defined($jinfo))     {  $xBug->("jinfo + $jinfo"); }     else { $xBug->("jinfo X"); }
    if (defined($resulting)) {  $xBug->("resul6 + $resulting"); } else { $xBug->("resul6 X"); }
  } # if
  if (!&tableAlreadyExists('TDALIAS',$dbDatabase)) {
    my $createAliasTable = "CREATE TABLE TDALIAS ( \n";
    $createAliasTable   .=   "  `tableID`       varchar(255) DEFAULT '',\n";
    $createAliasTable   .=   "  `fieldName`     varchar(255) DEFAULT '',\n";
    $createAliasTable   .=   "  `HeaderText`    varchar(255) DEFAULT '',\n";
    $createAliasTable   .=   "  UNIQUE(`tableID`,`fieldName`)\n";
    $createAliasTable   .= ');';
    my $resulting = &sendMysqlQuery($createAliasTable);
    my $jinfo = pop @queryResultFile;
    if (defined($jinfo))     {  $xBug->("jinfo + $jinfo"); }     else { $xBug->("jinfo X"); }
    if (defined($resulting)) {  $xBug->("resul7 + $resulting"); } else { $xBug->("resul7 X"); }
  } # if
  if (!&tableAlreadyExists('SUBMITlog',$dbDatabase)) {
    my $createAliasTable = "CREATE TABLE SUBMITlog ( \n";
    $createAliasTable   .= "  `UserID`     varchar(255) DEFAULT '',\n";
    $createAliasTable   .= "  `sourceName` varchar(255) DEFAULT '',\n";
    $createAliasTable   .= "  `Content`    text,\n";
    $createAliasTable   .= "  `tstamp`     timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP\n";
    $createAliasTable   .= ');';
    my $resulting = &sendMysqlQuery($createAliasTable);
    my $jinfo = pop @queryResultFile;
    if (defined($jinfo))     {  $xBug->("jinfo + $jinfo"); }     else { $xBug->("jinfo X"); }
    if (defined($resulting)) {  $xBug->("resul8 + $resulting"); } else { $xBug->("resul8 X"); }
  } # if
  if (!&tableAlreadyExists('visitors',$dbDatabase)) {
    $sql = "CREATE TABLE `visitors` (
                                `HTTP_ACCEPT_ENCODING` text,
                                `HTTP_ACCEPT_LANGUAGE` text,
                                `HTTP_ACCEPT`     text,
                                `HTTP_PRAGMA`     text,
                                `HTTP_CONNECTION` text,
                                `HTTP_COOKIE`     text,
                                `HTTP_FROM`       varchar(29) DEFAULT NULL,
                                `HTTP_HOST`       text,
                                `HTTP_REFERER`    text,
                                `HTTP_USER_AGENT` text,
                                `QUERY_STRING`    text,
                                `REMOTE_ADDR`     text,
                                `REMOTE_PORT`     int(11) DEFAULT NULL,
                                `REQUEST_METHOD`  text,
                                `REQUEST_SCHEME`  text,
                                `REQUEST_URI`     text,
                                `SCRIPT_FILENAME` text,
                                `SCRIPT_NAME`     text,
                                `SERVER_ADDR`     text,
                                `SERVER_ADMIN`    text,
                                `SERVER_NAME`     text,
                                `SERVER_PORT`     int(11) DEFAULT NULL,
                                `SERVER_PROTOCOL` text,
                                `VISITOR_NUMBER`  int(11) DEFAULT NULL,
                                `UserID`          varchar(255) DEFAULT '',
                                `SSH_CONNECTION`  varchar(19) DEFAULT NULL,
                                `tstamp` timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP
            ) ENGINE=InnoDB DEFAULT CHARSET=latin1;";
    my $resulting = &sendMysqlQuery($sql);
    my $jinfo     = pop @queryResultFile;
    if (defined($jinfo))     {  $xBug->("jinfo + $jinfo"); }     else { $xBug->("jinfo X"); }
    if (defined($resulting)) {  $xBug->("resul9 + $resulting"); } else { $xBug->("resul9 X"); }
  } # if
#
  my $userHostID = $main::cline{'HOSTNAME'};
  if (exists($main::cline{'UserID'})) { $userHostID .= '-' . $main::cline{'UserID'}; }
  &recordItemSUBMITlog($userHostID,'version',$__PACKAGE__::versionNumber,$xBug,'div5');
  $result = 0; # success
  return $result;
} # makesureHousekeepingTablesAreProperlySetUp

# ----------------------------------------------------------------------------
sub connectToThisDatabase {
  my $dbvptr = shift @_;
  my $xBug   = shift @_;                        # optional argument
  if (!defined($xBug)) { $xBug = \&xlogBug; } # just in case we forget to include an argument
  my $result = 1; # assume failure, still searching for db
#
  my $dbname = '*' . $dbvptr->{DBNAM} . '*'; # make this DBNAM easier to read
  if ($dbvptr->{DBENA}) {
    $main::cline{'dbConnected'} = $dbvptr->{DBCON} . $dbvptr->{DBUSR} . $dbvptr->{DBPWD};
    if ($main::dbh = DBI->connect($dbvptr->{DBCON},  $dbvptr->{DBUSR},  $dbvptr->{DBPWD},
                                  { RaiseError => 0, AutoCommit => 1, PrintError => 0 } )) {
      $main::dbConnected = 1;
      $main::cline{'dbConnected'} = $dbvptr->{DBCON};
      $xBug->("logged in dbh! $dbvptr->{DBCON}");
      $main::dbh->do( "set names utf8" );
      $result = 0; # success means no more searching
      if (my $errstr = DBI->errstr) { $xBug->("HEY BUDDY 3! $errstr"); }
      &makesureHousekeepingTablesAreProperlySetUp; # returns 0 success, or 1 on any failure
    } else                        { $xBug->("Hey Buddy!! $dbname AFU!"); }
  } else                          { $xBug->("Skipped this $dbname"); }
  return $result;
} # connectToThisDatabase

# ----------------------------------------------------------------------------
# Right trim function to remove trailing whitespace
sub rtrim($) {
  my $string = shift;
  if (defined($string)) {  $string =~ s/\s+$//; }
  return $string;
} # rtrim

# ----------------------------------------------------------------------------
my @ListOfDatabaseInfoHashes;
my @ListOfDatabaseInfoNames;
my %dbv;
# Reads the file and creates a list of database info hashes
sub buildListOfDatabases {
  my $privateInfoFilespec = shift @_;
  my $xBug = shift @_;                        # optional argument
  if (!defined($xBug)) { $xBug = \&xlogBug; } # just in case we forget to include an argument
  my $runawayCtr = 0;
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  if (open DBFILE, $privateInfoFilespec) {
    my @items = <DBFILE>;
    close DBFILE;
    my $searchingForDatabase = 1;
    my $runawayCtr = 0;
    my $dbIndex = 0;
    my $someIndexFoundInCline = 0; # assume none found
    while ($searchingForDatabase && ($runawayCtr < $#items)) {
      # connect to database
      my $dbIndexName = "database" . $dbIndex;
      %dbv =    ('DBCON'=> &rtrim($items[$runawayCtr]),
                 'DBUSR'=> &rtrim($items[$runawayCtr + 1]),
                 'DBPWD'=> &rtrim($items[$runawayCtr + 2]),
                 'DBXXX'=> 0,
                 'DBENA'=> 0,
                 'DBNAM'=> $dbIndexName);
      if (in { $dbIndexName eq $_ } (keys %main::cline)) {
        
        $dbv{'DBENA'}          = 1; # dbIndexName was found in state.txt
        $someIndexFoundInCline = 1; # least one found, DBENA
      } # the dbIndexName is a state.txt item
      push @ListOfDatabaseInfoHashes, { %dbv };
      push @ListOfDatabaseInfoNames,  $dbIndexName;
    #
      $runawayCtr += 4; # four lines per database in the dbinfo file
      $dbIndex++;
    } # while searchingForDatabase
    if (!$someIndexFoundInCline) {
       my $infoIndex = 0;
       for my $infoItem (@ListOfDatabaseInfoNames) {
         $ListOfDatabaseInfoHashes[$infoIndex]{'DBENA'} = 1;
         my $dbName = $ListOfDatabaseInfoHashes[$infoIndex]{'DBNAM'};
         $main::cline{$dbName} = 'off'; # toggle switched
         $infoIndex++;
       } # for ListOfDatabaseInfoNames
    } # if all are 0, then make them all 1
  } # read file
  else { $xBug->("Database password file is not found! $privateInfoFilespec "); }
#
  return; # debug stuff below
} # buildListOfDatabases

# ----------------------------------------------------------------------------
sub connectToAnyDatabase {
  my $privateInfoFilespec = shift @_;
  my $xBug                = shift @_;                        # optional argument
  my $someCodePtr         = shift @_; # not used
  if (!defined($xBug)) { $xBug = \&xlogBug; } # just in case we forget to include an argument
  $xBug->("Connecting to any database in $privateInfoFilespec");
  my $runawayCtr = 0;
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  if (open DBFILE, $privateInfoFilespec) {
    my @items = <DBFILE>;
    close DBFILE;
    my $searchingForDatabase = 1;
    my $runawayCtr = 0;
    my $indexCtr   = 0;
    while ($searchingForDatabase && ($runawayCtr < $#items)) {
      my $item              = &rtrim($items[$runawayCtr]);
      my $tmpResult         = $ListOfDatabaseInfoHashes[$indexCtr];
      my $dbname            = '*' . $tmpResult->{DBNAM} . '*'; # make this DBNAM easier to read
      $xBug->("Trying connection to $dbname $item");
      $searchingForDatabase = &connectToThisDatabase($tmpResult,$xBug); # returns 0 when connected, 1 on error
      $runawayCtr += 4; # four lines per database in the dbinfo file
      $indexCtr++;
    } # while searchingForDatabase
    if ($runawayCtr > $#items) {      $xBug->("No databases found!");    } 
  } # read file
  else { &main::BusyServer("Database password file is not found! $privateInfoFilespec "); } # no return!
} # connectToAnyDatabase

  # ------------------------------------------------------------------------------
sub getNextTableName {
  &incrementCounter('TDWH-TABLENUMBER');
  if ($main::cline{'TDWH-TABLENUMBER'} > 9999) { $main::cline{'TDWH-TABLENUMBER'} = 1001; }
  if ($main::cline{'TDWH-TABLENUMBER'} < 1000) { $main::cline{'TDWH-TABLENUMBER'} = 1001; }
  my $tablename = "TDWH" . $main::cline{'TDWH-TABLENUMBER'};
  &writestate; # save this value in case of later error stop program
  return $tablename;
} # getNextTableName

  # ------------------------------------------------------------------------------
sub urldecode {
  my $s = shift;
  $s =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
  $s =~ s/\+/ /g;
  return $s;
} # urldecode

  # ------------------------------------------------------------------------------
sub PlayBell { # creates a sound uploaded by the browser, assuming the sound file is available
  if (-e 'jungle.wav') {
    my $soundurl = '/jungle.wav';
    my $htmltext = "<!-- -- -- -- ---- -- -- ---- -- -- ---- -- -- -- -->\n";
    $htmltext .= "<script>\n";
    $htmltext .= "<!-- \n";
    $htmltext .= " var snd = new Audio(\"$soundurl\");\n"; # // buffers automatically when created
    $htmltext .= " snd.play();\n";
    $htmltext .= "// end comment --> \n";
    $htmltext .= "</script> \n";
    $htmltext .= "<noscript>Sounds Good!</noscript> \n";
    &bBug($htmltext); # formatting to STDOUT
    if (exists($main::cline{'version'})) {
      my $decoded = &urldecode($main::cline{'version'});
      &StateMessage("PlayBel defined: $decoded");
    }
  } else { &tBug("No PlayBell for you!"); } # else
} # PlayBell

  # ------------------------------------------------------------------------------
# require Excel::Writer::XLSX;
sub convertWorksheetToSQL {
  my $worksheet = shift @_;
  my $zBug = \&sBug;
#  my $CHARSET = 'utf8mb4'; # was latin1
  my ( $row_min, $row_max ) = $worksheet->row_range();
  my ( $col_min, $col_max ) = $worksheet->col_range();
  
  $zBug->("<div>$row_min $row_max $col_min $col_max</div>\n");

  my $tablename = &getNextTableName;
  if (&tableAlreadyExists($tablename,$dbDatabase)) {
    my $dresult = "DROP TABLE $tablename;\n";
    my $resulting = &sendMysqlQuery($dresult);
  } # if

  my $result = "CREATE TABLE `$tablename` (\n";
  for my $row ($row_min) {
    $main::cline{'TDWH-COLUMNNUMBER'} = 0;
    for my $col ($col_min .. $col_max) {
      &incrementCounter('TDWH-COLUMNNUMBER');
      my $cell = $worksheet->get_cell($row, $col);
      my $fieldName = 'COL';
      if ($main::cline{'TDWH-COLUMNNUMBER'} < 10) { $fieldName .= '0'; } # single digits have leading zeros for sorting
      $fieldName .= $main::cline{'TDWH-COLUMNNUMBER'};
      my $insertAlias = "REPLACE INTO TDALIAS "; # first try replace
      if (defined($cell)) {
#        my $columnHeaderText = Encode::_utf8_on($cell->unformatted()); # my first idea, didn't work
        my $columnHeaderText = $cell->unformatted();
        $columnNameReference{$fieldName} = $columnHeaderText; # save actual header text in hash
        my $encodedHeaderText = &urlencode($columnHeaderText); # hopefully this makes SQL happy
        $insertAlias .= " VALUES ( '$tablename', '$fieldName', '$encodedHeaderText');";
      } else {
        $insertAlias .= " VALUES ( '$tablename', '$fieldName', 'EMPTY');";
      }
      $zBug->("<div>  *** $insertAlias</div>\n");
      my $resulting = &sendMysqlQuery($insertAlias);
      $result .=   "  `$fieldName` TEXT,\n";
    } # for col
  } # for row
   $result .=   "  `TAILCOMMENT` TEXT\n";
#  $result .= "  `tstamp` timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,\n";
#  $result .= "  `rstamp` timestamp NOT NULL DEFAULT '0000-00-00 00:00:00'\n";
  $result .= ') ENGINE=MyISAM DEFAULT CHARSET=' . "$CHARSET;\n";
  $zBug->("<div> +++ $result</div>\n");
  my $resulting = &sendMysqlQuery($result);
# BEGIN{ $| = 1; } # https://stackoverflow.com/questions/33812618/can-you-force-flush-output-in-perl
  my $row_mod = $row_min + 1;
  for my $row ($row_mod .. $row_max) {
    my $DataLoad = "INSERT into `$tablename` VALUES \n"; # second guess REPLACE
    my $commaCounter=0;
    # my $nulnul = ", NULL, NULL";
    my $nulnul = ", NULL";
    $DataLoad .= "(" ;
    for my $col ($col_min .. $col_max) {
      my $col_mod = $col_max +1;
      if ($commaCounter) {
        my $tmptmp = $commaCounter % $col_mod;
        if ($tmptmp) {
          $DataLoad .= "," ;
        }
      }
      my $cell = $worksheet->get_cell($row, $col);
      if ($cell) {
         my $value = &urlencode($cell->unformatted());
         if ($value) {
           $value =~ s/\R//g; # strip any trailing ^M
           $DataLoad .= "\"$value\"";
         } else { $DataLoad .= "\"HOLLOW\""; }
      } else { $DataLoad .= "NULL"; }
      $commaCounter++;
    } # for each column
    $DataLoad .= "$nulnul);\n";
    $zBug->("$DataLoad\n"); # debug
    
    my $resulting = &sendMysqlQuery($DataLoad);
  } # for each row
  $main::cline{$tablename} = 'convertWorksheetToSQL';
  return $tablename;
} # convertWorksheetToSQL

  # ------------------------------------------------------------------------------
sub createSampleWorksheet {
  my $workbook       = shift @_;
  my $columnCount    = shift @_;
  my $selectSQL      = shift @_;
  my $sourceFilespec = shift @_;
  $sourceFilespec    =~ m/\/(.*)\./;
  my $tabName        = "AAXX $1";
  &xlogBug("Whattya think?  $tabName");
  my $jinfo = pop @queryResultFile;
 
  # The general syntax is write($row, $column, $token). Note that row and
  # column are zero indexed
 
 # Write some formulas
#  $worksheet->write( 7, 0, '=A3 + A6' );
#  $worksheet->write( 8, 0, '=IF(A5>3,"Yes", "No")' );
  if (!defined($main::dbh)) { &xlogBug("Not defined dbh"); return; }
  if (defined($workbook)) {
    for my $hitem (@tables) {
      if (exists($main::cline{$hitem})) {
      my $worksheet = $workbook->add_worksheet($hitem);
      if (defined($worksheet)) {
        my $sth = $main::dbh->prepare($selectSQL);
        if (my $errstr = DBI->errstr) { &xlogBug( "HEY 3 BUDDY! $errstr"); } # if
        $sth->execute();
        if (my $errstr = DBI->errstr) { &xlogBug( "HEY 4 BUDDY! $errstr <br> $selectSQL"); exit(0); return; } # if
   ############################## Insert Column Headers Here #####
        my $col=0;
        my @biteaPiece = ($selectSQL =~ m/SELECT (.*) FROM/);
        my $biteOffaPiece = $1;
        my @colList = ($biteOffaPiece =~ m/COL[0-9]+/g);
        for my $colID (@colList) {
          my $jsql = "SELECT HeaderText from TDALIAS WHERE tableID='$hitem'  AND (1)
                 AND HeaderText <> '' AND HeaderText <> '1' AND HeaderText <> 'EMPTY'
                 AND fieldName = '$colID'
                  ;";
          $spareCode .= " $jsql <BR>\n"; # debug
          if (my $tmpOutput .= &sendMysqlQuery($jsql)) {
            my $hresult .= pop @queryResultFile;
            my $decodedResult = &urldecode($hresult);
            $worksheet->write( 0, $col, $decodedResult ); # this is the header row of the xlsx output
          } # if... I guess the header text could be empty...
          $col++;
        } # for
        my $rowCnt = 1;
        while (my @row = $sth->fetchrow_array) {
          my $colCnt = 0;
          foreach my $item (@row) {
            if (defined($item)) {
              my $decodedResult = &urldecode($item);
              $worksheet->write( $rowCnt, $colCnt, $decodedResult ); 
            }
            else {  $worksheet->write( $rowCnt, $colCnt, '0' ); }
            $colCnt++;
          } # while item
          $rowCnt++;
        } # while
      } # if worksheet
    } # if hitem
  } # for hitem tables
  
    $workbook->close();
  } # if workbook
} # createSampleWorksheet

# ----------------------------------------------------------------------------
sub testSampleWorksheet {
  my $sourceFilespec = shift @_;
  my $columnCount    = shift @_;
  my $selectSQL      = shift @_;
#
&sBug("testSampleWorksheet");
# return; # dbb 3-29-2021

  if (my $workbook  = Excel::Writer::XLSX->new($sourceFilespec)) {
    &createSampleWorksheet($workbook,$columnCount,$selectSQL,$sourceFilespec);
    &bBug("<a href=\"$sourceFilespec\" download>wrote to $sourceFilespec</a>");
    # we should somehow download the xlsx file
  }
  else { &xlogBug("Boo-hoo! $sourceFilespec"); } # else
} # testSampleWorksheet

# ----------------------------------------------------------------------------
sub loadXLSXtoSQL {
  my $sourceFilespec = shift @_;
  my $tableID        = 'BLANK';
  my $xBug           = \&sBug; # R W X
  $xBug->("loadXLSXtoSQL!!");
  if (exists($ENV{'TEMP'})) {
    $xBug->("We think we are running from command line");
  } elsif (!exists($ENV{'USER'})) {
    $xBug->("No user??");
    return;
  } # if
  require Spreadsheet::ParseXLSX;
  if (my $parser = Spreadsheet::ParseXLSX->new) {
    $xBug->("Parsing $sourceFilespec");
    if (my $workbook = $parser->parse($sourceFilespec)) {
      if (defined($workbook)) {
        $sourceFilespec =~ m|/(.*)\.|;
        my $tabName = "YYXX$1";
        $xBug->("Ya1-hah! $tabName");
        for my $worksheet ( $workbook->worksheets($tabName) ) {
          $xBug->("Ya2-hah! $tabName");
          $tableID = &convertWorksheetToSQL($worksheet);
        }
      } else { $xBug->("Otto!"); } # else
    }
    else { $xBug->("Na1!"); } # else
  }
  else { $xBug->("Na2!"); } # else
  my $uploadRecord = "INSERT INTO TDUPLOADS SET sourceFilename='$sourceFilespec',tableName='$tableID';";
  my $resulting    = &sendMysqlQuery($uploadRecord);
  unlink $sourceFilespec;
  $xBug->("unlink $sourceFilespec");
  return $tableID;
} # loadXLSXtoSQL

  # ------------------------------------------------------------------------------
use IO::Uncompress::Unzip qw(unzip $UnzipError) ;
sub loadZIPtoCSV {
  my $xBug = \&sBug;
  my $input_filename_or_reference  = shift @_;
  my $output_filename_or_reference = shift @_;
  unzip $input_filename_or_reference => $output_filename_or_reference
        or &xlogBug("unzip failed: $UnzipError\n");
  my $uploadRecord = "INSERT INTO TDUPLOADS SET sourceFilename='$input_filename_or_reference';";
  my $resulting = &sendMysqlQuery($uploadRecord);
  $xBug->("unlink $input_filename_or_reference");
} # loadZIPtoCSV

  # ------------------------------------------------------------------------------
sub loadCSVtoSQL {
  my $output_filename_or_reference = shift @_;
#  my $CHARSET = 'utf8mb4'; # was latin1
  my $tableID = 'BLANK';
  # Read/parse CSV
  my @data;   # 2D array for CSV data
  my $xBug = \&sBug;
  $xBug->("1-loadCSVtoSQL\n"); # debug dbb 2-19-2021
#  if (my $csv = Text::CSV->new({ binary => 0, eol => $/ })) {
  require Text::CSV;
  if (my $csv = Text::CSV->new({ binary => 0 })) {
    $xBug->("2-loadCSVtoSQL\n"); # debug dbb 2-19-2021
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
    if (open my $fh, "<:encoding(utf8)", $output_filename_or_reference) {
      $xBug->("3-loadCSVtoSQL\n  QQQQQ $output_filename_or_reference \n"); # debug dbb 2-19-2021
      if (!$fh) {    &xlogBug(" QQQQQ $output_filename_or_reference "); }
      my $tablename = &getNextTableName;
      $tableID = $tablename;
      if (&tableAlreadyExists($tablename,$dbDatabase)) {
        $xBug->("4- DROP TABLE $tablename\n"); # debug dbb 2-19-2021
        my $dresult = &sendMysqlQuery("DROP TABLE $tablename;\n");
      } # if

      my $result = "CREATE TABLE `$tablename` (\n";
      if (defined(my $line = <$fh>)) {
        $xBug->("5- thisline $line\n"); # debug dbb 2-19-2021
        chomp $line;
        my @fieldNames = split(',',$line);
        $main::cline{'TDWH-COLUMNNUMBER'} = 0;
        for my $columnHeaderText (@fieldNames) {
          &incrementCounter('TDWH-COLUMNNUMBER');
          my $fieldName = 'COL';
          if ($main::cline{'TDWH-COLUMNNUMBER'} < 10) { $fieldName .= '0'; } # single digits have leading zeros for sorting
          $fieldName .= $main::cline{'TDWH-COLUMNNUMBER'};
          $columnNameReference{$fieldName} = $columnHeaderText; # save actual header text in hash
          my $encodedHeaderText = &urlencode($columnHeaderText);
          $result .=   "  `$fieldName` TEXT,\n";
          my $insertAlias = "REPLACE INTO TDALIAS VALUES ( '$tablename',  '$fieldName', '$encodedHeaderText');"; # third guess
          my $resulting = &sendMysqlQuery($insertAlias);
          my $querycsv         = pop @queryResultFile;
        }
        # &cBug(" @{[ $line ]} "); # interpolation trick
      } # ifs
   #   $result .= "  `dumdum` varchar(255) DEFAULT '',\n";
      $result .= "  `tstamp` timestamp  DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,\n";
      $result .= "  `rstamp` timestamp  DEFAULT '0000-00-00 00:00:00'\n";
      $result .= ') ENGINE=MyISAM DEFAULT CHARSET=' . "$CHARSET;\n";
      $xBug->("6- thisresult $result\n"); # debug dbb 2-19-2021
      my $resulting = &sendMysqlQuery($result,$xBug);
      my $rquerycsv = pop @queryResultFile;

      my $col_mod = $main::cline{'TDWH-COLUMNNUMBER'};
      my $lineCounter=0;
      my $commaCounter;
      # my $nulnul = ", NULL, NULL,  NULL";
      my $nulnul = ", NULL,  NULL";
      $xBug->("Here we go!");
      my $lineLimit = 70;
      $lineLimit = 999999;
      while (defined( my $row = <$fh> ) && ($lineCounter < $lineLimit)) { 
        $lineCounter++;
        if (($lineCounter % 3) == 1) {
          if (!exists($ENV{'HTTP_HOST'})) {
            print "Line $lineCounter\r";
          }
        }
        if ($row) {
          $commaCounter = 0;
          my $DataLoad = "INSERT INTO `$tablename` VALUES \n";
          if ($csv->parse($row)) {
            my @dataItems = $csv->fields();
            for my $value (@dataItems) {
              if ($commaCounter++) { $DataLoad .= ','; } else { $DataLoad .= '('; }
              $value =~ s/\R//g; # strip any trailing ^M
              if ($value) {
                       $DataLoad .= '"' . &urlencode($value) . '"';
              } else { $DataLoad .= "NULL"; }
            } # for
            $DataLoad .= "$nulnul);\n";
#            print "$lineCounter : $DataLoad"; # debug dbb 2-20-2021
            my $resulting = &sendMysqlQuery($DataLoad,\&Nothing);
            my $qquerycsv = pop @queryResultFile;
            # &uBug("\n $lineCounter $_ $! $^E");
            &logSQLresults($resulting, $qquerycsv, \&Nothing);
          } else {
            $xBug->("Line $tablename could not be parsed: $row\n");
            &incrementCounter('unparsed' . $tablename);
          } # we keep track of unparsed rows
        } # if row
        else {
            &incrementCounter('lostrows' . $tablename);
        } # else we keep track of lost rows
      } # while
      print "\nLines read $lineCounter into $tablename\n";
      close $fh;
      $main::cline{$tablename} = 'loadCSVtoSQL'; # init as checked
      &writestate; # in case someone hits ^C
    }
    else { $xBug->("Could not open $output_filename_or_reference: $!"); } # else
  }
  else { $xBug->('Failed to get Text-CSV object.'); } # else

  my $uploadRecord = "INSERT INTO TDUPLOADS SET sourceFilename='$output_filename_or_reference',tableName='$tableID';";
  $xBug->("7- uploadRecord $uploadRecord\n"); # debug dbb 2-19-2021
  my $rfsulting = &sendMysqlQuery($uploadRecord);
  unlink $output_filename_or_reference;
  $xBug->("unlink $output_filename_or_reference");

  return $tableID;
} # loadCSVtoSQL

  # ------------------------------------------------------------------------------
sub processUploadedDatafiles {
  my $directoryToLookIn     = shift @_;
  my $tableID               = 'ZIPPO';
  my $filesProcessedCounter = 0;
  my $filesProcessedMax     = 3;
  my $xBug = \&sBug;
  if (exists($main::cline{'filesProcessMax'})) { $filesProcessedMax = $main::cline{'filesProcessMax'}; }

  $xBug->("processUploadedDatafiles $directoryToLookIn\n"); # debug dbb 2-19-2021
  # look for all *.pl files
  my @files0 = glob($directoryToLookIn . '/' . "*.txt");
  foreach my $inputfile (@files0) {
    $xBug->("Eyeballing at $inputfile");
    if ($filesProcessedCounter++ > $filesProcessedMax) { return; }
    if (-f $inputfile) {
      &printdiv($inputfile,'dvx1','INPUTFILESMAYBE');
      unlink $inputfile;
      $xBug->("unlink $inputfile");
    } # if 
  } # for
  my @files1 = glob($directoryToLookIn . '/' . "*.zip");
  foreach my $inputfile (@files1) {
    $xBug->("Looking at $inputfile");
    if ($filesProcessedCounter++ > $filesProcessedMax) { return; }
    $xBug->("filesProcessedCounter $filesProcessedCounter");
    if (-f $inputfile) {
      my $outputfile = $inputfile;
      $outputfile =~ s/\.zip/\.csv/;
      $xBug->("outputfile $outputfile");
      print "<div>$inputfile $outputfile</div>\n";
      $xBug->("loadZIPtoCSV -- A");
      &loadZIPtoCSV($inputfile,$outputfile);
      $xBug->("loadZIPtoCSV -- B");
      $tableID = &loadCSVtoSQL($outputfile);
      $xBug->("loadZIPtoCSV -- C");
    } # if 
  } # for
  my @files2 = glob($directoryToLookIn . '/' . "*.csv");
  foreach my $inputfile (@files2) {
    $xBug->("Considering $inputfile \n");
    if ($filesProcessedCounter++ > $filesProcessedMax) { return; }
    if (-f $inputfile) {
      $xBug->("Pondering $inputfile \n");
      $tableID = &loadCSVtoSQL($inputfile);
      $xBug->("RePondering $inputfile \n");
    } # if 
  } # for
  my @files3 = glob($directoryToLookIn . '/' . "*.xlsx");
  foreach my $inputfile (@files3) {
    $xBug->("Looking at $inputfile");
    if (-f $inputfile) {
      if ($filesProcessedCounter++ > $filesProcessedMax) { return; }
      if ($inputfile =~ /[()]/) {
        unlink $inputfile;
        xBug->("unlink $inputfile");
        next;
      } # if
      $tableID = &loadXLSXtoSQL($inputfile);
    } # if 
  } # for
} # processUploadedDatafiles

  # ------------------------------------------------------------------------------
sub showSpecifiedTable {
  my $someLimit = 27; if (exists($main::cline{'someLimit'})) { $someLimit = $main::cline{'someLimit'}; }
  my $showtable   = 'SHOWTABLE';
  if (exists($main::cline{$showtable})) {
    my $someTable = $main::cline{$showtable};
    my $sql       = "SELECT * FROM  $someTable LIMIT $someLimit;";
    my $result    = &sendMysqlQuery($sql);
    my $jinfo     = pop @queryResultFile;
    &xlogBug('showSpecifiedTable: ' . $result);
    delete $main::cline{$showtable};
  } # if
} # showSpecifiedTable

  # ------------------------------------------------------------------------------
sub zapFilters {
  for my $citem (keys %main::cline) {
    if ($citem =~ /f1filter(.*)/) { delete $main::cline{$citem}; &xlogBug("Zzzz! $citem "); }
  } # for
} # zapFilters

  # ------------------------------------------------------------------------------
sub basicColumnsDisplay { # returns a CSS class tag that specifies format in some number of columns
                          # classes specified in basic.css: dvxA..dvxG  
  my $divCtr = shift @_;
  my $divvy = 'dvxG'; # display the table checkboxes with an appropriate number of columns, assume 8
  if (defined($divCtr)) {
    if    ($divCtr <  20) { $divvy = 'dvxA'; } # 2
    elsif ($divCtr <  40) { $divvy = 'dvxB'; } # 3
    elsif ($divCtr <  70) { $divvy = 'dvxC'; } # 4
    elsif ($divCtr < 100) { $divvy = 'dvxD'; } # 5
    elsif ($divCtr < 150) { $divvy = 'dvxE'; } # 6
    elsif ($divCtr < 200) { $divvy = 'dvxF'; } # 7
  } # if defined
  return $divvy;
} # basicColumnsDisplay

  # ------------------------------------------------------------------------------
sub basicChangesBackgroundColors { # changes color values in basic.css so user can notice a new display
  my $bakPtr  = shift @_;
  my $bakExt  = '.bak';
  if (defined($bakPtr)) {
    my $bakIdx                = 0;                           # index 0 by default, restored from state
    if (exists($main::cline{'bakToggle'})) { $bakIdx = $main::cline{'bakToggle'};  }
    my @bakCopy               = @$bakPtr;                    # copy the array of strings to change
    my $bakfr                 = $bakCopy[$bakIdx++];         # old string for search
    $bakIdx                   = 0 if ($bakIdx > $#bakCopy);  # advanced index wraps to 0
    my $bakto                 = $bakCopy[$bakIdx];           # new string to replace
    $main::cline{'bakToggle'} = $bakIdx;                     # save this to state
    my $CSSbak                = $CSSreference . $bakExt;     # temporary filename
    if (rename($CSSreference, $CSSbak)) {
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
      if (open(IN, '<' . $CSSbak)) {
        if (open(OUT, '>'.$CSSreference)) {
          while(<IN>) {                                            # read lines from IN
            $_ =~ s/$bakfr/$bakto/g;                               # line-by-line search and replace
            print OUT $_;                                          # write possibly changed lines to OUT
          } # while copying input to output
          close(OUT);
          close(IN);
          chmod $fileRWXmode, $CSSreference;
        } # if opened for output
        else {
          close(IN);
          rename($CSSbak, $CSSreference); # undo rename
          &xlogBug("$CSSbak Output Screwup!");
        } # else
      } # if opened for input
      else {
        rename($CSSbak, $CSSreference); # undo rename
        &xlogBug("$CSSbak Input Screwup! 2");
      } # else
    } # if renamed
    else {
      &xlogBug("bak rename Screwup");
    } # else
  } else { &xlogBug("bak undefined!"); }
} # basicChangesBackgroundColors

  # ------------------------------------------------------------------------------
sub basicChangeBackgroundColors { # the sequence of background colors displayed under columns of items
                                  # called when 'Submit' is clicked, under some circumstances
  my @bakScms = ('EBD59','EBD5A','EBD5B','EBD5C','EBD5D','EBD5E','EBD5F','EBD50');
  &basicChangesBackgroundColors(\@bakScms);
} # basicChangeBackgroundColors

  # ------------------------------------------------------------------------------
sub justtheTablesMaam {
  my $tablesOutput     = '';
  my $httpx         = 'http://';
  if (exists($ENV{HTTPS}) || ($httpX)) { $httpx         = 'https://'; }
  my $action           = $httpx . $ENV{'SERVER_NAME'} . $ENV{'SCRIPT_NAME'} . '/#displayTDWHheaders';
  my $formspec         = "action=\"$action\" id=\"justtheTablesMaam\" method=\"post\"";
  $labelId = 'justtheTablesMaam';
  my @exemptTableNames = ('SUBMITlog','visitors','TDALIAS','TDUPLOADS');   # dont risk zapping these tables
  my $divCtr           = 0;
  if (@tables) { 
    for my $hitem (@tables) {
     if (in { $hitem eq $_ } @exemptTableNames) { next; }                  # no need to encode these items
      $spareCode .= "DROP TABLE $hitem;<BR>\n"; # debug, don't drop tables...
      my $hsql  = "SELECT sourceFilename from TDUPLOADS WHERE tableName='$hitem' LIMIT 1;";
      my $hinfo = $hsql;
      $hinfo    = &sendMysqlQuery($hsql,\&Nothing);
      $hinfo    = pop @queryResultFile;
      if (!defined($hinfo)) { $hinfo = 'Empty!'; }
      if ($hinfo =~ /mimemail.(.*)/) { $hinfo = $1; } # remove path if file was in mimemail
      my $checked = '        ';
      if (exists($main::cline{$hitem})) {
        if ((exists($main::cline{'tablesForm'}))) {
          if (($main::cline{$hitem} eq 'off')) {
            delete $main::cline{$hitem}; # uncheck the item
            if ((exists($main::cline{'datesField'}))) { delete $main::cline{'datesField'}; } # still valid?  no.
          }
          else { $checked = 'checked '; $main::cline{$hitem} = 'off'; } # else
        } 
        else   { $checked = 'checked '; $main::cline{$hitem} = 'off'; } # else
      }
      if (!defined($hinfo)) { $hinfo = ''; }
       my $hxitem = "<a title=\"$hinfo\">$hitem</a>";
#      $tablesOutput .= "\n    <input type=\"checkbox\" name=\"$hitem\" onclick=\"submit()\" title=\"click here!\" $checked/> $hxitem <BR>"; #  
      $tablesOutput .= "\n    <input type=\"checkbox\" name=\"$hitem\"";
#      $tablesOutput .= " onclick=\"submit()\"";
      my $selecty = 'select ';
      if (exists($main::cline{$hitem})) {
        $selecty                       = 'deselect ';
      }
      $tablesOutput .= " title=\"$selecty $hinfo\" $checked/> $hxitem <BR>"; #  
      $divCtr++;
    } # for table items
    my $divvy = &basicColumnsDisplay($divCtr); # display the table checkboxes with an appropriate number of columns

    if (exists($main::cline{'tablesForm'})) {
      delete $main::cline{'tablesForm'};
      &basicChangeBackgroundColors;
    }
    my $submitTitle       = "click here to submit selections";
    my $submit1ButtonInfo = "    <input type=\"submit\" value=\"Submit\" title=\"$submitTitle\">";
    $submit1ButtonInfo   .= "    <input type=\"hidden\" name=\"tablesForm\" value=\"$userID\" />\n";
    &bBug("<form $formspec>$tablesOutput\n$submit1ButtonInfo  </form>",$divvy);
  } # if defined tables
  &showSpecifiedTable; # SHOWTABLE
} # justtheTablesMaam

  # ------------------------------------------------------------------------------
sub checkboxToDeleteTable {
  my $featureText         = shift @_;
  my $msg                 = shift @_; if (!defined($msg))   { $msg   = 'toggle'; }
  my $xBug                = shift @_; if (!defined($xBug))  { $xBug  = \&cBug; }
  my $class               = shift @_; if (!defined($class)) { $class = 'dvx4'; }
  my $featureControlName  =  $featureText; # $ColumnName;
  my $featureDescription  =  " $msg $featureText"; # $ColumnAlias;
  $featureUtilityString   = '';
  my $oneClick = 1;
  my $checkboxFeature     = &featureManifestation( \&Nothing, $featureControlName, $featureDescription,
                                               $featureText,\&featureUtilityString,$class,$oneClick);
  my $result = "<BR>$featureText: $checkboxFeature ";
  $xBug->($result);
} # checkboxToDeleteTable

  # ------------------------------------------------------------------------------
my  $globalUtilityString  = 'globalUtilityString not initialized!';
sub  globalUtilityString {
    $globalUtilityString .= shift @_; # save the output to the global variable
} #  globalUtilityString

sub InitializeglobalUtilityString {
    &sBug("InitializeglobalUtilityString");
} # InitializeglobalUtilityString

  # ------------------------------------------------------------------------------
my @deleteOnExit; # list of cline items to delete
sub deleteItemsOnExitAndSaveTheRest {
  if ($#deleteOnExit < 0) { return; } # we overwrite files only when there is a new batch of items deleted.
  my $zfilename = 'archives/l' . $oneFilename . '.txt';
  my $link = "<A HREF=\"$zfilename\">$zfilename</A>\n";
  $main::cline{'latestDeletedFilename'} = $zfilename;
  $main::cline{'latestDeletedURL'} = $link;
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  if   (open  ZFILE,'> ' . $zfilename) {
    for my $zapThis (@deleteOnExit) {
      print ZFILE $zapThis . '=' . $main::cline{$zapThis} . "\n";
      delete $main::cline{$zapThis};
    }
    close ZFILE;
    chmod $fileRWXmode, $zfilename;
  }
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  if   (open  GFILE,'> ' . 'leftovers.txt') {
    foreach my $pair (sort keys %main::cline) { # look at each key, decide where to save value
      print GFILE $pair . '=' . $main::cline{$pair} . "\n";
    } # foreach
    close GFILE;
    chmod $fileRWXmode, 'leftovers.txt';
   } # if opened leftovers.txt
} # deleteItemsOnExitAndSaveTheRest

  # ------------------------------------------------------------------------------
sub oneClickCheckbox {
  my $xBug                = shift @_;
  my $featureControlName  =  'oneClick'; # $ColumnName;
  my $featureDescription  =  " toggle OneClick"; # $ColumnAlias;
  my $class               = 'dvx4';
  my $featureText         = 'someOneClick'; # retain encoding at this point, treated as a value to be passed backed
  $featureUtilityString   = '';
  my $oneClick            = 1;
  my $checkboxFeature     = &featureManifestation( \&Nothing, $featureControlName, $featureDescription,
                                               $featureText,\&featureUtilityString,$class,$oneClick);
  my $result              = "<BR>thisOneClicK: $checkboxFeature ";
  $xBug->($result);
} # oneClickCheckbox

  # ------------------------------------------------------------------------------
sub limitMenu {
  my $someLimit = 13; if (exists($main::cline{'someLimit'})) { $someLimit = $main::cline{'someLimit'}; }
  my @limitList     = (5, 10, 20, 50, 100, 200, 500, 1000, 2000, 5000, 9999);
  my $optionsSelection = '';
  for my $optionSelection (@limitList) {
    my $selectedOne = '';
    if ($optionSelection eq $someLimit) { $selectedOne = ' selected'; }
    $optionsSelection .= "  <option value=\"$optionSelection\"$selectedOne>$optionSelection</option>\n    ";
  } # for the choices of limits listed
  my $onclickSubmit = " onselect=\"submit()\"";
  my $result = "
    <label for=\"someLimit\">Choose some limit</label>
    <select name=\"someLimit\" id=\"someLimit\"$onclickSubmit>
    $optionsSelection</select>  ";

  $result    .= "    <input type=\"hidden\" name=\"HEYBUD01\" value=\"MoBettah!\" />\n";
  if (!defined($main::cline{'oneClick'}) || (!$main::cline{'oneClick'})) {
    $result .= "    <input type=\"submit\" value=\"Submit\" title=\"click here to submit this set of values\">";
  } # if oneclick is set, then we don't need a submit button
  else {
    $result .= "\n    <input type=\"submit\" value=\"Submit\" title=\"click here to submit this set of values\">";
  }
  return $result;
} # limitMenu

  # ------------------------------------------------------------------------------
sub resetButtonClauses {
  if      (exists($main::cline{'wherebyButtonInfo'})) {
    &cBug("<A HREF=\"?DELETE=wherebyButtonInfo\" target=\"_self\" title=\"deletes wherebyButtonInfo\">reset</A>\n");
  } elsif (exists($main::cline{'groupButtonInfo'})) {
    &cBug("<A HREF=\"?DELETE=groupButtonInfo\" title=\"deletes groupButtonInfo\">RESET</A>\n");
  }
} # resetButtonClauses

  # ------------------------------------------------------------------------------
sub processTHWHfilter {
  $valueMarker = 'state';
  &sBug("-------------- processTHWHfilter ------------");
  my $httpx         = 'http://';
  if (exists($ENV{HTTPS}) || ($httpX)) { $httpx         = 'https://'; }
  my $action           = $httpx . $ENV{'SERVER_NAME'};
  &cBug("<A HREF=\"$action?resetTHWHfilter=1#selectTDWHfilter\">reset selectTDWHfilter</A>");
  if (exists($main::cline{'resetTHWHfilter'})) {
      if (exists($main::cline{'latestDeletedFilename'})) {
        if (-e $main::cline{'latestDeletedFilename'}) {
          unlink $main::cline{'latestDeletedFilename'}; # start fresh
          my $xBug = \&tBug;
          $xBug->("unlink $main::cline{'latestDeletedFilename'}"); # start fresh
          delete $main::cline{'latestDeletedFilename'}; # start fresh
        } # if
      } # if

      delete $main::cline{'resetTHWHfilter'}; # not saved, deleted now to avoid overwriting with empty info
      &cBug("--------- Resetting! ----- resetTHWHfilter ------------");
      # push @deleteOnExit,'resetTHWHfilter';
      # &processClineKeys;
  } # if 
} # processTHWHfilter

  # ------------------------------------------------------------------------------
sub showLatestDeletedFilename {
  if (exists($main::cline{'latestDeletedFilename'})) {
    if (-e $main::cline{'latestDeletedFilename'}) {
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
      if (open DBFILE,$main::cline{'latestDeletedFilename'}) {
        &cBug('showLatestDeletedFilename: ');
        for my $line (<DBFILE>) { &cBug($line); } close DBFILE; }
    }
  }
} # showLatestDeletedFilename

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

  # https://www.thesitewizard.com/apache/prevent-directory-listing-htaccess.shtml
  # ------------------------------------------------------------------------------
my $selection                = '';
sub showTableData {
  my $selectSQL = "show TABLES;";
  my $result    = &sendMysqlQuery($selectSQL,\&Nothing); # don't log this, tested & boring
  my $querycsv  = pop @queryResultFile;
  my $xBug      = \&cBug;
  my $yBug      = \&Nothing;
  my $someLimit = 17; if (exists($main::cline{'someLimit'})) { $someLimit = $main::cline{'someLimit'}; }
  &xlogBug("*************** showTableData 0 **************");
  &logSQLresults($result, $querycsv, $yBug); # don't display results 
  if (defined($querycsv)) {
    my @tables  = split (',',$querycsv);
    my $columnCount = 0;
    for my $hitem (@tables) {
      if (exists($main::cline{$hitem})) {
        my $selection = 'Count(*)';
        if (exists($main::cline{'wherebyButtonInfo'})) { $selection = "tstamp"; }
        $result = &sendMysqlQuery("describe $hitem;",\&cBug);
        my $hresult .= pop @queryResultFile;
#        $xBug->("showTableData @{[ %columnNameReference ]} "); # interpolation trick
        my @aresult = split(',',$hresult);
        my $aIndex  = 0;
        while ($aIndex < $#aresult) {
          if (exists($main::cline{$aresult[$aIndex]})) {
            $selection .= ',' . $aresult[$aIndex];
          } # if check recorded in state
          $aIndex += 5; # an artifact of using 'describe' and 'split'
        } # while looping thru columns, looking for checked
#
        my $tmin =        0; if (exists($main::cline{'datesMin'})) { $tmin = $main::cline{'datesMin'}; }
        my $tmax = 99999999; if (exists($main::cline{'datesMax'})) { $tmax = $main::cline{'datesMax'}; }
        # identify the column selected as the date
        my $dateColumn = 'COL99';
        $dateColumn    = 'tableID';
        if (exists($main::cline{'datesField'})) { $dateColumn = $main::cline{'datesField'}; }
        my  $whereclause = "WHERE ($dateColumn <= '$tmax') AND ($dateColumn >= '$tmin')";
        my $zapGroupBy = 0;
        if (exists($main::cline{'wherebyButtonInfo'}) && exists($main::cline{'groupButtonInfo'})) {
          $whereclause = "WHERE ($main::cline{'groupButtonInfo'} = '$main::cline{'wherebyButtonInfo'}')";
#          $zapGroupBy = 1;
        } # if
#
        my $gCol     = 'COL02'; # just guessing
        if (exists($main::cline{'groupButtonInfo'})) { $gCol     = $main::cline{'groupButtonInfo'}; }
        
        my $groupBy  = "GROUP BY $gCol ORDER BY $gCol";
        if ($zapGroupBy) { $groupBy  = ''; &cBug('Zap GroupBy!'); }
        $selection  .= ',' . $gCol . ',Count(*)';
        $selectSQL   = "SELECT $selection FROM $hitem $whereclause $groupBy LIMIT $someLimit;";
        if (exists($main::cline{'filteredQuery'})) { $selectSQL   = $main::cline{'filteredQuery'}; }
        $spareCode .= "$selectSQL <BR>\n";
        $result = &sendMysqlQuery($selectSQL);
        $xBug->($result, 'dvx2');
        my $querycsv = pop @queryResultFile;
      } # if
    } # for
    if (exists($main::cline{'XLSXOUTPUT'})) {
      my $outputFilename = 'archives/x' . $oneFilename . '.xlsx';
      &testSampleWorksheet( $outputFilename, $columnCount, $selectSQL );
    } # if
  } # if defined

  else { $xBug->("Undefined?"); }
#
  &resetButtonClauses; # whereby and groupby
} # showTableData

  # ------------------------------------------------------------------------------
sub preformattedFiledata {
  my $f1ilename = shift @_;  # should this be? $volatile . state.txt
  my $classname = shift @_;  # should this be? $volatile . state.txt
  my $xBug      = shift @_;                        # optional argument
  if (!defined($xBug)) { $xBug = \&sBug; } # just in case we forget to include an argument
  my $f1ile_content = do{local(@ARGV,$/)=$f1ilename;<>};
  my $o1utput = "<pre>\n$f1ile_content\n</pre>\n";
  $xBug->($o1utput, $classname);
} # preformattedFiledata

  # ------------------------------------------------------------------------------
sub showSTATE {
  my $xBug = shift @_;                        # optional argument
  if (!defined($xBug)) { $xBug = \&sBug; } # just in case we forget to include an argument
#  &preformattedFiledata($volatile . $statetxt, 'dvx1', $xBug);
  &preformattedFiledata('state.txt'          , 'dvx2', $xBug);
} # showSTATE

  # ------------------------------------------------------------------------------
my $uploadDirectory = $volatile . 'mimemail';
my $r1 = `mkdir $uploadDirectory`;
my $r2 = `chmod 777 $uploadDirectory`;
sub processAllUploadedDatafiles {
  print "\nprocessAllUploadedDatafiles $uploadDirectory\n"; # debug
  print XFILE "processAllUploadedDatafiles $uploadDirectory\n"; # debug
  if (exists($main::cline{'processUploadedDatafiles'})) {
    &processUploadedDatafiles($uploadDirectory); 
    if (exists($main::cline{'SourceDirectory'})) {
          &processUploadedDatafiles($main::cline{'SourceDirectory'});
    } # if
  } # if
  # &displayTDWHtables; # initializes global table array, which may have just changed
} # processAllUploadedDatafiles

  # ------------------------------------------------------------------------------
sub formHTMLonly {
  my $textValue = '';
  if (exists($main::cline{'response'}) && (&checkDEBUGXIP)) { $textValue = $main::cline{'response'}; }
  my $valueSetting = '';
  $labelId = 'form_container';

  $form_numberIncrementFlag = 1;
  my $counter = $main::cline{'visit_counter'};
  my $formHTML = "<div id=\"form_container\">";
  $formHTML .= "\n  <form id=\"form_$userID\" class=\"appnitro\" enctype=\"multipart/form-data\""; 
  $formHTML .= " method=\"post\" action=\"$pageurl\">";
  if (exists($main::cline{'response'})) {
    my $encodedResponse = &urlencode($main::cline{'response'});
    $formHTML .= "\n    <input type=\"hidden\" name=\"commentByEliza\" value=\"$encodedResponse\" />\n";
  } # if response needs to be saved in SUBMITlog, too.
  $formHTML .= "	<ul >\n";
#
  if (exists($main::cline{'requestName'})) {
    $formHTML .= "	<li id=\"li_1\" >\n";
    $formHTML .= "		<label class=\"description\" for=\"element_1\">Name </label>\n";
    $formHTML .= "		<span>\n";
    $formHTML .= "			<input id=\"element_1_1\" name= \"element_1_1a\" class=\"element text\" maxlength=\"255\" size= \"8\" value=\"\"/>\n";
    $formHTML .= "			<label>First</label>\n";
    $formHTML .= "		</span>\n";
    $formHTML .= "		<span>\n";
    $formHTML .= "			<input id=\"element_1_2\" name= \"element_1_2a\" class=\"element text\" maxlength=\"255\" size= \"14\" value=\"\"/>\n";
    $formHTML .= "			<label>Last</label>\n";
    $formHTML .= "		</span> \n";
    $formHTML .= "	</li>\n";
  } # requestName
#
  if (exists($main::cline{'requestEmail'})) {
    $formHTML .= "	<li id=\"li_2\" title=\"Your email address please\">\n";
    $formHTML .= "		<label class=\"description\" for=\"element_2\">Email </label>\n";
    $formHTML .= "		<div>\n";
    $formHTML .= "			<input id=\"element_2\" name=\"element_2a\" class=\"element text medium\"";
    $formHTML .= " type=\"text\" maxlength=\"255\" $valueSetting/> \n";
    $formHTML .= "		</div> \n";
    $formHTML .= "	</li>\n";
  } # UserState
#
  if (exists($main::cline{'requestAge'})) {
    $formHTML .= "	<li id=\"li_3\" >\n";
    $formHTML .= "		<label class=\"description\" for=\"element_3\">Drop Down </label>\n";
    $formHTML .= "		<div>\n";
    $formHTML .= "			<select class=\"element select medium\" id=\"element_3\" name=\"element_3a\"> \n";
    $formHTML .= "				<option value=\"\" selected=\"selected\"></option>\n";
    $formHTML .= "				<option value=\"1\" >Age 18-36</option>\n";
    $formHTML .= "				<option value=\"2\" >Age 30-50</option>\n";
    $formHTML .= "				<option value=\"3\" >Age 45+</option>\n";
    $formHTML .= "			</select>\n";
    $formHTML .= "		</div> \n";
    $formHTML .= "	</li>\n";
  } # requestAge
#
  if (exists($main::cline{'requestComments'})
         && ($main::cline{'requestComments'})) {
    $formHTML .= "	<li id=\"li_4\" >\n";
    $formHTML .= "	  <label class=\"description\" for=\"element_4\">Paragraph </label>\n";
    $formHTML .= "	  <div>\n";
    $formHTML .= "	    <textarea id=\"element_4\" name=\"element_4a\" class=\"element textarea medium\" \n";
    $formHTML .= "	              title=\"Write a short message and click Submit\"\n";
    $formHTML .= "	              onClick=\"this.select();\"\n";
    $formHTML .= "	              rows=\"10\" cols=\"40\">\n";
    $formHTML .= "$textValue\n";
    $formHTML .= "	    </textarea> \n";
    $formHTML .= "	  </div> \n";
    $formHTML .= "	</li>\n";
  } # requestComments
#
  if (exists($main::cline{'requestUpload'})
         && ($main::cline{'requestUpload'} != 0)) {
    $formHTML .= "	<li id=\"li_5\" >\n";
    $formHTML .= "	  <label class=\"description\" for=\"element_5\">Upload a File </label>\n";
    $formHTML .= "	    <div>\n";
    $formHTML .= "	      <input id=\"element_5\" name=\"element_5a\" class=\"element file\" type=\"file\" /> \n";
#  $formHTML .= "	      <input id=\"element_5\" name=\"element_5\" class=\"element file\" type=\"file\"  multiple=\"multiple\" />  \n";
    $formHTML .= "	   </div>  \n";
    $formHTML .= "	</li>\n";
  } # requestUpload
#
  if (exists($main::cline{'requestSubmit'})) {
    my $submitMessage = 'click here to send input data';
    if (exists($main::cline{'requestSubmitMessage'})) { $submitMessage = $main::cline{'requestSubmitMessage'}; }
    $formHTML .= "	<li class=\"buttons\">\n";
    $formHTML .= "		<input id=\"saveForm\" class=\"button_text\" type=\"submit\"\n";
    $formHTML .= "		 name=\"submit\" value=\"Submit\"\n";
    $formHTML .= "		 title=\"$submitMessage\" />\n";
    $formHTML .= "	</li>\n";
  } # requestSubmit
#
  $formHTML .= "</ul>\n";
  $formHTML .= "<input type=\"hidden\" name=\"form_id\" value=\"$userID\" />\n" if (defined($userID));
  $formHTML .= "</form>	\n";
  $formHTML .= "</div>\n";
  return $formHTML;
} # formHTMLonly

  # ------------------------------------------------------------------------------
sub checkBoxdebug {
  my $oneClick = 1; if (exists($main::cline{'oneClick'})) { $oneClick = $main::cline{'oneClick'}; }
  &xlogBug("dataWHdebug $oneClick");
} # checkBoxdebug

  # ------------------------------------------------------------------------------
sub checkBoxControls {
  my @featureInfo = (
      [   sub {
                &checkboxToggle('SHOWENV','show environment variables','Environment variables');
                &checkboxToggle('RAWDATA','show table data','Table Data');
              }, 'checkBoxControls', 'toggle display of checkbox controls'] );
  # for my $features (@featureInfo) { &featureManifestation(@{$features}); }
  my $featureDescription = 'toggle the display of checkbox controls';
  my $featureControlName = 'checkBoxControls';
 
  &checkboxToggle($featureControlName,$featureDescription,"It was already broken when I got here!",
    \&checkBoxdebug,'dvx2',1); # dbb 2/10/2021
  if (exists($main::cline{'SOURCECODE'})) {
    my $linkSourceCode = '';
    if (defined($sourceLink)) {
      my $result = __PACKAGE__ . $__PACKAGE__::versionNumber;
      $linkSourceCode = "<a href=\"$sourceLink\">$result</a>";
      &cBug("$linkSourceCode");
    } # defined
  } # if exists
} # checkBoxControls

  # ------------------------------------------------------------------------------
sub debugLinks {
  &pBug("debugLinks!");
  return; # dbb 2/3/2021
  if (&checkDEBUGXIP) {
    my $sql    = "SELECT UserID from SUBMITlog group by UserID;";
    my $result = &sendMysqlQuery($sql);
    &pBug("<div class=\"dvx7\"><TABLE>\n");
    my $UserID = 44445;
    if (exists($main::cline{'UserID'})) { $UserID = $main::cline{'UserID'}; }
    my $httpx         = 'http://';
    if (exists($ENV{HTTPS}) || ($httpX)) { $httpx         = 'https://'; }
    my $action           = $httpx . $ENV{'SERVER_NAME'} . $ENV{'SCRIPT_NAME'};
#    my $action = 'https://' . $ENV{'SERVER_NAME'} . '/';
    for my $oldComment (@queryResultFile) {
      my @oldFile = split ',',$oldComment;
      for my $oneComment (@oldFile) {
        my $uIDtext = $oneComment;
        if ($oneComment !~ /1[5-7][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]/) { next; } # ignore anything obviously not a UserID
        if ($oneComment eq $UserID) {
          $uIDtext = '<B>'. $oneComment . '</B>'; # highlight that this item is the current UserID
        } # if
        &pBug("<TR><TD><A HREF=\"$action?UserID=$oneComment\&cookieFlag=1\">$uIDtext</A></TD></TR>\n");
      } # for
    } # for
    &pBug("</TABLE></div>\n");
    my $querycsv = pop @queryResultFile;
    &logSQLresults($result, $querycsv, \&xlogBug);
  } # if enabled
} # debugLinks

  # ------------------------------------------------------------------------------
sub dataItemFrequency {
  my $dotFileName       = shift @_; # the data item we are counting
  if (defined($dotFileName)) {
    my $xBug            = shift @_;    if (!defined($xBug)) { $xBug = \&StateMessage; }
    my $encodedFileName = &urlencode($dotFileName); # the database Content items are urlencoded before inserting in table
    my $sql             = "SELECT Count(*) from SUBMITlog where Content like '$encodedFileName';";
    my $result          = &sendMysqlQuery($sql);
    for my $oldCount (@queryResultFile) {
      $xBug->("<TD>$oldCount</TD>\n");
      #  my $xFileName = '/dev/shm/mimemail/' . $dotFileName;
      #  if (-e $xFileName) { $xBug->("<TD> *** </TD>"); }
    } # for
    my $querycsv = pop @queryResultFile;
    &logSQLresults($result, $querycsv, \&xlogBug);
  } else { &StateMessage("dataItemFrequency not defined dotfileName"); }
} # dataItemFrequency

  # ------------------------------------------------------------------------------
sub selectJPGtoDisplay {
  my $some_dir = shift @_;  if (!defined($some_dir)) { $some_dir = '/dev/shm/mimemail/'; }
  my $xBug     = shift @_;
  if (!defined($xBug)) { $xBug = \&pBug; }
  if (opendir(my $dh, $some_dir)) {
    &xlogBug("Reading $some_dir\n");
    $xBug->("<div class=\"dvx7\"><TABLE>\n");
#    my @dots = grep { /^\./ && -f "$some_dir/$_" } readdir($dh);
    my @dots =  grep { /\.jpg/ } readdir($dh);
    for my $dotFileName (sort @dots) {
      my $hTarget = $pageurl . '?' . 'latestjpg=' . $some_dir . $dotFileName;
      $xBug->("<TR>\n");
      $xBug->("<TD><A HREF=\"$hTarget\">$dotFileName</A></TD>\n");
      &dataItemFrequency($dotFileName,$xBug); # maybe other data items for this row
      $xBug->("</TR>\n");
    } # for
    closedir $dh;
    $xBug->("</TABLE></div>\n");
  } # if opendir
  else { $xBug->(" selectJPGtoDisplay <h3>Boo!</h3>"); }
} # selectJPGtoDisplay

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

  # ------------------------------------------------------------------------------
my @sqlResultRow;
sub tableSQLresults {
  my $Zsql    = shift @_;
  my $results = "<div class=\"dvx1\">$Zsql<TABLE>\n";
  my $dbh     = $main::dbh;
  my $Zsth    = $dbh->prepare($Zsql);
  $Zsth->execute();
  while (my @sqlRR = $Zsth->fetchrow_array) { # was while dbb 1-29-18
    @sqlResultRow = @sqlRR; # save last row for use elsewhere
    $results     .= "<TR>";
    for my $itemm (@sqlRR) {
      if ($itemm) {
        $results .= "<TD> $itemm </TD>";
      } else {
        $results .= "<TD>Ugh!</TD>";
      } # else
    } # for
    $results     .= "</TR>\n";
  } # while
  $results       .= "</TABLE></div>\n";
  return $results;
} # tableSQLresults

# ----------------------------------------------------------------------------
my @noNeedToEncode = ('commentByEliza',
                      'maxCPUCoreTemp',  'minCPUCoreTemp', 'recentCPUCoreTemp',
                      'maxCPUPercent',   'minCPUPercent',  'recentCPUPercent',
                      'maxMemPercent',   'minMemPercent',  'recentMemPercent',
		      'UserID',          'sourceName',     'tstamp' );
sub recordItemSUBMITlog {
  my $form_id   = shift @_;
  my $item      = shift @_;
  my $content   = shift @_; if (!defined($content)) { $content = 'EMPTY'; }
  my $xBug      = shift @_; if (!defined($xBug)) { $xBug = \&xlogBug; }
  my $class     = shift @_; if (!defined($class)) { $class = 'dvx1'; }
  $xBug->("recordItemSUBMITlog $form_id $item $content",$class);
  if (!defined($form_id)) {
    $xBug->("form_id undefined!");
    return;
  } # if
  if (!defined($item)) {
    $xBug->("item undefined! $form_id");
    return;
  } # if
  my $encodedContent;
  if (in { $item eq $_ } @noNeedToEncode) { $encodedContent = $content; }             # no need to encode these items
  else                                    { $encodedContent = &urlencode($content); } # since it came from the internet, encode it
  my $result    = ", sourceName='$item', Content='$encodedContent'";
  my $sql       = "INSERT INTO SUBMITlog SET UserID='$form_id'$result;";
#  $main::cline{$item} = $encodedContent;
  my $resulting = &sendMysqlQuery($sql);
  $xBug->($resulting,$class);
  my $querycsv  = pop @queryResultFile;
  &logSQLresults($resulting, $querycsv, \&xlogBug);
} # recordItemSUBMITlog

# ----------------------------------------------------------------------------
sub Gaboosh {
  my $xBug = \&StateMessage;
  my $someURL = shift @_;
  my $someUserID = $main::cline{'HOSTNAME'}; # marker makes it easier to identify...
#  if (exists($main::cline{'UserID'})) { $someUserID = $main::cline{'UserID'}; }
  if (exists($main::cline{'UserID'})) { $xBug->('What the hell?' . $main::cline{'UserID'}); }
  if (defined ($someURL)) {
    $xBug->("Goboosh! $someURL");
    &recordItemSUBMITlog($someUserID,'SkimmedURL',$someURL,$xBug,&nextClass);
  } # if argument is defined
  else { $xBug->("Guboo!"); }
} # Gaboosh

# ----------------------------------------------------------------------------
sub textJig {
  my $xBug = \&xlogBug;
#  $xBug->('textJig:'); # formatted to STDOUT, HTMLOUTPUT, and QOUTPUT
  my $text = shift @_;
  my $yBug = shift @_;
  if (defined($yBug)) { $xBug = $yBug; }
  if (defined($text)) {
    my $lentext = length($text);
    my $encodedText = &urlencode($text);
    if ($text =~ /(http[s]:\/\/.*?)[\"\'\s\|]/) {
      my $tempDollarOne = $1; # extract an url from the text
      &Gaboosh($tempDollarOne); # and save the url in the database
      $xBug->("Match!-- " . $tempDollarOne); # formatted to STDOUT, HTMLOUTPUT, and QOUTPUT
    }
    elsif ($text =~ /(http[s]:\/\/.*?)[\s\"\']/) {
      my $tempDollarOne = $1; # extract an url from the text
      &Gaboosh($tempDollarOne); # and save the url in the database
      $xBug->("A Match!-- $tempDollarOne");
    }
    elsif ($text =~ /(http:\/\/.*?)[\s\"]/) {
      my $tempDollarOne = $1;
      &Gaboosh($tempDollarOne); # and save the url in the database
      $xBug->("The Match!-- $tempDollarOne $text");
    }
    else {
      $xBug->("missed Checking-- $lentext " . $encodedText);
    }
  } else { $xBug->('not defined text!'); }
} # textJig is called by HTML parser

# ----------------------------------------------------------------------------
# keep track of start/end nesting by keeping count
my $debugJig = 1; # dbb 7-31-2020
my %inside;
sub itag {
  my $xBug = \&xlogBug;
  my $tag  = shift @_;
  my $num  = shift @_;
  $inside{$tag} += $num;
  my $ctr=0;
  my $oneSomething = shift @_;
  my $twoSomething = shift @_;
  while (defined($twoSomething) && ($ctr < 100)) {
    my $threeSomething = @{[$twoSomething]};
    $xBug->("$tag  $inside{$tag}  $oneSomething $ctr $threeSomething   ") if ($debugJig);
    $ctr++;
    $twoSomething = shift @_;
  } # while
#  my $threeSomething = @{[ $twoSomething ]};
#  &tBug("$tag  $inside{$tag}  $oneSomething  @{[ $twoSomething ]} ") if ($debugJig);
} # itag

# ----------------------------------------------------------------------------
# see https://metacpan.org/pod/HTML::Parser
#
# these are the callback routines called during parsing
sub declarationJig {    &itag("declaration", '+1',@_); }
sub startJig {          &itag("indent",      '+1',@_); }
sub endJig {            &itag("indent",      '-1',@_); }
sub processJig {        &itag("process",     '+1',@_); }
sub defaultJig {        &itag("default",     '+1',@_); }
sub start_documentJig { &itag("document",    '+1',@_); }
sub end_documentJig {   &itag("document",    '-1',@_); }
sub commentJig {        &itag("comment",     '+1',@_); }

# ----------------------------------------------------------------------------
#  BEGIN {unshift @INC, '/home/pi/perl5/lib/perl5/arm-linux-gnueabihf-thread-multi-64int';}
# BEGIN {unshift @INC, '/usr/lib/aarch64-linux-gnu/perl5/5.36/';}
use HTML::Parser;
sub processBody {
  my $xBug = \&xlogBug;
  my $bodytext = shift @_;
  if (defined($bodytext)) {
    if (my $p = HTML::Parser->new( api_version => 3,
                         declaration_h    => [\&declarationJig,    "tagname"],
                         start_document_h => [\&start_documentJig, "tagname, attr"],
                         end_document_h   => [\&end_documentJig,   "tagname"],
                         start_h          => [\&startJig,          "tagname, attr"],
                         end_h            => [\&endJig,            "tagname"],
                         process_h        => [\&processJig,        "tagname, attr"],
                         text_h           => [\&textJig,           "dtext"],
                         comment_h        => [\&commentJig,        "tagname, attr"],
                         marked_sections => 1,
                       )) {
      $p->parse($bodytext);
    } # if
    else { $xBug->("Aw now what. Parser error!  $! $^E"); }
  } # if
  else { $xBug->("bodytext not defined!  $! $^E"); }
} # processBody

# ----------------------------------------------------------------------------
sub textJigParsing {
  my $xBug = \&xlogBug;
  my $filename = shift @_;
  if (defined($filename)) {
    if (-e $filename) {
      if (my $p = HTML::Parser->new( api_version => 3,
                         declaration_h    => [\&declarationJig,    "tagname"],
                         start_document_h => [\&start_documentJig, "tagname, attr"],
                         end_document_h   => [\&end_documentJig,   "tagname"],
                         start_h          => [\&startJig,          "tagname, attr"],
                         end_h            => [\&endJig,            "tagname"],
                         process_h        => [\&processJig,        "tagname, attr"],
                         text_h           => [\&textJig,           "dtext"],
                         comment_h        => [\&commentJig,        "tagname, attr"],
                         marked_sections => 1,
                       )) {
          $p->parse_file($filename);
          $xBug->(' NNNNNNN ' . $filename);
        } # if
        else { $xBug->("Aw textJigtest parser error!  $! $^E"); }
      } # if
      else { $xBug->("Aw textJigtest $filename now what.  $! $^E"); }
   } # if
   else { $xBug->("Aw not defined textJigtest ... no need to panic!  $! $^E"); }
} # textJigParsing

#------------------------------------------------------
# We fetch all the mailbox info we need from a file, pick one at random
#------------------------------------------------------
my $mail_debug        = 0;

# ----------------------------------------------------------------------------
my $realName          = 'Sweetheart';
my $UserState         = 5;
my $uState            = 'User0State';
$main::cline{$uState} = $UserState;

my $emailReply        =  'Hi and thanks for writing to me.
Please have patience with me.

-- :-D
dbrianhayes yahoo.com

';

my ($mail_hostname, $mail_username, $mail_password, $mail_ssl, $mail_folder);
my $mail_delete = 1;
my $mail_random = 0;
my $mail_bounce = 1; # reply to dbblackman@hotmail if 0
if ($mail_debug) {
  $mail_delete = 0;
  $mail_random = 0;
  $mail_bounce = 0; # reply to dbblackman@hotmail if 0
}
my $didx = 1; # default index into the mailinfo table below
my @mailinfo; # the list of mailboxes is stored in a file to protect the passwords
my $privateMbInfoFilespec = $privatePath . 'mbinfo.txt';

# ----------------------------------------------------------------------------
sub fetchMailInfoFromFile {
  my $privateMbInfoFilespec = shift @_;
  my $xBug = shift @_;
  if (!defined($xBug)) { $xBug = \&xlogBug; }  # optional argument, xlogBug
    # = = = = = = = = = = = = = = = = = = = = = = = =
  if (open MBFILE, "<",  $privateMbInfoFilespec) {
    $xBug->("Opening mail info! $privateMbInfoFilespec");
    foreach my $infoitems (<MBFILE>) {
      push @mailinfo, [split(/,/,$infoitems)];
    } # foreach
    close MBFILE;
    $didx = int ( rand (@mailinfo + 1) -1) if ($mail_random);
    if (exists($main::cline{'emailAccount'})) {
      ($mail_hostname, $mail_username, $mail_password, $mail_ssl, $mail_folder) = split(/,/,$main::cline{'emailAccount'});
    } # if emailAccount
    elsif ($#mailinfo >= 0) {
      ($mail_hostname, $mail_username, $mail_password, $mail_ssl, $mail_folder) = @{ $mailinfo[$didx] };
    }
    else { &xlogBug("Mailbox not identified! "); }

    $mail_folder = &rtrim($mail_folder); # strip end of line
  }
  else { &xlogBug("Mailbox list not found! $privateMbInfoFilespec  $! $^E"); }
} # fetchMailInfoFromFile

&fetchMailInfoFromFile($privateMbInfoFilespec);

 # maybeConnectToEmailServer

  # ------------------------------------------------------------------------------
sub processDeleteCommand {
  my $zapCommand = 'DELETE';
  if (exists($main::cline{$zapCommand})) {
    my $zaptarget = $main::cline{$zapCommand};
    if (exists($main::cline{$zaptarget})) { delete $main::cline{$zaptarget}; }
    delete $main::cline{$zapCommand};
  } # if the command is seen
} # processDeleteCommand

# ----------------------------------------------------------------------------
sub qRelocation {
  my $relocation = shift @_;
  my $result = "<script language=\"javascript\" type=\"text/javascript\">\n";
  if (defined($relocation)) {
    $result .=  "<!-- \n";
    $result .=  "window.location.href=";
    $result .=  "\"$relocation\";\n";
    $result .= "// end comment --> \n";
  } # if argument is defined
  $result .= "</script> \n";
  $result .= "<noscript>If javascript were enabled, you would be viewing <A HREF=\"$relocation\">$relocation</A></noscript> \n";
  $result .=  "<!-- -- -- -- ---- -- -- ---- -- -- ---- -- -- -- -->\n";
  return $result;
} # qRelocation

# ----------------------------------------------------------------------------
sub WindowRelocation {
  my $relocation = shift @_;
  print &qRelocation($relocation);
  &tBug("Window Relocation $relocation\n");
} # WindowRelocation

# ----------------------------------------------------------------------------
sub WindowClose {
  my $result ="<script>\n";
  $result .= "<!-- \n";
  $result .= " function CloseCurrentWindow() {
          try{
                this.focus();
                self.opener = this;
                self.close();
          }
          catch(e){
	  }
          try{
                window.open('','_self','');
                window.close();
          }
          catch(e){
          }
        }\n";
  $result .= "CloseCurrentWindow();\n";
  $result .= "// end comment --> \n";
  $result .=  "</script> \n";
  &bBug($result);
} # WindowClose

# ----------------------------------------------------------------------------
sub generateMailResponse {
  my $body         = (shift @_);
  my $msgf         = shift @_;
  my $msg_subject  = shift @_;
  my $msg_mailbox  = shift @_;
  my $msg_received = shift @_;
  my $unix_date    = shift @_;
  my $ddebug       = shift @_;
  my $xBug = \&xlogBug;
  $xBug->("generateMailResponse body $body mesf $msgf msg_subject $msg_subject");
#  BEGIN{push @INC, '/var/cgi-bin/tmp/Email-Sender-1.300031/lib';}
  print XFILE "generateMailResponse\n"; # debug

  my ($smtpserver,$smtpport,$smtpuser,$smtppassword); # read credentials from a file
  my $mxinfoFilespec = $privatePath . 'mxinfo.txt';
    # = = = = = = = = = = = = = = = = = = = = = = = =
  if (-e $mxinfoFilespec) {
    $xBug->("Got info $mxinfoFilespec");
  } else {
    $xBug->("Missing email info $mxinfoFilespec");
    return;
  }
  if (open MXFILE, "<", $mxinfoFilespec) {
    ($smtpserver,$smtpuser,$smtppassword,$smtpport) = split(/,/, <MXFILE>);
    close MXFILE;
  } # if
  print XFILE "Fetching mailbox info...\n"; # debug
  $smtpport =~ s/\s+$//; 
  $xBug->("  Host => $smtpserver,");
  $xBug->("    Hello => 'shaw.ca',");
  $xBug->("  Timeout => 30,");
  $xBug->("  Debug => $ddebug, ");
  $xBug->("  Port => $smtpport,");
  $xBug->("  Username => $smtpuser,");
  $xBug->("  Password => $smtppassword");
  use Net::SMTP;
  if (my $transport = Net::SMTP->new(
    Host => $smtpserver,
    Hello => 'shaw.ca',
    Timeout => 30,
    Debug => $ddebug, 
    Port => $smtpport,
    Username => $smtpuser,
    Password => $smtppassword,
  )) {
    print XFILE "Created SMTP!\n"; # debug
    my $msgcc = 'dbblackman@hotmail.com';
    print XFILE "Still doing it!\n"; # debug

    $transport->mail('dbblackman@shaw.ca');
    $transport->to("$msgf\n"); # this is the email that matters...
    $transport->data();
    $transport->datasend("To: $msgf\n"); # should agree with 'to' above
 #   $transport->datasend("Bcc: $msgcc\n"); # should agree with 'to' above
    $transport->datasend("From: bfbot\@shaw.ca\n");
#    $transport->datasend("Subject: $msg_subject $main::cline{'emails_Sent'} \n");
    $transport->datasend("Subject: $msg_subject\n");
                ##### ##### ##### ##### ##### ##### ##### ##### ##### #####
    my $attachBinaryFile = 'dskin.jpg';
    if (exists($main::cline{'latest'})) { $attachBinaryFile=$main::cline{'latest'}; }
    my $attachTextFile = 'willy.pl';

    my $boundary = 'CopyrightDanielBlackman2018StevestonCanada';
    if (exists($main::cline{'visit_counter'})) { $boundary .= $main::cline{'visit_counter'}; }
    my @textFile = ('Oh nooooo!','What happened?');
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
    if (open(DAT, $attachTextFile)) {
      @textFile = <DAT>;
      close(DAT);
    } # if

    $transport->datasend("MIME-Version: 1.0\n");
    $transport->datasend("Content-type: multipart/mixed;\n\tboundary=\"$boundary\"\n");
    $transport->datasend("\n");

    $transport->datasend("--$boundary\n");
    $transport->datasend("Content-type: text/plain\n");
    $transport->datasend("Content-Disposition: quoted-printable\n");
    if ($body) { $emailReply = $body; }
    $transport->datasend("\n$emailReply\n");

    if ($UserState > 8) {
#      if ($UserState > 1) { $formEmailRequest = 1; }
      $transport->datasend("--$boundary\n");
      $transport->datasend("Content-type: text/html\n");
      $transport->datasend("Content-Disposition: inline\n");
      $transport->datasend(&basicHTMLheader);
      $transport->datasend(&formHTMLonly);
      $transport->datasend("</body></html>\n");
    } # if 0

    if (0) {
      $transport->datasend("--$boundary\n");  
      $transport->datasend("Content-Type: application/text; name=\"$attachTextFile\"\n");
      $transport->datasend("Content-Disposition: attachment; filename=\"$attachTextFile\"\n");
      $transport->datasend("\n");
      foreach my $lineitem (@textFile) {  $transport->datasend($lineitem); }
    } # if 0

    if (1) {
      print XFILE "Sending... generateMailResponse\n"; # debug

      $transport->datasend("--$boundary\n");
      $transport->datasend("Content-Type: image/jpeg; name=\"$attachBinaryFile\"\n");
      $transport->datasend("Content-Transfer-Encoding: base64\n");
      $transport->datasend("Content-Disposition: attachment; filename=\"$attachBinaryFile\"\n");
      $transport->datasend("\n");
      my $buf;
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
      if (open(DAT, "<", $attachBinaryFile)) {
        binmode(DAT);
        local $/=undef;
        $buf = &MIME::Base64::encode_base64( <DAT> );
        $transport->datasend($buf);
        close(DAT);
      } # if open
    } # if 0

    $transport->datasend("--$boundary\n");
    $transport->dataend();
    $transport->quit();
    if (exists($main::cline{'emails_Sent'})) {
      $main::cline{'emails_Sent'}++;
    } else {
      $main::cline{'emails_Sent'} = 1;
    }
    my $ctr = $main::cline{'emails_Sent'};
    &cBug("<div  class=\"dvx5\">Message sent $ctr to $msgf\n$msg_subject\n$emailReply</div>\n");
  } # if connected
  else {
    &cBug("Outgoing mail connection failure");
    &cBug("Outgoing email server: $smtpserver $smtpuser $smtppassword $smtpport");
    print XFILE "Outgoing email server: $smtpserver $smtpuser $smtppassword $smtpport";
  }
  print XFILE "Outgoing email server: $smtpserver $smtpuser $smtppassword $smtpport";
  print XFILE "All done! generateMailResponse\n"; # debug
} #  generateMailResponse

  # ---------------------------------------------------------------------------
sub assignToEmail {
  my $xBug           = \&cBug; # W R
  $xBug = \&xlogBug;
  $xBug->("assignToEmail");
  my $emailFormVariable = 'element_2a';
  if (exists($main::cline{$emailFormVariable})) {
    if (Email::Valid->address($main::cline{$emailFormVariable})) {
      $main::cline{'toEmail'}=$main::cline{$emailFormVariable};
    } else {
      if (length($main::cline{$emailFormVariable}) > 2) {
        $xBug->("Bad email! $main::cline{$emailFormVariable}");
      }
      else {  $xBug->("Null email!"); }
    }
    delete $main::cline{$emailFormVariable};
  }
} # assignToEmail

  # ---------------------------------------------------------------------------
sub sendEmailAsRequired {
  my $xBug         = \&xlogBug;
  $xBug->("sendEmailAsRequired");
  &assignToEmail; # should set  $main::cline{'toEmail'}
  my $throwAwayKey = 666;
  if (exists($main::cline{'visitCounter'})) { $throwAwayKey = $main::cline{'visitCounter'}; }
  if (exists($main::cline{'testEmail'}) || exists($main::cline{'toEmail'})) {
    if (!exists($main::cline{'toEmail'})) { $main::cline{'toEmail'}='legal@bitbanger.com'; }
    delete $main::cline{'testEmail'};
    my $UserID = 4444;
    if (exists($main::cline{'UserID'})) { $UserID = $main::cline{'UserID'}; }
      my $eCounter = 1;
      if (exists($main::cline{'emails_Sent'})) { $eCounter += $main::cline{'emails_Sent'}; }
      my $body = "This is an important message.  You are hereby ordered to preserve and protect
this message numbered $eCounter for the good of the republic.  However, for security requirements
the meaningful content of this message has been redacted.  Do not worry, it is for the best.

See http://bf25.fun/?UserState$UserID=4&UserID=$UserID&throwAwayKey=$throwAwayKey&msgNumber=$eCounter

See http://10.0.0.77/?UserState$UserID=4&UserID=$UserID&throwAwayKey=$throwAwayKey&msgNumber=$eCounter

Love, dbb
";
    my $subject = "Important message $eCounter from central command";
    my $toDest = '<' . $main::cline{'toEmail'} . '>';
#    &generateMailResponse($body, $from,
#                     $subject, $mail_username, $received, $unix_date, $mail_debug);
    &generateMailResponse($body, $main::cline{'toEmail'},
                    $subject, 0, 0, 0, 0);
    delete $main::cline{'toEmail'};
  }
  else {
    $xBug->("sendEmail not Required!");
  }
} # sendEmailAsRequired

  # ------------------------------------------------------------------------------
use POSIX qw(strftime);
my $exactlyOneHour   = 3600;
my $eightHours       = 7 * $exactlyOneHour; # GMT offset from local PDT
my $FifteenDays      = 15 * 24 * $exactlyOneHour;
my $FifteenHours     = 15 * $exactlyOneHour;
my $FifteenMinutes   = 900;
my $FifteenSeconds   = 15;
my $MaybeAnHour      = $exactlyOneHour + int ( rand ($FifteenMinutes)) - ($FifteenMinutes / 2);
#
my $cookieExpOffset  = $eightHours + $FifteenMinutes - $FifteenSeconds; # would delete existing cookie
$cookieExpOffset    += $exactlyOneHour; # make cookie persistent for testing...
if ($UserState > 5)     { $cookieExpOffset += $MaybeAnHour;  }
if ($UserState > 10)    { $cookieExpOffset += $FifteenHours; }
if ($UserState > 100)   { $cookieExpOffset += $FifteenDays;  }
my $later_string     =  &readableTimeString(time + $cookieExpOffset);

  # ------------------------------------------------------------------------------
sub Ocean {
  my $hername = 'Océane';
  my $title   = " title=\"learn a little more about the author\"";
  my $href    = "HREF=\"https://www.couchsurfing.com/people/bud.verde\"";
  &cBug("<A $href $title>$hername</A>");
} # Ocean

  # ------------------------------------------------------------------------------
sub maybeSetACookie {
  my $xBug         = shift @_;    if (!defined($xBug)) { $xBug = \&StateMessage; }
  my $result       = '';
  $main::cline{'ZapCookie'} = 'yes'; # debug dbb 3-10-2021, lets see if we can get rid of cookies
  if (exists($main::cline{'UserID'})) {
    $userID = $main::cline{'UserID'};
    $xBug->("maybeSetACookie: UserID maybeSetACookie $userID");
  }

  if (defined($userID)) { $uState = 'UserState' . $userID; }

  if (exists($main::cline{'UserID'})) {
    $userID = $main::cline{'UserID'};
    &xlogBug("Found userID $userID");
  }
  if (defined($userID)) { $uState = 'UserState' . $userID; }
#
  if (exists($main::cline{'ZapCookie'})) {
    $cookieExpOffset = 0 - $FifteenDays; # would delete existing cookie
    $later_string = &readableTimeString(time + $cookieExpOffset);
    $xBug->("current uState $uState");
    delete $main::cline{$uState};
    delete $ENV{'HTTP_COOKIE'};
    delete $main::cline{'UserID'};
    $xBug->("Zapping cookie $later_string");
  } elsif (exists($main::cline{$uState})) {
    # $cookieExpOffset = $FifteenDays - $FifteenSeconds; # would overwrite existing cookie
    $later_string = &readableTimeString(time + $cookieExpOffset);
    if (defined($uState)) {
      if (exists($main::cline{$uState})) {
        my $justToMakeItClear = $main::cline{$uState};
        $xBug->("Setting cookie $later_string <BR> State  x $uState x = $justToMakeItClear"); # dbb 5-23-2020
    } else { $xBug->("XXXXX"); } } else { &xlogBug("YYYYY"); }
  } # increment UserState
#
  if (exists($formInfo{'form_id'}) || exists($main::cline{'ZapCookie'}) || exists($main::cline{'cookieFlag'})) {
    if (!exists($main::cline{'UserID'}) && !exists($main::cline{'ZapCookie'}) ) {
      $main::cline{'UserID'} = time;
    }
    if (!exists($main::cline{'UserID'})) {
      $main::cline{'UserID'} = 0;
    }
    if ($main::cline{'UserID'}) {
      $result = "Set-Cookie: user_id=$main::cline{'UserID'}; Expires=$later_string; HttpOnly\n";
      $xBug->("Setting: $result");
      $main::cline{'LastCookie'} = &urlencode("LastCookie $result");
    } # if not 0
    elsif (exists($main::cline{'ZapCookie'})) {
      $result = "Set-Cookie: user_id=$main::cline{'UserID'}; Expires=$later_string; HttpOnly\n";
      $xBug->("Zapping: $result");
      $main::cline{'LastCookie'} = &urlencode("LastCookie $result");
    } # allow us to delete a cookie with user_id=0
  }
#
  if (exists($main::cline{'ZapCookie'}))  { delete $main::cline{'ZapCookie'}; }
  if (exists($main::cline{'cookieFlag'})) { delete $main::cline{'cookieFlag'}; }
  &StateMessage("xmaybeSetACookie: userID $userID") if (defined($userID));
  &StateMessage("xmaybeSetACookie: uState $main::cline{'UserID'}") if (exists($main::cline{'UserID'}));;
  return $result;
} # maybeSetACookie

  # ----------------------------------------------------------------------
my $leadoffResetInterval = 7200;
sub leadoffHTMLheadings {
  my $didx    = shift @_;  if (!defined($didx)) { $didx = 0; }
  my $version = shift @_;
  my $refrint = shift @_; # refresh interval for webpage
  if (defined($refrint)) {
    $leadoffResetInterval = $refrint;
  } elsif (exists($main::cline{'RESETINTERVAL'})) {
    $leadoffResetInterval = $main::cline{'RESETINTERVAL'};
  } else {
    $main::cline{'RESETINTERVAL'} = $leadoffResetInterval;
  } # else
  $main::cline{'version'} = "YCOLD $__PACKAGE__::versionNumber";
  if (!defined($version)) {
    if (exists($main::cline{'version'})) { $version = $main::cline{'version'}; }
    else                                 { $version = 'No title'; }
  }
  else { $version = $main::cline{'version'}; }
  my $presult = qq(Content-type: text/html\n);
  $presult .= &maybeSetACookie(\&tBug);
  $presult .= "\n";
  # if ($contentTypeBannerSuppressed) { $presult = ''; }
  $presult .= &documentType($didx) . "\n";
  $presult .= "<HTML lang=\"en\">\n";
  $presult .= "<HEAD>\n";
  $presult .= "<TITLE>$version</TITLE>\n";
  if (exists($main::cline{'refTimeoutEnable'}) || (1)) {
    my $refreshURL4 = "http:\/\/$thisURL?INCREMENT=REFRESHCOUNTER";
    $presult       .=  "<meta http-equiv=\"refresh\"         content=\"$leadoffResetInterval; URL=$refreshURL4\">\n";
  } # if refTimeoutEnable
  return $presult;
} # leadoffHTMLheadings

  # ------------------------------------------------------------------------------
my $metaMessageX .=  '
<meta http-equiv="Pragma"            content="no-cache" />
<meta http-equiv="Cache-Control"     content="no-cache, no-store, must-revalidate" />
<meta http-equiv="Expires"           content="0" />
<meta http-equiv="Content-Type"      content="text/html; charset=utf-8">
';

  # ------------------------------------------------------------------------------
sub standardHeaders {
  my $presult = $metaMessageX;
  my $backgFilename = "https://wtf26.site/archives/mimemail/2am22411a.jpg";
  $backgFilename  = ''; # none, thanks.
  if (exists($main::cline{'latestFilename'})) {
    $backgFilename = "https://wtf26.site/archives/mimemail/$main::cline{'latestFilename'}";
  } # if
  my $httpx         = 'http://';
  if (exists($ENV{HTTPS}) || ($httpX)) { $httpx         = 'https://'; }
  if (!exists($ENV{'SERVER_NAME'})) { return $presult; }
  my $action           = $httpx . $ENV{'SERVER_NAME'} . '/';
  $presult   .= "<link href=\"$action$CSSreference\" rel=\"stylesheet\" type=\"text/css\" media=screen>\n";
  $presult   .= "<style>
body {
  background-image: url('$backgFilename');
  background-repeat: no-repeat;
  background-attachment: fixed; 
  background-size: 100% 100%;
}
</style>\n";
  return $presult;
} # standardHeaders

  # ------------------------------------------------------------------------------
sub partsHeaders {
  my $presult;
  if (!defined($presult)) { $presult = ''; }
  if (defined($partsPath)) {
    my $filename       = $partsPath . 'meta.txt';
    if (-e $filename) {
      my $file_content = do{local(@ARGV,$/)=$filename;<>};
      $presult        .=  $file_content;
    } else   { &xlogBug("filename $filename not found.");  }
  } else     { &xlogBug("partsPath not defined"); }
  return $presult;
} # partsHeaders

  # ------------------------------------------------------------------------------
my $someText = 'Copyright (c) Daniel Blackman 2019';
  # see https://gist.github.com/lancejpollard/1978404 info for HTML meta tags
my $metaMessage0 .=  '
<meta http-equiv="X-UA-Compatible"   content="IE=edge">
';
my $metaMessage1 = '
<meta name="PT"                      content="article">
<meta name="PST"                     content="News">
';
my $metaMessage2 = '
<META NAME="ROBOTS"                  CONTENT="INDEX, FOLLOW">
<meta name="byl"                     content="Helen Hayes">
<meta name="author"                  content="Daniel Brian Hayes">
<meta name="news_keywords"           content="Data Warehouse Changes World">
<meta name="keywords"                content="excel file upload">
<meta name="description"             content="Data Warehouse tool to view database.">
';

  # ------------------------------------------------------------------------------
my $metaMessage6 .=  '
<meta name="ROBOTS"                  content="INDEX, FOLLOW"/>
<meta name="byl"                     content="Old West Wranglers Diego"/>
<meta name="author"                  content="Daniel Brian Hayes"/>
<meta name="news_keywords"           content="SAR Dog Memorial Page"/>
<meta name="keywords"                content="search-and-rescue fundraising event"/>
<meta name="alt_description"         content="Old West Wranglers Diego 2004-2020"/>

<meta name="PT"                      content="article"/>
<meta name="PST"                     content="News"/>
<meta name="msapplication-starturl"  content="http://www.wtf26.site"/>
<meta name="msapplication-TileColor" content="#ffffff"/>
<meta name="msapplication-TileImage" content="/images/ms-icon-144x144.png"/>
<meta name="theme-color"             content="#ffffff"/>
';

   # ------------------------------------------------------------------------------
sub busyHeaders {
  my $didx             = shift @_;  if (!defined($didx)) { $didx = 0; }
  my $title            = shift @_;
  $leadoffResetInterval = 28;
  my $presult          = &leadoffHTMLheadings($didx,$title,30);
  $presult            .= &standardHeaders;
  $presult            .= $metaMessage0;
  return $presult;
} # busyHeaders

  # ------------------------------------------------------------------------------
sub print0HTMLheader {
  my $didx = shift @_;  if (!defined($didx)) { $didx = 0; }
  my $version;
  if (exists($main::cline{'version'})) { $version = $main::cline{'version'}; }
  elsif (!defined($version))           { $version = $__PACKAGE__::versionNumber; }
  my $presult = &leadoffHTMLheadings($didx,"Unfriendly Bot $version");
  $presult   .= "</HEAD>\n";
  &uBug($presult);
} # print0HTMLheader

  # ------------------------------------------------------------------------------
sub print1HTMLheader {
  my $didx    = shift @_;  if (!defined($didx)) { $didx = 0; }
  my $title   = shift @_;
  my $presult = &leadoffHTMLheadings($didx,$title);
  $presult   .= &standardHeaders;
  $presult   .= &partsHeaders;
  $presult   .= "</HEAD>\n";
  &uBug($presult);
} # print1HTMLheader

  # ---------------------------------------------------------------------------
sub print2HTMLheader {
  my $didx             = shift @_;  if (!defined($didx)) { $didx = 0; }
  my $title            = shift @_;
  my $presult          = &leadoffHTMLheadings($didx,$title);
  $presult            .= &standardHeaders;
  $presult            .= &partsHeaders;
  $presult            .= "</HEAD>\n";
  &uBug($presult);
} # print2HTMLheader

  # ---------------------------------------------------------------------------
sub print3HTMLheader {
  my $didx             = shift @_;  if (!defined($didx)) { $didx = 0; }
  my $title            = shift @_;
  my $presult          = &leadoffHTMLheadings($didx,$title);
  $presult            .= &standardHeaders;
  $presult            .= &partsHeaders;
  $presult            .= "</HEAD>\n";
  &uBug($presult);
} # print3HTMLheader

  # ---------------------------------------------------------------------------
sub print6HTMLheader {
  my $didx             = shift @_;  if (!defined($didx)) { $didx = 0; }
  my $title            = shift @_;
  my $presult          = &leadoffHTMLheadings($didx,$title);
  $presult            .= &standardHeaders;
  $presult            .= $metaMessage6;
  $presult            .= $metaMessage0;
  $presult            .= &partsHeaders;
  $presult            .= "</HEAD>\n";
  &uBug($presult);
} # print6HTMLheader

   # ------------------------------------------------------------------------------
sub assembleInfoBanner {
  my $infoBanner                                       = shift @_;
  if (exists($main::cline{'HOSTNAME'})) { $infoBanner .= ' ' .$main::cline{'HOSTNAME'}; }
  $infoBanner                                         .= ' ' . $__PACKAGE__::versionNumber;
  if (exists($ENV{'SERVER_NAME'}))      { $infoBanner .= ' ' . $ENV{'SERVER_NAME'}; }
  my $now_string                                       = &readableTimeString;
  $infoBanner                                         .= ' ' . $now_string;
  return $infoBanner;
} # assembleInfoBanner

   # ------------------------------------------------------------------------------
sub openHTMLOUTPUT {
  my $xBug = shift @_;
  if (!defined($xBug)) { $xBug = \&xlogBug; }  # optional argument, xlogBug
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  if (open HTMLOUTPUT,">:utf8","$resultsfn") {
    $HTMLopened = 1;
    chmod $fileRWXmode, $resultsfn;
    my $didx             = 0;
    my $title            = 'ZCharlie';
    my $presult          = &leadoffHTMLheadings($didx,$title);
    $contentTypeBannerSuppressed = 0;
    $presult            .= &standardHeaders;
    $presult            .= &partsHeaders;
    $presult            .= "</HEAD>\n";
    $presult            .= "<body>";
    &pBug($presult); # results output only
#
    my $linkedInfo = "<a href=\"\\\"  $title>" . __PACKAGE__ . "</a>";
    my $infoBanner = &assembleInfoBanner($title . $linkedInfo);
    &pBug($infoBanner);
    &pBug(&linkBand);
    $xBug->("HTMLOUTPUT to $resultsfn");
  } else {    $xBug->("openHTMLOUTPUT failed to open HTMLOUTPUT $resultsfn");  }
} # openHTMLOUTPUT

  # ------------------------------------------------------------------------------
  my $blacklistFilename = 'blacklist.txt';
  my $whitelistFilename = 'whitelist.txt';
sub checkBlacklist {
  my $result = shift @_;
  my $xBug   = shift @_;
  if (open BLACKLISTFILE, "<", "$blacklistFilename") {
    local $/=undef;
    my @blackList = split(/\n/,<BLACKLISTFILE>);
    if (exists($ENV{'REMOTE_ADDR'})) {
      if (in { $ENV{'REMOTE_ADDR'} eq $_ } @blackList) {
        $xBug->("Found on blacklist: $ENV{'REMOTE_ADDR'} ");
        # return 1;  # blacklisted!
        $result = 1; # blacklisted!
      } # if on blacklist
      else { $xBug->("Passed blacklist."); }
    } # if on blacklist
    else { $xBug->("Must be from shell!!! $result"); }
  } # if open
  else { $xBug->("blackList: $! $result"); }
  return $result;
} # checkBlacklist 

  # ------------------------------------------------------------------------------
sub lookupIPinfo {
  my $untrimmedIPaddress = shift @_; if(!defined($untrimmedIPaddress)) { $untrimmedIPaddress = '0.0.0.0'; }
  my $lastFlagPtr   = shift @_;
  my $goodGuyPtr    = shift @_;
  my $xBug          = shift @_;  if(!defined($xBug)) { $xBug = \&pBug; }
  my $class         = shift @_;
  my $someLimit = 40000; # if (exists($main::cline{'someLimit'})) { $someLimit = $main::cline{'someLimit'}; }
  my $result = -52;
  my $someIPaddress  = &rtrim($untrimmedIPaddress); # trim probbaly not necesary
#
  if (exists($IPcountryHash{$someIPaddress})) {
    my $someCountry = &rtrim($IPcountryHash{$someIPaddress});
    $xBug->("lookupInfo: IPcountryHash lives!!");
    # $$goodGuyPtr .= "lookupInfo: -- Found $someIPaddress = $IPcountryHash{$someIPaddress}!";
    # $$goodGuyPtr .= "\nlookupInfo: Checking whiteList:!";
    if (exists($whiteList{$someCountry})) {
      my $someValue = $whiteList{$someCountry};
      $xBug->("lookupInfo: Found on whitelist $someIPaddress = $someCountry ($someValue)!");
      # $$goodGuyPtr .= "\nlookupInfo: Found on whitelist $someIPaddress = $someCountry ($someValue)!";
      return 0;
    } else {
      $xBug->("lookupInfo: Not found on whitelist $someIPaddress! ($someCountry)");
      # $$goodGuyPtr .= "\nlookupInfo: Not found on whitelist $someIPaddress! ($someCountry) : @{[ %whiteList ]} ";
    } # else
  } 
  else {
    $xBug->("lookupInfo: Not found in IPcountryHash: $someIPaddress - ");
  } # else
#
# so we try to load the IPcountryHash from a file, if there is one specified
  if (exists($main::cline{$IPcountryTag})) {
    if (-e $main::cline{$IPcountryTag}) {
      if (open DBFILE, $main::cline{$IPcountryTag}) {
        $xBug->("lookupInfo: opened $main::cline{$IPcountryTag}");
        my $itemCounter = 0;
        for my $line (<DBFILE>) {
          $itemCounter++;
          my @splitsville = split("=",$line);
          my $name  = $splitsville[0];
          my $value = $splitsville[1];
          if (defined($name)) {
            if (defined($value)) { $IPcountryHash{$name}=$value; }
            else { return -43; } # value portion of pair not defined
          }
          else { return -42; }   # name portion of pair not defined
        } # for
        close DBFILE;
        chmod $fileRWXmode, $main::cline{$IPcountryTag};

        $xBug->("$itemCounter items loaded into hash!");
        if (exists($IPcountryHash{$someIPaddress})) {
           $main::cline{'CountryOfOrigin'} = substr($IPcountryHash{$someIPaddress},0,2);
           $xBug->("Found $someIPaddress = $main::cline{'CountryOfOrigin'}!");
           return 0;
        } # if
        else {
           $xBug->("-51 Not Found $someIPaddress in IPcountryHash");
           $xBug->("Well maybe we should look it up.");
           $xBug->(" ++ lookupIPinfo -5 $result");
           # unlink $main::cline{$IPcountryTag}; # force loading from database table
        }
      }
      else { $xBug->("failed to open $!"); return -41; } # else
    } # if
    else { # file doesn't exist, so we create it !-e $main::cline{$IPcountryTag}
      $xBug->("lookupIPinfo no such file $main::cline{$IPcountryTag}?"); # R & X only
      # my $regExp     = "'22country.22.3A..(.*)22'";
      my $selectClause  = 'sourceName,';
      $selectClause .= $ExtractCountry;
      $groupby    = ''; # "GROUP BY Smitty";

      my $anyIPaddress  = '_%._%._%._%';
      my $isql          = "SELECT $selectClause from SUBMITlog
                                       where sourceName like '$anyIPaddress' $groupby LIMIT $someLimit;";
      my $iresulting    = &sendMysqlQuery($isql,\&xlogBug);   $xBug->("lookupIPinfo Mark 2 this place! ");
      my $iquerycsv     = pop @queryResultFile;
      my $result        = -6;
      if (defined($iresulting)) {
        if (defined($iquerycsv)) {
          $xBug->("1 looking at iquerycsv"); # ###### 
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
          if (open IPFILE, ">:utf8", $main::cline{$IPcountryTag}) {
          # chmod $fileRWXmode, $main::cline{$IPcountryTag};

            my @items = split(',',$iquerycsv);
            my $ipname = shift @items; # discard
            my $country= shift @items;
            my $loopy = 0;
            while ($#items >= 0) {
              $IPcountryHash{$ipname} = $country;
              if ($loopy++ > 999999) { &xlogBug("Son of a bitch!"); return 'Cant fuking believe it!'; }
              print IPFILE "$ipname=$country\n";
              $ipname  = shift @items; # discard
              $country = shift @items; # discard
            }
            close IPFILE;
#
            if (exists($IPcountryHash{$someIPaddress})) {
              # $$goodGuyPtr .= " --looking it up-- Found $someIPaddress = $IPcountryHash{$someIPaddress}!";
              $xBug->("Found $someIPaddress = $IPcountryHash{$someIPaddress}!");
              return 0;
            } # if
            else {
              $xBug->("-52 Not Found $someIPaddress in IPcountryHash"); # R & X only
              $IPcountryHash{$someIPaddress} = 'CC';
              $xBug->("Well we oughtta look it up.");
              # $$goodGuyPtr .= ' --looking it up-- ';
              $result       = &fetchIPaddressInfo($iquerycsv,$someIPaddress,$lastFlagPtr,$goodGuyPtr, $xBug, $class);
              $xBug->(" ++ lookupIPinfo -7 $result");
              # unlink $main::cline{$IPcountryTag}; # force loading from database table
            } # else someIPaddress not in IPcountryHash
            $xBug->("Well do you think we should look it up?");
          } # if opemIPcountryTag file for output
          else {
            $xBug->("failed to open for output $IPcountryTag?"); # R & X only
            return -42;
          } # if open
        } # if defined iquerycsv
        else {
          $xBug->("impossible undefined iquerycsv"); # R & X only
          return -43;
        } # else
      }
      else { $xBug->("Not found! 2"); }
    } # else file doesn't exist, so we create it
  }
  else { $xBug->("Not found! 1"); }  # else !exists($main::cline{$IPcountryTag}
#
  $xBug->("lookupInfo: appealing to the database...");
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
  my $isql       = "SELECT $ExtractCountry from SUBMITlog where sourceName like '$someIPaddress';";
  my $iresulting = &sendMysqlQuery($isql,\&xlogBug);
  my $iquerycsv  = pop @queryResultFile;
  if (defined($iquerycsv)) {
    $main::cline{'CountryOfOrigin'} = substr($iquerycsv,0,2);
  } # not found
  $result        = -6;
  if (defined($iresulting)) {
    if (defined($iquerycsv)) {
      &logSQLresults($iresulting, $iquerycsv, $xBug);
      # $xBug->("2 looking at iquerycsv $iresulting");
      $result       = &CountryList($main::cline{'CountryOfOrigin'});
    } else {
      $xBug->("Well maybe we should look it up. - $iresulting -");
      # $$goodGuyPtr .= ' --looking it up-- ';
      $result       = &fetchIPaddressInfo($iquerycsv,$someIPaddress,$lastFlagPtr,$goodGuyPtr, $xBug, $class);
      # $xBug->(" ++++ lookupIPinfo $result $$goodGuyPtr");
    } # else
  } # if defined iresulting
  else {
    $xBug->("Well maybe we should look it on up.");
    # $$goodGuyPtr   .= ' --looking it on up-- ';
    $result         = &fetchIPaddressInfo($iquerycsv,$someIPaddress,$lastFlagPtr,$goodGuyPtr, $xBug, $class);
    $xBug->(" ++ lookupIPinfo NO RESULT? $result");
  } # else not defined iresulting
  return $result;
} # lookupIPinfo

  # ------------------------------------------------------------------------------
sub inspectVisitorsOrigins {
return 1;
  my $xBug              = shift @_; if (!defined($xBug)) { $xBug = \&tBug; }
  $xBug = \&xlogBug; # dbb 28 Feb 24
  my $result            = shift @_; # black by default
  if (!defined($result)) { $result = !&checkDEBUGXIP; } # black by default
  if (exists($ENV{'REMOTE_ADDR'})) { $xBug->(" --------------------------- inspectV! $ENV{'REMOTE_ADDR'}"); }
  else                             { $xBug->(" --------- inspectV! (shell)"); }
  if (exists($main::cline{'CountryOfOrigin'})) { $xBug->("COO! $main::cline{'CountryOfOrigin'}"); } # dbb debug 22-11-18
  if (exists($main::cline{'CountryOfOrigin'})) {
    if (exists($main::cline{'CountryPass'})) {
      $xBug->("ignoring CountryPass $main::cline{'CountryPass'} $result");
      $result = 0;
    } else {
      $result = 0;
    }
    $xBug->("Returning with $main::cline{'CountryOfOrigin'} $result");
    return $result; 
  } # dbb debug 22-11-18

  my $goodGuy           = '';
  my $lastFlag          = 1;
  my $class             = 'dvx9';
  if (exists($ENV{'REMOTE_ADDR'})) {
    my $r0esult            = &lookupIPinfo($ENV{'REMOTE_ADDR'},\$lastFlag,\$goodGuy,$xBug,$class);
    if (exists($main::cline{'CountryOfOrigin'})) {
      $xBug->("lookup:  $ENV{'REMOTE_ADDR'}  : $main::cline{'CountryOfOrigin'} : $r0esult");
      $main::cline{'CountryPass'} = $r0esult; # 0 or 1
    } else {
      $xBug->("lookup:  $ENV{'REMOTE_ADDR'}  : $r0esult");
    }
  } else {
    $xBug->("lookup:  shell!");
  }

    my $token                = '2dcd56c8f0a622';
    my $iquerycsv             = '';
    my $lastFlagPtr          = \$lastFlag;
    my $goodGuyPtr           = \$goodGuy;
    my $allok                = 1;

  if (!exists($main::cline{'CountryOfOrigin'})) { $main::cline{'CountryOfOrigin'} = 'KZ'; }
  if (exists($main::cline{'CountryList'})) {
    $xBug->("whiteList countries: $main::cline{'CountryList'}");
    my @CountryList = split(' ', $main::cline{'CountryList'});
    if (exists($main::cline{'ADDWHITE'})) {
      push @CountryList,$main::cline{'ADDWHITE'};
      delete $main::cline{'ADDWHITE'};
      $main::cline{'CountryList'} = "@CountryList";
    } # ADDWHITE command
    $xBug->("Country-WHITELIST: @CountryList");
    # for my $item (@CountryList) { $xBug->("yhay $item "); }
    if (in { $main::cline{'CountryOfOrigin'} eq $_ } @CountryList) {
      $result = 1; # white black
      $xBug->("A patriot!  What harm could he cause? $main::cline{'CountryOfOrigin'}");
      $result = &checkBlacklist($result,$xBug);
    }
    else {
      $xBug->("Not on country whiteList. $main::cline{'CountryOfOrigin'} $result");
      $result = &checkBlacklist($result,$xBug);
    }
  } # if yay!
  else {
    if (exists($main::cline{'CountryPass'})) { $result = $main::cline{'CountryPass'}; }
    $xBug->("whiteList not found. $main::cline{'CountryOfOrigin'} $result");
  }
#
      if (open WHITELISTFILE, "<", "$whitelistFilename") {
        local $/=undef;
        my @whiteList = split(/\n/,<WHITELISTFILE>);
        if (exists($ENV{'REMOTE_ADDR'})) {
          if (in { $ENV{'REMOTE_ADDR'} eq $_ } @whiteList) {
            $xBug->("Found on whitelist: $ENV{'REMOTE_ADDR'} ");
            # return 0; # whitelisted!
            $result = 0; # whitelisted!
          } # if on whitelist
          else { $xBug->("Passed whitelist."); }
        } # if open
      }
      else {
        $xBug->("whiteList: $! $result");
      }
#
# white_FileList	AE,AF,AL,AM,AR,AT,AU,BA,BD,BE,BG,BH,BI,BJ,BO,BR,CA,CH,CL,CM,CN,CO,CR,CY,CZ,DE,DK,DO,DZ,EC,EE,EG,ES,ET,FI,FR,GB,GE,GH,GQ,GR,HK,HN,HR,HU,ID,IE,IL,IN,IQ,IR,IS,IT,JP,KE,KG,KH,KR,KZ,LB,LT,LU,LV,LY,MA,MD,MK,MN,MO,MX,MY,NG,NI,NL,NO,NP,NZ,PA,PE,PH,PK,PL,PR,PS,PT,PY,QA,RO,RS,RU,RW,SA,SE,SG,SK,TH,TL,TM,TR,TW,TZ,UA,UG,US,UY,VE,VN,XK,YE,ZA,ZW
 #
  $xBug->(" --------------- END ------ inspectVisitorsOrigin: $result");
  return $result;
} # inspectVisitorsOrigins

  use Date::Parse;
  # ------------------------------------------------------------------------------
sub displayDiegoPoster {
  $main::cline{'diegojpg'} = $basePath . 'diego.jpg';
  &xlogBug("Downloading image! " . time());
  my $downloadSemaphoreFilename = $volatile . 'downloading.txt';
#
  if (-e $downloadSemaphoreFilename) {
    &xlogBug("$downloadSemaphoreFilename already exists!  Download previously failed.");
  } else {
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
    if (open (SOMEOLDFH, '>', $downloadSemaphoreFilename)) { # assert the semaphore, deleted below
      close SOMEOLDFH;
      chmod $fileRWXmode, $downloadSemaphoreFilename;
    } else {
      &xlogBug("Boo! $! $downloadSemaphoreFilename $^E");
    }
  }
#
  my $imageFilespec = $basePath . 'image.jpg';
  if (exists($ENV{HTTP_HOST})) {
  if ($ENV{HTTP_HOST} =~ /bfbot/) {
    if (-e $imageFilespec) { $main::cline{'diegojpg'} = $imageFilespec; }
  }
  }
#        <area shape=\"rect\" coords=\"5,560,740,1800\" alt=\"Nic\" href=\"https:\/\/www.facebook.com\/pages\/Romania-Country-Bread \/196538317031408?_fb_noscript=1\" title=\"Romania Bakery\">
  my $imagemapData = "\n<map name=\"inlineImageMap\">
        <area shape=\"default\" alt=\"Computer\" href=\"albert.pl\" title=\"click here for more photos\">
        <area shape=\"rect\" coords=\"20,30,256,52\"       alt=\"Contact Info\"       href=\"brian.pl\"                    title=\"Contact info\">
        <area shape=\"rect\" coords=\"5,60,505,560\"       alt=\"Old West Aussies\"   href=\"http:\/\/oldwestaussies.com\" title=\"Old West  Aussies\">
        <area shape=\"rect\" coords=\"505,0,1655,300\"     alt=\"BCSDA\"              href=\"http:\/\/bcsda.ca\"           title=\"BC Search Dog Association\">
        <area shape=\"rect\" coords=\"505,1431,1655,1629\" alt=\"SARDAA\"             href=\"http:\/\/sardaa.com\"         title=\"SARDAA\">
        <area shape=\"rect\" coords=\"505,301,1655,1430\"  alt=\"CARDA\"              href=\"http:\/\/carda.org\"          title=\"California Rescue Dog  Association\">
        <area shape=\"rect\" coords=\"5,560,400,770\"      alt=\"BitBanger\"          href=\"http:\/\/bitbanger.com\"      title=\"BitBanger\">
        <area shape=\"rect\" coords=\"5,1016,204,1129\"    alt=\"Dog Play\"           href=\"http:\/\/dog-play.com\"       title=\"Dog Play\">
        <area shape=\"rect\" coords=\"205,1016,400,1129\"  alt=\"Richmond-News\"      href=\"http:\/\/richmond-news.com\"  title=\"Richmond  News\">
        <area shape=\"rect\" coords=\"5,1130,400,1629\"    alt=\"RCMSAR\"             href=\"http:\/\/rcmsar10.org\"       title=\"Station 10\">
        <area shape=\"rect\" coords=\"745,2270,960,2434\"  alt=\"myBusyDog\"          href=\"https:\/\/mybusydog.com/\"    title=\"What about those  boots?\">
        <area shape=\"rect\" coords=\"300,1901,955,2270\"  alt=\"Previcox\"           href=\"https:\/\/www.previcox.com \/ThePrevicoxDifference.html\" title=\"Previcox pain relief\">
        <area shape=\"rect\" coords=\"5,1631,1500,1800\"   alt=\"GlacierView\"        href=\"https:\/\/glacierview.us\"    title=\"GlacierView  Animal Hospital\">
        <area shape=\"rect\" coords=\"1501,1631,1655,1850\" alt=\"IslandVetHospital\" href=\"https:\/\/islandvethospital.com\" title= \"Island Veterinary Hospital\">
        <area shape=\"rect\" coords=\"5,1801,1655,2465\"    alt=\"RAPS\"              href=\"https:\/\/rapsanimalhospital.com\" title=\"RAPS Animal  Hospital\">
        </map>\n";
  &showInlineImage('diegojpg',$imagemapData);
  print "</div>\n";
  &xlogBug("Completed downloading image!" . time());
#
  if (-e $downloadSemaphoreFilename) {
    unlink $downloadSemaphoreFilename;  # delete the image download semaphore
    my $xBug = \&tBug;
    $xBug->("unlink $downloadSemaphoreFilename");  # delete the image download semaphore
  } else {
    &xlogBug("$downloadSemaphoreFilename wasn't touched! $! Probably needs directory write permission.");
  }
} # displayDiegoPoster

  # ------------------------------------------------------------------------------
sub handleEventFlags {
  $main::qRelocat = &qRelocation("\/archives\/$main::resultsFilename"); # script causes browser to relocate
  # dbb 240404
  print HTMLOUTPUT $main::qRelocat; # this should stop output to HTMLOUTPUT at pBug
  if (exists($main::cline{'DownloadAborted'})) {
	&pBug('Download Aborted');
	delete($main::cline{'DownloadAborted'});
  } # if
  if (exists($main::cline{'RuntimeError'})) {
    my $RuntimeErrorFlag = $main::cline{'RuntimeError'}; # this is also a timestamp, when the RuntimeError was identified
    my $relevantResults = '<A HREF="/archives/r' . $RuntimeErrorFlag . '.html">RuntimeError</A>';
    my $relevant2Results = '<A HREF="/archives/t' . $RuntimeErrorFlag . '.tmp">XLOG</A>';
    my $later_string = &readableTimeString($RuntimeErrorFlag);
    my $userTitle = "title=\"$later_string\" "; # tool-tips convert UserID to a string date, better to understand
    my $titledFlag = "<A $userTitle>$RuntimeErrorFlag</A>\n";
    # &xlogBug("1. RuntimeError flag is up! $RuntimeErrorFlag\n");
    # &tBug("2. RuntimeError flag is up! $titledFlag\n");
    &tBug("$relevantResults $RuntimeErrorFlag | $relevant2Results |\n");
    &tBug(" <A HREF=\"\/?DELETE=RuntimeError\">RuntimeError flag is up!</A> $RuntimeErrorFlag\n");
    delete $main::cline{'RuntimeError'}; # single report per instance
  }
  if (exists($main::cline{'emailNotify'})) {
    my $mailFlag = $main::cline{'emailNotify'}; # this is also a timestamp, when the email was fetched
    my $relevantResults = '<A HREF="/archives/q' . $mailFlag . '.html">emailResult</A>';
    my $later_string = &readableTimeString($mailFlag);
    my $userTitle = "title=\"$later_string\" "; # tool-tips convert UserID to a string date, better to understand
    my $titledFlag = "<A $userTitle>$mailFlag</A>\n";
    # &xlogBug("Email flag is up! $mailFlag\n");
    # &tBug("Email flag is up! $titledFlag\n");
    &tBug("$relevantResults $mailFlag | \n");
    &tBug("<A HREF=\"\/?DELETE=emailNotify\">Email flag is up!</A> $mailFlag\n");
  }
  my $refreshLink = $pageurl . "archives\/$main::resultsFilename";
  if (&checkDEBUGXIP) {  &cBug("<A HREF=\"$refreshLink\">RESULTS!!</A>\n"); }

} # handleEventFlags

  # ------------------------------------------------------------------------------
sub textJigtest {
  my $xBug = \&xlogBug; # R X
  my $filespec = shift @_; # optional filespec argument
  if (defined($filespec)) {
    if (-e $filespec) {
      &textJigParsing($filespec);
    } else { $xBug->("test file not found! $filespec"); } # else
  } elsif (exists($main::cline{'parseSkimmedText'})) {
    if (defined($main::cline{'parseSkimmedText'})) {
      &textJigParsing($skimmedPath . $main::cline{'parseSkimmedText'});
    } else { $xBug->("not defined parseSkimmedText"); } # else
    delete $main::cline{'parseSkimmedText'}; # in any case,  it's a once-off test
  } elsif (exists($main::cline{'parseSkimmedHTML'})) {
    if (defined($main::cline{'parseSkimmedHTML'})) {
      &textJigParsing($skimmedPath . $main::cline{'parseSkimmedHTML'});
      delete $main::cline{'parseSkimmedHTML'}; # repeat this test until it works...
    } else { $xBug->("not defined parseSkimmedHTML"); } # else
  } #  else { $xBug->("no textJigtest"); } # else
#
  if (exists($main::cline{'bugTest'})) {
    if (defined($main::cline{'bugTest'})) {
      &bBug("bBug ***");
      &cBug("cBug ***");
      &pBug("pBug ***");
      &rBug("rBug ***");
      &sBug("sBug ***");
      &tBug("tBug ***");
      &uBug("uBug ***");
    } else { $xBug->("not defined bugTest"); } # else
    delete $main::cline{'bugTest'}; # in any case,  it's a once-off test
  } #  else { $xBug->("no bugTest"); } # else
#
  if (exists($main::cline{'cssTest'})) {
    $xBug = \&cBug; # W R
    if (defined($main::cline{'cssTest'})) {
      $xBug->("AAAAA0",'dvx0');
      $xBug->("AAAAB1",'dvx1');
      $xBug->("AAAAC2",'dvx2');
      $xBug->("AAAAD3",'dvx3');
      $xBug->("AAAAD4",'dvx4');
      $xBug->("AAAAD5",'dvx5');
      $xBug->("AAAAD6",'dvx6');
      $xBug->("AAAAD7",'dvx7');
      $xBug->("AAAAD8",'dvx8');
      $xBug->("AAAAD9",'dvx9');
    } else { $xBug->("not defined cssTest"); } # else
    delete $main::cline{'cssTest'}; # in any case,  it's a once-off test
  } #  else { &xlogBug("no cssTest"); } # else
#
} # textJigtest

  # ------------------------------------------------------------------------------
sub selectFileForAction {
  my $some_dir              = shift @_;
  my $subPtr                = shift @_;
  my $xBug                  = shift @_;
  my $inlineCommand         = "ls -1tr $some_dir";
  my @filesToZap            = split("\n",`$inlineCommand`); # get a directory listing
  my @featureInfo;
  for my $filename (@filesToZap) {
    my $fileSwitch          = 'parts' . $filename;
    push @featureInfo, (   [ $subPtr,  $fileSwitch,  $filename, "select $filename"]    );
  } # for
  $xBug->("<div class=\"dvxB\">\n");
  for my $features (@featureInfo) { &xfeatureManifestation(@{$features},$xBug); }
  $xBug->("</div>\n");
} # selectFileForAction

  # ------------------------------------------------------------------------------
sub selectDatabase {
  for my $infoItem (@ListOfDatabaseInfoHashes) {
    my $infoName = $infoItem->{'DBNAM'};
    my $infoDesc = $infoItem->{'DBCON'};
    my $selected = ''; # not selected
    if (exists($main::cline{'dbConnected'})) {
      if ($main::cline{'dbConnected'} eq /$infoDesc/) { $selected = '**'; }
    } # if exists dbConnected
    my @features = ( sub { &cBug("got $infoName"); }, $infoName,  "$infoDesc $selected", "Info $infoName");
    &featureManifestation(@features);
  } # for List of info hashes
} # selectDatabase

  # ------------------------------------------------------------------------------
sub showAudioInputForm {
  my $xBug                             = shift @_;
#  $main::cline{'requestComments'}      = 1;
  $main::cline{'requestUpload'}        = 1;
  $main::cline{'requestSubmit'}        = 1;
  $main::cline{'requestSubmitMessage'} = 'Upload an audio file mp3/wav, or submit some text!';
  if (exists($main::cline{'formHTMLonly'})) {
    if ($main::cline{'formHTMLonly'}) {
      $xBug->(&formHTMLonly);
    } # if
  } # if
#  if (exists($main::cline{'form_id'})) { delete $main::cline{'form_id'}; }
  if (exists($main::cline{'AudioUploadDirectory'})) { &selectFileForAction($main::cline{'AudioUploadDirectory'},\&Nothing,$xBug); }
} # showAudioInputForm

  # ------------------------------------------------------------------------------
sub showAudioTool {
  my $xBug       = shift @_;
  my $xPort      = 8885;
  # my $ipaddr     = '10.0.0.4';
  my $ipaddr     = 'ycold.world';
  if (exists($main::cline{'AUDIOPORT'})) {
    $xPort = $main::cline{'AUDIOPORT'};
  } else {
    $main::cline{'AUDIOPORT'} = $xPort;
  } # else
  my $sourceURL  = "http:\/\/$ipaddr:$xPort\/out.mp3";
  # my $sSourceURL = "/250-milliseconds-of-silence.mp3";
  $xBug->("<div class=\"dvx2\" id=\"showAudioTool\">\n");
  if (1) {
    $xBug->("  <iframe src=\"$sourceURL\" allow=\"autoplay\" id=\"audio\" style=\"display: inline\">\n");
    $xBug->("  </iframe>\n");
  } else {
    $xBug->('  <audio id="player" autoplay controls>');
    $xBug->("<source src=\"$sourceURL\" type=\"audio\/mpeg\">\n");
    $xBug->('Your browser does not support the audio element.' . "\n");
    $xBug->('  </audio>' . "\n");
  } # else
  $xBug->("</div>\n");
} # showAudioTool

  # ------------------------------------------------------------------------------
sub response6HTMLguts {
  my $xBug = \&StateMessage;
  &cBug("Current UserID $main::cline{'UserID'} ") if (exists($main::cline{'UserID'}) && exists($main::cline{'showUserID'}));
  print "<div>\n";
  if (exists($main::cline{'UserID'}) && exists($main::cline{'showUserID'})) {
    my $xx = $main::cline{'UserID'};
    &cBug("<div class=\"dvx8\">UserID <a href=\"\/?ZapCookie=$xx\">$xx</a></div>\n");
  }
  if (exists($ENV{'HTTP_USER_AGENT'})) {
    if ($ENV{'HTTP_USER_AGENT'} =~ /Mobile/) {
      &cBug("<div class=\"dvx7\">Mobile!</div>\n") if (exists($main::cline{'showUserID'}));
      &xlogBug("Mobile!\n");
    }
  }
  &cBug("<h3>current uState $uState</h3>") if (exists($main::cline{'debugBot'}));
  if (exists($main::cline{'LastCookie'})) {
    &cBug("Set cookie: $main::cline{'LastCookie'}") if (exists($main::cline{'debugBot'}));
    delete $main::cline{'LastCookie'};
  }
#
  &enableButton if (exists($main::cline{'enableButton'}) || (!exists($main::cline{'ENABLED'})));
#
  if (exists($main::cline{'showArguments'})) {   # if (exists($formInfo{'form_id'})) {
    my $result =  "<TABLE class=\"zagos\">";
    foreach my $item (sort keys %formInfo) {
      if ($item eq 'element_5a') {
        $result .=  "<TR><TD>$item</TD><TD> some file! </TD></TR>\n";
      } else {
        $result .=  "<TR><TD>$item</TD><TD> $formInfo{$item} </TD></TR>\n";
      }
    }
    $result .=  "</TABLE>\n";
    &cBug($result) if (exists($main::cline{'showFormInfo'}));
    &cBug($result);
    my $form_id = $formInfo{'form_id'};
    foreach my $item (sort keys %formInfo) {
      if (($item ne 'form_id') && ($item ne 'submit')) {
        my $encodedContent = &urlencode($formInfo{$item}); # since it came from the internet, we encode it
        if ($item eq 'commentByEliza') {
          $encodedContent = $formInfo{$item}; # already encoded
        }
        $result =  ", sourceName='$item', Content='$encodedContent'";
        my $sql = "INSERT INTO SUBMITlog SET UserID='$form_id'$result;";
        $main::cline{$item} = $formInfo{$item};
        my $resulting = &sendMysqlQuery($sql);
        &cBug($resulting);
        my $querycsv = pop @queryResultFile;
        &logSQLresults($result, $querycsv, \&xlogBug);
      } # if the item is of interest
    } # foreach 
  } # formInfo
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  if (open DBFILE, '/home/pi/txt/music.txt')   { print <DBFILE>; close DBFILE; }
#  if (open DBFILE, '/var/cgi-bin/RCMSAR.html') { print <DBFILE>; close DBFILE; }
  if (-e 'pedigree.png') {
    my $pedigreeURL = 'http://www.wtf26.site/pedigree.png';
    &bBug("<A HREF=\"$pedigreeURL\" title=\"Pedigree\" >Diego's Pedigree</A>");
  } else { &sBug("No pedigree!"); }
  &displayDiegoPoster;
#  print "</div>\n";
} # response6HTMLguts

  # ------------------------------------------------------------------------------
sub reportThisUsersPreviousVisits {
  # my $xBug     = \&Nothing; # = \&pBug;
  my $xBug     = \&pBug;
  $xBug->("reportThisUsersPreviousVisits:  ");
  my $someIPaddress;
  if (exists($ENV{REMOTE_ADDR})) {  $someIPaddress = $ENV{REMOTE_ADDR}; }
  if(!defined($someIPaddress)) { $someIPaddress = '0.0.0.0'; }
  my $sql      = "SELECT Count(*) from visitors WHERE REMOTE_ADDR like '$someIPaddress';";
  my $result   = &sendMysqlQuery($sql, $xBug);
  chomp $result;
  my $querycsv = pop @queryResultFile;
  &logSQLresults($result, $querycsv, $xBug);
  $xBug->($result,'dvx8');
  my $previousVisit = 0;
  if ($result =~ "<TD>([0-9]*)</TD>") {
    $previousVisit = $1;
  }
  $main::cline{'PreviousVisits'} = $previousVisit;
} # reportThisUsersPreviousVisits

  # ------------------------------------------------------------------------------
sub createRFilename {  $main::xxrtime = 'r' . $oneFilename . '.html'; } # createFilename
sub archiveRFile {
  &createRFilename;    # assigns main::xxrtime
  my $destFilespec = $varchive .$main::xxrtime;
  &xlogBug("# + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +");
  if (copy($resultsfn,$destFilespec)) {
    if (chmod($fileRWXmode, $destFilespec)) {
      &xlogBug(" archiveRFile : Success! copied and chmod: $resultsfn to $destFilespec");
    } else {
      &xlogBug(" archiveRFile : Partial success! copied but not chmod $resultsfn to $destFilespec");
    }
  } else {
    &xlogBug(" archiveRFile  some other screwup: not copied  $resultsfn to $destFilespec");
  }
} # archiveRFile

  # ------------------------------------------------------------------------------
sub createSFilename {  $main::xxstime = 's' . $oneFilename . '.txt'; } # createFilename
sub archiveSFile {
  &createSFilename;
  my $destsFilespec = $varchive . $main::xxstime;
  &xlogBug($__PACKAGE__::versionNumber);
  &xlogBug("# + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +");
  if (copy($statefn,$destsFilespec)) {
    if (chmod ($fileRWXmode, $destsFilespec)) {
      &xlogBug(" archiveSFile  full success! $statefn,$destsFilespec");
    } else {
      &xlogBug(" archiveSFile  some success! $statefn,$destsFilespec");
    }
  } else {
    &xlogBug(" archiveSFile  some other screwup! $statefn,$destsFilespec");
  }
} # archiveSFile

  # ------------------------------------------------------------------------------
my $child; # thread pointer
my $hostname      = `hostname`;
chomp $hostname;
sub standardInfoHTML {
  my $markerlabel     = shift @_;
  my $xBug = shift @_;
  if (defined($markerlabel)) {
    my $versionBanner = shift @_;
    # &pBug(&linkBand);
    &xlogBug("$markerlabel");
#    &StateMessage("standardInfoHTML $markerlabel current basicIndex = $main::cline{'basicIndex'}");
    if (exists($main::cline{'HOSTNAME'})) { $hostname = $main::cline{'HOSTNAME'}; }
    
    if (exists($main::cline{'version'})) {
      my $version = &urldecode($main::cline{'version'});
      # &StateMessage("standardInfoHTML $markerlabel $hostname $version");
      if (defined($versionBanner)) {
        my $buzz          = '*xx*************************************************************';
        my $hostName = $main::cline{'HOSTNAME'};
        &StateMessage("***** $hostname $versionBanner *****", $buzz);
        $xBug->("checkedBEBUG $hostName $versionBanner\n") if (&checkDEBUGXIP); # this works... dbb 7/15/2020
      } else { &StateMessage("standardInfoHTML versionBanner not defined"); }
    } else { &StateMessage("standardInfoHTML version not exists"); }
  } else { &StateMessage("standardInfoHTML markerlabel not defined"); }
  &handleEventFlags;
  &reportThisUsersPreviousVisits; # dbb 2/3/2021
  # $xBug->("standardInfoHTML -------------------- ");
  # my $result = &inspectVisitorsOrigins(\&Nothing); # R X result if white 1, else if black 0
  my $result=0; # white=0
  # $child = threads->create(\&enforceLimitDirectory);
  return $result; # 1 if black, 0 if white
} # standardInfoHTML

  # ------------------------------------------------------------------------------
# https://stackoverflow.com/questions/1533067/what-is-the-best-way-to-gunzip-files-with-perl
use IO::Uncompress::Gunzip qw(gunzip);
sub AccessLogChecking {
  my $xBug = \&sBug;
  if (!&checkDEBUGXIP) {  return; }
  $xBug->(" ****  ACCESS LOG PROCESSING  *** ");
  my $myURL = 'http://' . $ENV{'SERVER_NAME'};
  if ((-e $tmpfn) && (0)) {
    unlink $tmpfn;
    &sBug("unlink $tmpfn $! $^E");
  } # file exists
#
  $xBug->("<A HREF=\"$myURL\">$ENV{'SERVER_NAME'}</A>");
  # $xBug->("<A HREF=\"$myURL?ZAPACCESSTABLE=2\">drop access table</A>");
  $xBug->("<A HREF=\"$myURL?ACCESSLOGINDEX=1\">set to 1</A>");
  $xBug->("<A HREF=\"$myURL?ACCESSLOGINDEX=2\">set to 2</A>");
  if (-e $tmpfn) {
    $xBug->("<A HREF=\"$myURL?ZAPACCESSLOG=2\">zap $tmpfn</A>");
  }
  my $zapFlag = 0;
  if (exists($main::cline{'ZAPACCESSLOG'})) {
	  unlink $tmpfn;
	  $xBug->("unlink $tmpfn");
	  delete $main::cline{'ZAPACCESSLOG'};
	  $xBug->("Zapped! $tmpfn $!");
          $zapFlag = 1;
  }
  my $accesslogFilename = 'access.log';
  if (exists($main::cline{'ACCESSLOGINDEX'})) {
    my @logpaths = ('log/apache2/','/home/dbb/logs/','log/','/var/log/apache2/','/var/cgi-bin/log/','/var/log/');
    my $logpath = '/home/dbb/'; # helium
    my $foundFlag = 0;
    # my $pwdOut = `pwd` . `ls /var/log/apache2/`;
    for my $llogpath (@logpaths) {
      $accesslogFilename = $llogpath . 'access.log';
      if (!-e $accesslogFilename ) {
        $xBug->("Aw Fuuck! $! $accesslogFilename");
      }
      else       { $xBug->("Yay! $! $accesslogFilename"); 
                   $foundFlag = 1;  $logpath = $llogpath; last; }
    }
    if (!$foundFlag) { $xBug->("Zoot! $logpath"); return; }

    $xBug->("<A HREF=\"$myURL?DELETE=ACCESSLOGINDEX\">delete</A>");
    if (length($main::cline{'ACCESSLOGINDEX'})) {
      $accesslogFilename = $logpath . 'access.log.' . $main::cline{'ACCESSLOGINDEX'};
      if ((-e $tmpfn) && (!$zapFlag)) { $xBug->("$tmpfn in use!");  }
      else {
        if (-e $accesslogFilename) {
          $xBug->("ACCESSLOGINDEX set! $accesslogFilename ");
	  copy ($accesslogFilename, $tmpfn); 
        } # if
        else {
          if ($main::cline{'ACCESSLOGINDEX'} == 1) {
            $accesslogFilename = $logpath . 'access.log.' . $main::cline{'ACCESSLOGINDEX'};
            $xBug->("ACCESSLOGINDEX=1 set! $accesslogFilename -> $tmpfn ");
	    copy ($accesslogFilename, $tmpfn); 
          } else {
            $accesslogFilename = $logpath . 'access.log.' . $main::cline{'ACCESSLOGINDEX'} . '.gz';
            if (-e $accesslogFilename) {
              $xBug->("unzip this, bud! $accesslogFilename to $tmpfn ");
              system("gunzip -c $accesslogFilename > $tmpfn");
	    } else {
              $xBug->("gzip file not found!! $accesslogFilename ");
              return; # right?  dbb 2022-11-26
              system("gunzip -c $accesslogFilename > $tmpfn");
              # if (!-e $tmpfn) { return; }
	    }
	  }
        } # else
      } # else
      $accesslogFilename = $tmpfn;
    } # elsif
    # $accesslogFilename = 'access.log';
    my @ftpinfo;
    my $counter = 1;
    my $deBug   = \&Nothing;
    $xBug->("\n\nChecking $accesslogFilename");
    $xBug = \&Nothing;
    if (-e $accesslogFilename) {
      if (open ACCESSLOGFILE, "<", "$accesslogFilename") {
        $xBug->("$accesslogFilename Success!"); 
        local $/=undef;
        @ftpinfo = split(/\n/,<ACCESSLOGFILE>);
        my %replacement;
	foreach my $accessitem (@ftpinfo) {
		# $xBug->("$counter INFO: $accessitem");
	  $counter++;
          my @colinfo = split(/"/,$accessitem);
	  my @dateip  = split(/-/,$colinfo[0]);
	  my @resctrs = split(/ /,$colinfo[2]);
	  my $colcounter = 1;
	  $replacement{'IPsource'}              = $dateip[0] . " XXX $counter";
	  $replacement{'IPsource'}              = $dateip[0];
	  $replacement{'Extrastr'}  = &urlencode ($dateip[1] . ' ' . $colinfo[4]);
	  if ($replacement{'Extrastr'} eq '+++') {
		  $replacement{'Extrastr'} = '';
	  }
	  $replacement{'Datestr'}        = substr $dateip[2],   2;
	  $replacement{'Timezone'}       = substr $colinfo[0], -7, 5;
	  $replacement{'Request'}   = &urlencode(substr $colinfo[1],  0, -8);
	  $replacement{'HTTP'}      = &urlencode(substr $colinfo[1], -8);
	  $replacement{'Referer'}        = $colinfo[3];
	  $replacement{'ResponseCode'}   = $resctrs[1];
	  $replacement{'ResponseLength'} = $resctrs[2]; # ignored dbb 22/11/13 # . $colinfo[6];
	  $replacement{'UserAgent'} = &urlencode($colinfo[5]);
	  # $xBug->(" @{[ %replacement ]} ");
	  my $tableEnable = 1;
	  $xBug->("<TABLE><TR><TD>")                          if ($tableEnable);
	  # --------------------------------------------
	  my $fields = '( ';
	  my $values = '( ';
	  my $first  = 1;
	  my $where  = ' ';
	  foreach my $key (sort keys(%replacement)) {
	    $xBug->("$key </TD><TD>$replacement{$key}</TD></TR><TR><TD>")
	                                                    if ($tableEnable);
            if (exists($replacement{$key})) {
	      if ($first) { $first = 0; }
	      else { $fields .= ', '; $values .= ', '; $where .= ' AND '; }
	      $where .= "$key LIKE '$replacement{$key}'";
              $fields .= $key;
	      $values .= '"' . $replacement{$key} .'"';
            } # if defined
	  } # foreach table key and value, create sql query parts
	  $fields .= ')';
	  $values .= ')';
	  $where  .= '';
          $xBug->("</TD></TR></TABLE>")                     if ($tableEnable);
	  foreach my $colitem (@colinfo) {
            $xBug->(".$colcounter : $colitem");
	    $colcounter++;
          } # foreach
	  # --------------------------------------------
	  if (exists($main::cline{'recentAccessTableName'})) {
	    my $sql = "INSERT INTO $main::cline{'recentAccessTableName'} $fields VALUES $values;";
            my $xsql = "SELECT Count(*) from $main::cline{'recentAccessTableName'} WHERE $where;";
            $xBug->($xsql);
            my $resulting = &sendMysqlQuery($xsql,$deBug);
            my $jinfo     = pop @queryResultFile;
	    my $limit     = 0;
            print '.'; # debug?
            if (defined($jinfo))     {
	      $xBug->("jinfo ++ $jinfo");
	   # not numeric? $limit = $jinfo - 1; if ($limit < 0) { $limit = 0; }
	      if ($limit) {
                $sql = "DELETE FROM $main::cline{'recentAccessTableName'}
	                	WHERE $where LIMIT $limit;";
	      }
	      if ($jinfo ne "1,") {
                # $xBug->($sql);
                $resulting = &sendMysqlQuery($sql,$deBug);
                $jinfo     = pop @queryResultFile;
                if (defined($jinfo))     {  $xBug->("jinfo + $jinfo"); }
	   	else { $xBug->("jinfo X"); }
	      }
	    } else { $xBug->("jinfo X"); } # not defined
	  } # if exists($main::cline{'recentAccessTableName'})
	  #  if (my $errstr = DBI->errstr) { $xBug->( "HEY 6 BUDDY! $errstr"); } # if
        } # foreach
        close ACCESSLOGFILE;
        # unlink $accesslogFilename;
      } else { $xBug->("Failed to open $accesslogFilename"); }
    } else {   $xBug->("$accesslogFilename not found!"); }
  } else { $xBug->("<A HREF=\"$myURL?ACCESSLOGINDEX=\">create</A>"); }
  $xBug->("<A HREF=\"$myURL\">$ENV{'SERVER_NAME'}</A>");
} # AccessLogChecking

  # ------------------------------------------------------------------------------
sub showThisAndThat {
  if (exists($main::cline{'CountryOfOrigin'})) {
    &tBug("CountryOfOrigin $main::cline{'CountryOfOrigin'}"); # R X
  }
  my $result                = &htmlEnvTable;
  &pBug($result,'dvx9');
  &pBug(&linkBand);
  $main::cline{'SHOWstate'} = 'off';
  $main::cline{'SHOWENV'}   = 'off';
  $main::cline{'debug'}     = 'off';
  delete $main::cline{'SHOWstate'};
  delete $main::cline{'SHOWENV'};
  delete $main::cline{'debug'};
  &showSTATE     if (exists($main::cline{'SHOWstate'}));
  &showEnvTable  if (exists($main::cline{'SHOWENV'}));
  &debugLinks; # if (exists($main::cline{'debug'}));
  &AccessLogChecking;
} # showThisAndThat

  my %ipaddressResults;
  my $buggy0 = 1;
  my $buggy1 = 0;
  my $buggy2 = 0;
  my $buggy3 = 1;
  my $buggy4 = 1;
  my $buggy5 = 1;
  my $k      = 0;

  # ------------------------------------------------------------------------------
sub extractIPfromAccessLog {
    my $xBug        = \&sBug;
    my $logFilename = shift @_;
    if (-e $logFilename) {
       $xBug->(" YXZ!   $logFilename ++++++++++ dealWithAccessLog +++++++++++++++++");
#      if (open DBFILE, $logFilename) { print <DBFILE>; close DBFILE; }
       my @ftpinfo;
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
       if (open FTPFILE, "<",  $logFilename) {
         foreach my $infoitems (<FTPFILE>) {
           push @ftpinfo, [split(/"/,$infoitems)];
         } # foreach
         close FTPFILE;
         $xBug->("<TABLE>")                                              if ($buggy1);
         $xBug->("<TR>")                                                 if ($buggy1);
         for (my $j = 0; $j < 8; $j++) {
           $xBug->('<TH>' . $j . '</TH>')                                if ($buggy1);
         }
         $xBug->("</TR>")                                                if ($buggy1);
         for (my $i = 0; $i < $#ftpinfo; $i++) {
           my @accessParts = split(/-/,$ftpinfo[$i][0]);
           my @resultParts = split(/ /,$ftpinfo[$i][2]);
           $xBug->("<TR>")                                               if ($buggy1);
           $xBug->('<TD>' . $accessParts[0] . '</TD>')                   if ($buggy1);            # ip address  
           $xBug->('<TD>' . $accessParts[2] . '</TD>')                   if ($buggy1);            # date-time     
           $xBug->('<TD>' . $accessParts[3] . '</TD>')                   if ($buggy1);            # time-zone
           $xBug->('<TD>' . $ftpinfo[$i][1] . '</TD>')                   if ($buggy1);            # request

           $xBug->('<TD>' . $resultParts[1] . '</TD>')                   if ($buggy1);            # result
           $xBug->('<TD>' . $resultParts[2] . '</TD>')                   if ($buggy1);            # bytes returned
           $xBug->('<TD>' . $ftpinfo[$i][3] . '</TD>')                   if ($buggy1);            # referer
           $xBug->('<TD>' . $ftpinfo[$i][5] . '</TD>')                   if ($buggy1);            # agent
           my $ipaddressHash = &rtrim($accessParts[0]);
           SWITCH: for ($resultParts[1]) { # https://developer.mozilla.org/en-US/docs/Web/HTTP/Status/400
             /200/ && do {
               $ipaddressResults{$ipaddressHash} |= 1;
               last SWITCH;
             };
             /20[1-6]/ && do {
               $ipaddressResults{$ipaddressHash} |= 2;
               last SWITCH;
             };
             /30[0-8]/ && do {
               $ipaddressResults{$ipaddressHash} |= 128;
               last SWITCH;
             };
             /4[0-5][0-9]/ && do {
               $ipaddressResults{$ipaddressHash} |= 256;
               last SWITCH;
             };
             /5[0-1][0-9]/ && do {
               $ipaddressResults{$ipaddressHash} |= 512;
               last SWITCH;
             };
             $ipaddressResults{$ipaddressHash} *= -1; # result not recognised
           } # switch
           $xBug->('<TD>' . $ipaddressResults{$ipaddressHash} . '</TD>') if ($buggy1);   # encoded-result
           $xBug->("</TR>")                                              if ($buggy1);
         } # for each line in the input file
         $xBug->("</TABLE>")                                             if ($buggy1);
       }
    }
} # extractIPfromAccessLog

  # ------------------------------------------------------------------------------
sub dealWithAccessLog {
  my $xBug        = \&xlogBug;
  $xBug           = \&cBug; # W R
  $xBug->("unleashed! dealWithAccessLog");
 # return; # dbb 2/3/2021
  my $htaccessHeaderText = 'DirectoryIndex simple.cgi
Options +Includes +ExecCGI
AddHandler cgi-script .cgi
AddType application/octet-stream avi
AddType application/octet-stream dll
AddType application/octet-stream exe
AddType application/octet-stream gif
AddType application/octet-stream jpg
AddType application/octet-stream mny
AddType application/octet-stream zip
AddType application/x-httpd-perl pl
AddType application/x-javascript js
AddType text/css css
AddType text/plain pl
Limit GET>
order deny,allow';
  my $htaccessTailText = '/Limit>
RewriteEngine on
RewriteRule ^contactus.sc$ simple.cgi
RewriteRule ^login.sc$ simple.cgi
RewriteRule ^main.sc$ simple.cgi
RewriteRule ^register.sc$ simple.cgi
RewriteRule ^resume001.html$ simple.cgi
RewriteRule ^resume.html$ simple.cgi
RewriteRule ^resume.htm$ simple.cgi
RewriteRule ^viewcart.sc$ simple.cgi
ErrorDocument 302 https://www.baidu.com
ErrorDocument 400 https://www.baidu.com
ErrorDocument 403 https://www.baidu.com
ErrorDocument 404 https://www.baidu.com
ErrorDocument 500 https://perl.org';
  my $authlogFilename = 'auth.tmp';
  my %authloginfo;
  my $searchPattern  = '([0-9][0-9]*\.[0-9][0-9]*\.[0-9][0-9]*\.[0-9][0-9]*)';
  my $searchPattern3 = '([0-9][0-9]*\.[0-9][0-9]*\.[0-9][0-9]*\.)[0-9][0-9]*';
  my @outputStack; # place to push IP addresses for tentative output, duplicate3 subject to pop
  if (0) { # if (open AUFILE, "<",  $authlogFilename) {
    foreach my $infoitem (<AUFILE>) {
      if ($infoitem =~ /$searchPattern/) {
        $authloginfo{$1}++;
        $ipaddressResults{$1} |= 2048;
      }
    } # foreach
    close AUFILE;
    $xBug->("<TABLE>")                              if ($buggy0);
    for my $ipItem (sort keys %authloginfo) {
      $xBug->("<TR>")                               if ($buggy0);
      $xBug->("<TD>sshd: $ipItem</TD>")                   if ($buggy0);
     # $xBug->("<TD>$authloginfo{$ipItem}</TD>")     if ($buggy0);
      if (0) {
        my $sql           = "SELECT Content from SUBMITlog where sourceName like '$ipItem';";
        my $result        = &sendMysqlQuery($sql,\&xlogBug);   &xlogBug("dealWithAccessLog Mark this place! ");
        my $querycsv      = pop @queryResultFile;
        my $searchPattern = '"country": "([A-Z][A-Z])"';
        if ($result =~ /$searchPattern/) {
          $xBug->("<TD>$1</TD>")                    if ($buggy0);
        }
      }
      $xBug->("</TR>")                              if ($buggy0);
    } # for each ip
    $xBug->("</TABLE>")                             if ($buggy0);
  } # if open authlog
#  return;
#
  my $errorlogFilename = 'error.log';
  my %errorloginfo;
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  if (open ELFILE, "<",  $errorlogFilename) {
    foreach my $infoitem (<ELFILE>) {
      if ($infoitem =~ /$searchPattern/) {
        $errorloginfo{$1}++;
        $ipaddressResults{$1} |= 1024;
      }
    } # foreach
    close ELFILE;
    $xBug->("<TABLE>")                              if ($buggy3);
    for my $ipItem (sort keys %errorloginfo) {
      $xBug->("<TR>")                               if ($buggy3);
      $xBug->("<TD>$ipItem</TD>")                   if ($buggy3);
      $xBug->("<TD>$errorloginfo{$ipItem}</TD>")    if ($buggy3);
      if ($buggy3) {
        my $sql           = "SELECT Content from SUBMITlog where sourceName like '$ipItem';";
        my $result        = &sendMysqlQuery($sql,\&xlogBug);   &xlogBug("dealWithAccessLog Mark this place! ");
        my $querycsv      = pop @queryResultFile;
        my $searchPattern = '"country": "([A-Z][A-Z])"';
        if ($result =~ /$searchPattern/) {
          $xBug->("<TD>$1</TD>")                    if ($buggy3);
        }
      }
      $xBug->("</TR>")                              if ($buggy3);
    } # for each ip
    $xBug->("</TABLE>")                             if ($buggy3);
  } # if open errorlog
#
  if (exists($main::cline{'dealWithAccessLog'})) {
    my $threshold   = 127;
    my $logFilename = $main::cline{'dealWithAccessLog'};
    &extractIPfromAccessLog('access1.tmp');
    &extractIPfromAccessLog('access2.tmp');
    $xBug->("<TABLE>")                                              if ($buggy2);
    $xBug->("\n<pre>\n$htaccessHeaderText</pre>\n");
    my $previous;
    my $gotInfo = 0;
    for my $someIPaddress (sort keys %ipaddressResults) {
      $xBug->("<TR>")                                               if ($buggy2);
      $xBug->('<TD>' . $someIPaddress . '</TD>')                    if ($buggy2);
      $xBug->('<TD>' . $ipaddressResults{$someIPaddress} . '</TD>') if ($buggy2);
      $xBug->("</TR>")                                              if ($buggy2);
      if ($ipaddressResults{$someIPaddress} > $threshold) {
        if ($gotInfo) {
          my $sql           = "SELECT Content from SUBMITlog where sourceName like '$someIPaddress';";
          my $result        = &sendMysqlQuery($sql,\&xlogBug);   &xlogBug("dealWithAccessLog Mark this place! ");
          my $querycsv      = pop @queryResultFile;
          my $searchPattern = '"country": "([A-Z][A-Z])"';
          my $sflag         = ' ';
          if (exists($errorloginfo{$someIPaddress})) {                $sflag = '*';               }
          if (defined($previous) && ($gotInfo)) {
            my $somePattern3 = '([0-9][0-9]*\.[0-9][0-9]*\.[0-9][0-9]*)\.[0-9][0-9]*';
            if ($previous =~ /$somePattern3/) {
              my $partPrevious = $1;
              if ($someIPaddress =~ /$partPrevious/) { $sflag .= '!!!'; }
            } else                                   { $sflag .= '$$$'; }
          } # if previous
          $previous = $someIPaddress;
          if ($result =~ /$searchPattern/) {
            $xBug->("$k dxny $ipaddressResults{$someIPaddress} from $someIPaddress $1 $sflag");
          } else {
            $xBug->("$k deny $ipaddressResults{$someIPaddress} from $someIPaddress $sflag");
          } # else
          if (exists($errorloginfo{$someIPaddress})) {               $sflag = '*';            }
          $k++;
        } # if $gotInfo
        else { # not gotInfo
          push @outputStack,"deny from $someIPaddress";
          if (defined($previous)) {
            if ($previous =~ /$searchPattern3/) {
              my $partPrevious = $1;
              if ($someIPaddress =~ /$partPrevious/) {
                my $discard = pop @outputStack;
                $discard    = pop @outputStack;
                push @outputStack,"deny from $partPrevious";
              }
            }
          } # if previous
          $previous = $someIPaddress;
        }   # $gotInfo
      } # if threshold
      elsif ($ipaddressResults{$someIPaddress} < 0) {
        $xBug->("OddBall! $k $someIPaddress"); $k++;
      }
#      else { $xBug->("deny from $someIPaddress"); }
      $xBug->("</TABLE>")                                             if ($buggy2);
    } # for
    for my $item (@outputStack) { $xBug->($item); }
    $xBug->("\n<pre>\n$htaccessTailText</pre>\n");
  } else {
    $xBug->(" ++++++++++ Not happening! dealWithAccessLog +++++++++++++++++");
  }
} # dealWithAccessLog

  # ------------------------------------------------------------------------------
sub dealWithProcmailLog {
  my $xBug        = \&xlogBug;
  # my $xBug           = \&tBug; # R & X
  my $hourTime    = 3600; # seconds
  my $someTime    = $hourTime * 6; # hours
  if (exists($main::cline{'dealWithProcmailLog'})) {
    my $ticksToGo = $main::cline{'dealWithProcmailLog'} - $oneTime;
    my $logFilename = $volatile . 'dbb.log';
    if (-e $logFilename) {
      if ($main::cline{'dealWithProcmailLog'} < $oneTime) {
        $xBug->(" YXY!  $ticksToGo ++++++++++ dealWithProcmailLog +++++++++++++++++");
        my $newFilename = $volatile . 'p' . $oneFilename . '.log';
        rename $logFilename, $newFilename;
        &uploadAudioFile($newFilename,'plog',4);
        $main::cline{'dealWithProcmailLog'} = $oneTime + $someTime;
      } else {
        $xBug->(" PATIENCE! $ticksToGo $logFilename ++++++++++ dealWithProcmailLog +++++++++++++++++");
      }
    } else {
      $xBug->(" BOO!  $ticksToGo $logFilename ++++++++++ dealWithProcmailLog +++++++++++++++++");
      $main::cline{'dealWithProcmailLog'} = $oneTime + $someTime;
    }
#    $xBug->($logFilename);
#    $main::cline{'dealWithProcmailLog'} = 1; # any number less than onetime will do
  } else {
    $main::cline{'dealWithProcmailLog'} = $oneTime; # any number less than onetime will do
    $xBug->(" ++++++++++ dealWithProcmailLog +++++++++++++++++");
  }
} # dealWithProcmailLog

  # ---------------------------------------------------------------------------
my @MustNotZap    = ('.htaccess',$CSSreference,'archives'); # no erasing these
sub archiveBackupVersionFile {
  my $basefilename  = shift @_;
  my $thisfilename  = shift @_;
  my $fileVersion   = shift @_;
  my $fileExtension = shift @_;
  my $xBug          = shift @_;
  my @annointedOnes = ('patricia','gillian','francine','justine','Laurel','Jean-PC'); # these hosts don't need Annointed=1
  if (!defined($xBug)) { $xBug = \&xlogBug; }
#
  &xlogBug(" --------- archiveBackupVersionFile  thisfilename $thisfilename");
  if (defined($thisfilename) && defined($basefilename)) {
    if ($thisfilename eq 'usr/bin/su') {
       &xlogBug(" archiveBackupVersionFile  thisfilename $thisfilename");
       return;
    }
    if (defined($fileVersion)) {
      if ($fileVersion =~ /[0-9]\.([0-9]*[a-z])/) {
        my $versx                = $basefilename . '-' . $1 . $fileExtension;
        my $savedVersionFilespec = $varchive . $versx;
        if (-e $savedVersionFilespec) {
          $xBug->("Already exists $savedVersionFilespec");
          # push @MustNotZap,$savedVersionFilespec;
        } else {
          if (in { $main::cline{'HOSTNAME'} eq $_ } @annointedOnes) {
            my $systemCommand = "cp $thisfilename $savedVersionFilespec";
            &xlogBug(" archiveBackupVersionFile systemCommand1 $systemCommand");
            # system($systemCommand);
            &xlogBug(" # + + + + + + + + + + + + + + + + + + + + + + + + +");
            if (copy($thisfilename,$savedVersionFilespec)) {
              $xBug->(" archiveBackupVersionFile Success! $thisfilename,$savedVersionFilespec");
            }
            else {
              $xBug->(" archiveBackupVersionFile some extra $! $thisfilename extra screwup");
            }
            # $xBug->(" archiveBackupVersionFile $systemCommand \n Created by ordinary Annointment $savedVersionFilespec");
          } elsif (exists($main::cline{'Annointed'})) {
            if (-e $thisfilename) {
              &xlogBug(" # + + + + + + + + + + + + + + + + + + + + + + + + +");
              if (copy($thisfilename,$savedVersionFilespec)) {
                &StateMessage("some other screwup: $thisfilename,$savedVersionFilespec"); 
              }
              $xBug->(" archiveBackupVersionFile \n Created by special Annointment $savedVersionFilespec");
            } else { $xBug->("$thisfilename NOT FOUND!!"); }
          } elsif (exists($main::cline{'dealWithProcmailLog'})) {
            my $systemCommand = "cp $thisfilename $savedVersionFilespec";
#            $xBug->("Thinking about $versx $basefilename $fileVersion");
            my $createdTag = 'Saved-' . $basefilename;
            if (exists($main::cline{$createdTag})) {
               if ($main::cline{$createdTag} ne $fileVersion) {
                 &xlogBug(" archiveBackupVersionFile systemCommand3 $systemCommand");
                 # system($systemCommand);
                 my $attempt = "$thisfilename to $savedVersionFilespec (archiveBackupVersionFile)";
                 &xlogBug("    # + + + + + + + + + + + + + + + + + + + + + +");
                 if (copy($thisfilename,$savedVersionFilespec)) {
                   &StateMessage("Copied $attempt"); }
                 else                                           {
                   &StateMessage("Failed copy $attempt");
                 }
                 $main::cline{$createdTag} = $fileVersion;
               } # else we do nothing, since the version hasn't changed; so the file doesn't get uploaded
            } else {
              &xlogBug("archiveBackupVersionFile systemCommand4 $systemCommand");
              my $attempt = "$thisfilename to $savedVersionFilespec (archiveBackupVersionFile)";
              &xlogBug("    # + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +");
              if (copy($thisfilename,$savedVersionFilespec)) { &StateMessage("Copied $attempt"); }
              else                                           { &StateMessage("Failed copy $attempt"); }
              $main::cline{$createdTag} = $fileVersion;
            }
#            $xBug->("$systemCommand \n $main::cline{$createdTag} \n Saved by FTP $savedVersionFilespec");
            &uploadAudioFile($savedVersionFilespec,'archiv3a',0);
          } else { $xBug->("Not annointed $main::cline{'HOSTNAME'} to create $savedVersionFilespec"); }
          push @MustNotZap,$savedVersionFilespec;
        } # else
        $sourceLink = "\/archives\/$versx";
      } else {        $xBug->("archiveBackupVersionFile $fileVersion fileVersion FAILED!");      }
    } else {      $xBug->("archiveBackupVersionFile undefined FAILED!");    }
  } else {      $xBug->("archiveBackupVersionFile undefined thisfilename FAILED!");    }
} # archiveBackupVersionFile

  # ----------------------------------------------------------------------
sub decideOnFilenamesForArchives { # creates filename parts used to construct the archiving scheme
  my $rawfilename  = shift @_;
  my $thisfilename = shift @_; # actually a reference to 
  my $basefilename = shift @_; # actually a reference to 
#
  if    ($rawfilename =~ /archives\/(.*)/)    { $$thisfilename = $1; } # extract part without leading slash
  elsif ($rawfilename =~ /\/(.*)/)            { $$thisfilename = $1; } # extract part without leading slash
  else                                        { $$thisfilename = $rawfilename; }
#
  if    ($rawfilename =~ /archives\/(.*)\./)  { $$basefilename = ucfirst $1; } # extract part without leading slash
  elsif ($rawfilename =~ /\/(.*)\./)          { $$basefilename = ucfirst $1; } # extract part without leading slash
  else                                        { $$basefilename = __PACKAGE__; }
} # decideOnFilenamesForArchives

  # ------------------------------------------------------------------------------
sub backupThisVersionUnlessItIsAnArchive {
  my $rawfilename  = shift @_;
  my $thisfilename = shift @_;
  my $basefilename = shift @_;
  my $version      = shift @_;
  my $extension    = shift @_;
  my $xBug         = shift @_;    if (!defined($xBug)) { $xBug = \&StateMessage; }
  $xBug         = \&xlogBug;
  $xBug->(" ------------------ myVersionString ---------------- ");
#
#  &StateMessage("raw:  $rawfilename");
#  &StateMessage("this: $thisfilename");
#  &StateMessage("base: $basefilename");
#  &StateMessage("ext:  $extension");
  if ($rawfilename =~ /archives/) {
    $xBug->("myVersionString archive version running $rawfilename!");
  } else {
    &archiveBackupVersionFile($basefilename, $thisfilename, $version, $extension, $xBug);
  } # we can save this version because we are not running from archive directory,
} # backupThisVersionUnlessItIsAnArchive

  # ------------------------------------------------------------------------------
sub myVersionString {
  my $xBug = \&xlogBug; # X
  my ($basefilename, $thisfilename, $rawfilename,$version) = ('noext','albert.pl','echo.pl','0.00a'); # obviously wrong...
#
  $rawfilename = __PACKAGE__ . '.pm';  # we determine who we are, either from command line or http request
#
#   We compute the filenames, assuming we are called from shell
#
  &decideOnFilenamesForArchives($rawfilename, \$thisfilename, \$basefilename);
#
  $version = "$thisfilename v$__PACKAGE__::versionNumber";  # includes filename of this script
  if (exists($main::cline{'version'})) {
    $version .= ' (' . $main::cline{'version'} . ') ';
    # $version .= ' (' . $main::cline{'WillyVersion'} . ') ';
  } # willy version was saved
  if (exists($ENV{'SERVER_NAME'}))            { $version           .= ' ' . $ENV{'SERVER_NAME'}; }
  else                                        { $ENV{'SERVER_NAME'} = 'wtf26.site'; }
#
  &backupThisVersionUnlessItIsAnArchive($rawfilename, $thisfilename, $basefilename, $__PACKAGE__::versionNumber, '.pm', $xBug);
#
#   Then We again compute the filenames, this time assuming we are called from Apache
#
  if (defined($main::versionNNumber)) {
    if (exists($ENV{'SCRIPT_NAME'}))        { 
      $rawfilename = $ENV{'SCRIPT_NAME'};
      &decideOnFilenamesForArchives($rawfilename, \$thisfilename, \$basefilename);
    } elsif (exists($ENV{'SUDO_COMMAND'}))  { 
      $rawfilename = $ENV{'SUDO_COMMAND'};
      &decideOnFilenamesForArchives($rawfilename, \$thisfilename, \$basefilename);
    } elsif (defined($ARGV[0]))    { 
      $rawfilename = '/' . $0; # the call to this program
      $xBug->("2b. myVersionString rawfilename $rawfilename");
      &decideOnFilenamesForArchives($rawfilename, \$thisfilename, \$basefilename);
    } elsif (exists($ENV{'SERVER_NAME'}))        { 
      $rawfilename = $ENV{'SERVER_NAME'};
      $xBug->("myVersionString does exist SERVER_NAME");
      &decideOnFilenamesForArchives($rawfilename, \$thisfilename, \$basefilename);
    } else { $xBug->("myVersionString not exists SCRIPT_NAME"); }
    &backupThisVersionUnlessItIsAnArchive($rawfilename, $thisfilename, $basefilename, $main::versionNNumber, '.pl', $xBug);
  } else { $xBug->("myVersionString  * $version  * No Version??"); } # not defined main::versionNumber
#
  &textJigtest; # depends on parseSkimmedText being a filename in /var/cgi-bin/skimmed
  # &processClineKeys;
#
  return $version;
} # myVersionString

  # ------------------------------------------------------------------------------
sub closeHTMLOUTPUT {
  if ($QHTMLopened) {
    print QOUTPUT "</body></html>\n";
    close QOUTPUT;
    $QHTMLopened = 0;
  } # if QOUTPUT
  if ($HTMLopened) {
    print HTMLOUTPUT "</body></html>\n";
    close HTMLOUTPUT;
    $HTMLopened = 0;
    print XFILE "All done!!\n";
  } # if HTMLopened
} # closeHTMLOUTPUT

# ----------------------------------------------------------------------------
sub EssentialWrapUp {
  &xlogBug(" EssentialWrapUp ");
  my $message      = shift @_; if (!defined($message)) { $message = 'This should never happen!'; }
  my $hastaLaVista = "$message</body>\n</HTML>\n";
  &uBug($hastaLaVista);
  &pBug(&linkBand);
  &writestate;
  &closeHTMLOUTPUT; # /body /html, closes filehandle
 # return; # dbb 3/12/2021
  my $fromspec = $volatile . $resultsFilename;
  my $tospec   = $basePath . $resultsFilename;
  my $attempt   = "$fromspec to $tospec";
  &xlogBug("    # + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +");
  if (copy($fromspec,$tospec)) {
    if (chmod($fileRWXmode,$tospec)) {
      &xlogBug("success EssentialWrapUp $attempt ");
    } else {
      &xlogBug("half success EssentialWrapUp $attempt ");
    }
  }
  else                         { &xlogBug("Aw fuck! $attempt"); }
  STDOUT->autoflush(1);
} # EssentialWrapUp
my $shutdownProcedure = \&EssentialWrapUp; # exit via SIG

  # ------------------------------------------------------------------------------
  # --- from https://stackoverflow.com/questions/28349632/perl-get-directory-size-without-find-or-du
  # ----------------------------------------------------------------------
sub dir_size {  
  my ($dir) = @_;
  my $size  = 0;
  if (defined($dir)) {
    if (opendir my ($dh), $dir) {
      while (my $node = readdir $dh) {
        next if $node =~ /\A\.\.?\z/;
#
        my $fullname = "$dir/$node";
        stat $fullname;
#
        if    ( -f _ ) {          $size += -s _;                     }
    #    elsif ( -d _ ) {          $size += dir_size($fullname);      }
    #        &xlogBug("dir_size $dir $size $fullname $node");
      } # while
    } # if
  } else {
    &StateMessage("dir_size $size directory not defined!");
  }
  &xlogBug("dir_size $size");
  return $size;
} # dir_size

  # --------------------------------------------------------------------------
sub limitDirectorySize { # delete a few of the oldest files, if the directory is overweight
  my $some_dir        = shift @_;
  my $ldz             = shift @_;
  my $overWeight      = shift @_;
  my $xBug            = \&xlogBug;
  my $result          = 'nuthin.'; # overwritten below
  if (!defined($some_dir)) { $some_dir = $volatile . 'mimemail/'; }
  $result             = "limit: somedir is $some_dir";
#
  my @filesToZap;
  if (opendir(DIR, $some_dir)) {
    my @dir            =  readdir(DIR);
    if (@dir) {
    $xBug->("some_dir: $some_dir");
    @filesToZap = sort { -M "$some_dir/$b" <=> -M "$some_dir/$a" } (@dir); # sort by modification time
    } # if directory not empty
    closedir(DIR);
  } # if opendir
#
  # my $DirectorySize   = &dir_size($some_dir); # initialize: we keep track of directory size as we delete files
  my $DirectorySize   = $ldz; # initialize: we keep track of directory size as we delete files
  $result            .= "dir size $DirectorySize overWeight $overWeight\n"; # justification for deleting files
  my $loopCtr         = 0;
  my $maxFileToZap    = int ( rand(8)) +10; # dbb 240405
  # $maxFileToZap    = 2; # dbb 240405
  my $latestDeletedHTML; # saves the name of the HTML file last deleted = $filesToZap[$loopCtr];
#
         # and now we can delete the file, unless is it somehow special
  while (($loopCtr < $#filesToZap) && ($maxFileToZap--)) {
    my $thisOne       = $filesToZap[$loopCtr];
    $loopCtr++;
    if (in { $thisOne eq $_ } @MustNotZap) { next; }
    else {
      my $ftpAndZapFilename = $some_dir . $thisOne;
      &uploadAudioFile($ftpAndZapFilename,'archiv3b',3); # deletes this file
    #  $result        .= "Zapping: $thisOne $! \n";
      if ($thisOne =~ /(r[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9].html)/) {
        $latestDeletedHTML = $1;
      } # we need this filename because we know the next file in the list points to this deleted file
    } # else we found a file we can safely delete
  } # while deleting
  return $result;
} # limitDirectorySize

  # ------------------------------------------------------------------------------
sub PlayX { # http://192.168.0.14?overWeight=20000000
            # assigns global variable $targetDirectory
            # then checks that directory for total size,
            # and if it exceeds the 'overWeight' size, then
            # assigns 'limitDirectorySize', which is used later as a flag
            # to ftp and delete the oldest files in that directory.
            # --------------------------------------------------------------------
  if    (exists($ENV{DOCUMENT_ROOT})) { $targetDirectory = $ENV{DOCUMENT_ROOT} . '/archives/'; }
  elsif (exists($ENV{PWD}))           { $targetDirectory = $ENV{PWD} . '/archives/'; }
  if (!defined($targetDirectory)) {
    $targetDirectory                   = 'archives/';
  }
#
  my $overWeight                       = 585000; # most number of bytes allowed in this directory
  if (exists($main::cline{'overWeight'})) {
    $overWeight                        = $main::cline{'overWeight'};
  }
  else {
    $main::cline{'overWeight'}         = $overWeight;
  } # else overWeight
  my $s                                = dir_size($targetDirectory);
  my $result                           = "all is well: $s vs $overWeight";
  if ($s > $overWeight) {
    $result                            = 'overweight!';
    $main::cline{'limitDirectorySize'} = $s;
  }
  return $result;
} # PlayX

# ----------------------------------------------------------------------------
sub enforceLimitDirectory {
  my $discard = &PlayX; # assigns 'limitDirectorySize'
  if (exists($main::cline{'limitDirectorySize'})) {
    &StateMessage("limitDirectorySize flag set! $targetDirectory $main::cline{'limitDirectorySize'}");
    my $rresult = &limitDirectorySize($targetDirectory,$main::cline{'limitDirectorySize'},$main::cline{'overWeight'});
    &xlogBug($rresult); # not to main::cline...
    delete $main::cline{'limitDirectorySize'}; # delete flag set elsewhere
  } # if limitDirectorySize
} # enforceLimitDirectory 

# ----------------------------------------------------------------------------
sub StandardWrapUp {
  &sBug("\n $defaultBanner  --------------------------------------------!\n");
  &xlogBug(" StandardWrapUp ");
  &deleteItemsOnExitAndSaveTheRest;
  # if (defined($child)) { $child->join(); }
  &EssentialWrapUp(''); # output coming to an end, no message
  &enforceLimitDirectory;
  my $xBug        = \&xlogBug;
  my $findex = 0;
 # return;

         for my $Qptr (@zapQueue) {
           # $xBug->("YYay!! @{$Qptr}") if ($#{$Qptr} >= 0);
           if ($#{$Qptr} >= 0) {
  my $cdPath      = '/home/pi/ftp';
  my $someHost    = $ftpinfo[$findex][0];
  my $username    = $ftpinfo[$findex][1];
  my $password    = $ftpinfo[$findex][2];
  $xBug->("ftp-$findex $someHost $username $password");

  if (0) {
    my $ftp;
  # if (my $ftp = Net::FTP->new($someHost, Debug => 0)) {
    if ($ftp->login($username,$password) && $ftp->binary()) {
#      if ($ftp->cwd($cdPath)) {
#        $xBug->("skipping cd $cdPath");


         for my $getFilename (@{$Qptr}) {
               if ($ftp->put($getFilename)) {
#                 $xBug->("Yay. Put $getFilename");
                 if ($unlinkThisFile{$getFilename}) {
                   unlink $getFilename; # no longer needed here, right?
                   $xBug->("unlink $getFilename"); # no longer needed, right?
                 } # if
               } else { $xBug->("put failed $getFilename ", $ftp->message); }
         } # for

#      } else { $xBug->("Cannot change working directory $cdPath ", $ftp->message); }
    } else { $xBug->("Cannot login $someHost $username $password", $ftp->message); }
    $ftp->quit;
      } else {
          $xBug->("Cannot connect to $someHost: $@");
          for my $getFilename (@{$Qptr}) {
              my $fresult = `scp $getFilename pi@24.85.1.111:ftp`;
              $xBug->("securely uploaded! $fresult"); 
              unlink $getFilename; # no longer needed here, right?
              $xBug->("unlink(12) $getFilename"); # no longer needed, right?
          } # for  (@{$Qptr}) 
      }
    } # if ($#{$Qptr} >= 0)
    $findex++;
  } # for
  $xBug->("wrapped!");
} # StandardWrapUp

  # ------------------------------------------------------------------------------
sub response0HTMLbasic {
  my $pParameter = shift @_;
  my $pTagNum    = shift @_;
  my $didx       = 7;
  my $xBug       = \&tBug;
  if (exists($pParameter->{'docType'})) {
    $didx = $pParameter->{'docType'};
    $main::cline{'docType'} = $didx;
  } # if
#
  &incrementCounter('counter0');
  &print0HTMLheader($didx);
  $HTMLbody = 1; # let bBug output to STDOUT
  &uBug("<body>\n");
  my $black = &standardInfoHTML('response0HTMLbasic2',$xBug,'Sorry!');
  &pBug("Sorry. $black --  $pTagNum"); # R only
#
  &showThisAndThat;
  &incrementCounter('response0');
  &PlayBell;
#
  &tBug("response0HTMLbasic8");
  &StandardWrapUp;
} # response0HTMLbasic

  # --- from https://stackoverflow.com/questions/28349632/perl-get-directory-size-without-find-or-du
  # ----------------------------------------------------------------------
my %rFiles; # set of archive chain elements in the current archive directory
my %qFiles; # set of archive chain elements in the current archive directory
my $maxloops=3000;
sub zapqLink {
  my $filenumber = shift @_;
  # &sBug("$maxloops zapqLink: $filenumber");
  if (!$maxloops) { return; }
  $maxloops--; # belt and suspenders
  if (!$filenumber) { return; }
  if (exists($qFiles{$filenumber})) {
    &zapqLink($qFiles{$filenumber});
    delete($qFiles{$filenumber});
  } # if
} # zapqLink recursive!

  # ----------------------------------------------------------------------
sub zaprLink {
  my $filenumber = shift @_;
  # print '.';
  &sBug("zaprLink: $filenumber");
  if (!$maxloops) { return; }
  $maxloops--; # belt and suspenders
  if (!$filenumber) { return; }
  if (exists($rFiles{$filenumber})) {
    &zaprLink($rFiles{$filenumber});
    delete($rFiles{$filenumber});
  } # if
} # zaprLink recursive!

  # ----------------------------------------------------------------------
sub chainLinkHead {  
  my ($dir) = @_;
  my $size  = 0;
  my $debugLinks = 
  "<A HREF=\"http:\/\/10.0.0.77\">PATRICIA</A>" .
  "<A HREF=\"http:\/\/10.0.0.25\">BARBARA</A>";
  &sBug($debugLinks);
  if (defined($dir)) {
    if (opendir my ($dh), $dir) {
      while (my $node = readdir $dh) {
        next if $node =~ /\A\.\.?\z/;
#
        my $fullname = "$dir$node";
        stat $fullname;
#
        if ($node =~ /r([0-9]*)[.]html/) {
	  my $nTagnumber = $1;
          $qFiles{$nTagnumber}=0;
          $rFiles{$nTagnumber}=0;
          # &sBug("Halleujha! $nTagnumber $node $fullname");
          if (open(SFH,$fullname)) {
            my $linesread = 0;
            while (my $string = <SFH>) {
              $linesread++;
              if ($string =~ /r([0-9]*)[.]html/) {
                my $linkto = $1;
      #          if ($string !=~ /Archived/) { next; }
                my $ltFilename = 'archives/' . 'r' . $linkto . '.html';
                if (-e $ltFilename) {
                  if ($nTagnumber == $linkto) {
                    &sBug("Huh,really? nTagnumber $linkto");
                  } else {
                    $qFiles{$nTagnumber}=$linkto;
                    if (exists($rFiles{$linkto})) {
                      $rFiles{$linkto}=$nTagnumber;
                    }
                    else { $rFiles{$linkto}=9999999; }
        #            &sBug("$fullname $nTagnumber $linkto");
                  } # else
                  last;
                } # if ltFilename exists
                # else { $sBug("No file!"); }
              } # if we can identify a link-to filename
            } # while
            # &sBug("Lines read: $linesread $fullname");
            close (SFH);
          } # if we can open the archive file, sholud be able to
          else { &xlogBug("What the hell could be wrong?"); }
          # if    ( -f _ ) {          $size += -s _;                     }
        }
      } # while

      foreach my $key (sort keys %rFiles) {
        my $ltFilename = 'archives/' . 'r' . $key . '.html';
        my $htmlpart = "<A HREF=\"$ltFilename\">$ltFilename</A>";
        # &sBug("$key $rFiles{$key} $htmlpart");
        if (exists($qFiles{$key})) {
          if (exists($rFiles{$key})) {
             # &sBug("$key ----- $rFiles{$key} ---- $qFiles{$key}");
             &zapqLink($qFiles{$key});
          } # if
       #   if (!$rFiles{$key}) { delete $qFiles{$key}; }
       #   if (!$qFiles{$key}) { delete $qFiles{$key}; }
        } # if
      } # foreach
      # &sBug("<A HREF=\"http:\/\/$ENV{SERVER_NAME}\">PATRICIA</A>");
      &sBug($debugLinks);
      
      foreach my $key (sort keys %qFiles) {
        my $ltFilename = 'archives/' . 'q' . $key . '.html';
        my $dt  = strftime $stringFormat, localtime($key);
        my $htmlpart = "<A HREF=\"$ltFilename\">$ltFilename</A> $dt";
        &sBug("$key\t $qFiles{$key}\t $rFiles{$key}\t $htmlpart");
      } # foreach
    } # if
  } else {
    &StateMessage("dir_size $size directory not defined!");
  }
  # &sBug("<A HREF=\"http:\/\/$ENV{SERVER_NAME}\">PATRICIA</A>");
  &sBug($debugLinks);
  return $size;
} # chainLinkHead

  # ----------------------------------------------------------------------
sub response1HTMLbasic {
  my $pParameter            = shift @_;
  my $didx                  = 7;
  if (exists($pParameter->{'docType'})) {
    $didx                   = $pParameter->{'docType'};
    $main::cline{'docType'} = $didx;
  } # if
  my $xBug                  = \&sBug; # 
  my $yBug                  = \&tBug; # R & X
#
    $yBug->("starting response1HTMLbasic");
  &incrementCounter('counterBasic');
  &print1HTMLheader($didx,'Nothing to report');
  $HTMLbody             = 1; # let bBug output to STDOUT
  &uBug("<body>"); # formatting to STDOUT
  my $black = &standardInfoHTML('response1HTMLbasic2',$yBug,'You dont need this shit, dude!');
  if ($black) {
    $yBug->("BLACK $black");
    # $yBug->(&linkBand);
    $yBug->("response1HTMLbasic7");
    &StandardWrapUp;
    return;
  }
  else { $yBug->("WHITE!"); }
  $yBug->("response1HTMLbasic1");
     $yBug->("--------- etc! ------------");
  my $tstr = `/usr/bin/vcgencmd measure_temp`;
     $xBug->("--------- $tstr ------------");
     &recordItemSUBMITlog($main::cline{'HOSTNAME'},'TempuratureCPU',$tstr,$xBug,&nextClass);
     # look thru all files in archive, 
     #   collect time portion of filename from filename,
     #   time portion of linked-to filename from reading file,
     #   and create hashes forward and reverse, associate filename times;
     # for each hash which has no valid link-to, we build a reverse linked-list
     # we should end up with a set of linked-lists of archive filenames
     # and all files in current archive directory are accounted-for
     # The top of each linked-list is presented as a clickable link
     # for the user to start exploring records in the current archive.
    my $targetDirectory                   = 'archives/';
    my $s                                = &chainLinkHead($targetDirectory);
     $xBug->("--------- etc! $s ------------");
  &sendEmailAsRequired; 
#
  my $defaultRelocationURL = 'https://www.couchsurfing.com/events/6191871';
  if (exists($main::cline{'URL'}))              { $defaultRelocationURL = $main::cline{'URL'}; }
  if (exists($main::cline{'WindowRelocation'})) { &WindowRelocation($defaultRelocationURL); }
  if (exists($main::cline{'URL'})) {
   my $StevesURL             = $main::cline{'URL'};
   my $Steveston             = "<A HREF=\"$StevesURL\">Steveston</A>";
   my $msg                   = "<div>Amandine: click here for $Steveston tourist information.</div>\n";
   if (exists($main::cline{'PreviousVisits'})) {
     if ($main::cline{'PreviousVisits'} > 2) {
        $msg                 = "<h2>click here for $Steveston tourist information.</h2>\n";
     }
   }
   if (exists($main::cline{'showSteveston'})) {
     if ($main::cline{'showSteveston'}) {
       $xBug->($msg);
     }
   }
   my $msg1                  = "<div>The form and audio player below are part of a toy demo in development.</div>\n";
   # $xBug->($msg1);
  }
#
  &dealWithProcmailLog;
  &enableButton if (exists($main::cline{'enableButton'}) || (!exists($main::cline{'ENABLED'})));
  if (exists($main::cline{'playAudio'})) {
    if ($main::cline{'playAudio'}) {
      &showAudioTool($xBug);
    } # if
  } # if
  if (exists($main::cline{'showInputForm'})) {
    if ($main::cline{'showInputForm'}) {
      	$xBug->("-----  showAudioInputForm");
      	&showAudioInputForm(\&cBug);
    } # if
  } # if
  &showThisAndThat;
  &incrementCounter('response1');
  &PlayBell;
#
  $yBug->("response1HTMLbasic8");
  &StandardWrapUp;
} # response1HTMLbasic

  # ---------------------------------------------------------------------------
my $dmax = 1;
sub temperatureDelay {
  sleep 2;
  return;
  my $xBug = \&sBug;
    my $mtemp = `/usr/bin/vcgencmd measure_temp`;
    my $maxtemp = substr($mtemp,5,4);
        my @c = (1..$dmax); for (@c){ sleep(1); $xBug->("$_"); } # for
        my $temp = `/usr/bin/vcgencmd measure_temp`;
        my $tvalue = substr($temp,5,4);
        if ($tvalue > $maxtemp) {
           $dmax++; 
           $xBug->(" \nHi temp: $tvalue ($maxtemp)\n"); 
           $maxtemp += 0.3; sleep(10);
        } # if
        # sleep(1); $xBug->(" $temp $tvalue\n");
        # my $rightnow = `date`;
        my $rightnow = `uptime`;
        chomp $temp; # zap trailing newline
        $xBug->("\n $temp  ($maxtemp) $rightnow\n");
} # temperatureDelay 

  # ---------------------------------------------------------------------------
my $userid = $hostname . '-' . $__PACKAGE__::versionNumber;
my @fail2blacklist; # actually fail2blacklist
sub loadFail2blacklist {
  my $xBug = shift @_;
  my $result=0;
  my $fail2cmd  = 'sudo fail2ban-client status sshd';
  my $ssh  = ""; # use local fail2ban by default
  my $cName = 'fail2counter';
  if (exists($main::cline{$cName})) {
    $xBug->(" ********************** $cName: $main::cline{$cName} ********\n"); 
    if ($main::cline{$cName}++ & 1) {
      $ssh  = "ssh pi\@75.37.69.40";
    } else {
      $ssh  = "ssh pi\@24.85.1.111";
    }
  } else {
    $xBug->(" ********************** $cName NOT EXIST! ********\n"); 
    $main::cline{$cName} = 100;
  } # if exists counter
  my $fail2ssh  = "$ssh $fail2cmd";
  $xBug->("Checking $fail2ssh\n"); # debug dbb 8 Sept 24
  my $fail2list = `$fail2ssh`;
  @fail2blacklist = split (' ',$fail2list);
  $xBug->("\n"); 
  my $sheadza=36; # number of items to discard
  for my $sCounter (1..$sheadza) { 
    my $discard = shift @fail2blacklist;
  } # for each item to discard from blacklist
  return $result;
} # loadFail2blacklist 

  # ---------------------------------------------------------------------------
sub response2HTMLbasic {
  my $xBug = \&uBug; # stdout only
  my $pParameter = shift @_;
#
  &incrementCounter('counter2');
  &xlogBug("response2HTMLbasic4\n");
#
my $part0Content = '
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<HTML lang="en">
<HEAD>
<TITLE>Zheila has a secret desire</TITLE>
<meta http-equiv="refresh" content="1900; URL=http://wtf25.fun">

<meta http-equiv="Pragma"        content="no-cache" />
<meta http-equiv="Cache-Control" content="no-store, must-revalidate" />
<meta http-equiv="Content-Type"  content="text/html; charset=utf-8">
<link href="basic.css"
                                 rel="stylesheet" type="text/css" media=screen>
<meta name="theme-color"             content="#ffffff">
<meta name="msapplication-TileColor" content="#ffffff">
<meta name="msapplication-TileImage" content="/ms-icon-144x144.png">
<meta name="theme-color"             content="#ffffff">
<meta name="msapplication-starturl"  content="http://www.$webhost">
<meta name="msapplication-TileColor" content="#ffffff">
<meta name="msapplication-TileImage" content="/images/ms-icon-144x144.png">

<link rel="apple-touch-icon"     sizes="57x57"   href="/apple-icon-57x57.png">
<link rel="apple-touch-icon"     sizes="60x60"   href="/apple-icon-60x60.png">
<link rel="apple-touch-icon"     sizes="72x72"   href="/apple-icon-72x72.png">
<link rel="apple-touch-icon"     sizes="76x76"   href="/apple-icon-76x76.png">
<link rel="apple-touch-icon"     sizes="114x114" href="/apple-icon-114x114.png">
<link rel="apple-touch-icon"     sizes="120x120" href="/apple-icon-120x120.png">
<link rel="apple-touch-icon"     sizes="144x144" href="/apple-icon-144x144.png">
<link rel="apple-touch-icon"     sizes="152x152" href="/apple-icon-152x152.png">
<link rel="apple-touch-icon"     sizes="180x180" href="/apple-icon-180x180.png">
<link rel="icon"
          type="image/png"    sizes="192x192" href="/android-icon-192x192.png">
<link rel="icon" type="image/png"    sizes="32x32"   href="/favicon-32x32.png">
<link rel="icon" type="image/png"    sizes="96x96"   href="/favicon-96x96.png">
<link rel="icon" type="image/png"    sizes="16x16"   href="/favicon-16x16.png">
<link rel="manifest"                 href="/manifest.json">

<meta name="ROBOTS"                  content="INDEX, FOLLOW"/>
<meta name="byl"                     content="Daniel Brian Hayes"/>
<meta name="author"                  content="Daniel Brian Hayes"/>
<meta name="news_keywords"           content="BFbot Changes World"/>
<meta name="keywords"                content="travel dating"/>
<meta name="description"             content="BFbot searches the world"/>
<meta name="PT"                      content="article"/>
<meta name="PST"                     content="News"/>
<META HTTP-EQUIV="Expires"           CONTENT="-1">

<meta http-equiv="X-UA-Compatible"   content="IE=edge">
</HEAD>
<body>

<div class="dvx7">

<img src="thinrain.gif" alt="spawning fish"><BR>
<B>Brian seeks a low-maintenance
<A HREF="http://bf25.fun/gozheila.html"> <I>girlfriend</I></A>
</B>, age, race, geographic location of lesser importance.... <BR>
<img src="thinrain.gif" alt="spawning fish"><BR>
In pursuit of that objective, as well as vast wealth perhaps,<BR>
I aim to develop this website into a 
<A HREF="https://datingadvice.com/for-men/sites-like-backpage-and-craigslist-personals" -title="Thanks Robert for this link!">craigslist personals replacement.</A><BR>
My success requires your assistance.<BR>
<A HREF="test.pl" title="A secret desire">
<img src="result.jpg"><BR>
<img src="thinrain.gif" alt="spawning fish"><BR>
</A>
</div>

<div class="dvx0">
  <div id="form_container">
  <form id="form_0" class="appnitro"
            enctype="multipart/form-data"
             method="post" action="https://wtf25.fun/">
	<ul >
	<li id="li_4" >
	  <label class="description" for="element_4">Please write me a note including your contact information</label>
	  <div>
	    <textarea id="element_4" name="element_4a" 
                      class="element textarea medium" 
	              title="Write a short message and click Submit"
	              onClick="this.select();"
	              rows="10" cols="40">

	    </textarea> 
	  </div> 
	</li>
	<li id="li_5" >
	  <label class="description" for="element_5">Optionally upload a file
, preferably an image (anything else ignored) </label>
	    <div>
	      <input id="element_5" name="element_5a"
                     class="element file" type="file" /> 
	   </div>  
	</li>
	<li class="buttons">
		<input id="saveForm" class="button_text" type="submit"
		 name="submit" value="Submit"
		 title="Upload an audio file mp3/wav, or submit some text!" />
	</li>
</ul>
<input type="hidden" name="form_id" value="0" />
</form>	
</div>

<!-- 
// <img src="salmon.jpg" alt="spawning fish">
// end comment --> 

<!-- -- -- -- ---- -- -- ---- -- -- ---- -- -- -- -->

</body>
</HTML>
';
  my $filename       = 'latest.html';
  if (open GFILE, ">:utf8", $filename) {
    chmod $fileRWXmode, $filename;
    print GFILE $part0Content;
    close GFILE;
  } # if
  else { ; }
  if (-e $filename) {
      my $file_content = do{local(@ARGV,$/)=$filename;<>};
      my $presult = qq(Content-type: text/html\n);
      $xBug->("$presult$file_content");
  } else   { &xlogBug("filename $filename not found.");  }

  &tBug("response2HTMLbasic8");
  &StandardWrapUp; 
} # response2HTMLbasic

  my %blackHash;
  my %redlistHash;
  my %graylistHash;
  my %PingedHash;
  my %traceHash;
  my %geoipHash;
  my %geoloHash;
  my %nmapHash;

  # ---------------------------------------------------------------------------
my $zapCount = 0;
sub zapDuplicate {
  my $xBug           = shift @_;
  my $xtable         = shift @_;
  my $item           = shift @_;
  # my @excludeTables  = ('xnmap','xgeoip','xping','xtrace');
  my @excludeTables  = ('xgeoip','xping','xtrace');
  if (in { $xtable eq $_ } @excludeTables) { return; }
  $zapCount++;
  $xBug->("zapDup: $zapCount $xtable $item\n");
  if ($zapCount > 300) { return; }
  # sleep 1;
  my $zapsql = "DELETE FROM $xtable WHERE sourceName LIKE '$item' LIMIT 1;";
  $zapsql = '';
  my $hresulting     = &sendMysqlQuery($zapsql,$xBug);
  my $hquerycsv      = pop @queryResultFile;
  return (!defined($hresulting));
} # zapDuplicate

  # ---------------------------------------------------------------------------
sub loadHash {
  my $xBug           = shift @_;
  my $xtable         = shift @_; # 'xping';
  my $hashPtr        = shift @_ ; # \%PingedHash;
  my $hsql           = "SELECT sourceName FROM $xtable ORDER BY RAND();";
  my $hresulting     = &sendMysqlQuery($hsql,$xBug);
  my $hquerycsv      = pop @queryResultFile;
  my $result         = 1; # presume not ok
  if (defined($hresulting)) {
    $result         = 0; # presume ok
    if (defined($hquerycsv)) {
      my @Pingedaddresses = split (',',$hquerycsv);
      for my $item (@Pingedaddresses) {
        if (exists($hashPtr->{$item})) {
          $hashPtr->{$item}++;
          $result = &zapDuplicate($xBug,$xtable,$item);
        } else {
          $hashPtr->{$item}=1;
        } # else
      } # for each ip address in blacklist
    } else { $result = -2; } # else IP not found
    $xBug->("\n"); # HTML form with results of query
  } else { $result = -3; } # defined
  return $result;
} # loadHash 

  # ---------------------------------------------------------------------------
sub updateBlacklist {
  my $xBug           = shift @_;
  my $xitem          = shift @_; # 'xping';
  my $itemCommand    = shift @_; # 'ping -c 3';
  my $hashPtr        = shift @_ ; # \%PingedHash;
  my $numberOfItems  = shift @_; # number of enquiries to make
  my $likeContent    = shift @_; # Mapped or fail2ban 
  my $newContentFlag = shift @_;
  my $jsql  = "UPDATE blacklist SET
                                 Content='$newContentFlag',
                                 UserID='$userid'  WHERE sourceName LIKE '$xitem';";
  my $jresulting    = &sendMysqlQuery($jsql,$xBug);
  my $jquerycsv     = pop @queryResultFile;
  if (defined($jquerycsv)) { $xBug->("Updated:$jquerycsv"); }
  if (!defined($jresulting)) {
    $xBug->("1 Failure! lll\n"); 
    return 1;
  } # 2 BUDDY!
  return 0;
} # updateBlacklist

  # ---------------------------------------------------------------------------
  # to what extent to blacklist, graylist, and redlist overlap?
  # blacklist is collected by fail2ban upon fail ssh login
  # -rw-r--r-- 1 pi    pi       699289 Sep 22 17:24 blacklist.sql
  # graylist is all those ips referenced in output saved to archives
  # -rw-r--r-- 1 pi    pi       220528 Sep 22 17:26 graylist.sql
  # redlist ip addresses are drawn from /var/log/auth.log
  # -rw-r--r-- 1 pi    pi         4904 Sep 22 17:26 redlist.sql


sub checkGraylists {
  my $xBug           = shift @_;
  my $result=0; # presume error non-zero
  my $cHashPtr = \%redlistHash; # one compared-to
  my @ipaddresses = keys(%blackHash);

  my $isql  = "SELECT Count(*) FROM blacklist 
                         INNER JOIN redlist ON blacklist.sourceName = redlist.sourceName;";
  my $iresulting    = &sendMysqlQuery($isql,$xBug);
  my $iquerycsv     = pop @queryResultFile;
  if (defined($iresulting)) {
    $result=0; # all is well!
    # $xBug->("$iresulting\n"); # HTML form with results of query
    if (defined($iquerycsv)) {
      $xBug->("\n$iquerycsv\n"); # HTML form with results of query
    } # if
  } # if
  
  $isql  = "SELECT Count(*) FROM redlist 
                         INNER JOIN graylist ON graylist.sourceName = redlist.sourceName;";
  $iresulting    = &sendMysqlQuery($isql,$xBug);
  $iquerycsv     = pop @queryResultFile;
  if (defined($iresulting)) {
    $result=0; # all is well!
    # $xBug->("$iresulting\n"); # HTML form with results of query
    if (defined($iquerycsv)) {
      $xBug->("\n$iquerycsv\n"); # HTML form with results of query
    } # if
  } # if
  
  $isql  = "SELECT Count(*) FROM graylist 
                         INNER JOIN blacklist ON graylist.sourceName = blacklist.sourceName;";
  $iresulting    = &sendMysqlQuery($isql,$xBug);
  $iquerycsv     = pop @queryResultFile;
  if (defined($iresulting)) {
    $result=0; # all is well!
    # $xBug->("$iresulting\n"); # HTML form with results of query
    if (defined($iquerycsv)) {
      $xBug->("\n$iquerycsv\n"); # HTML form with results of query
    } # if
  } # if
  
  $isql  = "SELECT Count(*) FROM visitors 
                         INNER JOIN blacklist ON visitors.REMOTE_ADDR = blacklist.sourceName;";
  $iresulting    = &sendMysqlQuery($isql,$xBug);
  $iquerycsv     = pop @queryResultFile;
  if (defined($iresulting)) {
    $result=0; # all is well!
    # $xBug->("$iresulting\n"); # HTML form with results of query
    if (defined($iquerycsv)) {
      $xBug->("\n$iquerycsv\n"); # HTML form with results of query
    } # if
  } # if
  
  return $result; # 0 means all ok
} # checkGraylists

  # ---------------------------------------------------------------------------
sub enquiringMinds {
  my $xBug           = shift @_;
  my $xtable         = shift @_; # 'xping';
  my $itemCommand    = shift @_; # 'ping -c 3';
  my $hashPtr        = shift @_ ; # \%PingedHash;
  my $numberOfItems  = shift @_; # number of enquiries to make
  my $likeContent    = shift @_; # Mapped or fail2ban 
  my $newContentFlag = shift @_;
  if (!(defined($likeContent))) { $likeContent = 'Mapped'; }
  if (!(defined($numberOfItems))) { $numberOfItems = 1; }
# now check which items are already pinged, no need to do it again
  my $discard1 = &loadHash($xBug, $xtable, $hashPtr);
  if ($discard1) { return $discard1; } # error!
  my $result=1; # presume error non-zero

  # my $isql  = "SELECT sourceName FROM blacklist 
                          # WHERE Content LIKE '$likeContent' ORDER BY RAND() LIMIT $numberOfItems;";
  my $isql  = "SELECT sourceName FROM blacklist 
                         WHERE Content LIKE '$likeContent' ORDER BY RAND() LIMIT 100;";
  my $iresulting    = &sendMysqlQuery($isql,$xBug);
  my $iquerycsv     = pop @queryResultFile;

  if (defined($iresulting)) {
    $result=0; # all is well!
    $xBug->("\n"); # HTML form with results of query
    if (defined($iquerycsv)) {
      # $result       = 2; # IP is presumed not on whiteList
      my @ipaddresses = split (',',$iquerycsv);
      my $stateIndex=0;
      my $addedIndex=0;
      for my $item (@ipaddresses) {
        $stateIndex++;
        $xBug->("\n$stateIndex: $item\n");
        if (exists($hashPtr->{$item})) {
          $xBug->("Skipped $item!\n");
          $result = &updateBlacklist($xBug,
              $item, $itemCommand, $hashPtr, $numberOfItems, $likeContent, $newContentFlag);
          if ($result) { last; }
          next;
        } # we already did this one!
        $addedIndex++;
        if ($addedIndex > $numberOfItems) { last; }
#
        my $dping;
if (1) {
        $dping = `${itemCommand}${item}`;
} else {
        $dping = "NOTAPPLICABLE: ${itemCommand}$item";
} # if 1
#
        my $eping = &urlencode($dping);
        my $msql  = "INSERT INTO $xtable SET 
                              sourceName='$item',
                              UserID='$userid',
                              Content='$eping';";
        my $mresulting    = &sendMysqlQuery($msql,$xBug);
        my $mquerycsv     = pop @queryResultFile;
        if (defined($mquerycsv)) { $xBug->("Inserted:$mquerycsv"); }
         # if (defined($mresulting)) { $xBug->("\n (3) Resulting:$mresulting"); }
        if (!defined($mresulting)) {
           $xBug->("2 Failure! kkkk\n"); 
           $result += 1000;
           last;
           return $result;
        } # 2 BUDDY!

        $result = &updateBlacklist($xBug,
              $item, $itemCommand, $hashPtr, $numberOfItems, $likeContent, $newContentFlag);
        if ($result) { last; }
        &temperatureDelay;
      } # for each ip address in blacklist
    } else {
      $result += 10000; # IP not found
    } # else IP not found
  } else { $result += 100000; } # defined
  # if ($result) { $xBug->("enquiringMinds know NOTHING! $result\n"); }
  return $result; # 0 means all ok
} # enquiringMinds

  # ---------------------------------------------------------------------------
sub checkForNewBlacklistItems {
  my $xBug           = shift @_;
  my $stateIndex     = 0;
  my $result         = 0;
  $xBug->("\nLooking for new blacklist items\n"); # 
  my $discard2 = &loadHash($xBug,'blacklist',\%blackHash);
  if ($discard2) { return $discard2; } # error!

  for my $item (@fail2blacklist) {
    $stateIndex++;
    if (!exists($blackHash{$item})) {
      $xBug->("\n\nNew! $stateIndex: $item\n");
      my $jsql  = "INSERT INTO blacklist
                   SET Content='New',
                       sourceName='$item',
                       UserID='$userid';";
      my $jresulting    = &sendMysqlQuery($jsql,$xBug);
      my $jquerycsv     = pop @queryResultFile;
      if (defined($jquerycsv))  { $xBug->("Updated:$jquerycsv"); }
      if (defined($jresulting)) { $xBug->("\n (5) Resulting:$jresulting"); }
      else {
        $xBug->("1 Failure! kkk\n"); 
        $result += 10;
        return $result;
      } # 2 BUDDY!
      &temperatureDelay;
    } # if
  } # for
  return $result;
} # checkForNewBlacklistItems

# ---------------------------------------------------------------------------
sub delayedAction {
  my $xBug           = shift @_;
  my $hackID         = shift @_; # a unique, arbitrary name of the trigger timer
  my $someDelay      = shift @_; # the number of seconds to delay trigger
  my $code           = shift @_; # pointer to trigger code
  my $result         = 0;        # all ok
  my $triggerAction  = $main::cline{$hackID} < $oneTime;
  if (1) {
    if (exists($main::cline{$hackID})) {
      if ($triggerAction) {
	$code->($xBug);
        $main::cline{$hackID} = $oneTime + $someDelay;
      } # if Triggered!
      my $thisTime = `date --date \@$oneTime`;
      my $until    = `date --date \@$main::cline{$hackID}`;
      my $diffDiff  = $main::cline{$hackID} - $oneTime;
      my $diffHour  = int($diffDiff / 3600);
      my $diffShvd  = $diffDiff - ($diffHour * 3600);
      my $diffMint  = int($diffShvd / 60);
      my $diffSeco  = $diffShvd - ($diffMint * 60);
      my $diffTime  = "$diffHour hrs\t$diffMint mins\t$diffSeco secs";
      if (!$diffHour) {
        $diffTime  = "\t$diffMint mins\t$diffSeco secs";
        if (!$diffMint) {
          $diffTime  = "\t\t$diffSeco secs";
        }
      }
      $xBug->("$hackID\t$diffTime\tuntil $until");
    } else {
      $xBug->("++++ Initializing $hackID $someDelay +++++++++++++++++!\n");
      $main::cline{$hackID} = $oneTime + $someDelay;
    } # else nothing to do
  } # if (1)
  return $result;
} # delayedAction

  # ---------------------------------------------------------------------------
sub backupSourceCode {
  my $xBug           = shift @_;
      if (0) {
        # my $sshcommand = "scp *.pm pi@75.37.69.40:/dev/shm";
        # my $sshcommand = "scp *.pm pi@192.168.1.234:/dev/shm";

        my $ssh  = ""; # use local fail2ban by default
        my $cName = 'fail2counter';
        if (exists($main::cline{$cName})) {
          $xBug->(" ********************** $cName: $main::cline{$cName} ********\n");
          my $cycle4 = ($main::cline{$cName}++ & 3);
          SWITCH: for ($cycle4) { # https://developer.mozilla.org/en-US/docs/Web/HTTP/Status/400
              /0/ && do {
                $ssh  = "scp *.p? pi\@75.37.69.40:/dev/shm ";
                last SWITCH;
              };
              /1/ && do {
                $ssh  = "scp *.p? pi\@24.85.1.111:/dev/shm ";
                last SWITCH;
              };
              /2/ && do {
                $ssh  = "scp *.sh pi\@75.37.69.40:/dev/shm ";
                last SWITCH;
              };
              /3/ && do {
                $ssh  = "scp *.sh pi\@24.85.1.111:/dev/shm ";
                last SWITCH;
              };
          }; # for switch
          $xBug->("\n--------------- $version --------------------------------------------!\n");
          my $dumpresult = `$ssh`;
          $xBug->("--------------- $dumpresult --------------------------------------------!\n");
        } else {
          $xBug->(" ********************** $cName NOT EXIST! ********\n");
          $main::cline{$cName} = 100;
        } # if exists counter

      } # if 0 -- disable itemCommand execution -- til we figure out API quotas
} # backupSourceCode

  # ---------------------------------------------------------------------------
sub backupDatabase {
  my $xBug           = shift @_;
      if (0) {
        my $dumpcommand = 'mysqldump -u dbb -pCoc3la kittykat > /dev/shm/latest.sql';
        my $sshcommand = "ssh pi@75.37.69.40 '$dumpcommand'";
        $xBug->("\n--------------- $version --------------------------------------------!\n");
        my $dumpresult = `$sshcommand`;
        $xBug->("--------------- $dumpresult --------------------------------------------!\n");
      } # if 0 -- disable itemCommand execution -- til we figure out API quotas
} # backupDatabase

  # ---------------------------------------------------------------------------
sub showBlacklistContent {
  my $xBug           = shift @_;
      if (0) {
        my $dumpcommand = 'SELECT Count(*),Content from blacklist GROUP BY Content;';
        my $sshcommand = "mysql -u dbb -pCoc3la kittykat -h 75.37.69.40 -e '$dumpcommand'";
        $xBug->("\n--- $version ---- $sshcommand ---!\n");
        my $dumpresult = `$sshcommand`;
        $xBug->("$dumpresult\n");
      } # if 0 -- disable itemCommand execution -- til we figure out API quotas
} # showBlacklistContent

  # ---------------------------------------------------------------------------
sub code3 {
# fetch Location
  my $xBug           = shift @_;
  my $result = 0;
      if (1) {
        # my $result = &enquiringMinds($xBug,
        #      $xtable, $itemCommand, $hashPtr, $numberOfItems, $likeContent, $newContentFlag);
        $xBug->("\n------------- $result -------------------------------------!\n");
      } # if 0 -- disable itemCommand execution -- til we figure out API quotas
} # code3

  # ---------------------------------------------------------------------------
sub code4 {
# fetch Name
  my $xBug           = shift @_;
  my $result = 0;
      if (1) {
        # my $result = &enquiringMinds($xBug,
        #      $xtable, $itemCommand, $hashPtr, $numberOfItems, $likeContent, $newContentFlag);
        $xBug->("\n------------- $result -------------------------------------!\n");
      } # if 0 -- disable itemCommand execution -- til we figure out API quotas
} # code4

  # ---------------------------------------------------------------------------
sub nextHack {
  my $xBug           = shift @_;
  my $xtable         = shift @_; # 'xping';
  my $itemCommand    = shift @_; # 'ping -c 3';
  my $hashPtr        = shift @_;
  my $numberOfItems  = shift @_;
  my $likeContent    = shift @_; # Mapped or fail2ban 
  my $newContentFlag = shift @_;
  if (!(defined($xBug)))     { &sBug("nextHack: no xBug\n"); return; }
  my $result = &enquiringMinds($xBug,
              $xtable, $itemCommand, $hashPtr, $numberOfItems, $likeContent, $newContentFlag);
  $xBug->("\n------------- $result -------------------------------------!\n");
} # nextHack

  # ---------------------------------------------------------------------------
sub processBlacklist {
  my $xBug           = shift @_;
  my $xtable         = shift @_; # 'xping';
  my $itemCommand    = shift @_; # 'ping -c 3';
  my $hashPtr        = shift @_;
  my $numberOfItems  = shift @_;
  my $contentFlag    = shift @_;
  my $newContentFlag = shift @_;
  my $result = &enquiringMinds($xBug, 
                     $xtable,
                     $itemCommand,
                     $hashPtr, $numberOfItems, $contentFlag, $newContentFlag);
  return $result; # 0 means all ok
} # sub processBlacklist

# ---------------------------------------------------------------------------
sub fetchGeoip {
  my $xBug         = shift @_;
  my $yxtable      = 'xgeoip';
  my $yxhttp        = "https:\/\/api.hackertarget.com\/geoip\/?q=";
  my $yitemCommand = "curl --user-agent '$version'  $yxhttp";
  my $yhashPtr     = \%geoipHash;
  &nextHack($xBug,
                     $yxtable,
                     $yitemCommand,
                     $yhashPtr,1,'Mapped','Named',26000,'next2Hash',2);
} # fetchGeoip
  
# ---------------------------------------------------------------------------
sub fetchGeolocation {
  # https://ipgeolocation.io/documentation.html
  my $xBug         = shift @_;
  my $yxtable      = 'xgeolocation';
  my $yhttp        = 'https://api.ipgeolocation.io/ipgeo?apiKey=f5de996e209144d9a9d36e37cd1e05b6&ip=';
  my $yitemCommand = "curl --user-agent '$version'  $yhttp";
  my $yhashPtr     = \%geoloHash;
  &nextHack($xBug,
                     $yxtable,
                     $yitemCommand,
                     $yhashPtr,1,'Mapped','Located',2700,'next1Hack',7);
} # fetchGeolocation  

# ---------------------------------------------------------------------------
sub scanTheInternet {
  my $xBug = shift @_;
  my $iterations = 1;
  my $d3iscard = &processBlacklist($xBug,
                      'xnmap',
                      'nmap ',
                      \%nmapHash, $iterations, 'Traced','Mapped');
  my $d2iscard = &processBlacklist($xBug,
                      'xtrace', 
                      'traceroute -I ',
                      \%traceHash, $iterations,'Pinged','Traced');
  my $d1iscard = &processBlacklist($xBug,
                      'xping', 
                      'ping -c 3 ',
                      \%PingedHash, $iterations, 'New', 'Pinged' );
} # scanTheInternet

  # ---------------------------------------------------------------------------
sub code1 {
  my $xBug = \&sBug;
        my $r1esult=&loadFail2blacklist($xBug); # assigns fail2blacklist
        $xBug->("\n--------- $r1esult --------------------------------------------------!\n");
        my $rcheckResult = &checkForNewBlacklistItems($xBug);
        $xBug->("--------- $rcheckResult --------------------------------------------------!\n");
} # code1

  # ---------------------------------------------------------------------------
sub checkForTimedAction {
  my $xBug = shift @_;
  # my $code = sub { $xBug->("Code!! Code!!\n"); };
  # my $result1 = &delayedAction($xBug,'triggerTestCodeTest',   60,$code);        # every minute Code!

  my $result5 = &delayedAction($xBug,'triggerFetchGeoip',  76000,\&fetchGeoip);       # (48/mo, later)
  my $result3 = &delayedAction($xBug,'triggerBackupDatabe',86400,\&backupDatabase);   # daily
  my $result7 = &delayedAction($xBug,'triggerBackupSour',  10000,\&backupSourceCode); # every 15 mins
  my $result2 = &delayedAction($xBug,'triggerBlacklistUpd', 3600,\&code1);            # hourly
  my $result4 = &delayedAction($xBug,'triggerFetchGeolo'   ,2600,\&fetchGeolocation); # 1000/mo
  my $result6 = &delayedAction($xBug,'triggerScanIntern',    300,\&scanTheInternet);  # every 5 mins
  my $result8 = &delayedAction($xBug,'triggerShowBlackl',    240,\&showBlacklistContent); # 4 mins
} # checkForTimedAction

  # ---------------------------------------------------------------------------
sub response3HTMLbasic {
  my $xBug = \&sBug;
  my $pParameter = shift @_;
  my $iterations = 3; # dbb 9-22-24
  my $didx       = 7;
  if (exists($pParameter->{'docType'})) {
    $didx                   = $pParameter->{'docType'};
    $main::cline{'docType'} = $didx;
  } # if
  my $ztent = 1;
  if (exists($main::cline{'b2Filename'})) {
    if (-e $main::cline{'b2Filename'}) {
      $ztent = 0;
    }
    else { &tBug('Bad B2 filename'); }
  }
  else { &tBug('No B2 filename'); }
#
  &incrementCounter('counter2');
  &print2HTMLheader($didx,"Sandbox") if ($ztent);
  $HTMLbody = 1; # let bBug output to STDOUT
  &uBug("<body>\n") if ($ztent);
  my $black = &standardInfoHTML('response2HTMLbasic3',$xBug,'tossed to the wind');
#
  &incrementCounter('response3');
#
  # my $discard = &processBlacklist($xBug, 'xping', 'ping -c 3 ',\%PingedHash, 1, 'Mapped','3HTML!');
if (0) {
  $xBug->("\nTHIS PROGRAM calls checkGraylists ! $defaultBanner \n");
    my $discard1 = &loadHash(\&sBug, 'redlist', \%redlistHash);
    my $discard2 = &loadHash(\&sBug, 'graylist', \%graylistHash);
    my $discard3 = &loadHash(\&sBug, 'blacklist', \%blackHash);
} # if 0
  &displayDiegoPoster;
  $xBug->("Really doesnt do much");
  # my $d1iscard = &checkGraylists($xBug);
  # $xBug->("\nTHIS PROGRAM DOES GEOLOCATION! $defaultBanner \n");
  # &fetchGeolocation;
  # $xBug->("\nTHIS PROGRAM DOES GEOLOCATION! $defaultBanner \n");

  &StandardWrapUp; 
} # response3HTMLbasic

# ---------------------------------------------------------------------------
sub response4HTMLbasic {
  my $xBug = \&sBug;
  my $pParameter = shift @_;
  my $didx       = 7;
  if (exists($pParameter->{'docType'})) {
    $didx                   = $pParameter->{'docType'};
    $main::cline{'docType'} = $didx;
  } # if
  my $ztent = 1;
  if (exists($main::cline{'b2Filename'})) {
    if (-e $main::cline{'b2Filename'}) {
      $ztent = 0;
    }
    else { &tBug('Bad B2 filename'); }
  }
  else { &tBug('No B2 filename'); }
#
  &incrementCounter('counter2');
  &print2HTMLheader($didx,"Sandbox") if ($ztent);
  $HTMLbody = 1; # let bBug output to STDOUT
  &uBug("<body>\n") if ($ztent);
  my $black = &standardInfoHTML('response2HTMLbasic3',$xBug,'tossed to the wind');
  &incrementCounter('response4');
  &checkForTimedAction($xBug);
  &StandardWrapUp; 
} # response4HTMLbasic

  # ---------------------------------------------------------------------------
sub response5HTMLbasic {
  my $xBug = \&sBug;
  my $pParameter = shift @_;
  my $didx       = 7;
  if (exists($pParameter->{'docType'})) {
    $didx                   = $pParameter->{'docType'};
    $main::cline{'docType'} = $didx;
  } # if
  my $ztent = 0;
  if (exists($main::cline{'b2Filename'})) {
    if (-e $main::cline{'b2Filename'}) {
      $ztent = 0;
    }
    else { &tBug('Bad B2 filename'); }
  }
  else { &tBug('No B2 filename'); }
#
  &incrementCounter('counter2');
  &print3HTMLheader($didx,"Sandbox") if ($ztent);
  $HTMLbody = 1; # let bBug output to STDOUT
  &uBug("<body>\n") if ($ztent);
  my $black = &standardInfoHTML('response3HTMLbasic3',$xBug,'tossed to the wind');
#
  # &playAudio;       # connect to audio download stream, output to speakers
  # &showAudioTool($xBug);
  &tBug("skipped playAudio!");
  # &showAudioInputForm($xBug);
  # &printSomeMiscContent;
  &tBug("skipped printSomeMiscContent!");
  &xlogBug("response3HTMLbasic4\n");
#
  &showThisAndThat if ($ztent);
  &xlogBug("response3HTMLbasic5\n");
  &incrementCounter('response2');
  &PlayBell if ($ztent);
#
  if (!$ztent) {
    my $presult = qq(Content-type: text/html\n);
    $presult .= &maybeSetACookie(\&tBug);
    $presult .= "\n";
    print $presult;
    if (open B2FILE, $main::cline{'b2Filename'}) {
      print <B2FILE>; close B2FILE;
    }
    # &writestate;
    # &closeHTMLOUTPUT; # /body /html, closes filehandle
  } # if
  &tBug("response3HTMLbasic8");
  # &maybeConnectToEmailServer;
  &StandardWrapUp; # if ($ztent);
} # response5HTMLbasic

  # ---------------------------------------------------------------------------
sub response6HTMLbasic {
  my $xBug = \&sBug;
  my $pParameter = shift @_;
  my $didx       = 7;
  if (exists($pParameter->{'docType'})) {
    $didx                   = $pParameter->{'docType'};
    $main::cline{'docType'} = $didx;
  } # if
#
  &xlogBug("response6HTMLbasic2\n");
  &print6HTMLheader($didx,'Old West Wranglers Diego');
  $HTMLbody = 1; # let bBug output to STDOUT
  &uBug("<body>\n"); # formatting to STDOUT
  my $black = &standardInfoHTML('response6HTMLbasic3',$xBug,'The dawg must go on!');
#
  &response6HTMLguts;
#
  &tBug("response6HTMLbasic7");
  &showThisAndThat;
  &incrementCounter('response6');
  &PlayBell;
#
  &tBug("response6HTMLbasic8");
  # &maybeConnectToEmailServer;
  &StandardWrapUp;
} # response6HTMLbasic

# ----------------------------------------------------------------------------
  # Splits an argument pair into key and value, loads the global hash cline
  # This bit of form processing code came from http://www.cgi101.com/class/ch4/text.html
sub ScanArgumentPairs {
  my $pair = shift @_;
  my $xBug = \&StateMessage;
  my $flag = 0;
  while ((defined($pair))  && ($flag < 100)) {
    my ($name, $value) = split(/=/, $pair);
    if (defined($name)) {
      if (defined($value)) {
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $main::cline{$name} = $value; # store pairs in global cline.
      } else {
        $xBug->("ScanArgumentPairs $flag $name value not defined"); # formatted to STDOUT, HTMLOUTPUT, and QOUTPUT
      } # else not defined
    } # else { $xBug->("ScanArgumentPairs $flag name $pair not defined"); }
    $flag++;
    $pair = shift @_;
  } # else { $xBug->("ScanArgumentPairs pair not defined"); }
} # ScanArgumentPairs

# ----------------------------------------------------------------------------
sub ExtractFormInfo {
  my $mPart         = shift @_;
  my $xBug          = shift @_; if (!defined($xBug)) { $xBug = \&StateMessage; }
  my $partName      = 'noName';
  if ($mPart->head->as_string =~ /name="(.*?)"/) { # ? means non-greedy
    # https://www.ultraedit.com/support/tutorials-power-tips/ultraedit/non-greedy-perl-regex.html
    my $name        = $1;
    $partName       = $name;
    my $contenttype = $mPart->mime_type;
    if ($contenttype eq 'text/plain')    {
      $formInfo{$name}               = $mPart->bodyhandle->as_string;
    }
    elsif ($mPart->head->as_string =~ /; filename="(.*?)"/) {
      $formInfo{$name}               = $1;
      $main::cline{'latestFilename'} = $1;
    }
    else { $xBug->("WTF! no match?"); }
  }
  else { $xBug->("Why no name?"); }
  return $partName;
} # ExtractFormInfo

# ----------------------------------------------------------------------------
sub latestContent {
  my $mPart         = shift @_;
  my $fFilename     = shift @_;
  my $latestContent = shift @_;
  my $contenttype   = $mPart->mime_type;
  my $xBug          = shift @_; if (!defined($xBug)) { $xBug = \&StateMessage; }
  $xBug->("latestContent $fFilename");
  my $partName      = &ExtractFormInfo($mPart,$xBug);
  my $hastring = $mPart->header_as_string;
  $xBug->(" ********* $hastring **** $partName ****");
  if ($mPart->header_as_string =~ /filename="(.*?)"/) {
    my $fn = $1;
    if ($fn =~ /=\?UTF-8\?b\?(.*)\?=/) {
      $fn = decode_base64($1);
      $xBug->("UTF-8!!  $fn");
    }
    my $typeContentName = 'latest' . $latestContent;
    $main::cline{$typeContentName} = $uploadDirectory . '/' .  $fn;
  }
  else { $xBug->("$latestContent Curses!"); }
  return $partName;
} # latestContent

# ----------------------------------------------------------------------------
sub HandleTypeContent {
  my $mPart         = shift @_;
  my $fFilename     = shift @_;
  my $xBug          = shift @_;
  my $partName      = &latestContent($mPart,$fFilename,'TypeContent',$xBug);
  $xBug->("HandleTypeContent !! loadA ");
  &uploadAudioFile($fFilename,$partName,1);
} # HandleTypeContent

# ----------------------------------------------------------------------------
sub HandleTypeImage {
  my $mPart         = shift @_;
  my $fFilename     = shift @_;
  my $xBug          = shift @_;
  my $partName      = &latestContent($mPart,$fFilename,'Image',$xBug);
  $xBug->("HandleTypeImage !! loadA ");
  &uploadAudioFile($fFilename,$partName,0);
} # HandleTypeImage

# ----------------------------------------------------------------------------
sub HandleTypeTextPlain {
  my $mPart         = shift @_;
  my $fFilename     = shift @_;
  my $xBug          = shift @_;
  my $partName      = &latestContent($mPart,$fFilename,'TextPlain',$xBug);
  my @excludeParts  = ('submit','form_id');
  # my @excludeParts  = ('submit','element_4a','form_id');
  if (in { $partName eq $_ } @excludeParts) {
    $xBug->("excluded $partName");
    unlink $fFilename;
  } else {
    $xBug->("HandleTypeTextPlain !! loadA ");
    &uploadAudioFile($fFilename,$partName,1);
  }
} # HandleTypeTextPlain

# ----------------------------------------------------------------------------
sub HandleTypeTextHTML {
  my $mPart         = shift @_;
  my $fFilename     = shift @_;
  my $xBug          = shift @_;
  my $partName      = &processBody($mPart->bodyhandle->as_string);
  &latestContent($mPart,$fFilename,'TextPlain',$xBug);
  $xBug->("HandleTypeTextHTML !! loadA ");
  &uploadAudioFile($fFilename,$partName,1);
} # HandleTypeTextHTML

# ----------------------------------------------------------------------------
sub HandleTypeAudio {
  my $mPart         = shift @_;
  my $fFilename     = shift @_;
  my $xBug          = shift @_;
  my $partName      = &latestContent($mPart,$fFilename,'Audio',$xBug);
  $xBug->("HandleTypeAudio !! loadA ");
  &uploadAudioFile($fFilename,$partName,1);
} # HandleTypeAudio

# ----------------------------------------------------------------------------
sub HandleTypePdf {
  my $mPart         = shift @_;
  my $fFilename     = shift @_;
  my $xBug          = shift @_;
  my $partName      = &latestContent($mPart,$fFilename,'Pdf',$xBug);
  $xBug->("HandleTypePdf !! loadA ");
  &uploadAudioFile($fFilename,$partName,1);
} # HandleTypePdf

# ----------------------------------------------------------------------------
sub parseMultiPartFormData {
  my $xBug             = \&xlogBug;
  my $result           = 0;
  my $bodytxtReference = shift @_;
  my $outputdir        = $uploadDirectory; # directory should be created 777
  my %ContentTypeAction = (
                 'text/html'                => \&HandleTypeTextHTML,
                 'text/plain'               => \&HandleTypeTextPlain,
                 'audio/mpeg'               => \&HandleTypeAudio,
                 'audio/wav'                => \&HandleTypeAudio,
                 'image/jpeg'               => \&HandleTypeImage,
                 'image/png'                => \&HandleTypeImage,
                 'image/bmp'                => \&HandleTypeImage,
                 'image/gif'                => \&HandleTypeImage,
                 'application/pdf'          => \&HandleTypePdf,
                 'application/octet-stream' => \&HandleTypeTextPlain,
  ); # my ContentTypeAction
#
  require MIME::Parser;
  if (my $parser = new MIME::Parser) {
    &tBug("TestJig! $outputdir\n");
    my $oDir           = $parser->output_dir($outputdir);
#    my $outputFilename = 'parsed' . $oneTime;

    my $entity;
    if ($bodytxtReference) {
      $entity          = $parser->parse_data($bodytxtReference);
      $xBug->('HELLOOOOOOO!');
    } else { 
      my $body         = 'MIME-Version: 1.0' . "\nContent-Type: " . $ENV{'CONTENT_TYPE'} . 
                                "\n\nThis is a multipart message in MIME format.\n\n";
      for my $parts (<STDIN>) { $body .= $parts; }
      $entity          = $parser->parse_data(\$body);
    } # else...
    if (!$entity) { $xBug->("Bad entity!"); return -1; }
    my $results        = $parser->results;
#
    ### Get all messages logged:
    for my $msg ($results->msgs) {
       $xBug->("Message: $msg"); 
    } # for each msg
#
    ### Get messages of specific types (also tests if there were problems):
    my $had_errors     = $results->errors;
    $xBug->("Had errors: $had_errors")     if ($had_errors);
#
    my $had_warnings   = $results->warnings;
    $xBug->("Had warnings: $had_warnings") if ($had_warnings);
#
    my $fIdx           = 0;
    my $fExt           = $oDir->{'MPF_Ext'};
    # $xBug->(" !!! !!! fExt  @{[ %$fExt ]}"); # interpolation trick
    my $fPurgable      = $oDir->{'MPF_Purgeable'};
    for my $mPart ($entity->parts) {
      my $fFilename = $$fPurgable[$fIdx];
      $xBug->(" === $fIdx ===> fFilename $fFilename");
      $fIdx++;
      my $contenttype  = $mPart->mime_type;
      if (in { $contenttype eq $_ } keys %ContentTypeAction) {
        $ContentTypeAction{$contenttype}->($mPart,$fFilename,$xBug);
      } # if the part content type is one we have a handler
      else {
        $xBug->("Unexpected type!");
        &HandleTypeContent($mPart,$fFilename,$xBug);
      }
    } # for each part
    $result = 1;
#    $parser->filer->purge; # discard temporary output files
  } # if parser
  return $result; # 1 if we succeed, or we otherwise don't want to run the old email process
} # parseMultiPartFormData

# ----------------------------------------------------------------------------
# Needs to be called after dbh is set up, because some inputs might be saved in the database
sub readPosts {
  my $xBug = \&xlogBug; # X
#
  if (exists($ENV{'REQUEST_METHOD'}) && ($ENV{'REQUEST_METHOD'} eq 'POST')) {
    if (exists($ENV{'CONTENT_TYPE'})) {
      if ($ENV{'CONTENT_TYPE'} eq 'application/x-www-form-urlencoded') {
        my @pair2s = <STDIN>;
        $xBug->("YPAIR: {[ @pair2s ]} \n");
        foreach my $pair (@pair2s) {
          my @pair1s = split(/\&/,$pair);
          foreach my $pair (@pair1s) {
            &ScanArgumentPairs(&rtrim($pair));
            my $name;
            my $value;
            ($name, $value) = split(/=/, $pair);
            if (defined($value)) {
               $formInfo{$name} = $value;
            } # let us save to SUBMITlog
          } # foreach
        } # foreach
      } # application/x-www-form-urlencode
      elsif ($ENV{'CONTENT_TYPE'} =~ /multipart\/form-data/) {
        &parseMultiPartFormData;
      }
      else { $xBug->("Unknown CONTENT_TYPE $ENV{'CONTENT_TYPE'} "); }
    }
    else { $xBug->("No CONTENT_TYPE"); }
  } # request method is post, expect input at STDIN
  elsif (exists($main::cline{'textPost'}) && (!exists($ENV{'REMOTE_HOST'}))) {
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
    if (open DBFILE, $main::cline{'textPost'}) {
      my $oXutputText = 'MIME-Version: 1.0' . "\nContent-Type: multipart/mixed;
              boundary=\"XXXXboundary text\""  . 
                                "\n\nThis is a text message in MIME format.\n\n";
      $oXutputText .= "--XXXXboundary text\nContent-Type: text/plain\n\n";
      while (my $item = <DBFILE>) {  $oXutputText .= $item; }
      $oXutputText .= "\n--XXXXboundary text--\n";
      close DBFILE;
      $outputText .= " Finally, " . &parseMultiPartFormData(\$oXutputText);
      $xBug->("Some input text from $main::cline{'textPost'} $outputText");
      my $zcnt = 0;
      $outputText = "<div>ZZZZZZ<ol>\n";
      my $tocnt = 1500;
      $outputText .= "</ol></div>\n";
      $xBug->($outputText);
      delete $main::cline{'textPost'};
    }
    else { $xBug->("Input file not found"); }
  } # elsif
  else { $xBug->("No post"); }
} # readPosts

# ----------------------------------------------------------------------------
sub fetchArguments {
  foreach my $pair (@ARGV) {    &ScanArgumentPairs(&rtrim($pair));  } # foreach
} # fetchArguments

# ----------------------------------------------------------------------------
sub readEnvironmentVariables {
  if (exists($ENV{'HTTP_COOKIE'})) {
    my ($key, $value) = split('=',$ENV{'HTTP_COOKIE'});
    $uState = 'UserState' . $value;
    if (defined($value)) { $userID = $value; } else { $userID = 5555; }
    if (exists($main::cline{$uState})) { $UserState = $main::cline{$uState}; }
    else { $main::cline{$uState} = $UserState; }
  } # if cookie, affects how parsed input below is saved in database, user_id is a key
#
# These are persistent variables that override default values
  if (exists($main::cline{'uploadDirectory'})) { $uploadDirectory = $main::cline{'uploadDirectory'}; }

  if (exists($ENV{'QUERY_STRING'})) { # passed by http
    my @pair1s = split(/\&/,$ENV{'QUERY_STRING'});
    foreach my $pair (@pair1s) {
      print XFILE "PAIR: $pair \n";
      &ScanArgumentPairs(&rtrim($pair));
    } # foreach
  } # request method is post, expect input at STDIN
} # readEnvironmentVariables

# ----------------------------------------------------------------------------
sub readstate {
  my $statetxt = shift @_; # this is the file containing persistent variables as key-value pairs
  my $xBug     = \&StateMessage; # X
  my $yBug     = shift @_;  if (defined($yBug)) { $xBug = $yBug; }
#
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  if ((defined($statetxt)) && (open STATEFILE, $statetxt)) {
    $xBug->("Reading $statetxt!");
    my @pairs = <STATEFILE>;
    foreach my $pair (@pairs) {      &ScanArgumentPairs(&rtrim($pair));     } # foreach
    close STATEFILE;
  } # if open
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  elsif (open STATEFILE, 'state.txt') {
    $xBug->("Reading default!");
    my @pairs = <STATEFILE>;
    foreach my $pair (@pairs) {      &ScanArgumentPairs(&rtrim($pair));     } # foreach
    close STATEFILE;
  } # if open
  else {
    if (!defined($statetxt)) { $statetxt = 'statetxt Undefined!'; }
    $xBug->("Failed to read state! $statetxt");
  }
#
    # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  if (open CFILE, 'counters.txt') {
    $xBug->("Reading counters!");
    my @pairs = <CFILE>;
    foreach my $pair (@pairs) {      &ScanArgumentPairs(&rtrim($pair));     } # foreach
    close CFILE;
  } # if open
#
  &readEnvironmentVariables;
  &fetchArguments; # command line options override all other settings
#
} # readstate

# ----------------------------------------------------------------------------
sub cleanupState {
  my $xBug = \&xlogBug;
  # $xBug->("clS: 0");
  my @zapList = ('hiddenButtonInfo','DBB','TERM',
           'CountryPass','CountryOfOrigin',
           'Saved-Simple','Saved-Willy','Saved-ycold','select');
  for my $zapitem (@zapList) {
    if (exists($main::cline{$zapitem})) {    delete $main::cline{$zapitem};  }
  } # for each cline item to delete
# clean-up state.txt file, zap known stray variables
  if (!exists($main::cline{'comment'})) { # make Eliza work better
    if (exists($main::cline{'element_4a'})) { 
      $main::cline{'comment'} = $main::cline{'element_4a'}; 
    } # if
  } # user input may be taken from form text area
# basicIndex selects the webpage to be built when called by main::basicAutoWebpage
  if (!exists($main::cline{'basicIndex'})) {
   # &xlogBug("basicIndex $main::cline{'basicIndex'}"); }
  # else {
    &StateMessage("No basicIndex!");
    $main::cline{'basicIndex'} = 0; # just fix it
  }
  if (exists($main::cline{'basicAutoWebpage'}))   { &incrementCounter('basicIndex');  }
#
  if (exists($main::cline{'StateMessageZapper'})) { $main::cline{'StateMessageZap'} = 1; }
#
  # $xBug->("clS: 5");
  if (exists($main::cline{'StateMessageZap'})) {
    for my $key (keys %main::cline) {
      if ($key =~ /(StateMessage[0-9]*)/) { delete $main::cline{$1}; }
    }
    delete $main::cline{'StateMessageZap'};
    $main::cline{'StateMessageZap'} = 20; # if it rolls over 99, it is assigned 10,
                                          #  below 10 doesnt sort right
  } # if commanded to erase StateMessage list
  $main::cline{'timeStamp'} = $oneTime; # helps with debugging
  $main::cline{'HOSTNAME'}  = &rtrim(`hostname`);
  if (!defined($main::cline{'HOSTNAME'})) {
    $main::cline{'HOSTNAME'} = 'xHelium';
  }
  elsif ($main::cline{'HOSTNAME'} =~ /\./) {
    $main::cline{'HOSTNAME'} = 'xhelium';
  }
  delete($main::cline{'basicAutoWebpage'}); # somebody keeps turning this on, force off dbb 3-5-2021
  # $xBug->("clS: 9");
} # cleanupState

# ----------------------------------------------------------------------------
sub zapDVX {
  my @zaplist = ('DVX0','DVX0','DVX0','DVX0','DVX0','DVX0','DVX0','DVX0','DVX0','DVX0','DEBUGXIP');
  for my $zapitem (@zaplist) {
    if (exists($main::cline{$zapitem})) { delete $main::cline{$zapitem}; }
  } # for 
} # zapDVX

# ----------------------------------------------------------------------------
sub checkRESETcommand {
  if (exists($main::cline{'RESET'})) {
    my %presets = (
                  'MENTEE'   => 110,
                  'SEXSUGAR' => 108,
                  'PERKY'    => 106,
                  'MOAN'     => 104,
                  'GS2'      => 102,
                  'MILANO'   => 100,
                  'CLE'      => 98,
                  'UPTIME'   => 1,
                  'ODY'      => 10,
                  'DVX0' => 'MENTEE,MOAN',
                  'DVX1' => 'ODY,SEXSUGAR,MILANO',
                  'DVX2' => 'MOAN,CLE,PERKY,UPTIME,GS2',
                  'DVX6' => 'CLE',
                  'DVX7' => 'GS2',
                );
    &zapDVX;
    for my $key (keys %presets) {
      $main::cline{$key}   = $presets{$key};;
    }
    delete $main::cline{'RESET'};
    &initializeDirectoriesAndFiles;
  } # if commanded
} # checkRESETcommand

# ----------------------------------------------------------------------------
sub checkADJUSTcommand {
  if (exists($main::cline{'ADJUST'})) {
    &zapDVX;
    my %adjustments = (
                      'DVX0'    => 'MENTEE',
                      'DVX1'    => 'ODY,SEXSUGAR,MILANO',
                      'DVX2'    => 'UPTIME,GS2',
                      'DVX4'    => 'PERKY,CLE,MOAN',
                      'DVX7'    => 'GS2',
                      'DEBUGXIP' => $ENV{'REMOTE_ADDR'},
                      'MILANO'  => 1,
                     );
    for my $key (keys %adjustments) {
      $main::cline{$key}   = $adjustments{$key};;
    } # for
    delete $main::cline{'ADJUST'};
  } #if 
} # checkADJUSTcommand

  #-------------------------------------------------------------
sub checkVisitors {
  return;
  my $sql = "SELECT Count(*) FROM visitors;";
  my $dbh = shift @_;
  my $vbs = shift @_;
  my $xBug = \&xlogBug;
  my $yBug = \&xlogBug;
  if (!defined($dbh)) {
    $xBug->("Check Bad dbh!");
  } # be sure database was created
  $xBug->("CheckVisitors!!");
  my $sth = $main::dbh->prepare($sql);
  $sth->execute();
  my @row;
  my $item;
  $yBug->("<P>$sql<TABLE>\n") if ($vbs);
  if (@row = $sth->fetchrow_array) {
    $yBug->("<TR>") if ($vbs);
    foreach $item (@row) {
      $yBug->("<TD>$item</TD>") if ($vbs);
    } # while item
    $yBug->("</TR>\n") if ($vbs);
  } else {
    $sql = "CREATE TABLE visitors (
          HTTP_ACCEPT_ENCODING           VARCHAR(31),
          HTTP_ACCEPT_LANGUAGE           VARCHAR(9),
          HTTP_ACCEPT                    VARCHAR(23),
          HTTP_PRAGMA                    VARCHAR(20),
          HTTP_CONNECTION                VARCHAR(13),
          HTTP_COOKIE                    VARCHAR(10),
          HTTP_FROM                      VARCHAR(29),
          HTTP_HOST                      VARCHAR(65),
          HTTP_REFERER                   VARCHAR(104),
          HTTP_USER_AGENT                VARCHAR(215),
          QUERY_STRING                   VARCHAR(44),
          REMOTE_ADDR                    VARCHAR(18),
          REMOTE_PORT                    INTEGER,
          REQUEST_METHOD                 VARCHAR(10),
          REQUEST_SCHEME                 VARCHAR(7),
          REQUEST_URI                    VARCHAR(46),
          SCRIPT_FILENAME                VARCHAR(32),
          SCRIPT_NAME                    VARCHAR(14),
          SERVER_ADDR                    VARCHAR(17),
          SERVER_ADMIN                   VARCHAR(22),
          SERVER_NAME                    VARCHAR(65),
          SERVER_PORT                    INTEGER,
          SERVER_PROTOCOL                VARCHAR(11),
          VISITOR_NUMBER                 INTEGER,
          SSH_CONNECTION                 VARCHAR(44),
          tstamp                         timestamp);";
    my $result   = &sendMysqlQuery($dbh, $sql, $vbs);
    my $querycsv = pop @queryResultFile;
    &logSQLresults($result, $querycsv, \&xlogBug);
  } # else
} # sub checkVisitors
  
  #-------------------------------------------------------------
  # this is the logging function, appends a journal entry to visitors table
sub insertVisitors {
  my $dbh = shift @_;
  if (defined($dbh)) {
    my %iENV = %ENV; # copy hash-list of environment variables
    my $sql = "DESCRIBE visitors;"; # we look at the table column names
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    my $first = 0;
    $sql = "INSERT INTO visitors SET UserID='$userid'";
    while (my @row = $sth->fetchrow_array) {
      if (exists($ENV{$row[0]})) {
        if ($first) { $first = 0; } else { $sql .= ','; }
        $sql .= " $row[0] = " . $dbh->quote($ENV{$row[0]});
        delete $iENV{$row[0]}; # zapped because we will save it in database
      } # if exists
    } # while constructing sql command to record environment values in visitors table
    if (exists($main::cline{'visitorNumber'})) { $main::cline{'visitorNumber'}++; }
    else                                       { $main::cline{'visitorNumber'}=110000;  }
    $sql .= ', VISITOR_NUMBER=' . $main::cline{'visitorNumber'};
    $sql .= ';';
    my $resulting = &sendMysqlQuery($sql);
#    &xlogBug($resulting);
    my $querycsv = pop @queryResultFile;
    &logSQLresults($resulting, $querycsv, \&xlogBug);
if (0) {
    my $iflag = 1;
    for my $ikey (keys %iENV) {
      if (exists($iENV{$ikey})) {
        if (defined($iENV{$ikey})) {
          &xlogBug("Did not save $ikey \t $iENV{$ikey}");
        } else {
          &xlogBug("Did not save $ikey \t BBBBBBB ");
        }
      } else {
        &xlogBug("Did not save $ikey \t AAAAAAA ");
      }
      $iflag = 0;
    } # report those in ENV but not visitors table
    if ($iflag) { &xlogBug("No extras!"); }
} # if 0
  } else {    &xlogBug("Insert Bad dbh!");  } # be sure database was created
} # sub insertVisitors

  #-------------------------------------------------------------
sub tallyVisitor {
  my $debug = shift @_;  if (!defined($debug)) { $debug = 0; } # make sure debug is defined
  if (defined($main::dbh)) {
    &checkVisitors($main::dbh, $debug); # create table if necessary
                                      # also initializes main::selected
    &insertVisitors($main::dbh, 0, $debug); # log visit details in mysql database
  } else {
    &xlogBug("Tally Bad dbh! $debug");
  } # be sure database was created
} # tallyVisitor

# ----------------------------------------------------------------------------
sub miscHousekeeping {
  if (exists($main::cline{'XLOG'})) { &xlogBug(' XLOG! ' . __PACKAGE__ . ' ' . $main::cline{'XLOG'}); }
#
  if (exists($main::cline{'INCREMENT'})) {
    &incrementCounter($main::cline{'INCREMENT'});
    delete $main::cline{'INCREMENT'};
  }
#
  &incrementCounter('visitCounter');
#
  if (exists($main::cline{'UserID'})) { $main::cline{$main::cline{'UserID'}}=$oneTime; }
  else { &xlogBug('No UserID here!'); }
} # miscHousekeeping

# ----------------------------------------------------------------------------
sub bailoutBuddy {
  my $message         = shift @_;
  $main::cline{'SIGNAL'} = $message;
  &xlogBug("\n" . $message . "\n");
  &$shutdownProcedure($message);
  exit(0); # no return
} # bailoutBuddy no return

# ----------------------------------------------------------------------------
# package initialization
# ----------------------------------------------------------------------------
# ----------------------------------------------------------------------------
# see https://perldoc.perl.org/variables/%25SIG
# %SIG
if (1) {
  $SIG{QUIT} = sub {                   &bailoutBuddy("QUIT received"); };  # not sure where this originates
  $SIG{INT}  = sub {                   &bailoutBuddy("INT received");  };  # kill -2  or Ctrl-C
  $SIG{TERM} = sub {                   &bailoutBuddy("TERM received"); };  # kill -15
  $SIG{TSTP} = sub {                   &bailoutBuddy("TSTP received"); };  # kill -20 or Ctrl-Z
  $SIG{KILL} = sub {                   &bailoutBuddy("KILL received"); };  # kill -9  cannot catch it
# $SIG{$name} = 'IGNORE';             # to ignore it
# $SIG{$name} = 'DEFAULT';            # to reset to the default behavior
} # if 0
 
my $saved; # not defined, tho
if (exists($main::cline{'dbConnected'})) { $saved = $main::cline{'dbConnected'}; }
&readEnvironmentVariables;
&xlogBug("UserState is $UserState ($okDirectory)");
&determinePersistentVariableFilename; # sets UserID, statefn from cookie
&readstate($statefn);
&cleanupState;
# create a unique table name for each host using the database, marked so we can pick them out
if (exists($main::cline{'HOSTNAME'})) { $accessLogTableName = $main::cline{'HOSTNAME'} . 'access'; }
$main::cline{'recentAccessTableName'} = $accessLogTableName; # a debugging
if (exists($main::cline{'SIGNAL'})) { delete $main::cline{'SIGNAL'} ; }

$main::cline{'dbConnected'} = 'No connection to DB';
$main::dbConnected = 0;
my $dbbinfo = 'dbzinfo.txt';
&buildListOfDatabases($privatePath . $dbbinfo, \&xlogBug, sub {});
&connectToAnyDatabase($privatePath . $dbbinfo, \&xlogBug, sub {});
$main::cline{'processUploadedDatafiles'} = 1; # debug force this 3HTML function
&readPosts;
#
if (defined($saved)) { $main::cline{'dbConnected'} = $saved; } # restored bacause it would have been overwritten
&archiveRFile;
&archiveSFile;
&openQOUTPUT(\&xlogBug);
&openHTMLOUTPUT(\&xlogBug); # &StateMessage("Ready for HTMLOUTPUT");
&processDeleteCommand;
&checkRESETcommand;
&checkADJUSTcommand;
&tallyVisitor;
&miscHousekeeping;
&myVersionString; # initialize global
&StateMessage(" ****  init complete!  *** ");
STDOUT->autoflush(1);

return 1;
# C:\Users\Owner1\Downloads\putty.exe  helium.he.net -l dbb -pw 8it7yxpf
# C:\Users\Owner1\Downloads\putty.exe  wtf20.club  -l pi -pw Aw5trewq
#  -pw Q2wsdfghjkl
# --- END --- END --- END --- END --- END --- END --- END --- END --- END --- END ---
# Zheila Zeinekhabyl
# using a color wheel to pick colors! https://www.canva.com/colors/color-wheel/
# https://www.namecheap.com/support/knowledgebase/article.aspx/9821/38/apache-redirect-to-https/
# https://fatsodevelopment.godaddysites.com/