#!/Perl/bin/perl.exe -w

#*****************************************************************************
#
#                               --- WARNING ---
#
#   This work contains trade secrets of DataDirect Networks, Inc.  Any
#   unauthorized use or disclosure of the work, or any part thereof, is
#   strictly prohibited.  Copyright in this work is the property of
#   DataDirect Networks.  All Rights Reserved.  In the event of publication,
#   the following notice shall apply:  © 2007, DataDirect Networks.
#
#
# Name:     API.pl
# Object:   Perl CGI script for Intranet Applications API
# Project:  Intranet
#
# Description:
#
#     This Perl CGI script contains the common routines used by to
#     access tables in a MySQL database.
#
#
# Inputs:
#     The following global variables must be defined before requiring this file:
#          API::diag
#          API::program
#          API::title
#          API::revision
#          API::dbh
#          API::today
#          API::navbar
#          API::burger
#
#*****************************************************************************
#
#     $Id: API.pl 1420 2014-06-04 19:23:22Z c.schneider $
#     $URL: svn://ereo-bstt/DDN/TC/Tools/trunk/Intranet/cgi-bin/API.pl $
#     $Author: c.schneider $
#     $Revision: 1420 $
#     $Date: 2014-06-04 15:23:22 -0400 (Wed, 04 Jun 2014) $
#
#*****************************************************************************


#*****************************************************************************
#
# initialize variables
#
#*****************************************************************************
my $id = '$Id: API.pl 1420 2014-06-04 19:23:22Z c.schneider $';
my @Id = split(/ /, $id);
$API::revision .= '.MMTC.'.$Id[2];

$www::Color{MouseOver}    = 'lightblue';
$www::HTML{EscapeKey}     = '<b><code>&lt;Esc&gt;</b></code>';
$www::HTML{Password}      = '<div class=explain>
Passwords are not required.<br>
Only enter passwords if you want to change them.</td>
</div>';
$www::HTML{RePostWarning} = '<div class=div_RePostWarning>Do not re-fresh this page, that will cause this form to be re-posted and another record to be created.</div>';
# initialize summaries
$www::HTML{CalendarTotals} = '';

$BS::submit = 'btn btn-default';
$BS::reset  = 'btn btn-primary';
$BS::other  = 'btn btn-info';

$www::ID_List      = '';
$www::cgidir       = 'cgi-bin';
$www::Holiday{pre} = ' background=/images/bday/';
$www::Holiday{post} = '_bg.jpg';
$www::upload       = 'upload';
$www::border_table = "<table class='table table-striped'>";
$www::max_td_width = 40;
$www::date_format  = 'yyyy-mm-dd';
$www::time_format  = 'hh:mmam - hh:mmpm';
$www::null_date    = '0000-00-00';
$www::null_IDL     = '000';
$www::select_one   = '----Select One----';
$www::select_more  = '----Select One or More----';
$www::none         = '----None----';
$www::undefined    = '<i>undefined</i> ';
$www::numeric_field = '';
$www::max_entries_per_day = 4;
$www::report_menu  = '';
$www::policy_title = "You must sign in to have read-write access";
# the leading zero causes it to sort first
$www::last_prefix  = '0myLast_';

# POSIX format patterns, see POSIX module
$www::Format{Week} = '%y-%W';
$www::Format{Date} = '%m/%d/%y';
$www::Format{Saturdays} = '%Y-%m-%d';
$www::Format{Numeric} = '%2.2f';

# edit indicators
$www::edit{guest}   = 0;
$www::edit{world}   = 1;
$www::edit{other}   = 2;
$www::edit{lead}    = 3;
$www::edit{manager} = 4;
$www::edit{author}  = 5;

$www::Subject = 'Title';

@www::Months =
    ('January',
     'February',
     'March',
     'April',
     'May',
     'June',
     'July',
     'August',
     'September',
     'October',
     'November',
     'December');

@www::DaysPerMonthLeapYear =
    (0,31,29,31,30,31,30,31,31,30,31,30,31);

@www::DaysPerMonth =
    (0,31,28,31,30,31,30,31,31,30,31,30,31);

@www::FormCols =
    ('Go',
     'ListBy',
     'ViewBy',
     'OrderBy',
     'Edit',
     'Prefs',
     'Append',
     'Delete');

@www::TextAreas =
    ('Title',
     'Description',
     'Definitions',
     'Comments',
     'Agenda');

$www::Size{TextAreas}   = 80;
$www::Size{Description} = 10;
$www::Size{Definitions} = 10;
$www::Size{Comments}    = 12;
$www::Size{Agenda}      = 8;

@www::Dynamic_Lists =
    ('Department',
     'Project',
     'Forum');

@www::Enum_Lists =
    (@www::Dynamic_Lists,
     'Status');

# disabled enumerations variables
$www::Disabled{title} = "\nFurthor additions are disabled";
$www::Disabled{font} = '<font color=black>';
$www::Disabled{tag} = 'DISABLED';

# preferences defaults
$www::Prefs_Defaults{APIOutDept}   = 'SW';
$www::Prefs_Defaults{APIOutDir}    = 'DESC';
$www::Prefs_Defaults{APIOutFmt}    = 'Uncompressed';
$www::Prefs_Defaults{APIOutWin}    = 'Self';
$www::Prefs_Defaults{APIViewSQL}   = 'No';
$www::Prefs_Defaults{APIViewReset} = 'Yes';
$www::Prefs_Defaults{APILayout}    = 'Horiz';
$www::Prefs_Defaults{APIWeek}      = 'Sunday';

# preferences labels
$www::Prefs_Labels{APIOutDept}   = 'Default Department';
$www::Prefs_Labels{APIOutDir}    = 'ID Sort Direction';
$www::Prefs_Labels{APIOutFmt}    = 'Default Report Output';
$www::Prefs_Labels{APIOutWin}    = 'View ID Window Type';
$www::Prefs_Labels{APIViewSQL}   = 'View SQL';
$www::Prefs_Labels{APIViewReset} = 'Reset on Forms';
$www::Prefs_Labels{APILayout}    = 'Tile Records Layout';
$www::Prefs_Labels{APIWeek}      = 'Start of Week';

# output format types
$www::APIOutFmt{Uncompressed}    = 'in browser';
##$www::APIOutFmt{Compressed}      = 'Compressed HTML';
$www::APIOutFmt{XTABS}           = 'in MS Excel';
##$www::APIOutFmt{Word_Compressed} = 'Compressed HTML for Word';
##$www::APIOutFmt{Word_NoComp}     = 'HTML for Word';

# direction format types
$www::APIOutDir{ASC}             = 'Ascending';
$www::APIOutDir{DESC}            = 'Descending';

# ID Window types
$www::APIOutWin{Blank}           = 'Opens the record into a new browser window.';
$www::APIOutWin{Self}            = 'Opens the record into the same window.';

# Tiles Layout
$www::APILayout{Horiz}           = 'Horizontally';
$www::APILayout{Vert}            = 'Vertically';

# View SQL types (Boolean)
$www::APIWeek{Sunday}            = 'Sunday';
$www::APIWeek{Monday}            = 'Monday';

@www::Light_Colors =
    ('bisque',
     'cornsilk',
     'ghostWhite',
     'khaki',
     'lightBlue',
     'lightCoral',
     'lightCyan',
     'lightGoldenrod',
     'lightGoldenrodYellow',
     'lightGreen',
     'lightPink',
     'lightSalmon',
     'lightSeagreen',
     'lightSkyBlue',
     'lightSteelBlue',
     'lightYellow',
     'linen',
     'silver',
     'snow',
     'white',
     'whiteSmoke');

# Dev Estimates
$API::Enumerations{Group_ID}            = 'Dev_Estimates';
$API::Enumerations{Risk}                = 'Dev_Estimates';
# Release Management
$API::Enumerations{Target_Release}      = 'Releases';
$API::Enumerations{Product}             = 'Releases';

$API::Enumerations{Department}          = 'Issues:Minutes:Boards:Parts_Request:EDRs:EIRs:Results:Cases:Builds:Reviews:Requests';
$API::Enumerations{Project}             = 'Issues:Minutes:Reviews:Eirs';
$API::Enumerations{Forum}               = 'Issues:Minutes:Eirs';
$API::Enumerations{Send_Email}          = 'Minutes';
$API::Enumerations{Build}               = 'Results';
$API::Enumerations{Type}                = 'Results';
$API::Enumerations{Found_Release}       = 'Results';
$API::Enumerations{Fix_Release} = 'Results';
##$API::Enumerations{Product}             = 'Results';
# Board was defined to BOM earlier, changes to parts request
$API::Enumerations{Board}               = 'Parts_Request';
$API::Enumerations{MFG1}                = 'BOM';
$API::Enumerations{Package}             = 'BOM';
$API::Enumerations{Reseller}            = 'BOM';
$API::Enumerations{Functional_Area}     = 'Cases';
$API::Enumerations{PCB_Assy_Function}   = 'Boards';

$API::Enumerations{Application}        = 'Builds';
$API::Enumerations{Area}                = 'Builds';
$API::Enumerations{NE_Type}            = 'Builds';
$API::Enumerations{System_Release}     = 'Builds:Releases';
$API::Enumerations{Rel_Type}            = 'Releases';

# for Action Requests
$API::Enumerations{AR_Type}             = 'Actions';
$API::Enumerations{Category}            = 'Actions';

# for firmware binaries
$API::Enumerations{FW_Type}            = 'Firmware';
$API::Enumerations{FW_Sub_Type}        = 'Firmware';
$API::Enumerations{FW_Release}          = 'Firmware';

# for workout tracker
$API::Enumerations{Leg}                = 'Logs';
$API::Enumerations{WorkOut}            = 'Logs';
$API::Enumerations{Equipment}          = 'Logs';

# added for reading the WAR table
$www::Hours{sep} = '_';

# the default order from keys is not acceptable
@www::List_Status =
    ('Open',
     'Past Due',
     'Ready to Close',
     'On Hold',
     'Closed',
     'Cancelled');

@www::List_Boolean =
    ('Yes',
     'No');
@www::List_Active = @www::List_Boolean;

@www::List_Gender =
    ('Male',
     'Female');

@www::List_Day =
    ('Sunday',
     'Monday',
     'Tuesday',
     'Wednesday',
     'Thursday',
     'Friday',
     'Saturday');

@www::Since =
    ('Today',
     'Yesterday',
     'Sunday',
     'Seven Days Ago',
     'Last Sunday',
     'Fourteen Days Ago',
     'Beginning of the Month',
     'Beginning of the Year',
     'Dawn of Time');

@www::QueryCols =
    ('Name',
     'QueryUserid',
     'TableName',
     'OrderBy',
     'GroupBy',
     'Format',
     'Display',
     'Since',
     'Other');

@www::AccountCols =
    ('user_id',
     'user_login',
     'user_pass',
     'user_nicename',
     'user_email',
     'user_url',
     'user_registered',
     'display_name',
     'startdate',
     'enddate',
     'status',
     'modified');

@www::IPCols =
    ('ID',
     'IP',
     'HTTP_COOKIE',
     'HTTP_USER_AGENT',
     'Userid',
     'Modified');

$www::Size{Userid}       = 32;
$www::Size{Password}     = 32;
$www::Size{Verify}       = $www::Size{Password};
$www::Size{Name}         = 80;
$www::Size{Email}        = 80;
$www::Size{Phone}        = 20;
$www::Size{City}         = 80;
$www::Size{State}        = 2;
$www::Size{Postal_Code}  = 5;
$www::Size{Country_Code} = 2;

$API::Label{Userid}     = 'Username';
$API::Label{Password}   = 'Password';
$API::Label{Verify}     = 'Re-Type Password';
$API::Label{DOB}        = 'Date of Birth';

$API::Label{EndDate}    = 'PMPro End Date';

$www::Help{Userid}       = 'Up to 40 characters alpha-numeric';
$www::Help{Password}     = 'Up to 8 characters alpha-numeric++';
$www::Help{Verify}       = 'Must match your password';
$www::Help{Name}         = 'Up to 80 characters alpha-numeric';
$www::Help{Email}        = 'Up to 80 characters alpha-numeric';
$www::Help{Phone}        = 'Up to 80 characters numeric';
$www::Help{DOB}          = $www::date_format;
$www::Help{City}         = 'Up to 80 characters alpha-numeric';
$www::Help{State}        = '2 characters alpha';
$www::Help{Postal_Code}  = '5 characters numeric';
$www::Help{Country_Code} = '2 characters alpha';
$www::Help{Gender}       = 'Future Use';

$www::db_dev_estimates_table = 'dev_estimates';
$www::db_releases_table = 'rlogs';
$www::db_query_table = 'saved_queries';
$www::db_org_table = 'xxx.orgchart';
$www::db_accounts_table = $www::db_org_table;
$www::db_ip_table = 'xxx.accounts_by_ip';

$www::ImageTags{Email}   = "<i class='fa fa-envelope-o'></i> ";
$www::ImageTags{NoEmail} = "<i class='fa fa-user-times'></i> ";
$www::ImageTags{Sort}    = "<i class='fa fa-sort'></i> ";
$www::ImageTags{Hide}    = "<i class='fa fa-eye-slash'></i> ";
$www::ImageTags{Left}    = "<i class='fa fa-left'></i> ";
$www::ImageTags{Right}   = "<i class='fa fa-right'></i> ";
$www::ImageTags{Filter}  = "<i class='fa fa-filter'></i> ";
$www::ImageTags{Kill}    = '<i class="fa fa-minus-square-o"></i>';

$www::ImageTags{Week}    = "<i class='fa fa-calendar-o'></i> ";
$www::ImageTags{Month}   = "<i class='fa fa-calendar'></i> ";
$www::ImageTags{Year}    = "<i class='fa fa-calendar'></i> ";

$www::GrEq{title} = 'Greater Than or Equal to';
$www::GrEq{tag} = '&#131';
$www::GrEq{tag} = "<i class='fa fa-search-plus'></i> ";

$www::LtEq{title} = 'Less Than or Equal to';
$www::LtEq{tag} = '&#134';
$www::LtEq{tag} = "<i class='fa fa-search-minus'></i> ";

$www::OnAfter{title} = 'On or After';
$www::OnAfter{tag} = '&#131';

$www::BeforeOn{title} = 'Before or On';
$www::BeforeOn{tag} = '&#134';

$www::HTML{Image} = "/images/$API::Site{name}.gif";
$www::HTML{ImageHeight} = 59;
$www::HTML{DayFormat} = 'kbd';
$www::HTML{t1} = "<td valign=top>
<table class='table'>
<tr>
<td bgcolor=lightgrey align=center>
<b>";
$www::HTML{t2} = "<br>
</b>
</td>
</tr>
<tr>
<td valign=top>
<center>";
$www::HTML{Terminal} = 'font color=darkgray face=Terminal size=-1';
$www::HTML{Site_CSS} = "/css/$API::Site{name}.css";
$www::HTML{User_CSS} = '';

$www::Menu_Labels{Newest}       = "<a title=\'New!\'><font color=red size=-1> &#134</font></a>";
$www::Menu_Labels{Main_Menu}    = 'Home<br>Page';
$www::Menu_Labels{Show_Details} = 'Tile<br>Records';
$www::Menu_Labels{Build_Rpt}    = 'Query<br>';
$www::Menu_Labels{Metrics}      = 'Metrics<br>Report';
$www::Menu_Labels{Search}       = 'Search<br>';
$www::Menu_Labels{Edit_Prefs}   = 'Change<br>Options';
$www::Menu_Labels{Form_Submit}  = 'Form has been submitted.  Please wait...';
# remove this after all applications have been changed
$www::Menu_Labels{Top}          = '';

# mozilla firefox does not display newlines correctly
if ($ENV{HTTP_USER_AGENT} =~ /Firefox/) {
   $www::Help{Multiple_Sel_Title}
   = "Multiple Select: control/left-button to select individual items, shift/left-button to select a range of items";
   $www::Help{Single_Sel_Title}
   = "Single Select: left-button to select an individual item";
} else {
   $www::Help{Multiple_Sel_Title}
   = "Multiple Selection List:
Use control/left-button to select/de-select individual items
Use shift/left-button to select a range of items";
   $www::Help{Single_Sel_Title}
   = "Single Selection List:
Use left-button to select an individual item";
}

$www::Help{Append_Title}
= 'Added as a bullet with date and author indicated';
$www::Help{ID}
= 'Automatic: Unique record identifier';
$www::Help{Department}
= 'Automatic: Change using My Department pull-down menu';
$www::Help{Originator}
= 'Mandatory: Not editable';
$www::Help{Lead}
= 'Mandatory: Allowed to edit this record';
$www::Help{Select_One}
= 'Mandatory: Select One';
$www::Help{Status}
= $www::Help{Select_One};
$www::Help{Project}
= 'Mandatory: Department-based list';
$www::Help{Forum}
= 'Mandatory: Department-based list';
$www::Help{Work_Package}
= 'Mandatory: Work Package Number';
$www::Help{Title}
= 'Mandatory: Short descriptive title';
$www::Help{Date}
= $www::date_format;
$www::Help{Assigned}
= "Mandatory, will not be editable: $www::date_format";
$www::Help{Due}
= "Mandatory, will not be editable: $www::date_format";
$www::Help{RevDue}
= "Optional: $www::date_format";
$www::Help{Append_Only}
= "Can not be editted once submitted, only added to";
$www::Help{Description}
= $www::Help{Append_Only};
$www::Help{Comments}
= $www::Help{Append_Only};
$www::Help{Documents}
= 'Attach/Remove Documents or URLs';
$www::Help{DocumentRef}
= 'Optional: Unformatted Text';
$www::Help{Minutes}
= 'Automatic: Link to Meeting Minutes, if applicable';
$www::Help{MinutesRef}
= 'Optional: Unformatted Text';
$www::Help{History}
= 'Automatic: Appended to each time this record is changed';
$www::Help{Modified}
= 'Automatic: Last time this record has changed';
$www::Help{Helpers}
= 'Optional: Allowed to edit this issue';
$www::Help{Notify}
= 'Optional: Not allowed to edit this record';
$www::Help{External}
= 'Optional: Enter address\'';
$www::Help{Send_Email}
= 'If sent immediately, then all of todays changes will cause emails to be sent';
$www::Help{Search}
= 'Optional: Case insensitive search string';
$www::Help{RegExp}
= "<h3>Regular Expressions Syntax</h3><br>
<ul>
<li>
<i>n</i> : Return record where ID number = <i>n</i> 

<li>
<i>n1</i> :<i>n2</i> :<i>n3...</i> : Return records where ID number =
<i>n1</i> or <i>n2</i> or <i>n3</i> 

<li>
<i>n1</i> -<i>n2</i> </i> : Return records where ID number =
<i>n1</i> through <i>n2</i> 

<li>
&gt<i>n</i> : Return records where ID number &gt <i>n</i> 

<li>
&lt<i>n</i> : Return records where ID number &lt <i>n</i> 

</ul>
";

$www::Help{External_Verbose}
= 'List of email address\' that will receive an email when this Issue is
created or changed.<br>
They may be separated by spaces, tabs, commas or semi-colons.<br>
Since the email will not contain a hyper-link to the database,
it will include all the fields.<br>';

$www::HTML{Legal_NA} = '';

$www::HTML{Legal} = "<p>
<b>ACCEPTANCE OF TERMS</b><br>
Welcome to the $API::title Intranet Tool.<br>
Passwords are stored in using 64-bit DES encryption, but are sent 'in the clear' to the server.<br>
<p>
This same account information is used to login to the Subversion server.<br>
Unfortunately, for Subversion access, the passwords must be stored in free-text on the MS Windows Subversion server.
<p>
The data is backed up to the N drive daily.
Do not close your browser window if you receive an error, contact me ASAP instead.
<p>
";


#*****************************************************************************
#
# Routine:      header
#
#*****************************************************************************
sub header {
   my $here = $API::program.'::header';

   my $title = shift(@_);
   my $msg = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: title=$title, msg=$msg\n";
   }

   my $formJava = '';
   if ($msg eq 'REFRESH') {
      $msg = '';
      # refresh Main Menu pages every 5 minutes (300 seconds)
      $formJava = "
</script>
<meta http-equiv=\"REFRESH\" content=\"300;url=$ENV{SCRIPT_NAME}\">";
   }

   my $utitle = &get_user_title($ENV{REMOTE_USER});

   my $rtitle = $title;
   # in the real title, don't use HTML test
   if ($rtitle =~ /^([^<]*)</) {
      $rtitle = $1;
   }

   my $ssl_title = 'Connection not encrytpted';
   if ($ENV{HTTP_COOKIE}) {
      $ssl_title .= ', HTTP Cookie: '. $ENV{HTTP_COOKIE};
   }
   my $ssl_i = "<small><i class='fa fa-chain-broken'></i></small> ";
   if ($ENV{SSL_CIPHER}) {
      if ($ENV{SSL_SESSION_ID}) {
         $ssl_title = 'SSL Session ID: '.$ENV{SSL_SESSION_ID};
      }
      ##$ssl_title .= ", $ENV{SSL_PROTOCOL}/$ENV{SSL_CIPHER}/$ENV{SSL_CIPHER_ALGKEYSIZE} bit\n";
      ##$ssl_title .= ", $ENV{SSL_SERVER_I_DN_CN}, $ENV{SSL_SERVER_I_DN_O}, $ENV{SSL_SERVER_I_DN_OU}\n";
      ##$ssl_title .= ", $ENV{SSL_SERVER_I_DN_L}, $ENV{SSL_SERVER_I_DN_ST}, $ENV{SSL_SERVER_I_DN_C}\n";
      $ssl_i = "<small><i class='fa fa-key'></i></small> ";
   }

   my $navbar_class = "navbar-inverse";
   my $welcome = "<a title='$ENV{REMOTE_USER}'>Welcome, $www::Name{$ENV{REMOTE_USER}}</a>";
   if ($ENV{REMOTE_USER} eq $API::Site{guest}) {
      $welcome = "<a title='$www::policy_title' href='$ENV{SCRIPT_NAME}'>Welcome, $www::Name{$ENV{REMOTE_USER}}</a>";
   }
   my $logout = "";
   my $settings = "";
   if ($ENV{REMOTE_USER} ne $API::Site{guest}) {
      $navbar_class = "navbar-default";
      my ($first, $other) = split(/ /, $www::Name{$ENV{REMOTE_USER}});
      $welcome = "<a title='Edit Account' href='$ENV{SCRIPT_NAME}?Edit=Account'>Welcome, $first</a>";
      $logout = "<a title='Sign Out' href='$ENV{SCRIPT_NAME}?Edit=Logout'><i class='fa fa-sign-out'></i> Sign Out</a>";
      $settings = "<a title='Edit Options' href='$ENV{SCRIPT_NAME}?Prefs=Edit&Table=elogs'><i class='fa fa-wrench'></i> Settings</a>";
   }

   my $icon = '';
   if ($www::HTML{Appl_Icon}) {
      $icon = "<link rel='icon' type='image/vnd.microsoft.icon' href='$www::HTML{Appl_Icon}'>";
   };

   # check for User CSS file
   if ($www::HTML{User_CSS}) {
      my $css = $ENV{DOCUMENT_ROOT}.$www::HTML{User_CSS};
      unless (-r $css) {
         $www::HTML{User_CSS} = '';
	 print STDERR "$here: User CSS, $css does not exist\n";
      }
   }

   my $info = '';
   if ($www::My_Prefs{elogsMgmt} eq 'A') {
      $info = "<br><font color=red>$API::Site{account} on $API::Site{sql_server}</font>";
   }

   my $div_title = "<div class='container-fluid'><h4>$title</h4></div>";
   if ($title =~ /button/) {
     $div_title = "<div class='btn-group' role='group'>
$title
</div>";
   }

   my $navbar_product = "<a class='navbar-brand' title='Version: $API::revision, $ssl_title' href='$ENV{SCRIPT_NAME}' name='navbar-brand' id='navbar-brand'>$API::title$ssl_i</a>";
   ##<li><a title='$ssl_title' href=\"/\">$ENV{SERVER_NAME}$ssl_i</a></li>
   my $html_title = $API::title;
   if ($rtitle) {
      $html_title .= "//$rtitle";
   }
   my $out = "Content-type: text/html

<html>
<head>
<meta charset='utf-8'>
<meta name='viewport' content='width=device-width, initial-scale=1'>
<meta property='og:type' content='website'>
<link rel='stylesheet' type='text/css' href='/css/font-awesome.css'>
<link rel='stylesheet' type='text/css' href='/css/bootstrap.css'>
<link rel='stylesheet' type='text/css' href='/css/sub-menus.css'>
<link rel='stylesheet' type='text/css' href='/css/navbar-fixed-top.css'>
<link rel='stylesheet' type='text/css' href='$www::HTML{Appl_CSS}'>
<link rel='stylesheet' type='text/css' href='$www::HTML{User_CSS}'>
<style>
.carousel-inner > .item > img,
.carousel-inner > .item > a > img {
  height: $www::My_Prefs{elogsCH}%;
  margin: auto;
}
</style>
$icon
<title>
$html_title
</title>
<script language='javascript' type='text/javascript' src='/jquery-2.1.3.min.js'></script>
<script language='javascript' type='text/javascript' src='/bootstrap.min.js'></script>
<script language='javascript' type='text/javascript' src='/infobox.js'></script>
<script language='javascript' type='text/javascript' src='/createImageBox.js'></script>
<script language='javascript' type='text/javascript' src='$www::HTML{Appl_JS}'></script>
<div id='infodiv' style='position: absolute; visibility: hidden; z-index: 20; top: 0px; left: 0px;'></div>
<div id='hintbox' style='position: absolute; visibility: hidden; z-index: 20; top: 0px; left: 0px;'></div>
</head>
<body>

  <!-- Fixed navbar -->
  <nav class='navbar $navbar_class navbar-fixed-top' name='$navbar_class' id='$navbar_class' role='navigation'>
    <div class='container' name='navbar-container' id='navbar-container'>
      <div class='navbar-header' name='navbar-header' id='navbar-header'>
        <button type='button' class='navbar-toggle collapsed' name='navbar-toggle' id='navbar-toggle' data-toggle='collapse' data-target='#navbar' aria-expanded='false' aria-controls='navbar'>
          <span class='sr-only'  name='sp_toggle' id='sp_toggle'>Toggle navigation</span>
          $API::burger
        </button>
        $navbar_product
      </div>
      <div class='navbar-collapse collapse' name='navbar' id='navbar' >
        <ul class='nav navbar-nav' name='mb_left' id='mb_left'>
          $API::navbar
        </ul>
        <ul class='nav navbar-nav navbar-right' name='welcome' id='welcome'>
          <li>$welcome</li>
          <li>$logout</li>
          <li class='hidden-md'>$settings</li> 
       </ul>
      </div><!--/.nav-collapse -->
    </div>
  </nav>
$div_title
$msg
";
   print $out;
   $API::bytes += length($out);
}


#*****************************************************************************
#
# Routine:      footer
#
#*****************************************************************************
sub footer {
   my $here = $API::program.'::footer';

   my $msg = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: msg=$msg\n";
   }

   my $sql = '';
   if (($www::My_Prefs{APIViewSQL}) &&
       ($www::My_Prefs{APIViewSQL} eq 'Yes')) {
      if ($API::sql) {
         $sql = "<div class=itemFoot>$API::sql</div>";
      }
   }
   my $out = "<a name=END></a>
</center>
$sql
</body>
<foot>
$msg
$www::HTML{Foot}
</foot>
</html>\n";
   print $out;
   $API::bytes += length($out);
}


#*****************************************************************************
#
# Routine:      get_dir_buttons
#
#*****************************************************************************
sub get_dir_buttons {
   my $here = $API::program.'::get_dir_buttons';

   my $id = shift(@_);
   my $order = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: id=$id order=$order www::Form{IDL}=$www::Form{IDL}\n";
   }

   $www::disabled{first} = 'disabled';
   $www::disabled{previous} = 'disabled';
   $www::disabled{next} = 'disabled';
   $www::disabled{last} = 'disabled';
   my $td = '';
   # Add extra links to next & previous
   my $first = 0;
   my $last = 0;
   my $next = $id+1;
   my $previous = $id-1;
   my $andIDL = '';

   if (($www::Form{IDL}) &&
       ($www::Form{IDL} ne $www::null_IDL)) {
      $andIDL = "&IDL=$www::Form{IDL}";

      $next = 0;
      $previous = 0;
      my $i = 0;
      my @IDL = split(/:/, $www::Form{IDL});
      if ($IDL[0] != $id) {
         $first = $IDL[0];
      }
      if ($IDL[$#IDL] != $id) {
         $last = $IDL[$#IDL];
      }

      foreach my $entry (@IDL) {
         if ($id == $IDL[$i]) {
            if ($i < $#IDL) {
               $next = $IDL[$i+1];
            }
            if ($i) {
               $previous = $IDL[$i-1];
            }
            last;
         }
         $i++;
      }
   } else {
      $www::Form{IDL} = $id;
   }

   if ($API::diag > 2) {
      print STDERR "$here: previous=$previous id=$id next=$next\n";
   }

   if ($first == 0 && $last == 0) {
     return '';
   }
   if ($first) {
     $www::disabled{first} = '';
     $www::disabled{previous} = '';
   }
   if ($last) {
     $www::disabled{next} = '';
     $www::disabled{last} = '';
   }

   my $div = "<div class='btn-group' role='group'>\n";
   $div .= "<button type='button' class='btn btn-info $www::disabled{first}' title='Go to first record on set'
onClick=\"window.location='?ViewBy=ID&OrderBy=$order&ID=$first$andIDL'\">
<span class='glyphicon glyphicon-fast-backward'></span> First
</button>\n";
   $div .= "<button type='button' class='btn btn-info $www::disabled{previous}' title='Go back one record'
onClick=\"window.location='?ViewBy=ID&OrderBy=$order&ID=$previous$andIDL'\">
<span class='glyphicon glyphicon-step-backward'></span> Previous
</button>\n";
   $div .= "<button type='button' class='btn btn-info $www::disabled{next}' title='Go forward one record'
onClick=\"window.location='?ViewBy=ID&OrderBy=$order&ID=$next$andIDL'\">
<span class='glyphicon glyphicon-step-forward'></span> Next
</button>\n";
   $div .= "<button type='button' class='btn btn-info $www::disabled{last}' title='Go to last record in set'
onClick=\"window.location='?ViewBy=ID&OrderBy=$order&ID=$last$andIDL'\">
<span class='glyphicon glyphicon-fast-forward'></span> Last
</button>\n";
   $div .= "</div>\n";

   return $div;
}


#*****************************************************************************
#
# Routine:      regexp_syntax_error
#
#*****************************************************************************
sub regexp_syntax_error {
   my $here = $API::program.'::regexp_syntax_error';

   my $regexp = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: regexp=$regexp\n";
   }

   my $msg = 'Syntax Error';
   my $out = "<center>
<h2><font color=red>
$msg in $regexp
</font></h2>
</center>
";
   $out .= $www::Help{RegExp};

   &header($msg, '');
   print $out;
   $API::bytes += length($out);
   &footer('');
   exit;
}


#*****************************************************************************
#
# Routine:      get_hh_mm_ss
#
#*****************************************************************************
sub get_hh_mm_ss {
   my $here = $API::program.'::get_hh_mm_ss';

   my $secs = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: secs=$secs\n";
   }

   my $time = '';
   if ($secs) {
      my $hh = int($secs / 3600);
      my $rem = int($secs % 3600);
      my $mm = int($rem / 60);
      my $ss = int($rem % 60);
      $time = sprintf('%d:%2.2d:%2.2d', $hh, $mm, $ss);
   }

   return $time;
}


#*****************************************************************************
#
# Routine:      get_max_id
#
#*****************************************************************************
sub get_max_id {
   my $here = $API::program.'::get_max_id';

   my $table = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: table=$table\n";
   }

   my $sth = $API::dbh->prepare("SELECT MAX(ID) AS ID
FROM $table;");
   $API::queries++;
   $sth->execute();

   my $ref = $sth->fetchrow_hashref();

   return $ref->{ID};
}


#*****************************************************************************
#
# Routine:      get_range
#
#*****************************************************************************
sub get_range {
   my $here = $API::program.'::get_range';

   my $min = shift(@_);
   my $max = shift(@_);
   my $exp = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: min=$min max=$max exp=$exp\n";
   }

   if ($max < $min) {
      &regexp_syntax_error("$exp ($max is less than $min)");
   }
   my $range = '';
   foreach my $id ($min .. $max) {
      $range .= $id.':';
   }

   return $range;
}


#*****************************************************************************
#
# Routine:      regexp_to_sql
#
#*****************************************************************************
sub regexp_to_sql {
   my $here = $API::program.'::regexp_to_sql';

   my $rlist = shift(@_);
   my $table = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: rlist=$rlist table=$table\n";
   }

   $www::Form{RegExp} = $rlist;
   # strip off all whitespace
   $rlist =~ s/\s//g;
   my $sql = '';
   foreach my $regexp (split(/:/, $rlist)) {
      if ($regexp =~ /^(\d+)$/) {
         $sql .= $1.':';
      } elsif ($regexp =~ /^(\d+)\-(\d+)$/) {
         $sql .= &get_range($1, $2, $regexp);
      } elsif ($regexp =~ /^\<(\d+)$/) {
         my $max = $1;
         $max++;
         $sql .= &get_range(1, $max, $regexp);
      } elsif ($regexp =~ /^\>(\d+)$/) {
         my $min = $1;
         $min++;
         my $max = &get_max_id($table);
         $sql .= &get_range($min, $max, $regexp);
      } else {
         &regexp_syntax_error($rlist);
      }
   }
   $sql =~ s/:$//g;

   return $sql;
}


#*****************************************************************************
#
# Routine:      edit_account
#
#*****************************************************************************
sub edit_account {
   my $here = $API::program.'::edit_account';

   my $userid = shift(@_);
   my $ip = shift(@_);
   my $errmsg = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: userid=$userid ip=$ip errmsg=$errmsg\n";
   }

   my $msg;
   my $value;
   my $type;
   my $legal;
   if ($userid eq 'NULL') {
      $msg = "New User Request Form";
      $value = 'I Agree';
      $type = 'New';
      $legal = $www::HTML{Legal};
   } else {
      $msg = "Display User $userid Form";
      $value = 'Changes Disabled';
      $type = 'Old';
      $legal = $www::HTML{Legal_NA};
   }
   my $submit = "<input class='$BS::submit' type='submit' name=Submit value='$value' disabled=1 >
<input type=hidden name=Type value=$type>";

   my $ref;
   if ($errmsg) {
      # this is the simplest way to make these fields editable
      if ($userid eq 'NULL') {
         $www::Form{Userid} = '';
         $www::Form{Password} = '';
         $www::Form{Verify} = '';
      }
   } else {
      if ($userid eq 'NULL') {
         foreach my $col (@www::AccountCols) {
            $www::Form{$col} = '';
         }
         $www::Form{Email} = '';
         $www::Form{Phone} = '';
         $www::Form{City} = '';
         $www::Form{State} = '';
         $www::Form{Postal_Code} = '';
         $www::Form{Country_Code} = '';
         $www::Form{Active} = 'Yes';
      } else {
         my $sth = $API::mmtc_dbh->prepare("SELECT *
FROM wp_users, wp_pmpro_memberships_users
WHERE wp_users.ID = wp_pmpro_memberships_users.user_id AND user_login = ?;");
         $API::queries++;
         $sth->execute($userid);

         $ref = $sth->fetchrow_hashref();

         foreach my $col (@www::AccountCols) {
            $www::Form{$col} = $ref->{$col};
            ##print STDERR "$here: www::Form{$col}=$www::Form{$col}, ref->{$col}=$ref->{$col}\n";
         }
      }
   }

   my $out = $legal;
   foreach my $col (@www::AccountCols) {
      unless ($www::Help{$col}) {
         $www::Help{$col} = "Help on $col TBD";
      }
      # change underscores to word-breaks
      my $label = $col;
      if ($API::Label{$col}) {
         $label = $API::Label{$col};
      }
      # change underscores to spaces
      $label =~ s/_/ /g;

      if ($col eq 'Userid') {
         if ($userid eq 'NULL') {
            $out .= &build_select_td($label,
                                     $www::Help{$col},
                                     &build_text($col, $www::Size{$col}));
         } else {
            $out .= "<input type=hidden name=$col value='$userid'>
$www::HTML{Password}\n";
         }

      } elsif ($col eq 'Prefs') {
         $out .= "<input type=hidden name=$col value='$www::Form{$col}'>\n";

      } elsif ($col eq 'DOB') {
         $out .= &build_select_td($label,
                                  $www::Help{$col},
                                  &build_date($col, 0));

      } elsif (($col eq 'Password') ||
               ($col eq 'Verify')) {
         $out .= &build_select_td($label,
                                  $www::Help{$col},
                                  &build_password($col, $www::Size{$col}));

      } elsif (($col eq 'Active') ||
               ($col eq 'Gender')) {
         no strict 'refs';
         my $array = "www::List_$col";
         my $radio = &build_radio_list($col, \@$array);
         $out .= "<p>
<label class='col-sm-2 control-label' title='$www::Help{$col}'>$col</label>
<label>$radio</label>
</p>";

      } elsif (($col eq 'History') ||
               ($col eq 'Modified')) {
         unless ($userid eq 'NULL') {
            my $td = $ref->{$col};
            $out .= &build_select_td($label,
                                     $www::Help{$col},
                                     $td);
         }
      } else {
         $out .= &build_select_td($col,
                                  $www::Help{$col},
                                  &build_text($col, $www::Size{$col}));
      }
   }

   if (($www::My_Prefs{APIViewReset}) &&
       ($www::My_Prefs{APIViewReset} ne 'No')) {
      $www::Default{ResetForm} = "<input class='$BS::reset' type='reset' value='Discard Changes'>";
   }

   &header($msg, '');

   # large labels require more than 10%
   $out = "$errmsg

<form method=post action=$ENV{SCRIPT_NAME}>
<input type=hidden name=Field value=Accounts>
<input type=hidden name=Prefs value='$www::Form{Prefs}'>
$out
<p>
$submit
$www::Default{ResetForm}
<p>
</form>\n";
   print $out;
   $API::bytes += length($out);

   $www::HTML{Foot} = "";
   &footer('');
}


#*****************************************************************************
#
# Routine:      logout
#
#*****************************************************************************
sub logout {
   my $here = $API::program.'::logout';

   my $ip = shift(@_);
   my $errmsg = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: ip=$ip errmsg=$errmsg\n";
   }

   my $sth = $API::dbh->prepare("DELETE
FROM $www::db_ip_table
WHERE IP = ?;");
   $API::queries++;
   $sth->execute($ip);

   $ENV{REMOTE_USER} = $API::Site{guest};
   &read_orgchart_table;
   &build_buttons;
   &splash;
}


#*****************************************************************************
#
# Routine:      login
#
#*****************************************************************************
sub login {
   my $here = $API::program.'::login';

   my $ip = shift(@_);
   my $errmsg = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: ip=$ip errmsg=$errmsg\n";
   }

   $API::Extras = '';

   my $msg = "<i class='fa fa-sign-in'></i> Sign In from $ip";
   my $submit = "<input class='$BS::submit' type='submit' name=signin value='Sign In'>";

   my $to = $ENV{SERVER_ADMIN};
   my $out = "<p>
<div>
<h4>
To Log In, simple use your MMTC Username and Password</br>
Can't remember your Username or Password?<br>
First, check the \"Caps Lock\", I'm not sure why it can't be disbled, I never use it.<br>
If that doesn't work, just send me, $API::Site{sysadmin}, an
<a href='mailto:$to'>email</a>, I will reset it for you.<br>
</h4>
<div>
";

   $col = 'Userid';
   $www::Form{$col} = '';
   $out .= &build_select_td($API::Label{$col},
                            $www::Help{$col},
                            &build_text($col, $www::Size{$col}));

   $col = 'Password';
   $www::Form{$col} = '';
   $out .= &build_select_td($API::Label{$col},
                            $www::Help{$col},
                            &build_password($col, $www::Size{$col}));

   &header($msg, $API::Extras);

   $out = "$errmsg

<form method=post action=$ENV{SCRIPT_NAME}>
<input type=hidden name=Field value=Login>
<input type=hidden name=IP value='$ip'>
$out
<p>
$submit
<input class='$BS::reset' type='reset' value='Reset'>
<p>
</form>\n";
   print $out;
   $API::bytes += length($out);
   &footer('');
}


#*****************************************************************************
#
# Routine:      write_free_text_passwd
#
#*****************************************************************************
sub write_free_text_passwd {
   my $here = $API::program.'::write_free_text_passwd';

   my $cmd = shift(@_);
   my $userid = shift(@_);
   my $passwd = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: cmd=$cmd, userid=$userid, passwd=$passwd\n";
   }

   my $old = 'passwd';
   my $new .= $old.'.tmp';

   open(OLD, $old) ||
       die ("$here: Error opening $old for reading: $!\n");
   # Read/parse file from standard in
   my @Lines = <OLD>;
   close(OLD) ||
       die ("$here: Error closing $old after reading: $!\n");

   open(NEW, '>'.$new) ||
       die ("$here: Error opening $new for write: $!\n");
   my $found = 0;
   foreach my $line (@Lines) {
      if ($line =~ /^$userid/) {
         $found++;
         print NEW "$userid = $passwd\n";
      } else {
         print NEW $line;
      }
   }
   unless ($found) {
      print NEW "$userid = $passwd\n";
   }
   close(NEW) ||
       die ("$here: Error closing $new after writing: $!\n");

   rename($old, $old.'.last') ||
       die ("$here: Error renaming $old: $!\n");
   rename($new, $old) ||
       die ("$here: Error renaming $new to $old: $!\n");
}


#*****************************************************************************
#
# Routine:      write_account
#
#*****************************************************************************
sub write_account {
   my $here = $API::program.'::write_account';

   if ($API::diag > 2) {
      print STDERR "$here: www::Form{Userid}=$www::Form{Userid}\n";
   }

   if ($API::diag > 3) {
      foreach my $col (@www::AccountCols) {
         print STDERR "$here: www::Form{$col}=$www::Form{$col}\n";
      }
   }

   if ($www::Form{Password} ne $www::Form{Verify}) {
      my $errors = 'Password entries do not match';
      &edit_account($www::Form{Userid}, $ENV{REMOTE_ADDR},
                    &print_errors($errors));
      return 0;
   }

   my $created = "$API::today -- Created by $ENV{REMOTE_USER}";

   # always check if the userid is already in use
   my $sth = $API::dbh->prepare("SELECT *
FROM $www::db_accounts_table
WHERE Userid = ?;");
   $API::queries++;
   $sth->execute($www::Form{Userid});

   my $ref = $sth->fetchrow_hashref();

   my $command;
   if ($www::Form{Userid} ne $ref->{Userid}) {
      # verify new accounts match application requirements
      my $errors = &verify_new_account($www::Form{Userid});
      if ($errors) {
         &edit_account('NULL', $ENV{REMOTE_ADDR},
                       &print_errors($errors));
         return 0;
      }
      $command = 'INSERT';
      $www::Form{History} = $created;
   } else {
      if ($www::Form{Type} eq 'New') {
         my $errors = "User ID, $www::Form{Userid} already in use";
         &edit_account('NULL', $ENV{REMOTE_ADDR},
                       &print_errors($errors));
         return 0;
      }

      $command = 'REPLACE';

      $www::Form{History} = $ref->{History};
      $www::Form{History} .= "<br>
$API::today -- Modified by $ENV{REMOTE_USER}";

      my $changes = 0;
      foreach my $col (@www::AccountCols) {
         if (($col eq 'History') ||
             ($col eq 'Prefs') ||
             ($col eq 'Verify') ||
             ($col eq 'Modified')) {
            next;
         }

         if ($www::Form{$col} ne $ref->{$col}) {
            $changes++;
            $www::Form{History} .= ", $col changed";
            unless ($col eq 'Password') {
               my $old = $ref->{$col};
               my $new = $www::Form{$col};

               foreach my $item (\$old, \$new) {
                  if ($$item eq '') {
                     $$item = $www::undefined;
                  }
               }
               $www::Form{History} .= " from $old to $new";
            }
         }
      }
      unless ($changes) {
         my $errors = 'No account changes found';
         &edit_account($www::Form{Userid}, $ENV{REMOTE_ADDR},
                       &print_errors($errors));
         return 0;
      }
   }

   # insert the record
   my $sql = "$command INTO $www::db_accounts_table SET ";
   # do not store passwords in the clear anymore
   foreach my $col (@www::AccountCols) {
      unless (($col eq 'Modified') ||
              ($col eq 'Password') ||
              ($col eq 'Verify')) {
         $sql .= "$col = ".$API::dbh->quote("$www::Form{$col}").',';
      }
   }

   # add encrypted password
   my $col = 'Passwd';
   # not sure what seed to choose, why not WT?
   $www::Form{$col} = crypt($www::Form{Password}, 'WT');
   $sql .= "$col = ".$API::dbh->quote("$www::Form{$col}").',';

   $sql =~ s/,$/;/g;
   if ($API::diag > 3) {
      print STDERR "$here: sql=$sql\n";
   }
   $API::dbh->do($sql);

   &write_free_text_passwd($command, $www::Form{Userid}, $www::Form{Password});
   print STDERR "$here: $ENV{REMOTE_USER}, $command, $www::Form{Userid}\n";

   # switch users if a new account is created
   if ($ENV{REMOTE_USER} eq $API::Site{guest}) {
      $userid = $www::Form{Userid};
      $ENV{REMOTE_USER} = $userid;
      $www::Passwd{$userid} = $www::Form{Passwd};
      $www::Form{IP} = $ENV{REMOTE_ADDR};
      &process_login;
   } else {
      $www::HTML{Legal_NA} = '<p>
<big><font color=green>
Account Information Updated
</font></big>';
      &edit_account($www::Form{Userid}, $ENV{REMOTE_ADDR}, '');
   }
   return 1;
}


#*****************************************************************************
#
# Routine:      verify_wordpress_pass
#
#*****************************************************************************
sub verify_wordpress_pass {
    my ($wordpress_hashed_pw, $passphrase) = @_;

    use Authen::Passphrase::PHPass;

    my $ppr = Authen::Passphrase::PHPass->from_crypt($wordpress_hashed_pw);

    # Note, $passphrase is the unencrypted password you want to verify
    return $ppr->match($passphrase); # Returns 1 if matched, undef if failed
}


#*****************************************************************************
#
# Routine:      process_login
#
#*****************************************************************************
# use HASH MAC
use Digest::HMAC;
use Digest::HMAC_SHA1;
use Digest::SHA;

sub process_login {
   my $here = $API::program.'::process_login';

   if ($API::diag > 1) {
      print STDERR "$here:\n";
   }

   my $invalid_code = 'Invalid Userid or Password';
   my $userid = $www::Form{Userid};
   my $ip = $www::Form{IP};

   # verify that userid exists
   unless ($www::Passwd{$userid}) {
      &login($ip, &print_errors($invalid_code));
      return;
   }

   my $wp_passwd = $www::Passwd{$userid};

   my $ok = verify_wordpress_pass($wp_passwd, $www::Form{Password});

   if ($API::diag > 2) {
      print STDERR "$here: www::Passwd{$userid}=$www::Passwd{$userid}\n";
      print STDERR "$here: www::Form{Password}=$www::Form{Password}\n";
      print STDERR "$here: wp_passwd=$wp_passwd, ok=$ok\n";
   }
   if ($ok == 0) {
       &login($ip, &print_errors($invalid_code));
       return;
   }

   # add HTTP_USER_AGENT for more uniqueness (IP is not unique through firewalls)
   $www::Form{HTTP_USER_AGENT} = $ENV{HTTP_USER_AGENT};
   # add SSL_SESSION_ID or HTTP_COOKIE for uniqueness
   $www::Form{HTTP_COOKIE} = 'No cookie or SSL';
   if ($ENV{HTTP_COOKIE}) {
       $www::Form{HTTP_COOKIE} = $ENV{HTTP_COOKIE};
   }
   if ($ENV{SSL_SESSION_ID}) {
       $www::Form{HTTP_COOKIE} = $ENV{SSL_SESSION_ID};
   }

   my $sql = "REPLACE INTO $www::db_ip_table SET ";
   foreach my $col (@www::IPCols) {
      unless ($col eq 'Modified') {
         if ($www::Form{$col}) {
            $sql .= "$col = ".$API::dbh->quote("$www::Form{$col}").',';
         }
      }
   }
   $sql =~ s/,$/;/g;
   if ($API::diag > 3) {
      print STDERR "$here: sql=$sql\n";
   }
   $API::dbh->do($sql);

   $ENV{REMOTE_USER} = $userid;
   &read_orgchart_table;
   &build_buttons;
   &splash;
}


#*****************************************************************************
#
# Routine:      get_userid_by_IP
#
#  inputs:      IP address
#               days
# outputs:      userid
#
#*****************************************************************************
sub get_userid_by_IP {
   my $here = $API::program.'::get_userid_by_IP';

   my $ip = shift(@_);
   my $days = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: ip=$ip, days=$days\n";
   }

   my $cookie = '';
   if ($ENV{HTTP_COOKIE}) {
       $cookie = "AND HTTP_COOKIE = '$ENV{HTTP_COOKIE}'";
   }
   if ($ENV{SSL_SESSION_ID}) {
       $cookie = "AND HTTP_COOKIE = '$ENV{SSL_SESSION_ID}'";
   }
   if ($API::diag > 3) {
       print STDERR "$here: ip=$ip, days=$days, cookie=$cookie\n";
   }

   # only read entries that are less than one day old
   my $where = "TO_DAYS(NOW()) - TO_DAYS(Modified) < $days";
   my $sth = $API::dbh->prepare("SELECT Userid
FROM $www::db_ip_table
WHERE $where $cookie
AND HTTP_USER_AGENT = ?
AND IP = ?;");
   $API::queries++;
   $sth->execute($ENV{HTTP_USER_AGENT}, $ip);

   my $ref = $sth->fetchrow_hashref();
   my $userid = $ref->{Userid};

   if ($userid) {
      return $userid;
   }
   return $API::Site{guest};
}


#*****************************************************************************
#
# Routine:      read_orgchart_table
#
#*****************************************************************************
sub read_orgchart_table {
   my $here = $API::program.'::read_orgchart_table';

   if ($API::diag > 2) {
      print STDERR "$here:\n";
   }

   my $sth = $API::mmtc_dbh->prepare("SELECT *
FROM wp_users, wp_pmpro_memberships_users
WHERE wp_users.ID = wp_pmpro_memberships_users.user_id;");
   $API::queries++;
   $sth->execute();

   my @Userids;
   while (my $ref = $sth->fetchrow_hashref()) {
      my $userid = $ref->{user_login};
      push(@Userids, $userid);

      $www::Passwd{$userid} = $ref->{user_pass};
      $www::Name{$userid} = $ref->{display_name};
      $www::Email{$userid} = $ref->{user_email};
      $www::Phone{$userid} = "N/A";
      $www::Location{$userid} = "Maryland";
      $www::BDay{$userid} = $ref->{enddate};
      $www::EndDate{$userid} = $ref->{enddate};
      $www::Active{$userid} = 'No';
      if ($ref->{status} =~ /active/) {
	  $www::Active{$userid} = 'Yes';
      }

      # build a new list that is sorted by name, not userid
      $www::ByName{$www::Name{$userid}} = $userid;

   }
   $sth->finish();

   # populate www::MyUsers array
   foreach my $userid (@Userids) {
      if ($www::Active{$userid} eq 'Yes') {
         push(@www::MyUsers, $userid);
      }
   }

   # create the Application User Name tables
   foreach my $list (@www::Names) {
      no strict 'refs';
      my $array = "www::List_$list";
      @$array = @www::MyUsers;
   }

   # Split information into name/value pairs
   $www::Prefs{$ENV{REMOTE_USER}} = "APIWeek=Monday&Tablet=1&elogsBgColor=white&elogsBlog=-1&elogsCH=51&elogsCI=9&elogsCalendar=Leg:WorkOut:Miles&elogsCarWth=30&elogsHome=M&elogsIH=D&elogsImages=Race&elogsRange=90&elogsTemp=F&elogsUnits=MPH&elogsWX=N&elogsWeek=0";
   my @Pairs = split(/&/, $www::Prefs{$ENV{REMOTE_USER}});
   foreach my $pair (@Pairs) {
      my ($name, $value) = split(/=/, $pair);
      $www::My_Prefs{$name} = $value;
      if ($API::diag > 11) {
         print STDERR "$here: www::My_Prefs{$name}=$value\n";
      }
   }
   $www::Default{OrderBy} = 'ID';
   if ($www::My_Prefs{APIOutDir}) {
      $www::Default{OrderBy} .= ' '.$www::My_Prefs{APIOutDir};
   }
   if ($www::My_Prefs{APIOutFmt}) {
      $www::Form{Format} = $www::My_Prefs{APIOutFmt};
   }
   $www::Default{ResetForm} = "<input class='$BS::reset' type='reset' value='Discard Changes'>";
   if (($www::My_Prefs{APIViewReset}) &&
       ($www::My_Prefs{APIViewReset} eq 'No')) {
      $www::Default{ResetForm} = '';
   }
}


#*****************************************************************************
#
# Routine:      editable
#
#*****************************************************************************
sub editable {
   my $here = $API::program.'::editable';

   my $ref = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: ref=$ref\n";
   }

   if ($ENV{REMOTE_USER} eq $API::Site{guest}) {
      return $www::edit{guest};
   } elsif ("$API::Site{sysadmin}:$API::Site{Managers}" =~ /$ENV{REMOTE_USER}/) {
      # allow dbadmin & managers to edit records
      return $www::edit{manager};
   }

   foreach my $field (@www::Check) {
      $value = $ref->{$field};
      if ($API::diag > 2) {
         print STDERR "$here: field=$field value=$value\n";
      }
      # change from equal to pattern to match history entry
      if ($field eq 'History') {
         if ($value =~ /Created by $ENV{REMOTE_USER}/) {
            return $www::edit{author};
         }
      } else {
         foreach my $user (split(/:/, $value)) {
            if ($user eq $ENV{REMOTE_USER}) {
               if ($author_gone) {
                  return $www::edit{author};
               } else {
                  return $www::edit{other};
               }
            }
         }
      }
   }

   return $www::edit{world};
}


#*****************************************************************************
#
# Routine:      get_id
#
#*****************************************************************************
sub get_id {
   my $here = $API::program.'::get_id';

   my $ref = shift(@_);
   my $id = shift(@_);
   my $msg = shift(@_);
   my $order = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: id=$id msg=$msg order=$order\n";
   }

   # use users preference on how to open this window
   my $title;
   my $target;
   if (($www::My_Prefs{APIOutWin}) &&
       ($www::My_Prefs{APIOutWin} eq 'Blank')) {
      $title = "View $msg $id in a new window";
      $target = 'target=_blank';
   } else {
      $title = "View $msg $id in this window";
      $target = 'target=_self';
   }

   my $td = "<a title=\"$title\" $target href=\"$ENV{SCRIPT_NAME}?ViewBy=ID&OrderBy=$order&ID=$id&IDL=$www::null_IDL\">$id</a>";

   my $perms = &editable($ref);
   if ($perms > $www::edit{world}) {
      $title = "Edit $msg $id";
      $td .= " <a title=\"$title\" href=\"$ENV{SCRIPT_NAME}?Edit=$id\"><i class='fa fa-pencil'></i> Edit</a>";
      $title = "Add Me to $ref->{Brief}";
      $td .= " <a title=\"$title\" href=\"$ENV{SCRIPT_NAME}?Clone=$id\"><i class='fa fa-paste'></i> Add Me</a>";
   } elsif ($perms == $www::edit{world}) {
      $title = "Add comment to $ref->{Brief}";
      $td .= " <a title=\"$title\" href=\"$ENV{SCRIPT_NAME}?Append=$id\"><i class='fa fa-pencil-square'></i> Append</a>";
      $title = "Add Me to $ref->{Brief}";
      $td .= " <a title=\"$title\" href=\"$ENV{SCRIPT_NAME}?Clone=$id\"><i class='fa fa-paste'></i> Add Me</a>";

   } elsif ($perms == $www::edit{guest}) {
      $td .= " <a title=\"$www::policy_title\"><i class='fa fa-pencil-square-o'></i> R/O</a>";
   }

   unless ($www::ID_List eq $www::null_IDL) {
      $www::ID_List .= $id.':';
      if (length($www::ID_List) > 1024*2) {
         $www::ID_List = $www::null_IDL;
      }
   }

   return "<div class='col-sm-2'><nobr>$td</nobr></div>";
}


#*****************************************************************************
#
# Routine:      get_column
#
#*****************************************************************************
sub get_column {
   my $here = $API::program.'::get_column';

   my $type = shift(@_);
   my $field = shift(@_);
   my $status = shift(@_);
   my $order = shift(@_);
   my $current = shift(@_);
   if ($API::diag > 3) {
      print STDERR "$here: type=$type field=$field status=$status order=$order current=$current\n";
   }

   # hide is not always/usually specified and is different from sort
   my $hide = $www::Form{Hide};
   my $andHide = '';
   $hide =~ s/^,//g;
   if ($hide) {
      if ($API::diag > 3) {
	 print STDERR "$here: hiding $hide\n";
      }
      $andHide = "&Hide=$hide";
   }

   # show is not always/usually specified and is different from sort
   my $andShow = '';
   if ($www::Form{Show}) {
      my $show = $www::Form{Show};
      $show =~ s/^,//g;
      if ($show) {
	 if ($API::diag > 3) {
	    print STDERR "$here: showing $show\n";
	 }
	 $andShow = "&Show=$show";
      }
   }

   my $extra = '';
   my $font = "<font class='font_$status'>";
   # replace periods, classes do not contain them
   $font =~ s/\./_/g;

   # don't add Day of week if it's already a field
   unless (grep(/Day/, @www::Enum_Lists)) {
      if ($status =~ /^\d{4,4}-\d{2,2}-\d{2,2}$/) {
         use POSIX;
         my @Date = split(/-/, $status);
         my $day = POSIX::strftime('%A', 0, 0, 0,
                                   $Date[2] - 1, $Date[1] - 1, $Date[0]);
         if ($www::HTML{DayFormat}) {
            $extra = " (<$www::HTML{DayFormat}>$day</$www::HTML{DayFormat}>)";
         }
         ##print STDERR "Date=$Date[2]/$Date[1]/$Date[0], extra=$extra\n";
      }
   }

   # use old instead of current, its the simplest way to remove duplicates
   my $old = '';
   my $fields = '';
   my $title = "List Only ";

   foreach (split(/:/, $current)) {
      # check that we aren't already filtering on that field
      unless ($_ eq $field) {
         $old .= $_.':';
         $fields .= "&$_=$www::Form{$_}";
         $title .= $www::Form{$_}.' ';
         $title = &get_full_name($title);
      }
   }
   my $date_title = $title;
   $title .= "$status $type";

   my $disarray = "www::Disabled_$field";
   if (grep(/^$status$/, @$disarray)) {
      $title .= $www::Disabled{title};
      $font = $www::Disabled{font};
   }

   # allow section names to be broken apart
   (my $label = $status) =~ s:/-:/<wbr><nobr>-:g;

   if (grep(/$field/, $www::numeric_field)) {
      $label = sprintf($www::Format{Numeric}, $status);
   }

   my $td = '';
   if ($field eq 'Date') {
      my ($year, $month, $day) = split(/-/, $status);
      my $mmm = $www::Months[$month - 1];
      my $ytitle = "$date_title $year $type";
      $td .= "<a title=\"$ytitle\" href=\"$ENV{SCRIPT_NAME}?ListBy=${old}Year&OrderBy=$order$fields&Year=$year\">$year</a>-";
      if ($year && $mmm) {
          my $mtitle = "$date_title $mmm $type";
          $td .= "<a title=\"$mtitle\" href=\"$ENV{SCRIPT_NAME}?ListBy=${old}MonthName&OrderBy=$order$fields&MonthName=$mmm\">$month</a>-";
      } else {
          my $mtitle = "$date_title $year-$month $type";
          $td .= "<a title=\"$mtitle\" href=\"$ENV{SCRIPT_NAME}?ListBy=${old}Month&OrderBy=$order$fields&Month=$year-$mmm\">$month</a>-";
      }
      $td .= "<a title=\"$title\" href=\"$ENV{SCRIPT_NAME}?ListBy=${old}$field&OrderBy=$order$fields&$field=$status\">$day</a>";

   } else {
      $td = "<a title=\"$title\"
href=\"$ENV{SCRIPT_NAME}?ListBy=${old}$field$andHide$andShow&OrderBy=$order$fields&$field=$status\">
$font
$label</font></a>";
   }

   if ($field eq 'Eqmt') {
     # add kill-filter
     $title = "Filter Out $field $status";
     $extra = " <a title=\"$title\"
href=\"$ENV{SCRIPT_NAME}?ListBy=${old}$field$andHide$andShow&OrderBy=$order$fields&$field=-$status\">$www::ImageTags{Kill}</a>";
   }

   if ($extra) {
      $td .= $extra;
   }

   return "<div class='col-sm-2'><nobr>$td</nobr></div>";
}


#*****************************************************************************
#
# Routine:      get_date_column
#
#*****************************************************************************
sub get_date_column {
   my $here = $API::program.'::get_date_column';

   my $type = shift(@_);
   my $field = shift(@_);
   my $value = shift(@_);
   my $order = shift(@_);
   my $current = shift(@_);
   if ($API::diag > 3) {
      print STDERR "$here: type=$type field=$field value=$value order=$order current=$current\n";
   }

   unless ($value) {
      return '';
   }

   # use old instead of current, its the simplest way to remove duplicates
   my $old = '';
   my $fields = '';
   my $title = "List Only ";
   foreach (split(/:/, $current)) {
      # check that we aren't already filtering on that field
      unless ($_ eq $field) {
         $old .= $_.':';
         $fields .= "&$_=$www::Form{$_}";
         $title .= $www::Form{$_}.' ';
      }
   }
   my $titleGrEq = $title;
   $title .= "$value $type";
   $titleGrEq .= "$www::OnAfter{title} $value";

   my $td = "<a title=\"$title\"
href=\"$ENV{SCRIPT_NAME}?ListBy=$old$field&OrderBy=$order$fields&$field=$value\">$value</a>

<a title=\"$titleGrEq\" href=\"$ENV{SCRIPT_NAME}?ListBy=GrEq$field:$old&OrderBy=$order$fields&GrEq$field=$value\">$www::OnAfter{tag}</a>";

   return "<div class='col-sm-2'><nobr>$td</nobr></div>";
}


#*****************************************************************************
#
# Routine:      get_numeric_column
#
#*****************************************************************************
sub get_numeric_column {
   my $here = $API::program.'::get_numeric_column';

   my $type = shift(@_);
   my $field = shift(@_);
   my $value = shift(@_);
   my $order = shift(@_);
   my $current = shift(@_);
   if ($API::diag > 3) {
      print STDERR "$here: type=$type field=$field value=$value order=$order current=$current\n";
   }

   unless ($value) {
      return '';
   }
   my $int = int($value);

   # use old instead of current, its the simplest way to remove duplicates
   my $old = '';
   my $fields = '';
   my $title = "List Only ";
   foreach (split(/:/, $current)) {
      # check that we aren't already filtering on that field
      unless ($_ eq $field) {
         $old .= $_.':';
         $fields .= "&$_=$www::Form{$_}";
         $title .= $www::Form{$_}.' ';
      }
   }

   my $td = "
<a title='$title'
  href=\"$ENV{SCRIPT_NAME}?ListBy=$old$field&OrderBy=$order$fields&$field=$value\">$value</a>
";

   if ($current eq 'Athlete') {
       my $titleGrEq = $title;
       my $titleLtEq = $title;
       $title .= "$value $type";
       $titleGrEq .= "$www::GrEq{title} $int";
       $titleLtEq .= "$www::LtEq{title} $int";

       $td .= "
<a title='$titleGrEq'
  href=\"$ENV{SCRIPT_NAME}?ListBy=GrEq$field:$old&OrderBy=$order$fields&GrEq$field=$int\">$www::GrEq{tag}</a>
<a title='$titleLtEq'
  href=\"$ENV{SCRIPT_NAME}?ListBy=LtEq$field:$old&OrderBy=$order$fields&LtEq$field=$int\">$www::LtEq{tag}</a>
";
       return "<div class='col-sm-2'><nobr>$td</nobr></div>";
   }

   return $td;
}


#*****************************************************************************
#
# Routine:      get_user_title
#
#*****************************************************************************
sub get_user_title {
   my $here = $API::program.'::get_user_title';

   my $userid = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: userid=$userid\n";
   }

   my $title;

   unless ($www::Email{$userid}) {
      $title = "Userid: $userid, not in orgchart";

   } else {
      # mozilla firefox does not display newlines correctly
      if ($ENV{HTTP_USER_AGENT} =~ /Firefox/) {
         $title = "Userid: $userid, Email: $www::Email{$userid}, Phone: $www::Phone{$userid}, Location: $www::Location{$userid}";
      } else {
         $title = "Userid: $userid
Email: $www::Email{$userid}
Phone: $www::Phone{$userid}
Location: $www::Location{$userid}";
      }
   }

   if ($API::diag > 3) {
      print STDERR "$here: title=$title\n";
   }
   return $title;
}


#*****************************************************************************
#
# Routine:      get_missing_user
#
#*****************************************************************************
sub get_missing_user {
   my $here = $API::program.'::get_missing_user';

   my $userid = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: userid=$userid\n";
   }

   # change the first characters to uppercase
   (my $linitial = substr($userid, 1, 1)) =~ tr/a-z/A-Z/;
   (my $finitial = substr($userid, 0, 1)) =~ tr/a-z/A-Z/;
   my $name = $finitial.' '.$linitial.substr($userid, 2);
   if ($userid =~ /^(.*)\.(.{1,1})(.*)$/) {
      ($finitial = $1) =~ tr/a-z/A-Z/;;
      ($linitial = $2) =~ tr/a-z/A-Z/;;
      my $last = $3;
      $name = $finitial.' '.$linitial.$last;
   }
   if ($API::diag > 3) {
      print STDERR "$here: name=$name\n";
   }
   return $name;
}


#*****************************************************************************
#
# Routine:      get_full_missing_user
#
#*****************************************************************************
sub get_full_missing_user {
   my $here = $API::program.'::get_full_missing_user';

   my $userid = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: userid=$userid\n";
   }

   my $pad = 10;
   my $fullname = &get_missing_user($userid);
   my $full = $fullname;
   $full .= '.' x $pad;
   $full .= "$userid not in orgchart table";

   return $full;
}


#*****************************************************************************
#
# Routine:      get_user_mailto
#
#*****************************************************************************
sub get_user_mailto {
   my $here = $API::program.'::get_user_mailto';

   my $userid = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: userid=$userid\n";
   }

   my $td = '';
   if ($userid) {
      if ($www::Name{$userid}) {
         # no link for disabled users
         unless ($www::Active{$userid} eq 'Yes') {
            my $title = "User account has been disabled";
            $td = "<a name=$userid title=\"$title\">$www::Name{$userid}</a>";
         } else {
            my $title = &get_user_title($userid);
            $td = "<a name=$userid title=\"$title\"
href=\"mailto:$www::Email{$userid}\">$www::Name{$userid}</a>";
         }
      } else {
         my $title = &get_full_missing_user($userid);
         my $fullname = &get_missing_user($userid);
         $td = "<a name=$userid title=\"$title\"
href=\"mailto:$userid\@$API::Site{Domain}\">$fullname</a>";
      }
   }
   return $td;
}


#*****************************************************************************
#
# Routine:      get_script
#
#*****************************************************************************
sub get_script {
   my $here = $API::program.'::get_script';

   my $type = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: type=$type ENV{SCRIPT_NAME}=$ENV{SCRIPT_NAME}\n";
   }

   foreach my $singular (split('/', $type)) {
      # make singular to match key
      $singular =~ s/s$//g;
      foreach my $key (sort keys %www::CGI) {
         if ($key =~ /$singular/) {
            if ($API::diag > 3) {
               print STDERR "$here: type=$type singular=$singular key=$key\n";
            }
            return "/$www::cgidir/$www::CGI{$key}";
         }
      }
   }

   unless (($type eq 'Records') ||
           ($type eq 'Workouts') ||
           ($type eq 'Entries')) {
      print STDERR "$here: type=$type ENV{SCRIPT_NAME}=$ENV{SCRIPT_NAME}\n";
   }
   return $ENV{SCRIPT_NAME};
}


#*****************************************************************************
#
# Routine:      get_user_select_by_field
#
#*****************************************************************************
sub get_user_select_by_field {
   my $here = $API::program.'::get_user_select_by_field';

   my $type = shift(@_);
   my $userid = shift(@_);
   my $field = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: type=$type userid=$userid field=$field\n";
   }

   my $td = '';
   if ($userid) {
      if ($www::Name{$userid}) {
         my $script = &get_script($type);
         my $title = "List $field $www::Name{$userid} $type";
         # remove <nobr></nobr> so that caller can use it in History
         $td = "<a name=$userid title=\"$title\" href=\"$script?ListBy=$field&OrderBy=$www::Default{OrderBy}&$field=$userid\"><nobr>$www::Name{$userid}</nobr></a>";
         # no link for disabled users
         unless ($www::Active{$userid} eq 'Yes') {
            my $title = "User account has been disabled";
            $td .= "<a name=$userid title=\"$title\">$www::ImageTags{NoEmail}</a>";
         }

      } else {
         my $title = &get_full_missing_user($userid);
         my $fullname = &get_missing_user($userid);
         $td = "<a name=$userid title=\"$title\"
href=\"mailto:$userid\@$API::Site{Domain}\"><nobr>$fullname</nobr></a>";
      }
   }

   return "<div class='col-sm-2'><nobr>$td</nobr></div>";
}


#*****************************************************************************
#
# Routine:      get_user_select
#
#*****************************************************************************
sub get_user_select {
   my $here = $API::program.'::get_user_select';

   my $type = shift(@_);
   my $userid = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: type=$type userid=$userid\n";
   }

   return &get_user_select_by_field($type, $userid, 'User');
}


#*****************************************************************************
#
# Routine:      get_full_name
#
#*****************************************************************************
sub get_full_name {
   my $here = $API::program.'::get_full_name';

   my $text = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: text=$text\n";
   }

   foreach my $name (@www::Names) {
      if ($www::Form{$name}) {
         foreach (split(/:/, $www::Form{$name})) {
            if ($www::Name{$_}) {
               $text =~ s/$_/$www::Name{$_}/g;
            }
         }
      }
   }

   if ($API::diag > 5) {
      print STDERR "$here: text=$text\n";
   }
   return $text;
}


#*****************************************************************************
#
# Routine:      get_id_link
#
#*****************************************************************************
sub get_id_link {
   my $here = $API::program.'::get_id_link';

   my $type = shift(@_);
   my $id = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: type=$type id=$id\n";
   }

   my $script = &get_script($type);
   my $td = "<input type=button class='btn btn-default' value='View $id'
onClick=\"window.location='$script?ViewBy=ID&OrderBy=$www::Default{OrderBy}&ID=$id'\">\n";
   return $td;
}


#*****************************************************************************
#
# Routine:      get_attach
#
#*****************************************************************************
sub get_attach {
   my $here = $API::program.'::get_attach';

   my $all = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: all=$all\n";
   }

   my $td = '';
   foreach my $attach (split(/,/, $all)) {
      # allow for word breaks at both types of directory specs
      my $wbr = $attach;
      $wbr =~ s:/:/<wbr>:g;
      $wbr =~ s:\\:\\<wbr>:g;
      if ($attach =~ /tp:\/\//) {
         $td .= "<a target=_blank title=\"$attach\" href=\"$attach\">
$wbr</a><br>";
      } else {
         my $title = "View local copy of:
$attach";
         $td .= "<a target=_blank href='file:$attach'>$wbr</a><br>";
      }
   }
   $td =~ s/<br>$//g;

   return $td;
}


#*****************************************************************************
#
# Routine:      get_upload
#
#*****************************************************************************
sub get_upload {
   my $here = $API::program.'::get_upload';

   my $all = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: all=$all\n";
   }

   my $td = '';
   foreach my $upload (split(/,/, $all)) {
      my ($where, $dir, $what) = split(/\//, $upload, 3);
      if ($what eq '.') {
         $what = $dir.'/';
      }
      my $title = "Get local copy of:
$what";
      $td .= "<a target=_blank title=\"$title\" href=\"/$upload\">
$what</a><br>";
   }
   $td =~ s/<br>$//g;

   return $td;
}


#*****************************************************************************
#
# Routine:      get_history
#
#*****************************************************************************
sub get_history {
   my $here = $API::program.'::get_history';

   my $type = shift(@_);
   my $history = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: type=$type history=$history\n";
   }

   my $td = '';
   foreach my $line (split(/\n/, $history)) {
      # unfortunately this didn't look great
      ## $td .= '<nobr>';
      $td = '';
      foreach my $word (split(/ /, $line)) {
         if ($API::diag > 3) {
            print STDERR "$here: type=$type word=$word\n";
         }
         my $extra = '';
         # include colons so that user lists are not changed
         # include ampersands so that external emails are not changed
         if ($word =~ /^(\W*)(\w+[:@]*)(.*)/) {
            $td .= $1;
            $word = $2;
            $extra = $3;
         }
         if ($www::Name{$word}) {
            my $user_select = &get_user_select($type, $word);
            $td .= $user_select;
         } else {
            $td .= $word;
         }
         $td .= $extra.' ';
      }
      $td .= '</nobr>';
      $td .= "\n";
   }

   return $td;
}


#*****************************************************************************
#
# Routine:      add_multiple_user_history
#
#*****************************************************************************
sub add_multiple_user_history {
   my $here = $API::program.'::add_multiple_user_history';

   my $old = shift(@_);
   my $new = shift(@_);
   if ($API::diag > 3) {
      print STDERR "$here: old=$old new=$new\n";
   }

   my @Old = split(/:/, $old);
   my @New = split(/:/, $new);
   foreach my $usr (@Old) {
      unless (grep(/$usr/, @New)) {
         $www::Form{History} .= " $usr removed,";
      }
   }

   foreach my $usr (@New) {
      unless (grep(/$usr/, @Old)) {
         $www::Form{History} .= " $usr added,";
      }
   }
   $www::Form{History} =~ s/,$//;
}


#*****************************************************************************
#
# Routine:      get_hidden
#
#*****************************************************************************
sub get_hidden {
   my $here = $API::program.'::get_hidden';

   my $type = shift(@_);
   my $field = shift(@_);
   my $ref = shift(@_);
   my $id = $ref->{ID};
   if ($API::diag > 2) {
      print STDERR "$here: type=$type field=$field id=$id\n";
   }

   my $hidden = "<input type=hidden name=Field value=$type:$field>
<input type=hidden name=ID value=$id>
<input type=hidden name=Title value='$ref->{$www::Subject}'>
<input type=hidden name=History value='$ref->{History}'>\n";
   # pass the Names as hidden fields so they're available to send_emails
   foreach (@www::Names) {
      if ($ref->{$_}) {
         $hidden .= "<input type=hidden name=$_ value='$ref->{$_}'>\n";
      }
   }

   return $hidden;
}


#*****************************************************************************
#
# Routine:      append_field_form
#
#*****************************************************************************
sub append_field_form {
   my $here = $API::program.'::append_field_form';

   my $type = shift(@_);
   my $field = shift(@_);
   my $ref = shift(@_);
   my $id = $ref->{ID};
   if ($API::diag > 2) {
      print STDERR "$here: type=$type field=$field id=$id\n";
   }

   $www::Form{$field} = '';
   my $hidden = &get_hidden($type, $field, $ref, $id);
   my $label = "Additional<br>$field";
   my $input = &build_textarea($field, $www::Size{$field});

   my $form = "<tr>
<form method=post action=$ENV{SCRIPT_NAME}>
$hidden
<td valign=top align=right width=10%><b><a title=\"$www::Help{Append_Title}\">$label</a>:</b></td>
<td>$input<br>
<input class='$BS::submit' type='submit' value='Append $field'></td>
</form>
</tr>\n";

   return $form;
}


#*****************************************************************************
#
# Routine:      build_list
#
#*****************************************************************************
sub build_list {
   my $here = $API::program.'::build_list';

   my $field = shift(@_);
   my $default = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field default=$default\n";
   }

   my $size = 1;
   if ($www::Size{$field}) {
      $size = $www::Size{$field}
   }

   my $td = "<select class='form-control' name=$field size=$size>\n";
   if ($default eq $www::select_one) {
      unless (length($www::Form{$field})) {
         $td .= "<option selected>$default\n";
      } else {
         $td .= "<option>$default\n";
      }
   }

   no strict 'refs';
   my $array = "www::List_$field";
   my $disarray = "www::Disabled_$field";
   foreach my $enum (@$array) {
      my $label = $enum;
      my $key = $field.':'.$enum;
      if ($www::EnumLabels{$key}) {
         $label = $enum.'.....'.$www::EnumLabels{$key};
      }
      if ($enum eq $www::Form{$field}) {
         $td .= "<option selected value='$enum'>$label\n";
      } else {
         # do not add enumerations that have been disabled
         unless (grep(/^$enum$/, @$disarray)) {
            $td .= "<option value='$enum'>$label\n";
         }
      }
   }
   $td .= "</select>\n";
   return $td;
}


#*****************************************************************************
#
# Routine:      build_datalist
#
#*****************************************************************************
sub build_datalist {
   my $here = $API::program.'::build_datalist';

   my $field = shift(@_);
   my $default = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field default=$default\n";
   }

   no strict 'refs';
   my $array = "www::List_$field";
   my $disarray = "www::Disabled_$field";

   # do not add default unless its in your list
   unless (grep(/^$default$/, @$array)) {
     $default = '';
   }

   my $td = "<input class='form-control'
id='$field'
name='$field'
placeholder='$field'
type='text'
list='dl_$field'
value='$default'>\n
<datalist id=dl_$field name=dl_$field>\n";

   foreach my $enum (@$array) {
      my $label = $enum;
      my $key = $field.':'.$enum;
      if ($www::EnumLabels{$key}) {
         $label = $enum.'.....'.$www::EnumLabels{$key};
      }
      # add all enumerations, even if disabled
      $td .= "<option value='$enum'>$label\n";
   }
   $td .= "</datalist>\n";
   return $td;
}


#*****************************************************************************
#
# Routine:      build_distinct_list
#
#*****************************************************************************
sub build_distinct_list {
   my $here = $API::program.'::build_distinct_list';

   my $field = shift(@_);
   my $table = shift(@_);
   my $where = shift(@_);
   if ($API::diag > 1) {
      print STDERR "$here: field=$field table=$table where=$where\n";
   }

   my $dir;
   if (($field =~ /date/i) ||
       ($field =~ /assigned/i) ||
       ($field =~ /due/i) ||
       ($field =~ /year/i) ||
       ($field =~ /month/i) ||
       ($field =~ /week/i)) {
      $dir = 'DESC';
   } else {
      $dir = 'ASC';
   }

   my $array = "www::List_$field";
   @$array = ();
   my $select = $field;
   if ($www::SQL{$field}) {
      $select = $www::SQL{$field};
   }
   my $sth = $API::dbh->prepare("SELECT DISTINCT($select) AS $field
FROM $table
$where
ORDER BY 1 $dir;");
   $API::queries++;
   $sth->execute();

   while (my $ref = $sth->fetchrow_hashref()) {
      if ($ref->{$field}) {
         push(@$array, $ref->{$field});
      }
   }
}


#*****************************************************************************
#
# Routine:      build_multiple_user_list
#
#*****************************************************************************
sub build_multiple_user_list {
   my $here = $API::program.'::build_multiple_user_list';

   my $field = shift(@_);
   my $size = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field size=$size\n";
   }

   my $unselected = '';
   my $selected = '';
   my $current = $www::Form{$field};
   foreach (@www::List_User) {
      my ($full, $userid) = split(/:/, $_);
      # no link for disabled users
      unless ($www::Active{$userid} eq 'Yes') {
         $unselected .= "<option value=$userid>$full\n";
      }
      # change from eq to pattern to get helpers
      if ($userid && ($current =~ /:?$userid:?/)) {
         $selected .= "<option value=$userid>$full\n";
      }
   }

   # handle ex-employees not in orgchart
   foreach my $userid (split(/:/, $current)) {
      if ($userid) {
         unless ($selected =~ /value=$userid>/) {
            my $full = &get_full_missing_user($userid);
            $selected .= "<option value=$userid>$full\n";
         }
      }
   }

   my $style = 'style=width:350';
   my $title = "a title='Sorted by Last Name'";
   my $td = "<table>
<tr>
<th><small><$title>Available</a></th>
<th></th>
<th><small><$title>Selected</a></th>
</tr>

<tr>
<td>
<select name=src_$field size=$size multiple $style>
$unselected
</select>
</td>
<td>
<input title=\"Add Selected Users\" type=button value=\">>\" onClick=\"addEntry(this.form.$field,this.form.src_$field)\"><br>
<input title=\"Remove Selected Users\" type=button value=\"<<\" onClick=\"removeEntry(this.form.$field)\">
</td>
<td>
<select name=$field size=$size multiple $style>
$selected
</select>
</td>
</tr>
</table>
\n";
   return $td;
}


#*****************************************************************************
#
# Routine:      build_user_list
#
#*****************************************************************************
sub build_user_list {
   my $here = $API::program.'::build_user_list';

   my $field = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field\n";
   }

   my $td = "<select name=$field>\n";

   my $current = $www::Form{$field};
   my $found = 0;
   foreach ("$www::select_one:", @www::List_User) {
      my ($full, $userid) = split(/:/, $_);
      if ($current eq $userid) {
         $td .= "<option selected value=$userid>$full\n";
         $found++;
      } else {
         if (($userid) &&
             ($www::Active{$userid} eq 'Yes')) {
            $td .= "<option value=$userid>$full\n";
         }
      }
   }

   # handle ex-employees not in orgchart
   my $pad = 10;
   unless ($found) {
      my $full = &get_full_missing_user($current);
      $td .= "<option selected value=$current>$full\n";
   }
   $td .= "</select>\n";

   return $td;
}


#*****************************************************************************
#
# Routine:      get_date
#
#*****************************************************************************
sub get_date {
   my $here = $API::program.'::get_date';

   my $field = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field\n";
   }

   $API::Date{day} = (localtime)[3];
   $API::Date{mmm} =
       ('Jan',
        'Feb',
        'Mar',
        'Apr',
        'May',
        'Jun',
        'Jul',
        'Aug',
        'Sep',
        'Oct',
        'Nov',
        'Dec') [(localtime)[4]];
   $API::Date{month} = (localtime)[4] + 1;
   $API::Date{year} = (localtime)[5]+1900;
   $API::Date{day_of_week} =
       ('Sun',
        'Mon',
        'Tue',
        'Wed',
        'Thu',
        'Fri',
        'Sat') [(localtime)[6]];

   # to calculate week, add for January 1st offset
   use Time::Local;
   my $gmtime = timegm(0,0,0,1,0,$API::Date{year}-1900);
   my @Gmtime = gmtime($gmtime);
   my $off = $Gmtime[6] - 1;
   if ($API::diag > 3) {
      my ($day_of_week) = gmtime($gmtime) =~ /^(\S+)/; # fetch first word
      print STDERR "$here: off=$off, Gmtime[6]=$Gmtime[6], day_of_week=$day_of_week\n";
   }
   $API::Date{week} = int(((localtime)[7] + $off)/7);

   my $day = $API::Date{day};
   my $mon = (localtime)[4]+1;
   my $year = $API::Date{year};
   if ($field eq 'Due' ||
       $field eq 'No_Later_Than'||
       $field eq 'Due_Date' ||
       $field eq 'End_Date' ||
       $field eq 'Delivery_Date') {
      my $days = 30;
      $day += 14;
      if ($day > $days) {
         $day -= $days;
         if (++$mon > 12) {
            $mon = 1;
            $year++;
         }
      }
   }
   if ($day < 10) {
      $day = "0$day";
   }
   if ($mon < 10) {
      $mon = "0$mon";
   }
   return "$year-$mon-$day";
}


#*****************************************************************************
#
# Routine:      build_date
#
#*****************************************************************************
sub build_date {
   my $here = $API::program.'::build_date';

   my $field = shift(@_);
   my $read_only = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field read_only=$read_only\n";
   }

   my $value = $www::Form{$field};
   unless ($value) {
      $value = &get_date($field);
   }
   if ($value eq $www::null_date) {
      $value = '';
   }
   $www::Form{$field} = $value;

   my $td;
   if ($read_only) {
      $td = "<input class='form-control'
type='hidden'
id='$field'
name='$field'
value='$value'>
$value\n";
   } else {
      $td = "<input class='form-control'
type='text'
id='$field'
name='$field'
placeholder='$field'
maxlength='10'
size='10'
value='$value'>\n";
      # HTML5 input type=date is only supported in Chrome/Safari/Opera
      if(($ENV{HTTP_USER_AGENT} =~ /Chrome/i) ||
         ($ENV{HTTP_USER_AGENT} =~ /Safari/i) ||
         ($ENV{HTTP_USER_AGENT} =~ /Opera/i)) {
        $td = "<input class='form-control'
type='date'
id='$field'
name='$field'
placeholder='$field'
value='$value'>\n";
      }
   }

   return $td;
}


#*****************************************************************************
#
# Routine:      build_password
#
#*****************************************************************************
sub build_password {
   my $here = $API::program.'::build_password';

   my $field = shift(@_);
   my $width = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field width=$width\n";
   }

   my $value = '';
   if ($www::Form{$field}) {
      $value = $www::Form{$field};
   }

   my $td = "<input class='form-control'
type='password'
name='$field'
placeholder='$field'
value='$value'
maxlength='$width'
size='$width'>\n";

   return $td;
}


#*****************************************************************************
#
# Routine:      build_readonly_text
#
#*****************************************************************************
sub build_readonly_text {
   my $here = $API::program.'::build_text';

   my $field = shift(@_);
   my $width = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field width=$width www::Form{$field}=$www::Form{$field}\n";
   }

   my $size;
   if ($width > 100) {
      $size = 100;
   } else {
      $size = $width;
   }
   my $td = "<input class='form-control'
type='text'
name='$field'
placeholder='$field'
maxlength='$width'
size='$size'
readonly
value='$www::Form{$field}'>\n";
   return $td;
}


#*****************************************************************************
#
# Routine:      build_text
#
#*****************************************************************************
sub build_text {
   my $here = $API::program.'::build_text';

   my $field = shift(@_);
   my $width = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field width=$width www::Form{$field}=$www::Form{$field}\n";
   }

   my $size;
   if ($width > 100) {
      $size = 100;
   } else {
      $size = $width;
   }
   my $td = "<input class='form-control'
type='text'
name='$field'
placeholder='$field'
maxlength='$width'
size='$size'
value='$www::Form{$field}'>\n";
   return $td;
}


#*****************************************************************************
#
# Routine:      build_numeric
#
#*****************************************************************************
sub build_numeric {
   my $here = $API::program.'::build_numeric';

   my $field = shift(@_);
   my $width = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field width=$width www::Form{$field}=$www::Form{$field}\n";
   }

   my $size;
   if ($width > 100) {
      $size = 100;
   } else {
      $size = $width;
   }
   # use text, not number, so that math may be used, i.e.: 33+44
   my $td = "<input class='form-control'
type='text'
name='$field'
placeholder='$field'
maxlength='$width'
size='$size'
value=\"$www::Form{$field}\">\n";
   return $td;
}


#*****************************************************************************
#
# Routine:      build_radio_list
#
#*****************************************************************************
sub build_radio_list {
   my $here = $API::program.'::build_radio_list';

   my $field = shift(@_);
   my $array = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field array=$array\n";
   }
   my $td;
   my $checked;
   my $disarray = "www::Disabled_$field";

   foreach my $enum (@$array) {
      my ($left, $right) = split(/:/, $field);
      if ($enum eq $www::Form{$left}) {
	 $checked = 'checked';
      } else {
	 $checked = '';
      }
 
      # do not add enumerations that have been disabled
      unless (($checked eq '') &&
	      (grep(/^$enum$/, @$disarray))) {
	 my $font = "<font class='font_$enum'>";
	 my $title = '';
	 if($www::Help{$enum}) {
	     $title = $www::Help{$enum};
	 }
         # onclick required by Date, which adds today and yesterday as radio buttons
	 $td .= "$font<input class='form-control'
type='radio'
name='$field'
$checked
value=\"$enum\" \
onclick=\"document.getElementById('${left}').value='$enum';\"> \
<nobr title='$title'>$enum</nobr></font>\n";
      }
   }
   return $td;
}


#*****************************************************************************
#
# Routine:      build_attach
#
#*****************************************************************************
sub build_attach {
  my $here = $API::program.'::build_attach';

  my $field = shift(@_);
  if ($API::diag > 2) {
    print STDERR "$here: field=$field\n";
  }

  # type=file value= does not work, so display the current value before
  # and hide a copy of the value, required for re-submits
  my $td = "<font size=-1>$www::Form{$field}</font><br>
<input type=hidden
name=Hidden_$field
value=\"$www::Form{$field}\">
<input type=file
name=$field
placeholder=$field
size=$www::Size{TextAreas}
value=\"$www::Form{$field}\">\n";
  return $td;
}


#*****************************************************************************
#
# Routine:      build_textarea
#
#*****************************************************************************
sub build_textarea {
   my $here = $API::program.'::build_textarea';

   my $field = shift(@_);
   my $rows = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field rows=$rows\n";
   }

   my $td = "<textarea class='form-control'
name='$field'
placeholder='$field'
rows='$rows'
cols='$www::Size{TextAreas}'
wrap='virtual'>
$www::Form{$field}
</textarea>\n";
   return $td;
}


#*****************************************************************************
#
# Routine:      build_append_only
#
#*****************************************************************************
sub build_append_only {
   my $here = $API::program.'::build_append_only';

   my $field = shift(@_);
   my $id = shift(@_);
   my $ref = shift(@_);
   my $pass2 = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field id=$id ref->{$field}=$ref->{$field} pass2=$pass2\n";
   }

   my $out;
   # multi-page forms use extra NULL strings
   if (($id =~ /NULL/) ||
       (length($ref->{$field}) == 0)) {
      $out .= &build_select_td($field,
                               $www::Help{$field},
                               &build_textarea($field, ($www::Size{$field}*2)));
   } else {
      # no one change edit these fields, all are appends
      $out .= &build_select_td($field,
                               $www::Help{$field},
                               $ref->{$field});
      # do not clear the field if re-editting after an error
      unless ($pass2) {
         $www::Form{$field} = '';
      }
      $out .= &build_select_td("Additional<br>$field",
                               $www::Help{Append_Title},
                               &build_textarea($field, $www::Size{$field}));
   }
   return $out;
}


#*****************************************************************************
#
# Routine:      read_count
#
#*****************************************************************************
sub read_count {
   my $here = $API::program.'::read_count';

   my $type = shift(@_);
   my $field = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: type=$type field=$field\n";
   }

   no strict 'refs';
   my $array = "www::List_$field";

   my $count = "www::${type}_count";
   my $table = "www::db_${type}_table";
   foreach my $enum (@$array) {
      if ($enum) {
         $$count{$enum} = 0;
      }
   }

   my $calc_sql = $field;
   my $select = $field;
   if ($www::SQL{$field}) {
      $calc_sql = $www::SQL{$field};
      $select = "$calc_sql AS $field";
   }

   my $group = "GROUP BY $field";
   my $sql = "SELECT COUNT($calc_sql) AS Count, $select
FROM $$table
$group;";

   if ($API::diag > 3) {
      print STDERR "$here: sql=$sql\n";
   }
   # build the list
   my $sth = $API::dbh->prepare($sql);
   $API::queries++;
   $sth->execute();

   while (my $ref = $sth->fetchrow_hashref()) {
      my $value = $ref->{$field};
      if ($value) {
         $$count{$value} = $ref->{Count};
         if ($API::diag > 4) {
            print STDERR "$here: count=$count, field=$field, value=$value, Count=$ref->{Count}\n";
         }
      }
   }
}

#*****************************************************************************
#
# Routine:      read_total_count
#
#*****************************************************************************
sub read_total_count {
   my $here = $API::program.'::read_total_count';

   my $type = shift(@_);
   my $field = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: type=$type field=$field\n";
   }

   no strict 'refs';
   my $array = "www::List_$field";

   my $count = "www::${type}_count";
   my $table = "www::db_${type}_table";
   foreach (@$array) {
      $$count{$_} = 0;
   }

   $sql = "SELECT COUNT(ID) AS Count, $field
FROM $$table
GROUP BY $field;";

   if ($API::diag > 3) {
      print STDERR "$here: sql=$sql\n";
   }
   # build the list
   my $sth = $API::dbh->prepare($sql);
   $API::queries++;
   $sth->execute();

   while (my $ref = $sth->fetchrow_hashref()) {
      my $value = $ref->{$field};
      $$count{$value} = $ref->{Count};
   }
}


#*****************************************************************************
#
# Routine:      edit_enum
#
#*****************************************************************************
sub edit_enum {
   my $here = $API::program.'::edit_enum';

   my $field = shift(@_);
   my $status = shift(@_);
   my $userid = shift(@_);

   if ($API::diag > 2) {
      print STDERR "$here: field=$field status=$status userid=$userid\n";
   }

   # change underscores to spaces
   (my $flabel = $field) =~ s/_/ /g;
   my $out = "\n<table class='table'>\n<tr>\n<th>$flabel Name</th>\n";
   foreach my $label (split(/:/, $API::Enumerations{$field})) {
      # change the first character to lowercase
      (my $table = $label) =~ tr/A-Z/a-z/;
      &read_total_count($table, $field);
      $out .= "<th>$label</th>\n";
   }
   $out .= "</tr>\n";
   &header("$flabel Management Form", '');

   no strict 'refs';

   my $array = "www::List_$field";
   foreach (@$array) {
      # sum all the counts
      my $count = 0;
      foreach my $label (split(/:/, $API::Enumerations{$field})) {
         # change the first character to lowercase
         (my $table = $label) =~ tr/A-Z/a-z/;
         my $var = "www::${table}_count";
         $count += $$var{$_};
      }

      $out .= "<tr class=tr_list>\n<td align=left><nobr>$_</nobr></td>\n";
      foreach my $label (split(/:/, $API::Enumerations{$field})) {
         # change the first character to lowercase
         (my $table = $label) =~ tr/A-Z/a-z/;
         my $var = "www::${table}_count";

         my $items = 0;
         if ($count) {
            if ($$var{$_}) {
               my $title = "List All $_ $flabel";
               my $a = "a title=\"$title\" href=\"$ENV{SCRIPT_NAME}?ListBy=$field&OrderBy=$www::Default{OrderBy}&$field=$_\"";
               $items = "<$a>$$var{$_}</a>";
            }
         } else {
            my $title = "Remove $flabel $_";
            my $a = "a title=\"$title\" href=\"$ENV{SCRIPT_NAME}?Delete=$field&$field=$_\"";
            if ($userid eq $API::Site{enum_admin}) {
               $items = "0, select <$a>here</a> to delete";
            } elsif (($field ne 'Project') && ($field ne 'Forum')) {
               $items = "0, select <$a>here</a> to delete";
            } else {
               $items = "0";
            }
         }
         $out .= "<td align=center>$items</td>\n";
      }
      $out .= "</tr>\n";
   }

   $www::Form{$field} = '';
   my $opt = &build_text($field, 80);

   if (($field ne 'Project') && ($field ne 'Forum')) {
      $out .= "</table>
<table class='table'>
<tr>
$status
</tr>
<tr>
<form method=post action=$ENV{SCRIPT_NAME}>
<input type=hidden name=Field value=$field>
<td valign=top align=right><b>New $flabel:</b></td>
<td>$opt</td>
<td><input class='$BS::submit' type='submit' value='Submit $flabel'></td>
</form>
</tr>
</table>\n\n";
   } elsif ($userid eq $API::Site{enum_admin}) {
      $out .= "</table>
<table class='table table-hover'>\n<tr>
$status
</tr>
<tr>
<form method=post action=$ENV{SCRIPT_NAME}>
<input type=hidden name=Field value=$field>
<td valign=top align=right><b>New $flabel:</b></td>
<td>$opt</td>
<td><input class='$BS::submit' type='submit' value='Submit $flabel'></td>
</form>
</tr>
</table>\n\n";
   } else {
      $flabel = &get_user_mailto($API::Site{enum_admin});
      $out .= "</table>
<table class='table table-hover'>\n<tr></tr>
<tr><td>
<b><font color=red>Please email $flabel to add New Projects and/or Forums</font></b>
</td></tr>
</table>\n\n";
   }

   print $out;
   $API::bytes += length($out);
   &footer('');
}


#*****************************************************************************
#
# Routine:      build_select_td
#
#*****************************************************************************
sub build_select_td {
   my $here = $API::program.'::build_select_td';

   my $label = shift(@_);
   my $title = shift(@_);
   my $input = shift(@_);
   if ($API::diag > 3) {
      print STDERR "$here: label=$label title=$title\n";
   }
   if ($API::diag > 4) {
      print STDERR "$here: input=$input\n";
   }

   # change underscores to spaces
   $label =~ s/_/ /g;

   return "<p>
<div class='form-group' id='$label-1'>
<label for='$label' class='col-sm-2 control-label' title=\"$title\">$label</label>
<div class='col-sm-10' id='$label-2'>
$input
</div>
</div>
</p>\n";
}


#*****************************************************************************
#
# Routine:      create_file
#
#*****************************************************************************
sub create_file {
   my $here = $API::program.'::create_file';

   my $filename = shift(@_);
   my $data = shift(@_);
   my $len = length($data);
   if ($API::diag > 2) {
      print STDERR "$here: filename=$filename len=$len\n";
   }

   open(CREATE, ">$filename") ||
       die "$here: Error creating $filename: $1";

   print CREATE $data;

   close(CREATE) ||
       die "$here: Error closing $filename: $!";

   print STDERR "$here: $filename created with $len bytes\n";
}


#*****************************************************************************
#
# Routine:      process_content
#
#*****************************************************************************
sub process_content {
   my $here = $API::program.'::process_content';

   my $buffer = shift(@_);
   my $len = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: len=$len buffer =
========================================
$buffer
========================================\n";
   }

   my $i = 0;
   my $disposition = '';
   my $type = '';
   my $name = '';
   my $filename = '';
   my $skip_first = 0;
   $new::File = '';

   foreach my $line (split(/\n/, $buffer)) {
      $i++;
      my $len = length($line);
      ##print STDERR "$here: i=$i len=$len\n";

      # create file if read complete
      if ($line =~ /^Content-\S+:/) {
         if (length($new::File)) {
            # buffers always have an extra blank line, do not save it
            chop($new::File);
            chop($new::File);
            if ($www::Form{Upload_Dir} =~ /^(\S+)$/) {
               my $write_dir = $ENV{DOCUMENT_ROOT}.'/'.$www::upload.'/'.$1;
               mkdir $write_dir, 0775 ||
                   die "$here: Failed to make directory $write_dir: $!\n";
               my $write = $write_dir.'/'.$filename;
               &create_file($write, $new::File);
               my $read = $www::upload.'/'.$www::Form{Upload_Dir}.'/'.$filename;
               $www::Form{$name} = $read;
               $new::File = '';
            } else {
               die "$here: Invalid Upload Dir=$www::Form{Upload_Dir}\n";
            }
         }
      }
      if ($line =~ /^\-+(\S+)/) {
         my $cgi_id = $1;
         ##print STDERR "$here: cgi_id=$cgi_id\n";
      } elsif ($line =~ /^Content-Disposition:\s+(\S+);\s+name=\"(\S+)\";\s+filename=\".*\\(.*)\"/) {
         $skip_first = 1;
         $disposition = $1;
         $type = '';
         $name = $2;
         $filename = $3;
         $new::File = '';
         ##print STDERR "$here: disposition=$disposition name=$name filename=$filename\n";
      } elsif ($line =~ /^Content-Disposition:\s+(\S+);\s+name=\"(\S+)\"/) {
         $skip_first = 1;
         $disposition = $1;
         $type = '';
         $name = $2;
         $filename = '';
         ##print STDERR "$here: disposition=$disposition name=$name\n";
      } elsif ($line =~ /^Content-Type:\s+(\S+)/) {
         $skip_first = 1;
         $type = $1;
         ##print STDERR "$here: type=$type\n";
      } elsif ($skip_first) {
         $skip_first = 0;
         if ($line =~ /\S+/) {
            print STDERR "$here: SKIPPING line=$line\n";
         }
      } else {
         if ($disposition) {
            if ($disposition eq 'form-data') {
               if ($filename) {
                  $new::File .= $line;
                  $new::File .= "\n";
               } else {
                  if (grep(/$name/, @www::TextAreas)) {
                     # add newline so that cleanup_text_areas does the correct substitution
                     $line .= "\n";
                  } else {
                     # remove HTML newlines
                     $line =~ s/\r//g;
                  }
                  $www::Form{$name} .= $line;
                  if ($API::diag > 4) {
                     print STDERR "$here: www::Form{$name}=$www::Form{$name}\n";
                  }
               }
            } else {
               print STDERR "$here: unknown disposition=$disposition name=$name line=$line\n";
            }
         } elsif ($type) {
            print STDERR "$here: type=$type line=$line\n";
         } else {
            print STDERR "$here: unexpected line, line=$line\n";
         }
      }
   }
}


#*****************************************************************************
#
# Routine:      read_input
#
#*****************************************************************************
sub read_input {
   my $here = $API::program.'::read_input';

   my $method = $ENV{REQUEST_METHOD};
   if ($API::diag > 2) {
      print STDERR "$here: method=$method\n";
   }

   if ($method eq 'GET') {
      foreach my $col (@www::FormCols) {
         $www::Form{$col} = '';
      }
   }

   # Read in text
   my $buffer;
   if ($method eq 'POST') {
      read(STDIN, $buffer, $ENV{CONTENT_LENGTH});
      if ($buffer =~ /Content-\S+:/) {
         &process_content($buffer, $ENV{CONTENT_LENGTH});
         return;
      }
   } else {
      $buffer = $ENV{QUERY_STRING};
   }
   if ($API::diag > 2) {
      print STDERR "$here: buffer=$buffer\n";
   }

   # hide html special characters
   $buffer =~ s/&amp;/<amp>/g;
   $buffer =~ s/&amp/<amp>/g;
   $buffer =~ s/&lt/<lt>/g;
   $buffer =~ s/&gt/<gt>/g;
   $buffer =~ s/&%/<and>%/g;

   my $name;
   my $value;
   # Split information into name/value pairs
   my @Pairs = split(/&/, $buffer);
   foreach my $pair (@Pairs) {
      # restore html special characters
      $pair =~ s/<amp>/&amp;/g;
      $pair =~ s/<lt>/&lt/g;
      $pair =~ s/<gt>/&gt/g;
      $pair =~ s/<and>/&/g;
      ($name, $value) = split(/=/, $pair, 2);
      $value =~ tr/+/ /;
      $value =~ s/%(..)/pack("C", hex($1))/eg;
      # fix the name also
      $name =~ tr/+/ /;
      if ($www::Form{$name}) {
         $www::Form{$name} .= ':'.$value;
      } else {
         $www::Form{$name} = $value;
      }
      if ($API::diag > 3) {
         print STDERR "$here: $name=$value\n";
      }
   }
}


#*****************************************************************************
#
# Routine:      open_database
#
#*****************************************************************************
sub open_database {
   my $here = $API::program.'::open_database';

   my $db_name = shift(@_);
   my $db_user = shift(@_);
   my $db_passwd = shift(@_);
   if ($API::diag > 1) {
      print STDERR "$here: db_name=$db_name db_user=$db_user\n";
   }

   # Connect to the database.
   my $dbh = DBI->connect($db_name,
                          $db_user,
                          $db_passwd,
                          {'RaiseError' => 1});
   return $dbh;
}


#*****************************************************************************
#
# Routine:      by_fullname
#
#*****************************************************************************
sub by_fullname {
   my $here = $API::program.'::by_fullname';

   if ($API::diag > 8) {
      print STDERR "$here: a=$a b=$b\n";
   }
   (my $aa = $a) =~ s/-//g;
   (my $bb = $b) =~ s/-//g;
   $aa cmp $bb;
}


#*****************************************************************************
#
# Routine:      create_list_of_users
#
#*****************************************************************************
sub create_list_of_users {
   my $here = $API::program.'::create_list_of_users';

   if ($API::diag > 7) {
      print STDERR "$here:\n";
   }

   my @Unsorted;
   foreach (keys(%www::Name)) {
      my $user = $www::Name{$_};
      my $pad = 22 - length($user);
      $pad = 10;
      $user .= '.' x $pad;
      $user .= $www::Location{$_};
      push(@Unsorted, $user.':'.$_);
   }
   @www::List_User = sort by_fullname(@Unsorted);

   # the entire list is very long, just look at a sample pattern
   if ($API::diag > 7) {
      foreach my $user (@www::List_User) {
         if ($user =~ /^c/i) {
            print STDERR "$here: user=$user\n";
         }
      }
   }
   if ($API::diag > 8) {
      print STDERR "$here: List_User=@www::List_User\n";
   }
}


#*****************************************************************************
#
# Routine:      write_one_column
#
#*****************************************************************************
sub write_one_column {
   my $here = $API::program.'::write_one_column';

   my $id = shift(@_);
   my $field = shift(@_);
   my $table = shift(@_);
   my $detail = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: id=$id field=$field table=$table detail=$detail\n";
   }

   my $created = "$API::today -- Created by $ENV{REMOTE_USER}";

   my $sth = $API::dbh->prepare("SELECT History, $field
FROM $table
WHERE ID = \"$id\";");
   $API::queries++;
   $sth->execute();

   my $ref = $sth->fetchrow_hashref();

   # add field to the record
   my $sql = "UPDATE $table SET $field = ".
       $API::dbh->quote("$www::Form{$field}")."WHERE ID = $id;";
   $API::dbh->do($sql);

   # only change the history if not the original date/author
   unless ($ref->{History} eq $created) {
      my $history = $ref->{History}."<br>
$API::today -- Modified by $ENV{REMOTE_USER}";

      if ($www::Form{$field} ne $ref->{$field}) {
         my $old = $ref->{$field};
         my $new = $www::Form{$field};

         foreach my $item (\$old, \$new) {
            if ($$item eq '') {
               $$item = $www::undefined;
            }
         }
         $history .= ", $field changed";
         if ($detail) {
            if ($field ne 'Documents') {
               $history .= " from $old to $new";
            }
         }
      }
      my $sql = "UPDATE $table SET History = ".
          $API::dbh->quote("$history")."WHERE ID = $id;";
      $API::dbh->do($sql);
   }

   print STDERR "$here: $ENV{REMOTE_USER}, UPDATE $table SET $field ID = $id\n";
}


#*****************************************************************************
#
# Routine:      get_max_enum
#
#*****************************************************************************
sub get_max_enum {
   my $here = $API::program.'::get_max_enum';

   my $table = shift(@_);
   my $enum = shift(@_);
   my $group = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: table=$table enum=$enum group=$group\n";
   }

   my $sth = $API::dbh->prepare("SELECT MAX($enum) AS MAX
FROM $table
WHERE $group = \"$www::Form{$group}\";");
   $API::queries++;
   $sth->execute();

   my $ref = $sth->fetchrow_hashref();

   return $ref->{MAX};
}


#*****************************************************************************
#
# Routine:      set_new_id
#
#*****************************************************************************
sub set_new_id {
   my $here = $API::program.'::set_new_id';

   my $table = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: table=$table\n";
   }

   if ($www::Form{ID} eq 'NULL') {
      my $sth = $API::dbh->prepare("SELECT MAX(ID) AS ID
FROM $table
WHERE History = \"$www::Form{History}\";");
      $API::queries++;
      $sth->execute();

      my $ref = $sth->fetchrow_hashref();
      $www::Form{ID} = $ref->{ID};
   }
}


#*****************************************************************************
#
# Routine:      print_errors
#
#*****************************************************************************
sub print_errors {
   my $here = $API::program.'::print_errors';

   my $errors = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: errors=$errors\n";
   }

   return "<font color=red size=+1>
The following errors occurred:
</font>
<ul>
$errors
</ul>
Please fix and resubmit the form\n";
}


#*****************************************************************************
#
# Routine:      get_mail_to
#
#*****************************************************************************
sub get_mail_to {
   my $here = $API::program.'::get_mail_to';

   if ($API::diag > 2) {
      print STDERR "$here:\n";
   }

   my @Mail = ($ENV{REMOTE_USER},
               $API::Site{sysadmin});

   foreach my $field (@www::Names) {
      ##print STDERR "$here: field=$field\n";
      push(@Mail, split(/:/, $www::Form{$field}));
   }

   my $users = '';
   my $to = '';
   foreach my $mailee (@Mail) {
      my $userid = $mailee;
      if ($API::diag > 3) {
         print STDERR "$here: mailee=$mailee\n";
      }
      # for disabled users, send email to their manager instead
      if ($www::Name{$userid} =~ /^-/) {
         if ($www::Manager{$userid} eq 'N/A') {
            print STDERR "$here: mailing nobody since $mailee has no manager\n";
            next;
         } else {
            $userid = $www::Manager{$userid};
         }
         print STDERR "$here: mailing $userid instead of $mailee\n";
      }
      unless ($users =~ /$userid:/) {
         $users .= $userid.':';
         $to .= $www::Email{$userid}.',';
      }
   }
   if ($API::diag > 3) {
      print STDERR "$here: to=$to\n";
   }

   return $to;
}


#*****************************************************************************
#
# Routine:      send_email_to
#
#*****************************************************************************
sub send_email_to {
   my $here = $API::program.'::send_email_to';

   my $to = shift(@_);
   my $subject = shift(@_);
   my $msg = shift(@_);
   my $link = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: to=$to subject=$subject msg=$msg link=$link\n";
   }

   use Net::SMTP;

   my $id = $www::Form{ID};
   # mail server only accepts from local accounts
   my $author = $ENV{REMOTE_USER};
   $author =~ s/\.//g;
   $author .= '@'.$API::Site{Domain};

   my @To = split(/,/, $to);
   foreach my $to (@To) {
      my $smtp = Net::SMTP->new($API::Site{smtp_server},
                                Timeout => 60,
                                Debug => $API::diag);
      if ($API::diag > 2) {
         print STDERR "$here: Domain=".$smtp->domain,"\n";
         print STDERR "$here: Banner=".$smtp->banner,"\n";
      }

      $smtp->mail($author);
      $smtp->to($to);

      $smtp->data();
      my $data = "From: $author
Reply-To: $author
To: $to
Subject: $subject
Content-Type: text/html; charset=us-ascii
Content-Transfer-Encoding: 7bit

<!doctype html public \"-//w3c//dtd html 4.0 transitional//en\">
<html>
<b>Title:</b><br>
$www::Form{Title}
<p>
$msg
<p>
$link<br>
</html>\n";

      $smtp->datasend($data);
      $smtp->dataend();
      $smtp->quit;
      print STDERR "$here: $id: email sent to $to\n";
   }
}


#*****************************************************************************
#
# Routine:      send_emails
#
#*****************************************************************************
sub send_emails {
   my $here = $API::program.'::send_emails';

   my $subject = shift(@_);
   my $msg = shift(@_);
   my $link = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: subject=$subject msg=$msg link=$link\n";
   }

   my $to = &get_mail_to;
   if ($API::diag) {
      print STDERR "$here: to=$to\n";
      $to = "$API::Site{sysadmin}\@$API::Site{Domain}";
   }

   if ($ENV{SCRIPT_NAME} =~ /$www::cgidir\/\w+\/\w+\.pl$/) {
      print STDERR "$here: email NOT sent to $to\n";
   } else {
      &send_email_to($to, $subject, $msg, $link);
   }
}


#*****************************************************************************
#
# Routine:      verify_date
#
#*****************************************************************************
sub verify_date {
   my $here = $API::program.'::verify_date';

   my $field = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field\n";
   }

   my $date = $www::Form{$field};
   my $errors = '';
   if ($date =~ /^(\d{4,4})[-\/]{1,1}(\d{1,2})[-\/]{1,1}(\d{1,2})$/) {
      my $year = $1;
      my $month = $2;
      my $day = $3;
      if (($year < 1999) || ($year > $API::Date{year})) {
         $errors .= "<li><b>$date</b> invalid,
year should be between 1999 and $API::Date{year}</li>\n";
      }
      if ($month > 12) {
         $errors .= "<li><b>$date</b> invalid,
month should be between 1 and 12</li>\n";
      }
      if ($day > 31) {
         $errors .= "<li><b>$date</b> invalid,
day should be between 1 and 31</li>\n";
      }
   } else {
      $errors .= "<li><b>$date</b> invalid,
$field format should be <i>$www::date_format</i> </li>\n";
   }

   return $errors;
}


#*****************************************************************************
#
# Routine:      verify_numeric
#
#*****************************************************************************
sub verify_numeric {
   my $here = $API::program.'::verify_numeric';

   my $field = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field\n";
   }

   my $value = $www::Form{$field};
   if ($API::diag > 3) {
      print STDERR "$here: field=$field, value=$value\n";
   }
   my $errors = '';
   unless (($value =~ /^\d+\.?\d$/) ||
           ($value =~ /^\d+$/)) {
      $errors .= "<li><b>$value</b> invalid, $field must be numeric</li>\n";
   }

   return $errors;
}


#*****************************************************************************
#
# Routine:      date_to_ascii
#
#*****************************************************************************
sub date_to_ascii {
   my $here = $API::program.'::date_to_ascii';

   my $date = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: date=$date\n";
   }

   my $day = (localtime($date))[3];
   my $mmm =
       ('Jan',
        'Feb',
        'Mar',
        'Apr',
        'May',
        'Jun',
        'Jul',
        'Aug',
        'Sep',
        'Oct',
        'Nov',
        'Dec') [(localtime($date))[4]];
   my $month = (localtime($date))[4] + 1;
   my $year = (localtime($date))[5]+1900;
   my $day_of_week =
       ('Sun',
        'Mon',
        'Tue',
        'Wed',
        'Thu',
        'Fri',
        'Sat') [(localtime($date))[6]];
   my $ss = (localtime($date))[0];
   my $hh = (localtime($date))[1];
   my $mm = (localtime($date))[2];

   my $ascii = sprintf('%4.4d-%2.2d-%2.2d %2.2d:%2.2d', $year, $month, $day, $mm, $hh, $ss);

   return $ascii;
}


#*****************************************************************************
#
# Routine:      delete_enum
#
#*****************************************************************************
sub delete_enum {
   my $here = $API::program.'::delete_enum';

   my $column = shift(@_);
   if ($API::diag > 1) {
      print STDERR "$here: column=$column\n";
   }

   no strict 'refs';

   my $value = $www::Form{$column};
   if ($API::diag > 2) {
      print STDERR "$here: column=$column value=$value\n";
   }
   # fix ampersands, trailing space affects auto conversion?
   $value =~ s/& /&amp; /g;
   my $status;

   # total all the counts
   my $total = 0;
   foreach my $label (split(/:/, $API::Enumerations{$column})) {
      # change the first character to lowercase
      (my $table = $label) =~ tr/A-Z/a-z/;
      &read_count($table, $column);
      my $var = "www::${table}_count";
      $total += $$var{$value};
   }

   if ($total) {
      $status = "<font size=+1 color=red>Sorry, $value count is $total, not zero</font>";
   } else {

      my $array = "www::List_$column";

      foreach my $label (split(/:/, $API::Enumerations{$column})) {
         # change the first character to lowercase
         (my $type = $label) =~ tr/A-Z/a-z/;

         my $table = "www::db_${type}_table";
         # alter the table
         my $sql = "ALTER TABLE $$table MODIFY $column ENUM(";
         foreach (@$array) {
            unless ($_ eq $value) {
               $sql .= $API::dbh->quote("$_").',';
            }
         }
         chop($sql);
         $sql .= ') NOT NULL';

         if ($API::diag > 3) {
            print STDERR "$here: sql=$sql\n";
         } else {
            $API::dbh->do($sql);
         }
      }
      my $msg = "$value deleted from $column";
      print STDERR "$here: $msg by $ENV{REMOTE_USER}\n";
      $status = "<font size=+1 color=green>$msg</font>";

      # use the first table
      my ($label, $other) = split(/:/, $API::Enumerations{$column}, 2);
      # change the first character to lowercase
      (my $type = $label) =~ tr/A-Z/a-z/;
      my $table = "www::db_${type}_table";
      &create_dynamic_lists($$table);
   }

   &edit_enum($column, $status, $ENV{REMOTE_USER});
}


#*****************************************************************************
#
# Routine:      insert_enum
#
#*****************************************************************************
sub insert_enum {
   my $here = $API::program.'::insert_enum';

   my $column = shift(@_);
   my $value = shift(@_);
   if ($API::diag) {
      print STDERR "$here: column=$column value=$value\n";
   }

   unless ($value =~ /^[ \w\-\.\/\&]+$/) {
      return "<big><font color=red>$value invalid</font>, $column can only contain letters, numbers, spaces, dashes, periods, slashes and ampersands</big>";
   }

   no strict 'refs';

   my $array = "www::List_$column";
   foreach (@$array) {
      if ($value eq  $_) {
         return "<big><font color=red>$value invalid</font>, it already exists in $column</big>";
      }
   }
   push(@$array, $value);
   my @new = sort(@$array);

   foreach my $label (split(/:/, $API::Enumerations{$column})) {
      # change the first character to lowercase
      (my $type = $label) =~ tr/A-Z/a-z/;
      my $table = "www::db_${type}_table";
      # alter the table
      my $sql = "ALTER TABLE $$table MODIFY $column ENUM(";
      foreach (@new) {
         $sql .= $API::dbh->quote("$_").',';
      }
      chop($sql);
      $sql .= ') NOT NULL';
      $API::dbh->do($sql);
   }

   my $msg = "$value inserted into $column";
   print STDERR "$here: $msg by $ENV{REMOTE_USER}\n";

   # use the first table
   my ($label, $other) = split(/:/, $API::Enumerations{$column}, 2);
   # change the first character to lowercase
   (my $type = $label) =~ tr/A-Z/a-z/;
   my $table = "www::db_${type}_table";
   &create_dynamic_lists($$table);

   return "<big><font color=green>$msg</font></big>";
}


#*****************************************************************************
#
# Routine:      recall_saved_query
#
#*****************************************************************************
sub recall_saved_query {
   my $here = $API::program.'::recall_saved_query';

   my $qname = shift(@_);
   my $table = $www::Form{Table};
   if ($API::diag > 1) {
      print STDERR "$here: qname=$qname table=$table\n";
   }

   my $sth = $API::dbh->prepare("SELECT *
FROM $www::db_query_table
WHERE TableName = '$table' AND
Name = '$qname';");
   $API::queries++;
   $sth->execute();

   my $ref = $sth->fetchrow_hashref();

   foreach my $field (@www::QueryCols) {
      if ($API::diag > 2) {
         print STDERR "$here: ref->{$field}=$ref->{$field}\n";
      }
      unless ($field eq 'Other') {
         $www::Form{$field} = $ref->{$field};
      } else {
         my @Lists = split(/&&/, $ref->{$field});
         foreach my $list (@Lists) {
            my ($name, $val) = split(/=/, $list, 2);
            $www::Form{$name} = $val;
            if ($API::diag > 3) {
               print STDERR "$here: list=$list\n";
            }
         }
      }
   }
}


#*****************************************************************************
#
# Routine:      report_form
#
#*****************************************************************************
sub report_form {
   my $here = $API::program.'::report_form';

   my $column = shift(@_);
   my $tables = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: column=@$column tables=@$tables\n";
   }

   my $msg = $www::Menu_Labels{Build_Rpt}.$API::subtitle.' Form';

   if ($www::Form{Saved}) {
      &recall_saved_query($www::Form{Saved}, $tables);
      if ($www::Form{Saved} eq $www::last_prefix.$www::Form{QueryUserid}) {
         $msg .= '-My Last Query';
      } else {
         $msg .= '-'.$www::Form{Saved};
      }
   }

   no strict 'refs';

   &header($msg, $www::report_menu);

   my $out = "<form method=post action=$ENV{SCRIPT_NAME}>
<input type=hidden name=Field value=Report>
<input type=hidden name=Table value=$www::Form{Table}>
<table width=100% valign=top>
<tr>
";

   my $options;
   my $size;
   my $default;
   my $selected;
   # add the Sort Order
   if ($www::Form{OrderBy}) {
       $default = $www::Form{OrderBy};
   } else {
       $default = 'ID';
   }
   $options = '';
   foreach my $col (@$column) {
      if ($default =~ /$col/) {
         $selected = 'selected';
      } else {
         $selected = '';
      }
      $options .= "<option $selected>$col\n";
   }
   $size = $#$column+1;
   $out .= "$www::HTML{t1}
<a title='$www::Help{Multiple_Sel_Title}'>Sort<br>
Order</a>
$www::HTML{t2}
<select name=OrderBy size=$size multiple>
$options
</select></td></tr></table>

</td>\n";

   # add the Display List
   $default = ':';
   if ($www::Form{Display}) {
      $default .= $www::Form{Display}.':';
   } else {
      foreach my $def (@www::Default_Display) {
         $default .= $def.':';
      }
   }
   $options = '';
   foreach my $col (@$column) {
      if ($default =~ /:$col:/) {
         $selected = 'selected';
      } else {
         $selected = '';
      }
      $options .= "<option $selected>$col\n";
   }
   $size = $#$column+1;
   $out .= "$www::HTML{t1}
<a title='$www::Help{Multiple_Sel_Title}'>Display<br>
List</a>
$www::HTML{t2}
<select name=Display size=$size multiple>
$options
</select></td></tr></table>

</td>\n";

   # add the Group By List
   $default = ':';
   if ($www::Form{GroupBy}) {
       $default .= $www::Form{GroupBy}.':';
   } else {
       foreach my $def (@www::Default_GroupBy) {
           $default .= $def.':';
       }
   }
   $options = '';
   foreach my $col (@$column) {
      if ($default =~ /:$col:/) {
         $selected = 'selected';
      } else {
         $selected = '';
      }
      $options .= "<option $selected>$col\n";
   }
   $size = $#$column+1;
   $out .= "$www::HTML{t1}
<a title='$www::Help{Multiple_Sel_Title}'>Group By<br>
List</a>
$www::HTML{t2}
<select name=GroupBy size=$size multiple>
$options
</select></td></tr></table>

</td>\n";

   # add the Modified Since List
   if ($www::Form{Since}) {
      $default = $www::Form{Since};
   } else {
      $default = '';
   }
   $options = '';
   foreach my $col (@www::Since) {
      if ($col eq $default) {
         $selected = 'selected';
      } else {
         $selected = '';
      }
      $options .= "<option value=\'$col\' $selected>$col\n";
   }
   $size = $#www::Since+1;
   $out .= "$www::HTML{t1}
<a title='$www::Help{Single_Sel_Title}'>Modified<br>
Since</a>
$www::HTML{t2}
<select name=Since size=$size>
$options
</select></td></tr></table>

</td>
</tr>
<tr>";

   # add the specified tables
   foreach my $field (@$tables) {
      # use the defaults from the database if present
      if (grep(/$field/, @www::Names)) {
         foreach my $name (@www::Names) {
            if (length($www::Form{$name})) {
               $default = $www::Form{$name};
            }
         }
      } elsif ($www::Form{$field}) {
         $default = $www::Form{$field};
      } else {
         $default = '';
      }

      my $array = "www::List_$field";
      if ($API::diag > 3) {
         print STDERR "$here: field=$field default=$default array=$array\n";
      }
      my $size = 0;
      my $options = '';
      my $disabled = '';
      foreach my $entry (@$array) {
         # cap the enum lists same as the field lists
         unless ($size > $#$column) {
            $size++;
         }
         if (grep(/$field/, @www::Names)) {
            my ($name, $value) = split(/:/, $entry);
            # select the defaults if specified
            if ($default =~ /$value/) {
               $selected = 'selected';
            } else {
               $selected = '';
            }
            if ($name =~ /^-/) {
               $disabled .= "<option value=$value $selected>$name\n";
            } else {
               $options .= "<option value=$value $selected>$name\n";
            }
         } else {
            # select the defaults if specified
            if (${default} =~ /${entry}$/) {
               $selected = 'selected';
            } elsif ($default =~ /${entry}:/) {
               $selected = 'selected';
            } else {
               $selected = '';
            }
            $options .= "<option $selected>${entry}\n";
         }
      }

      my $checked;
      # change underscores to spaces
      (my $label = $field) =~ s/_/ /g;
      my $radio = '';
      if (grep(/$field/, @www::Names)) {
         foreach my $name (@www::Names) {
            # for the default, make the first one checked
            if (($name eq $www::Names[0]) ||
                (length($www::Form{$name}))) {
               ##print STDERR "$here: name=$name\n";
               $checked = 'checked';
            } else {
               $checked = '';
            }
            $radio .= "<input type=radio name=Radio$field value=$name $checked>$name\n";
         }
      }
      if ($radio) {
         $label = $radio;
      }
      # start these lists in a new tables
      if (grep(/$field/, (@www::Names))) {
         $out .= "</tr>
</table>
<table width=100% valign=top>
<tr>\n";
      }
      $out .= "$www::HTML{t1}
<a title='$www::Help{Multiple_Sel_Title}'>$label<br>
Filter</a>
$www::HTML{t2}
<select name=$field size=$size multiple>
$options
$disabled
</select></td></tr>
</table>

</td>\n";
   }

   my $search_html = '';
   my $label = 'Search';
   foreach my $col (@www::TextAreas) {
      $label .= " $col,";
   }
   $label =~ s/,$//g;
   $search_html = "<a title='$www::Help{Search}'>Include $label</a>: 
<input type=text
name=SearchString
maxlength=40
size=40><br>\n";

   $not_search_html = "<a title='$www::Help{Search}'>Exclude $label</a>: 
<input type=text
name=NotSearchString
maxlength=40
size=40><br>\n";

   $out .= "</tr>
</table>
$search_html
$not_search_html
<big>
<input type=hidden name=Name value=$www::last_prefix$ENV{REMOTE_USER}>
<input class='$BS::submit' type='submit' name=Submit value='Submit Query'>
$www::Default{ResetForm}
View Results:\n";

   my $checked;
   if ($www::Form{Format}) {
      $default = $www::Form{Format};
   } elsif ($www::Default{OrderBy}) {
      $default = $www::Prefs_Defaults{APIOutFmt};
   } else {
      $default = $www::Prefs_Defaults{APIOutDir};
   }
   foreach my $val (sort keys %www::APIOutFmt) {
      if ($val eq $default) {
         $checked = 'checked';
      } else {
         $checked = '';
      }
      $out .= "<input type=radio name=Format value=$val $checked>$www::APIOutFmt{$val}\n";
   }
   $out .= "</form>\n";

   print $out;
   $API::bytes += length($out);
   &footer($www::report_menu);
}


#*****************************************************************************
#
# Routine:      printenv
#
#*****************************************************************************
sub printenv {
   my $here = $API::program.'::printenv';

   if ($API::diag > 2) {
      print STDERR "$here: \n";
   }

   my $msg = 'Print Environment';
   &header($msg, '');

   my $out = "<table class='table table-striped'>\n";

   foreach my $var (reverse(sort(keys(%ENV)))) {
      my $val = $ENV{$var};
      $val =~ s|\n|\\n|g;
      $val =~ s|"|\\"|g;
      $out .= "<tr><th>${var}</th><td>${val}</td></tr>\n";
   }

   $out .= "</table>\n";

   print $out;
   $API::bytes += length($out);
   &footer('');
}


#*****************************************************************************
#
# Routine:      get_since
#
#*****************************************************************************
sub get_since {
   my $here = $API::program.'::get_since';

   my $field = shift(@_);
   my $since = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field since=$since\n";
   }

   my $sql;
   my ($year, $month, $day) = split(/-/, $API::today);
   if ($since eq 'Today') {
      $sql = "TO_DAYS(NOW()) - TO_DAYS($field) <= 0";
   } elsif ($since eq 'Yesterday') {
      $sql = "TO_DAYS(NOW()) - TO_DAYS($field) <= 1";
   } elsif ($since eq 'Seven Days Ago') {
      $sql = "TO_DAYS(NOW()) - TO_DAYS($field) <= 7";
   } elsif ($since eq 'Sunday') {
      my $daysago = (localtime)[6];
      $sql = "TO_DAYS(NOW()) - TO_DAYS($field) <= $daysago";
   } elsif ($since eq 'Last Sunday') {
      my $daysago = (localtime)[6]+7;
      $sql = "TO_DAYS(NOW()) - TO_DAYS($field) <= $daysago";
   } elsif ($since eq 'Fourteen Days Ago') {
      $sql = "TO_DAYS(NOW()) - TO_DAYS($field) <= 14";
   } elsif ($since eq 'Beginning of the Month') {
      $sql = "$field LIKE \'$year-$month%\'";
   } elsif ($since eq 'Beginning of the Year') {
      $sql = "$field LIKE \'$year%\'";
   } elsif ($since eq 'Dawn of Time') {
      $sql = "$field LIKE \'%\'";
   } else {
      &error_page('Error',
                  'Form Corrupted',
                  "$here: since=$since");
   }
   return "$sql\n";
}


#*****************************************************************************
#
# Routine:      get_rank
#
#*****************************************************************************
sub get_rank {
   my $here = $API::program.'::get_rank';

   my $field = shift(@_);
   my $rank = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field rank=$rank\n";
   }

   my $sql = '';
   foreach my $index (0 .. $#www::List_Rank) {
      if ($API::diag > 3) {
         print STDERR "$here: www::List_Rank{$index}=$www::List_Rank[$index]\n";
      }
      if ($rank eq $www::List_Rank[$index]) {
         # Perl arrays are zero based, MySQL enums are 1 based
         $index++;
         $sql = "$field >= $index";
         last;
      }
   }

   return $sql;
}


#*****************************************************************************
#
# Routine:      save_query
#
#*****************************************************************************
sub save_query {
   my $here = $API::program.'::save_query';

   my $name = shift(@_);
   my $savesql = shift(@_);
   if ($API::diag > 1) {
      print STDERR "$here: name=$name savesql=$savesql\n";
   }

   $www::Form{TableName} = $www::Form{Table};

   # only use the last specified format, the default is always first
   foreach (split(/:/, $www::Form{Format})) {
      $www::Form{Format} = $_;
   }
   if ($API::diag > 2) {
      print STDERR "$here: name=$name www::Form{Format}=$www::Form{Format}\n";
   }

   unless ($name) {
      # no name specified, save as My Last Query
      $www::Form{Name} = $www::last_prefix.$ENV{REMOTE_USER};
   } elsif ($name =~ /^[ \w\.\-\&]+$/) {
      # check to see that the name is not already in use
      my $sth = $API::dbh->prepare("SELECT QueryUserid
FROM $www::db_query_table
WHERE TableName = '$www::Form{TableName}' AND
Name = '$name';");
      $API::queries++;
      $sth->execute();

      my $ref = $sth->fetchrow_hashref();

      if ($ref->{QueryUserid} &&
          ($ref->{QueryUserid} ne $ENV{REMOTE_USER})) {
         &error_page('Error',
                     'Query not saved',
                     "Query Name, $name, already in use by $www::Name{$ref->{QueryUserid}}");
         return 0;
      }
      $www::Form{Name} = $name;
   } else {
      &error_page('Error',
                  'Query not saved',
                  'Query Name can only contain letters, numbers, periods, spaces, dashes and ampersands');
      return 0;
   }
   $www::Form{QueryUserid} = $ENV{REMOTE_USER};

   # save all the selections
   $www::Form{Other} = '';
   foreach my $field (@www::Enum_Lists, @www::Names) {
      if ($www::Form{$field}) {
         $www::Form{Other} .= $field.'='.$www::Form{$field}.'&&';
      }
   }

   # insert the records by column
   my $sql = "REPLACE INTO $www::db_query_table SET ";
   foreach my $col (@www::QueryCols) {
      unless ($col eq 'Modified') {
         if ($www::Form{$col}) {
            $sql .= "$col = ".$API::dbh->quote("$www::Form{$col}").',';
         }
      }
   }
   $sql =~ s/,$/;/g;
   if ($API::diag > -3) {
      print STDERR "$here: sql=$sql\n";
   }
   $API::dbh->do($sql);

   if ($API::diag) {
      print STDERR "$here: $ENV{REMOTE_USER}, query $www::Form{Name} saved\n";
   }
   return 1;
}


#*****************************************************************************
#
# Routine:      get_total_label
#
#*****************************************************************************
sub get_total_label {
   my $here = $API::program.'::get_total_label';

   my $only = shift(@_);
   my $order = shift(@_);
   my $field = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: only=$only, order=$order, field=$field\n";
   }

   my $label = '';
   my @Fields = split(/:/, $field);
   ##my @Values = split(/<br>/, $only);
   $only =~ s/<br>/,/g;
   my @Values = split(/,/, $only);
   foreach my $i (0 .. $#Fields) {
      unless ($Values[$i]) {
         next;
      }
      if ($API::diag > 3) {
         print STDERR "$here: Fields[$i]=$Fields[$i] Value[$i]=$Values[$i]\n";
      }
      if (length($Values[$i]) > 80) {
         next;
      }
      # do not add numeric field labels
      if ($order =~ /$Fields[$i]/) {
         next;
      }
      if ($Values[$i] eq 'Yes') {
         $label .= $Fields[$i];
      } elsif ($Values[$i] eq 'No') {
         $label .= "Not $Fields[$i]";
      } else {
         $label .= $Values[$i];
      }
      $label .= ', ';
   }
   $label =~ s/, $/ /g;

   return $label;
}


#*****************************************************************************
#
# Routine:      get_numeric_total_tr
#
#*****************************************************************************
sub get_numeric_total_tr {
   my $here = $API::program.'::get_numeric_total_tr';

   my $key = shift(@_);
   my $format = shift(@_);
   my $only = shift(@_);
   my $order = shift(@_);
   my $field = shift(@_);
   my $colspan = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: key=$key format=$format only=$only, order=$order field=$field colspan=$colspan\n";
   }

   my $tr;
   my $label = &get_total_label($only, $order, $field);

   # use full names if applicable
   my $slabel;
   if (grep(/^$order$/, @www::Names)) {
      $slabel = $www::Name{$key};
   } else {
      $slabel = $key;
   }
   # add enum labels if available
   foreach my $o (split(/,/, $order)) {
      my $k = "$o:$key";
      if ($www::EnumLabels{$k}) {
         $slabel .= ': ';
         if ($format eq 'XTABS') {
            $slabel .= "$www::EnumLabels{$k}";
         } else {
            $slabel .= "<i>$www::EnumLabels{$k}</i> ";
         }
      }
   }

   ## TBD - Add special enum sub-totals logic
   ## when always on, fields like Date & Miles look like crap
   if (0) {
      if ($format eq 'XTABS') {
	 $tr = "\t" x ($colspan - 1);
	 $tr .= "$slabel $label Total $www::numeric_field\t$tmp::Subtotal{$key}\n";
      } elsif ($format =~ /Compressed/) {
	 $tr = "<tr><td>$slabel, $label <b>Total $www::numeric_field</b>$tmp::Subtotal{$key}</td></tr>\n";
      } else {
	 $tr = "<tr><td align=right colspan=$colspan>$slabel, $label <b>Total $www::numeric_field</b></td>
<td>$tmp::Subtotal{$key}</td></tr>\n";
      }
   }

   return $tr;
}


#*****************************************************************************
#
# Routine:      get_numeric_grand_tr
#
#*****************************************************************************
sub get_numeric_grand_tr {
   my $here = $API::program.'::get_numeric_grand_tr';

   my $format = shift(@_);
   my $only = shift(@_);
   my $order = shift(@_);
   my $field = shift(@_);
   my $colspan = shift(@_);
   my $grand = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: format=$format only=$only, order=$order field=$field colspan=$colspan grand=$grand\n";
   }

   my $tr;
   my $label = &get_total_label($only, $order, $field);

   if ($format eq 'XTABS') {
      $tr = "\t" x ($colspan - 1);
      $tr .= "Total $label $www::numeric_field\t$grand\n";
   } elsif ($format =~ /Compressed/) {
      $tr .= "<tr><td><b>Total $label $www::numeric_field:</b>$grand</td></tr>\n";
   } else {
      $tr .= "<tr><th align=right colspan=$colspan>Grand Total $label $www::numeric_field</th>
<td>$grand</td></tr>\n";
   }

   return $tr;
}


#*****************************************************************************
#
# Routine:      get_tr_start
#
#*****************************************************************************
sub get_tr_start {
   my $here = $API::program.'::get_tr_start';

   if ($API::diag > 2) {
      print STDERR "$here: www::Color{MouseOver}=$www::Color{MouseOver}\n"
       }

   return "TR class=tr_list
onMouseover=\"this.style.backgroundColor='$www::Color{MouseOver}'\"
onMouseOut=\"this.style.backgroundColor=''\"
";
}


#*****************************************************************************
#
# Routine:      set_user_prefs
#
#*****************************************************************************
sub set_user_prefs {
   my $here = $API::program.'::set_user_prefs';

   my $bgcolor = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: bgcolor=$bgcolor\n";
   }

   $www::Color{MouseOver} = $bgcolor;
}


#*****************************************************************************
#
# Routine:	select_image
#
#*****************************************************************************
sub select_image {
   my $here = $API::program.'::select_image';

   my $prefs = shift(@_);
   if ($API::diag > 1) {
      print STDERR "$here: prefs=$prefs\n";
   }

   (my $locations = $prefs) =~ s/:/','/g;
   my $sth = $API::dbh->prepare("SELECT URL
FROM uimagez
WHERE Type IN ('$locations')
ORDER BY rand() LIMIT 1;");
   $API::queries++;
   $sth->execute();

   my $ref = $sth->fetchrow_hashref();
   if ($ref->{URL}) {
      $www::HTML{Image} = $ref->{URL};
   }

   if ($API::diag > 3) {
      print STDERR "$here: locations=$locations, www::HTML{Image}=$www::HTML{Image}\n";
   }
}


#*****************************************************************************
#
# Routine:      load_user_images
#
#*****************************************************************************
sub load_user_images {
   my $here = $API::program.'::load_user_images';

   my $subdirs = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: subdirs=$subdirs\n";
   }

   my $dir;
   foreach my $sdir (split(/:/, $subdirs)) {
      $dir = $ENV{DOCUMENT_ROOT}."/images/$sdir";
      if (opendir(DIR, $dir)) {
         my @files = readdir(DIR);
         closedir(DIR);
         foreach my $file (@files) {
            if ($file =~ /jpg$/) {
               push(@my::Images, $sdir.'/'.$file);
            }
         }
      } else {
         print STDERR "$API::program: Can't open directory $dir: $!\n";
      }
   }
   # if no images are found in the user-specified sub-dirs, then just read images
   if ($#my::Images == -1) {
      $dir = $ENV{DOCUMENT_ROOT}."/images";
      if (opendir(DIR, $dir)) {
         my @files = readdir(DIR);
         closedir(DIR);
         foreach my $file (@files) {
            if ($file =~ /jpg$/) {
               push(@my::Images, $sdir.$file);
            }
         }
      }
   }

   # select a random number for image rotation
   my $r = int(rand($#my::Images));
   $www::HTML{Image} = '/images/'.$my::Images[$r];
}


#*****************************************************************************
#
# Routine:      get_label_tr
#
#*****************************************************************************
sub get_label_tr {
   my $here = $API::program.'::get_label_tr';

   my $format = shift(@_);
   my $table = shift(@_);
   my $grouped = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: format=$format grouped=$grouped\n";
   }

   my $tr;
   if ($format eq 'XTABS') {
      $tr = '';
   } else {
      $tr = "
$www::border_table
<tr>";
   }
   foreach my $col (@$table) {
      my $label = $col;
      if ($grouped) {
         if (grep(/$col/, $www::numeric_field)) {
            $label = 'Sum<br>'.$col;
         } else {
            $label = 'Maxium<br>'.$col;
         }
      }
      if ($format eq 'XTABS') {
         $tr .= $label."\t";
      } elsif ($format =~ /Compressed/) {
         # compress output
         if (grep(/^$col$/, (@www::TextAreas, 'History'))) {
            unless ($col =~ /Title/) {
               $compress .= "<th><b>$label</b></th>\n";
            }
         } else {
            $compress .= ' ';
         }
      } else {
         $tr .= "<th><b>$label</b></th>\n";
      }
   }
   if ($compress) {
      $tr .= "<th>$compress</th>\n";
   }
   if ($format ne 'XTABS') {
      $tr .= '</tr>';
   }
   $tr .= "\n";

   return $tr;
}


#*****************************************************************************
#
# Routine:      print_any_format
#
#*****************************************************************************
sub print_any_format {
   my $here = $API::program.'::print_any_format';

   # revert the numeric format
   $www::Format{Numeric} = '%2.2f';

   my $format = shift(@_);
   my $table = shift(@_);
   my $only = shift(@_);
   my $order = shift(@_);
   my $grouped = shift(@_);
   my $sth = shift(@_);
   my $field = shift(@_);
   my $display = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: format=$format table=$table only=$only, order=$order field=$field display=$display\n";
   }

   my $compress;
   my $uncompress;
   my $title;
   my $summary;
   $_ = $display;
   my $colspan = tr/:/:/;
   my $out;
   my $td_spec = '<td valign=top><nobr><small>';
   my $grand = 0;

   # build the display columns
   my @New;
   my @Labels;
   my @Order = split(/,/, $order);
   foreach my $col (split(/,/, $grouped),
                    @Order,
                    split(/:/, $display)) {
      $col =~ s/ DESC//g;
      unless (grep(/^$col$/, @New)) {
         push(@New, $col);
         push(@Labels, $col);
      }
   }

   # create the table header row
   $out = &get_label_tr($format, \@Labels, $grouped);

   foreach my $col (@www::Names) {
      $MailList{$col} = '';
   }
   # initilize Last assoc array
   foreach my $ord (@Order) {
      $Last{$ord} = '';
   }
   my $items = 0;
   while (my $ref = $sth->fetchrow_hashref()) {
      $items++;
      my $tr;
      if ($format eq 'XTABS') {
         $tr = '';
      } else {
         $tr = '<'.&get_tr_start.'>';
      }
      $compress = '';
      $uncompress = '';
      $title = '';
      $summary = '';
      foreach my $col (@New) {
	 my $cell;
         if ($ref->{$col}) {
            $cell = $ref->{$col};
         } elsif ($ref->{"XXX_$col"}) {
	    $cell = $ref->{"XXX_$col"};
	 } else {
	    $cell = '';
         }

         my $td = '';
         if ($format eq 'XTABS') {
            $td = $cell;
         } else {

            if ($col eq 'ID') {
               $td = &get_id($ref, $cell, 'ID', $order);
               $td =~ s/<br>/, /g;

            } elsif (grep(/^$col$/, @www::Names)) {
               foreach my $helper (split(/:/, $cell)) {
                  $td .= &get_user_mailto($helper).'<br>';
                  # add the email addresses
                  my $mail = $www::Email{$helper};
                  if ($mail) {
                     unless (grep(/$mail/, $MailList{$col})) {
                        $MailList{$col} .= $mail.'; ';
                     }
                  }
               }

            } elsif ($col eq 'Documents') {
               $td = &get_attach($cell);

            } elsif ($col eq 'Release_Notes') {
               if (length($cell)) {
                  $td = &get_upload($cell);
               }

            } elsif ($col eq 'History') {
               $td = &get_history('Records', $cell);

            } elsif (grep(/^$col$/, @www::TextAreas)) {
               $td = $cell;

            } else {
               $td = &get_column('Records', $col, $cell, $order, $field);
            }
         }

         # add up the numeric sub-totals & grand total
         if (grep(/$col/, $www::numeric_field)) {
            if ($cell) {
               $grand += $cell;
               # add sub-totals as well
               foreach my $ord (@Order) {
                  my $value = $ref->{$ord};
                  $tmp::Subtotal{$value} += $cell;
                  if ($value ne $Last{$ord}) {
                     ##print STDERR "$here: ord=$ord value=$value\n";
                     if ($Last{$ord}) {
                        $summary = &get_numeric_total_tr($Last{$ord}, $format, $only, $order, $field, $colspan);
                     }
                     $Last{$ord} = $value;
                  }
                  ##print STDERR "$here: ref->{$ord}=$ref->{$ord} tmp::Subtotal{$ref->{$ord}}=$tmp::Subtotal{$ref->{$ord}} cell=$cell\n";
               }
            }
         }

         # remove trailing breaks, in Helpers and Description
         $td =~ s/<br>$//g;

         my $nobr = '';
         if (length($cell) > $www::max_td_width) {
            $nobr = '</nobr>';
         }
         # compress output
         if ($format eq 'XTABS') {
            $tr .= $td."\t";
         } elsif ($format =~ /Compressed/) {
            if ($col =~ /Title/) {
               if ($display =~ /Description/) {
                  $title .= "<b>$col: </b>$td<br><br>";
               } else {
                  $compress .= "<nobr><b>$col:</b>$td<br>\n";
               }
            } elsif ($col eq 'Description') {
               $uncompress .= $td_spec.$nobr.$title.$td."</td>\n";
            } elsif (grep(/^$col$/, (@www::TextAreas, 'History'))) {
               $uncompress .= $td_spec.$nobr.$td."</td>\n";
            } else {
               $compress .= "<nobr><b>$col:</b>$td<br>\n";
            }
         } else {
            $tr .= $td_spec.$nobr.$td."</td>\n";
         }
      }
      if ($compress) {
         $tr .= $td_spec.$compress."</td>\n";
      }
      if ($uncompress) {
         $tr .= $uncompress;
      }
      if ($format ne 'XTABS') {
         $tr .= '</tr>';
      }
      $tr .= "\n";
      if ($summary) {
         $out .= $summary;
      }
      $out .= $tr;
   }
   $sth->finish();

   if ($grand) {
      # add the last summary
      my $ord = $Order[$#Order];
      $summary = &get_numeric_total_tr($Last{$ord}, $format, $only, $order, $field, $colspan);
      $out .= $summary;
      # add the grand total
      $out .= &get_numeric_grand_tr($format, $only, $order, $field, $colspan, $grand);
   }

   unless ($items) {
      $only = &get_full_name($only);
      $out = "<center><h2>No <font color=red>$only</font> Records found</h2></center>\n";
   }

   $only = &get_full_name($only);
   # why not use www::Names
   my $sorted = "Sorted by $order";
   foreach my $name (@www::Names) {
      if ($order eq $name) {
         $sorted .= ' (Userid)';
      }
   }
   if ($grouped) {
      $sorted .= "<br>Grouped by $grouped";
   }

   if ($format eq 'XTABS') {
      # Content-Type: application/octet-stream;
      $out = "Content-Type: application/vnd.ms-excel;

$only Records ($items): $sorted
Created on $API::today
$out
";
      print $out;
   } elsif ($format =~ /Word/) {
      my $addresses = '';
      foreach my $key (sort(keys %MailList)) {
         (my $address = $MailList{$key}) =~ s/; $//g;
         if ($address) {
            $addresses .= "<br>\n<b>Addresses for all ${key}s:</b> $address<br>\n";
         }
      }

      $out = "Content-Type: application/msword;

<html>
<center>
$only Records ($items): $sorted<br>
Created on $API::today<br>
$addresses
$out
</table>
</center>
</html>\n";
      print $out;
   } else {
      $out .= "</table>\n\n";

      if (length($only) > 256) {
         $only = substr($only, 0, 256).'...';
      }
      &header("$only Records ($items): $sorted", '');
      if ($API::diag > 5) {
         print STDERR "$here: www::ID_List=$www::ID_List\n";
      }
      $out =~ s/IDL=$www::null_IDL/IDL=$www::ID_List/g;
      print $out;
      &footer('');
   }
   $API::bytes += length($out);
}


#*****************************************************************************
#
# Routine:      build_report
#
#*****************************************************************************
sub build_report {
   my $here = $API::program.'::build_report';

   my $table = $www::Form{Table};
   my $order = $www::Form{OrderBy};
   my $display = $www::Form{Display};
   if ($API::diag > 2) {
      print STDERR "$here: table=$table order=$order display=$display\n";
   }

   # only use the last specified format, the default is always first
   my $format;
   foreach (split(/:/, $www::Form{Format})) {
      $format = $_;
   }
   if ($API::diag > 2) {
      print STDERR "$here: table=$table order=$order format=$format\n";
   }

   # no Fields select for display, just refresh selection
   unless ($display) {
      &error_page('Error',
                  'Form Incomplete',
                  'At least one field must be selected from the Display List');
      return;
   }

   # no sort Fields, just refresh selection
   unless ($order) {
      &error_page('Error',
                  'Form Incomplete',
                  'At least one field must be selected from the Sort Order');
      return;
   }

   ##print STDERR "$here: display=$display\n";
   my $fields = '';
   my $msg = '';
   ##(my $select = $display) =~ s/:/, /g;
   my $select = '';
   my $group_by = '';
   unless ($www::Form{GroupBy}) {
      foreach my $col (split(/:/, $display)) {
         if ($www::SQL{$col}) {
            $select .= "$www::SQL{$col} AS $col";
         } else {
            $select .= $col;
         }
         $select .= ', ';
      }
   } else {
      foreach my $col (split(/:/, $display)) {
         if (grep(/$col/, $www::numeric_field)) {
            if ($www::SQL{$col}) {
               $select .= "SUM($www::SQL{$col}) AS XXX_$col";
            } else {
               $select .= "SUM($col) AS XXX_$col";
            }
         } else {
            # change this later
            if ($www::SQL{$col}) {
               $select .= "MAX($www::SQL{$col}) AS XXX_$col";
            } else {
               $select .= "MAX($col) AS XXX_$col";
            }
         }
         $select .= ', ';
      }
   }
   $select =~ s/, $//g;
   ##print STDERR "$here: select=$select\n";

   # the permission fields must always be selected
   my $check = '';
   foreach my $col (split(/:/, $order),
                    split(/:/, $www::Form{GroupBy}),
                    @www::Check) {
      if ($www::SQL{$col}) {
         $check .= "$www::SQL{$col} AS $col";
      } else {
         $check .= $col;
      }
      $check .= ', ';
   }
   ##print STDERR "$here: check=$check\n";

   my $sql = "SELECT $check $select
FROM $table\n";
   my $where = '';

   # if using dual tables, add the join logic
   if ($table =~ /,/) {
      $where = "($www::join_column) AND ";
   }

   # change Lead into Lead, Helpers, Organizer, User as per Geoff
   foreach my $name (@www::Names) {
      if ($www::Form{"Radio$name"}) {
         my $value = $www::Form{"Radio$name"};
         unless ($name eq $value) {
            $www::Form{$value} = $www::Form{$name};
            $www::Form{$name} = '';
         }
      }
   }

   # report forms do not set ListBy
   my @FieldArray;
   if ($www::Form{ListBy}) {
      @FieldArray = split(/:/, $www::Form{ListBy});
   } else {
      push(@FieldArray, @www::Enum_Lists);
      push(@FieldArray, @www::Names);
   }

   foreach my $field (@FieldArray) {
      if ($www::Form{$field}) {
         $www::Form{$field} =~ s/&/&amp;/g;
         $fields .= $field.':';
         $only = $www::Form{$field};
         $only_title .= $only.' ';
         $where .= '(';
         if ($field eq 'User') {
            foreach my $value (split(/:/, $only)) {
               my $usr;
               foreach my $name (@www::Names) {
                  unless ($name eq 'User') {
                     $usr .= "$name LIKE \'%$value%\' OR ";
                  }
               }
               $usr =~ s/ OR $//g;
               $where .= "( $usr ) OR\n";
               $msg .= "$value, ";
            }
         } elsif (($field eq 'Section') ||
                  ($field eq 'Work_Package') ||
                  ($field eq 'Notify')) {
            # handle single and multiple values
            foreach my $value (split(/:/, $only)) {
               $where .= "$field LIKE \'%$value%\' OR\n";
               $msg .= "$value, ";
            }
         } elsif ($field =~ /^GrEq(\w+)$/) {
            # handle greater than or equal to, single values only
            $where .= "$1 >= \'$only\' OR\n";
            $msg .= "$only, ";
         } else {
            # handle single and multiple values
            foreach my $value (split(/:/, $only)) {
               # add special week entries for WAR
               if ($field eq 'Week') {
                  $value =~ s/^Last$/$www::Weeks[5]/g;
                  $value =~ s/^This$/$www::Weeks[4]/g;
               }
               if ($www::SQL{$field}) {
                  $field = $www::SQL{$field};
               }
               $where .= "$field = \"$value\" OR\n";
               $msg .= "$value, ";
            }
         }
         $msg =~ s/, $/<br>/g;
         $where =~ s/ OR$//g;
         $where .= ") AND\n";
      }
   }
   if ($www::Form{Since}) {
      $msg .= "Modified Since $www::Form{Since}";
      $where .= &get_since('Modified', $www::Form{Since});
      $where .= " AND\n";
   }
   if ($www::Form{LtEqRank}) {
      # don't tell people about what they can't see
      $where .= &get_rank('Rank', $www::Form{LtEqRank});
      $where .= " AND\n";
   }

   # search text areas if search string is present
   if ($www::Form{SearchString}) {
      my $string = $www::Form{SearchString};
      # translate common wildcard into SQL wildcard
      $string =~ s/\*/%/g;
      unless ($string =~ /^[ \w\,\.\:\-\&\%]+$/) {
         &error_page('Error',
                     "$string Invalid",
                     'Search string can only contain alphanumeric characters, commas, periods, spaces, dashes and ampersands');
         return;
      }
      # backslash underscores for SQL
      $string =~ s/_/\\_/g;
      # entire search clause needs to be enclosed
      $where .= '(';
      foreach my $field (@www::TextAreas) {
         $where .= " ( $field LIKE '%$string%' ) OR\n";
         $msg .= "$field,"
      }
      $msg =~ s/,$//g;
      $msg .= " contains $string<br>\n";
      # change extra OR into closing paren
      $where =~ s/ OR$/)/g;
      $where .= " AND\n";
   }

   # NOT search text areas if search string is present
   if ($www::Form{NotSearchString}) {
      my $string = $www::Form{NotSearchString};
      # translate common wildcard into SQL wildcard
      $string =~ s/\*/%/g;
      unless ($string =~ /^[ \w\,\.\:\-\&\%]+$/) {
         &error_page('Error',
                     "$string Invalid",
                     'Search string can only contain alphanumeric characters, commas, periods, spaces, dashes and ampersands');
         return;
      }
      # backslash underscores for SQL
      $string =~ s/_/\\_/g;
      # entire search clause needs to be enclosed
      $where .= '(';
      foreach my $field (@www::TextAreas) {
         $where .= " ( $field NOT LIKE '%$string%' ) OR\n";
         $msg .= "$field,"
      }
      $msg =~ s/,$//g;
      $msg .= " does NOT contain $string<br>\n";
      # change extra OR into closing paren
      $where =~ s/ OR$/)/g;
      $where .= " AND\n";
   }

   if (length($where)) {
      chop($fields);
      $msg =~ s/<br>$//g;
      $where =~ s/ AND$//g;
      $sql .= "WHERE $where";
   }
   # allow for grouping
   if (($www::Form{GroupBy}) &&
       ($www::Form{GroupBy} ne 'None')) {
      $group_by = $www::Form{GroupBy};
      $group_by =~ s/:/,/g;
      $sql .= "GROUP BY $group_by ";
   }
   # add the ID Direction if the user has a preference
   if (($order eq 'ID') &&
       $www::My_Prefs{APIOutDir}) {
      $order .= ' '.$www::My_Prefs{APIOutDir};
   }
   $order =~ s/:/,/g;
   $sql .= "ORDER BY $order";

   # save query so that it can be recalled
   $sql .= ';';
   unless (&save_query($www::Form{Name}, $sql)) {
      return;
   }

   # build the list of issues
   my $sth = $API::dbh->prepare($sql);
   $API::sql = $sql;
   if ($API::diag > -3) {
      print STDERR "$here: sql=$sql\n";
   }
   $API::queries++;
   $sth->execute();

   # cleanup the look of the sql line
   $sql =~ s/^SELECT \S*/SELECT /g;
   &print_any_format($format, $table, $msg, $order, $group_by, $sth, $fields, $display);
}


#*****************************************************************************
#
# Routine:      error_page
#
#*****************************************************************************
sub error_page {
   my $here = $API::program.'::error_page';

   my $header = shift(@_);
   my $red = shift(@_);
   my $msg = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: header=$header red=$red msg=$msg\n";
   }

   &header($header, '');
   my $out = "<center><big>
<font color=red>
$red
</font>,<br>
$msg
</big></center>";
   print $out;
   $API::bytes += length($out);
   &footer('');
}


#*****************************************************************************
#
# Routine:      prefs_form
#
#*****************************************************************************
sub prefs_form {
   my $here = $API::program.'::prefs_form';

   my $field = shift(@_);
   my $status = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: field=$field status=$status\n";
   }

   no strict 'refs';

   my $msg = "$field Options Form";

   &header($msg, '');

   my $default;
   my $checked;
   my $tr = "tr class=tr_list";
   my $th = 'th bgcolor=lightgrey align=right';
   my $td;

   # add a record for each preference
   my $api = '';
   my $not_api = '';
   my $record;

   if ($#www::List_Department != -1) {
      foreach my $dept (@www::List_Department) {
         $www::APIOutDept{$dept} = $dept;
      }
   } else {
      $www::Prefs_Defaults{APIOutDept} = '';
      $www::Prefs_Labels{APIOutDept} = '';
   }

   foreach my $pref (sort keys %www::Prefs_Defaults) {
      my $array = "www::$pref";

      unless ($www::Prefs_Labels{$pref}) {
         next;
      }
      if ($pref =~ /Color/) {
         $td = "td bgcolor=darkgray";
      } else {
         $td = 'td';
      }

      $record = "<$tr><$th>$www::Prefs_Labels{$pref}:</th><$td>";
      if ($www::My_Prefs{$pref}) {
         $default = $www::My_Prefs{$pref};
      } else {
         $default = $www::Prefs_Defaults{$pref};
      }

      foreach my $val (sort keys %${array}) {
         if ($val eq $default) {
            $checked = 'checked';
         } else {
            $checked = '';
         }
         $record .= "<input type=radio name=$pref value=$val $checked>${$array}{$val}\n";
      }
      $record .= "</td></tr>\n";
      if ($pref =~ /^API/) {
         $api .= $record;
      } else {
         $not_api .= $record;
      }
   }

   my $not_api_label = '';
   if ($not_api) {
      $not_api_label = "<tr><th colspan=2>$API::title Options</th></tr>\n";
   }

   my $out = "
<form method=post action=$ENV{SCRIPT_NAME}>
<input type=hidden name=Field value=Prefs>
<input type=hidden name=Table value=$www::Form{Table}>
<table class='table table-hover'>
<tr><th colspan=2>Generic Options</th></tr>
$api
$not_api_label
$not_api
</table>
$status<br>
<input class='$BS::submit' type='submit' value='Save Changes'>
$www::Default{ResetForm}
</form>\n";

   print $out;
   $API::bytes += length($out);
   &footer('');
}


#*****************************************************************************
#
# Routine:      save_prefs
#
#*****************************************************************************
sub save_prefs {
   my $here = $API::program.'::save_prefs';

   my $userid = shift(@_);
   if ($API::diag > 1) {
      print STDERR "$here: userid=$userid\n";
   }

   # add a record for each preference
   foreach my $pref (sort keys %www::Prefs_Defaults) {
      if ($www::Form{$pref}) {
         $www::My_Prefs{$pref} = $www::Form{$pref};
      }
   }

   my $value;
   foreach my $key (sort keys %www::My_Prefs) {
      if ($API::diag > 11) {
         print STDERR "$here: www::My_Prefs{$key}=$www::My_Prefs{$key}\n";
      }
      $value .= "$key=$www::My_Prefs{$key}&";
   }
   $value =~ s/&$//g;

   # add field to the record
   my $sql = "UPDATE $www::db_org_table
SET Prefs = '$value'
WHERE Userid = '$userid';";
   $API::dbh->do($sql);

   print STDERR "$here: $ENV{REMOTE_USER}, SET Prefs = $value\n";

   my $msg = '<big><font color=green>Options Saved</font>';
   &prefs_form('Edit', $msg);
}


#*****************************************************************************
#
# Routine:      process_enums
#
#*****************************************************************************
sub process_enums {
   my $here = $API::program.'::process_enums';

   if ($API::diag > 3) {
      print STDERR "$here:\n";
   }

   my $field = $www::Form{Field};
   my $value = $www::Form{$field};
   # fix ampersands
   $value =~ s/\s*&\s*/&amp;/g;
   my $msg;
   if (length($value)) {
      $msg = &insert_enum($field, $value);
   } else {
      $msg = "<font size=+1 color=red>$field must be specified</font>";
   }

   &edit_enum($field, $msg, $ENV{REMOTE_USER});
}


#*****************************************************************************
#
# Routine:      verify_unique_value
#
#*****************************************************************************
sub verify_unique_value {
   my $here = $API::program.'::verify_unique_value';

   my $field = shift(@_);
   my $table = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: www::Form{$field}=$www::Form{$field} table=$table\n";
   }

   # reverse sort to save time looping through the records
   my $sth = $API::dbh->prepare("SELECT ID, $field
FROM $table
WHERE ID != ?
ORDER BY ID DESC;");
   $API::queries++;
   $sth->execute($www::Form{ID});

   my $errors = '';
   while (my $ref = $sth->fetchrow_hashref()) {
      if ($www::Form{$field} eq $ref->{$field}) {
         $errors = "<li><b>$field</b> must unique and is already used in ID $ref->{ID}</li>\n";
      }
   }
   $sth->finish();

   return $errors;
}


#*****************************************************************************
#
# Routine:      add_userid_to_list
#
#*****************************************************************************
sub add_userid_to_list {
   my $here = $API::program.'::add_userid_to_list';

   my $field = shift(@_);
   my $table = shift(@_);
   my $list = shift(@_);
   my $userid = shift(@_);
   if ($API::diag > 3) {
      print STDERR "$here: field=$field table=$table list=$list userid=$userid\n";
   }

   foreach $ele (sort(split(/:/, $list))) {
      if ($userid eq $ele) {
         # user already in list
         return 0;
      }
   }

   my $sorted = join(':', (sort($userid, split(/:/, $list))));
   if ($API::diag > 4) {
      print STDERR "$here:sorted=$sorted\n";
   }

   $www::Form{$field} = $sorted;
   &write_one_column($www::Form{ID}, $field, $table, 0);
}


#*****************************************************************************
#
# Routine:      process_append
#
#*****************************************************************************
sub process_append {
   my $here = $API::program.'::process_append';

   my $field = shift(@_);
   my $table = shift(@_);
   if ($API::diag > 3) {
      print STDERR "$here: field=$field table=$table\n";
   }

   my @Append = ($field);
   &cleanup_text_areas(\@Append);

   if (length($www::Form{$field})) {
      my $sth = $API::dbh->prepare("SELECT *
FROM $table
WHERE ID = \"$www::Form{ID}\";");
      $API::queries++;
      $sth->execute();

      my $ref = $sth->fetchrow_hashref();

      # verify permission to append
      unless (&editable($ref)) {
         my $error = "Permission denied, you are not allowed to edit ID $www::Form{ID} in $table";
         &warning($error);
         return 0;
      }

      my $both = $ref->{$field};
      $both .= $www::HTML{Append};
      $both .= $www::Form{$field};
      $both .= $www::HTML{AppendEnd};
      $www::Form{$field} = $both;
      &write_one_column($www::Form{ID}, $field, $table, 0);

      # auto-add userid to Notify column
      if ($ref->{Notify}) {
         my $notify = $ref->{Notify};
         &add_userid_to_list('Notify', $table, $notify, $ENV{REMOTE_USER});
      }
   }
}


#*****************************************************************************
#
# Routine:      process_radio
#
#*****************************************************************************
sub process_radio {
   my $here = $API::program.'::process_radio';

   my $field = shift(@_);
   my $table = shift(@_);
   if ($API::diag > 3) {
      print STDERR "$here: field=$field table=$table\n";
   }

   my $sth = $API::dbh->prepare("SELECT $field
FROM $table
WHERE ID = \"$www::Form{ID}\";");
   $API::queries++;
   $sth->execute();

   my $ref = $sth->fetchrow_hashref();
   if ($ref->{$field} ne $www::Form{$field}) {
      &write_one_column($www::Form{ID}, $field, $table, 1);
   }
}


#*****************************************************************************
#
# Routine:      process_form
#
#*****************************************************************************
sub process_form {
   my $here = $API::program.'::process_form';

   if ($API::diag > 2) {
      print STDERR "$here: www::Form{Field}=$www::Form{Field}\n";
   }

   &read_input;
   if ($www::Form{Field} eq 'Report') {
      &build_report;
   } elsif ($www::Form{Field} eq 'Login') {
      &process_login;
   } elsif ($www::Form{Field} eq 'Accounts') {
      &write_account;
   } elsif ($www::Form{Field} eq 'Prefs') {
      &save_prefs($ENV{REMOTE_USER});
   } else {
      my $found = 0;
      foreach my $column (@www::Dynamic_Lists) {
         if ($www::Form{Field} eq $column) {
            &process_enums;
            $found++;
            last;
         }
      }
      unless ($found) {
         &header("Software Logic Error", '');
         print &print_errors("Software logic error,
invalid Field=$www::Form{Field}");
         &footer('');
      }
   }
}


#*****************************************************************************
#
# Routine:      create_dynamic_lists
#
#*****************************************************************************
sub create_dynamic_lists {
   my $here = $API::program.'::create_dynamic_lists';

   my $table = shift(@_);
   if ($API::diag > 1) {
      print STDERR "$here: table=$table\n";
   }

   foreach my $column (@www::Dynamic_Lists) {
      if ($API::diag > 2) {
         print STDERR "$here: table=$table column=$column\n";
      }
      no strict 'refs';
      my $array = "www::List_$column";
      @$array = ();
      my $disarray = "www::Disabled_$column";
      @$disarray = ();

      my $sth = $API::dbh->prepare("SHOW COLUMNS
FROM $table
LIKE '$column';");
      $API::queries++;
      $sth->execute();

      my $ref = $sth->fetchrow_hashref();
      if ($API::diag > 3) {
         print STDERR "$here: table=$table column=$column Type=$ref->{Type}\n";
      }
      if ($ref->{'Type'} =~ /enum\((.*)\)/) {
         my $enum = $1;
         foreach (split(/,/, $enum)) {
            s/\'//g;
            if (/^$www::Disabled{tag}:(.*)/) {
               push(@$disarray, $1);
            } else {
               push(@$array, $_);
            }
         }
      }

      if ($API::diag > 3) {
         print STDERR "$here: $array=@$array $disarray=@$disarray\n";
      }
   }
}


#*****************************************************************************
#
# Routine:      fix_alt_text
#
#*****************************************************************************
sub fix_alt_text {
   my $here = $API::program.'::fix_alt_text';

   my $id = shift(@_);
   my $text = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: id=$id text=$text\n";
   }
   my $title = '';
   if ($text) {
      # only get the original text
      my $append;
      ($title, $append) = split(/<li/, $text, 2);
      $title =~ s/<br>//g;
      $title =~ s/\"//g;
      $title =~ s/&amp;/&/g;
      $title =~ s/&amp/&/g;
      $title =~ s/&lt/</g;
      $title =~ s/&gt/>/g;
      $title =~ s/&#039;/\'/g;
      chomp($title);
      # mozilla firefox does not display newlines correctly
      if (($title) &&
          ($ENV{HTTP_USER_AGENT} =~ /Firefox/)) {
         my @Alt = split(/\n/, $title);
         $title = $Alt[0];
      }
   }

   if ($API::diag > 3) {
      print STDERR "$here: title=$title\n";
   }
   return $title;
}


#*****************************************************************************
#
# Routine:      warning
#
#*****************************************************************************
sub warning {
   my $here = $API::program.'::warning';

   my $msg = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: msg=$msg\n";
   }

   my $userid = $ENV{REMOTE_USER};
   print STDERR "$here: WARNING! userid=$userid REMOTE_ADDR=$ENV{REMOTE_ADDR} $msg\n";

   &header('WARNING', '');
   my $out = "<center><h1><font color=red>
WARNING!<br>
$msg<br>
</font></h1></center>
<big>
Userid: $userid<br>
Name: $www::Name{$userid}<br>
Location: $www::Location{$userid}<br>
REMOTE_ADDR: $ENV{REMOTE_ADDR}<br>\n";
   print $out;
   $API::bytes += length($out);
   &footer('');
}


#*****************************************************************************
#
# Routine:      get_dayofweek
#
#*****************************************************************************
sub get_dayofweek {
   my $here = $API::program.'::get_dayofweek';

   my $year = shift(@_);
   my $month = shift(@_);
   my $day = shift(@_);
   if ($API::diag) {
      print STDERR "$here: year=$year month=$month day=$day\n";
   }

   my $sth = $API::dbh->prepare("SELECT DAYOFWEEK('$year-$month-$day') AS DAYOFWEEK;");
   $API::queries++;
   $sth->execute();

   my $ref = $sth->fetchrow_hashref();
   my $dow = $ref->{DAYOFWEEK};

   if ($API::diag > 1) {
      print STDERR "$here: dow=$dow\n";
   }

   return $dow;
}

sub get_calendar_class {
   my $here = 'get_calendar_class';

   my $date_token = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: date_token=$date_token\n";
   }

   my $bg = $www::Holiday{pre}.$date_token.$www::Holiday{post};
   my $class = 'calendarHoliday'.$bg;

   # if the token is a URL, then just use it faded with 50% opacity
   if ($date_token =~ /http:/) {
      $class = "calendarHoliday background='$date_token' style='opacity: 0.5'";
   }

   return $class;
}


#*****************************************************************************
#
# Routine:      get_date_class
#
#*****************************************************************************
sub get_date_class {
   my $here = $API::program.'::get_date_class';

   my $year = shift(@_);
   my $month = shift(@_);
   my $d = shift(@_);
   my $nth = shift(@_);
   my $ddd = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: year=$year month=$month d=$d nth=$nth ddd=$ddd\n";
   }

   # remove leading zeros
   $month =~ s/^0//g;
   $d =~ s/^0//g;

   my $mon_dd = sprintf("-%2.2d-%2.2d", $month, $d);
   my $date = sprintf("%4.4d-%2.2d-%2.2d", $year, $month, $d);
   my $dow = $nth.'th-'.$ddd.'-'.$month;
   if ($API::diag > 3) {
      print STDERR "$here: dow=$dow\n";
   }

   my $bg;
   my $class;
   if ($www::CalendarClass{$mon_dd}) {
      $class = get_calendar_class($www::CalendarClass{$mon_dd});

   } elsif ($www::CalendarClass{$date}) {
      $class = get_calendar_class($www::CalendarClass{$date});

   } elsif ($www::CalendarClass{$dow}) {
      $class = get_calendar_class($www::CalendarClass{$dow});

   } elsif ($date eq $API::today) {
      $class = 'calendarNow';

   } else {
      $class = 'calendarOther';
   }
   if ($API::diag > 4) {
      print STDERR "$here: year=$year month=$month d=$d nth=$nth ddd=$ddd class=$class\n";
   }

   return $class;
}


#*****************************************************************************
#
# Routine:      calendar_table
#
#*****************************************************************************
sub calendar_table {
   my $here = $API::program.'::calendar_table';

   my $year = shift(@_);
   my $month = shift(@_);
   my $caption = shift(@_);
   my $insert = shift(@_);
   my $skip = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here: year=$year month=$month caption=$caption insert=$insert skip=$skip\n";
   }

   my $max = $www::DaysPerMonth[$month];
   # from wikipedia
   #
   # if year modulo 400 is 0 then leap
   # else if year modulo 100 is 0 then no_leap
   # else if year modulo 4 is 0 then leap
   # else no_leap
   #
   unless ($year%100 == 0) {
      if ($year%4 == 0) {
	 $max = $www::DaysPerMonthLeapYear[$month];
      }
   }

   my $table = "<table class='table table-bordered'>
<caption>
$caption
</caption>";
   # add the day names
   $table .= '<tr>';
   foreach my $day (@www::List_Day) {
      $table .= "<th>$day</th>";
   }
   $table .= '</tr>';

   my $i = 1;
   my $d = $i - $skip;
   foreach my $row (1 .. 6) {
      $table .= '<tr>';
      my $ddd = 0;
      foreach my $day (@www::List_Day) {
         if ($d <= 0) {
            my $month = $month - 1;
            if ($month == 0) {
               $month = 12;
            }
            my $max = $www::DaysPerMonth[$month];
            my $d = $max + $d;
            my $mmm = $www::Months[$month - 1];
            $table .= "<td class=calendarNull>$mmm - $d</td>";

         } elsif ($d > $max) {
            my $month = $month + 1;
            if ($month == 13) {
               $month = 1;
            }
            my $d = $d - $max;
            my $mmm = $www::Months[$month - 1];
            $table .= "<td class=calendarNull>$mmm - $d</td>";

         } else {
            my $dt;
            my $date = sprintf("%4.4d-%2.2d-%2.2d", $year, $month, $d);
            if ($insert) {
               (my $title = "Insert $date $API::subtitle") =~ s/s$//g;
               my $btn = "btn-default";
               if ($date eq $API::today) {
                  $btn = "btn-primary";
               }
               $dt = "<a title='$title' href='$insert&Date=$date' class='btn $btn'>$d</a>";
            } else {
               $dt = "<a title='Inserts disabled' class='btn btn-info'>$d</a>";
            }
            # calculate the 'nth', from the row number, ie: 4th monday
            my $nth = $row;
            if ($ddd < $skip) {
               $nth--;
            }
            my $class = &get_date_class($year, $month, $d, $nth, $day);
            $table .= "<td width=10% class=$class><table>$dt";
            foreach my $slot (1 .. $www::max_entries_per_day) {
               $table .= '<tr class=tr_calendar><td class=td_calendar>';
               if ($www::Calendar{$slot, $d}) {
                  $table .= "$www::Calendar{$slot, $d}";
               } else {
                  $table .= '&nbsp;';
               }
               $table .= "</td></tr>\n";
            }
            $table .= '</table></td>';
         }
         $i++;
         $d = $i - $skip;
         $ddd++;
      }
      $table .= '</tr>';
      if ($d > $max) {
         last;
      }
   }
   $table .= '</table>';

   return $table;
}


#*****************************************************************************
#
# Routine:      view_calendar
#
#*****************************************************************************
sub view_calendar {
  my $here = $API::program.'::view_calendar';

  my $userid = shift(@_);
  my $year = shift(@_);
  my $month = shift(@_);
  my $msg = shift(@_);
  if ($API::diag > 2) {
     print STDERR "$here: userid=$userid year=$year month=$month msg=$msg\n";
  }

  # show birthday of displayed user
  my $bday = $www::BDay{$userid};
  $www::CalendarClass{$bday} = 'Birthday';
  # show enddate of displayed user
  my $enddate = $www::EndDate{$userid};
  $www::CalendarClass{$enddate} = 'EndDate';
  &fill_calendar($userid, $year, $month);

  my $meta = '';
  # refresh Main Menu Calandars
  if ($year eq $API::Date{year} && $month eq $API::Date{month}) {
     $meta = 'REFRESH';
  }
  &header($msg, $meta);

  my $caption = &get_calendar_caption($userid, $year, $month);
  my $insert = "$ENV{SCRIPT_NAME}?Edit=NULL";
  # diable inserts when guest or viewing others calendars
  if (($userid ne $ENV{REMOTE_USER}) ||
      ($userid eq $API::Site{guest})) {
     $insert = '';
  }

  my $skip = &get_dayofweek($year, $month, 1) - 1;
  if (($www::My_Prefs{APIWeek}) &&
      ($www::My_Prefs{APIWeek} eq 'Monday')) {
     $skip--;
     # can't skip forward a negative number, jump a week instead
     if ($skip == -1) {
	$skip += 7;
     }
  }
  my $out = &calendar_table($year, $month, $caption, $insert, $skip);

  $out .= $www::HTML{CalendarTotals};
  $out .= &get_calendar_friends($userid, $year, $month);
  print $out;

  $API::bytes += length($out);
  &footer('');
}


#*****************************************************************************
#
# Routine:      uncleanup_text_areas
#
#*****************************************************************************
sub uncleanup_text_areas {
   my $here = $API::program.'::uncleanup_text_areas';

   my $array = shift(@_);
   if ($API::diag > 2) {
      print STDERR "$here:\n";
   }

   foreach my $txt (@$array) {
      if ($API::diag > 3) {
         print STDERR "$here: txt=$txt\n";
      }

      if ($www::Form{$txt}) {
         # this one is just for old, corrupted text
         $www::Form{$txt} =~ s/&ampamp/&/g;
         # revert all html
         $www::Form{$txt} =~ s/<br>//g;
         $www::Form{$txt} =~ s/\"//g;
         $www::Form{$txt} =~ s/&amp;/&/g;
         $www::Form{$txt} =~ s/&amp/&/g;
         $www::Form{$txt} =~ s/&lt/</g;
         $www::Form{$txt} =~ s/&gt/>/g;
         $www::Form{$txt} =~ s/&#039;/\'/g;
         chomp($www::Form{$txt});
      }

      if ($API::diag > 4) {
          print STDERR "$here: www::Form{$txt}=$www::Form{$txt}\n";
      }
   }
}


#*****************************************************************************
#
# Routine:      cleanup_text_areas
#
#*****************************************************************************
sub cleanup_text_areas {
  my $here = $API::program.'::cleanup_text_areas';

  my $array = shift(@_);
  if ($API::diag > 2) {
    print STDERR "$here:\n";
  }

  foreach my $txt (@$array) {
    if ($API::diag > 3) {
      print STDERR "$here: txt=$txt\n";
    }
    # convert html special characters
    $www::Form{$txt} =~ s/&/&amp;/g;
    $www::Form{$txt} =~ s/</&lt/g;
    $www::Form{$txt} =~ s/>/&gt/g;
    $www::Form{$txt} =~ s/"/&quot;/g;
    $www::Form{$txt} =~ s/'/&#039;/g;
    # force unix newlines
    $www::Form{$txt} =~ s/\r\n/<br>\n/g;
    if ($API::diag > 4) {
      print STDERR "$here: www::Form{$txt}=$www::Form{$txt}\n";
    }
  }
}
