#!/usr/bin/perl
#
# program:    exform   # - 12/8/03 # version 3
# purpose:    Generate the Cell Leader Online Report Form
# requires:	  POSIX perl module
# --------------------------------------------------------------------------
# $Changes$
# --------------------------------------------------------------------------
# 12/28/04
# -Added support for international dates.  Change the two date definitons below
# 08/24/04
# - Fixed: Couldnt read the last member field on some unix boxes
# 06/25/04
# - preserving commas in uploaded data by translating ` char in to comma
# 01/08/04
# - Removed checking for valid directories
# 12/8/03
# - changed calling parameters to allow only the LeaderID to be passed in a paramter labeled MemberID
#   this method does not require a password
# - if more than one cell group matches the login parameters, a page is printed that lists
#   each cell group and notifies the user that more than one cell group matched
# - you can specify what field in excells.txt to use as the password field
#   if the password field contains the word Phone anywhere in the fieldname, it will only
#   use the last four digits of that field
# - most global variables are now imported from exlib.pm
# 2/1/02
# - you can specify which field in the cell record field you want to use for the password (still only uses last four characters)
# - you can specify whether or not to show the birthday or anniversary year
# 11/13/02
# - allows GET or POST method when requesting to generate a report
# - added ability to add any cell information in the report (excluding the Member Information band)
# 1/9/03
# - changed login picklist to handle names like Jill Smith-Walker
# --------------------------------------------------------------------------

# This defines the date order.  Options are MDY,DMY,YDM,YMD
my $datesequence ='DMY';
# This defines the date seperator.  Options are -, /
my $datesep='/';

# Directives
use strict;
use POSIX;
#use ExLib qw( :all );
#require "exlib.pl";
#---------------------------------------------------------------------------
# Imported Global variables
# Database related globals
my $delimiter = "\t";
my $cell_data_file = 'excells.txt'; # Cell information text file
my %cell_fields = ();
my @current_cell_record = 0; # cell record that the report is being generated for

my $member_data_file = 'exmembrs.txt'; # Member information text file
my %member_fields = ();
my $member_index_file = 'exmembrs.ndx'; # Member information byte offset file (for seek())
my $cellmember_index_file = 'exclmems.ndx'; # Cell member id numbers
my @current_member_record = 0;

my $master_data_file = 'exmaster.txt'; # Master church information file
my %master_fields = ();
my @master_data = 0;

my $member_update_file = 'exupdate.txt';
my $followup_index_file = 'exwr_followup_index.txt';
my $picklists_file = 'exwr_picklists.txt';
my %picklists = ();

# Internal database related globals - DO NOT EDIT
my $lock_file = 'exbusy.txt';

# Directory information related globals
my $database_files_dir = '';
my $cgi_path = '';
my $cgi_url = '';
my $this_script_name = '';
my $cell_leader_form_script_name = 'exform.pl';
my $member_info_script_name = 'exinfo.pl';
my $web_report_script_name = 'exwebrpt.pl';
my $cell_leader_form_submit_script_name = 'exsubmit.pl';

# Internal cgi related globals - DO NOT EDIT
my $html_header_printed = 0;
my %form_params = ();
my $post_length_max = 1024 * 1000; # max number of bytes that can be post-ed
my $debug = 0;

# Template related globals
my %template_keywords = (
	"SCRIPT_LOCATION" => '',
	"LocationOfScript" => '',
	"SCRIPT_LOCATION_exinfo" => '',
	"LocationOfScript_exinfo" => '',
	"SCRIPT_LOCATION_exform" => '',
	"LocationOfScript_exform" => '',
	"SCRIPT_LOCATION_exwebreport" => '',
	"LocationOfScript_exwebreport" => '',
	"SCRIPT_LOCATION_exsubmit" => '',
	"LocationOfScript_exsubmit" => '',
	"METHOD" => 'POST',
	"CGIPATH" => ''
);

my $dateformat="\\d+\\$datesep\\d+\\$datesep\\d+";     #   \d+\/\d+\/\d+
my $datematch="\^$dateformat\$";                       #  ^\d+\/\d+\/\d+$
my $datefetch="(\\d+)\\$datesep(\\d+)\\$datesep(\\d+)";   #  (\d+)\/(\d+)\/(\d+)
my $daterangematch="\^$dateformat\-$dateformat\$";     #  ^\d+\/\d+\/\d+-\d+\/\d+\/\d+$
my $daterangefetch="\^($dateformat)\-($dateformat)\$"; #  ^(\d+\/\d+\/\d+)-(\d+\/\d+\/\d+)$

#---------------------------------------------------------------------------
# Program related globals
my $report_template = 'exreport.htm'; # cell leader online report form template
my $login_template = 'exlogin.htm';   # Login form template (not used)
$this_script_name = $cell_leader_form_script_name;   # script that generates cell leader form
my $exsubmit_script = 'exsubmit.pl';  # script that processes cell leader form
my $pswd_field = 'Cells_PriPhone';
#---------------------------------------------------------------------------
# switches- control certain elements of the output of items in the report form
my $anniversaryYear = 1; # reset to 0 to not show the anniversary year, set to 1 to show the year
my $birthdayYear = 1; # reset to 0 to not show the birthday year, set to 1 to show the year
#------------------------------------------------------------------------------

# make sure that the data files are not being updated before trying to use them
setup_directories( $this_script_name );
check_server_updating( $this_script_name );

# setup the %cell_fields hash
get_field_info( $cell_data_file, \%cell_fields, $this_script_name );

# if request is GET, print the login screen
# if POST, read in values into %form_params
# else exit with error
read_query_string();
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
	if( $ENV{'QUERY_STRING'} eq 'environment' ) {
		print_html_header();
		debug_print_hash( \%ENV );
		exit;
	}
	if( !(exists($form_params{'MemberID'})) ) {
		my $list = generate_login_list();
		generate_login_page( $list );
		exit;
	}
}
elsif( $ENV{'REQUEST_METHOD'} ne 'POST' ) {
	error( "Request method '$ENV{REQUEST_METHOD}' not supported", 'die', $this_script_name );
}

# Look for either MemberID or LOGIN in %form_params
# if MemberID, do no authentication
# if LOGIN, authenticate
if( !(exists $form_params{'MemberID'} || exists $form_params{'LOGIN'}) ) {
	if ( $form_params{'LOGIN'} eq '' ) {
	    error( "Please type in a Login Name.", 'exit', $this_script_name );
	}
	else {
		error( "Login information supplied is incorrect.", 'exit', $this_script_name );
	}
}

# parsing the form_params for the dynamic variable
# if the DYNA variable is there, the login information is found between the []'s
# in the LOGIN variable
if( exists( $form_params{'DYNA'} ) ) {
    $form_params{'LOGIN'} =~ /\[(.*)\]/is;
    $form_params{'LOGIN'} = $1;
}

# try to find all matching cell records based on the LOGIN information (or MemberID)
open( CELL_DATA, "$database_files_dir$cell_data_file" ) or error( "Could not open $database_files_dir$cell_data_file: $!", 'die', $this_script_name );
<CELL_DATA>; # throw away the first line, it contains the field information
my $authenticated;
my @matching_cell_records;
while( my $line = <CELL_DATA> ) {
	my @record = split /$delimiter/, $line;
	my $cell_leader = uc(@record[$cell_fields{'Cells_LeaderName'}]);
	if( $cell_leader eq '' ) {
		$cell_leader = 'NULL';
	}
	my $cell_name = uc(@record[$cell_fields{'Cells_Name'}]);
	my $cell_leader_id = @record[$cell_fields{'Cells_LeaderID'}];
	if( (uc($form_params{'LOGIN'}) eq $cell_leader) || (uc($form_params{'LOGIN'}) eq $cell_name) || ($form_params{'MemberID'} == $cell_leader_id) ) {
		push( @matching_cell_records, $line );
	}
}
close( CELL_DATA );
if ( scalar( @matching_cell_records ) < 1 ) {
	error ("Login information supplied is incorrect. Check your username.", 'exit', $this_script_name);
}
elsif( scalar( @matching_cell_records ) == 1 ) {
	@current_cell_record = split /$delimiter/, @matching_cell_records[0];
}
else {
	# need to print the login screen with the @matching_cell_records list appearing in the login screen
	generate_login_page( \@matching_cell_records, 'This leader matches more than one cell group' );
	exit;
}

# only check the password if MemberID is not supplied
my $rpass;
if( !exists $form_params{'MemberID'} ) {
	# checking the password
	# if the $pswd_field indicates a phone number field called PriPhone, only use the last four digits
	$rpass = @current_cell_record[$cell_fields{$pswd_field}];
	if( $pswd_field =~ /Phone/ ) {
		$rpass =~ s/\D//g; # remove everything that is not a digit 0-9
						   # there aren't any phone #'s with letters, right?
		#$rpass=~s/^\s*(.*?)\s*$/$1/g; # get rid of that white space!
		$rpass = substr( $rpass, -4, 4 ); # using only last 4 digits
	}
	if ( $form_params{'PSWD'} ne $rpass ) {
	    error( "<font color=#ff0000>Invalid password</font>",'exit', $this_script_name );
	}
}
############################################################################
# main execution of the program
# (user has logged in and been verified)

    ## getting masterinfo file ready for parsing
	get_field_info( $master_data_file, \%master_fields, $this_script_name );
    open (MASTERIN, "<$database_files_dir$master_data_file") or error ("Could not open $database_files_dir$master_data_file: $!",'die', $this_script_name);
	while( my $line = <MASTERIN> ) {
		@master_data = split /$delimiter/, $line;
	}
	close( MASTERIN );

    # getting $member_data_file fieldnames ready for later referencing
	get_field_info( $member_data_file, \%member_fields, $this_script_name );

    # getting memberid index file ready to be used by seek function
    my %member_indexes = (); # $member_indexes{$id} = $offset;
    open( MEMBERIDIN, "<$database_files_dir$member_index_file" ) or error( "Could not open $database_files_dir$member_index_file: $!",'die', $this_script_name);
    while ( my $line = <MEMBERIDIN> ) {
        my ($id, $offset) = split /$delimiter/, $line;
        $member_indexes{$id} = $offset;
    }
    close( MEMBERIDIN );

    # getting cellmember index file ready to be used by seek function
    open( CELLMEMIN, "<$database_files_dir"."$cellmember_index_file") or error( "Could not open $database_files_dir"."$cellmember_index_file: $!",'die', $this_script_name);
	my @CellMem;
	while( my $line = <CELLMEMIN> ) {
        my ($tmpCellID,$mem_id) = split /$delimiter/,$line;
        if ( $tmpCellID == @current_cell_record[$cell_fields{'Cells_CellID'}] ) {
            push (@CellMem,$mem_id);
        }
    }
    close (CELLMEMIN);

	# open the online cell leader report form template
	my( $template_file, $template_file_copy );
	{
		# slurp the entire file into a scalar
		local(*TEMPLATE_FILE, $/);
        open (TEMPLATE_FILE, "$database_files_dir$report_template") or error("could not open $database_files_dir$report_template: $!", 'die', $this_script_name);
        $template_file = <TEMPLATE_FILE>;
    }

	# $template_file_copy is just used to get all the tags outside of the $member_band
	my( $member_band, $external_band, $external_tags );
	$template_file_copy = $template_file;
	$template_file_copy =~ /<!-- Exc MemberInfo -->(.*)<!-- Exc MemberInfo -->/is;
	$member_band = $1;
	$template_file_copy =~ s/<!-- Exc MemberInfo -->.*<!-- Exc MemberInfo -->//is;
	$external_band = $template_file_copy;

	$external_tags = get_tags( $external_band );

    # replacing external tags and data fields in the html report form with the valid information
	build_keyword_values();
	my $picklist_good = read_picklist_table();
	foreach my $tag ( @$external_tags ) {
	  if( exists( $template_keywords{$tag} ) ) {
		if( $tag eq 'SCRIPT_LOCATION' || $tag eq 'LocationOfScript' ) {
			$template_file =~ s/\^$tag\^/$cgi_url$cell_leader_form_submit_script_name/s;
		}
		else {
			$template_file =~ s/\^$tag\^/$template_keywords{$tag}/s;
		}
	  }
	  elsif( $tag eq 'TITLE' ) {
        $template_file =~ s/\^TITLE\^/@current_cell_record[$cell_fields{'Cells_Name'}]/s;
      }
      elsif( $tag eq 'MASTER_NAME' ) {
        $template_file =~ s/\^MASTER_NAME\^/@master_data[$master_fields{'Name'}]/g;
      }
      elsif( $tag =~ /^[a-zA-Z0-9]+_[a-zA-Z0-9]+/ ) {
		my( $table, $field, $type ) = split /_/, $tag;
		my $fieldname = $table.'_'.$field;
		my $replace;
		if( $type eq 'PL' && $picklist_good ) {
			$replace = build_picklist_options( $fieldname, '' );
		}

		else
		{
			$replace = @current_cell_record[$cell_fields{$tag}];
			$replace =~ s/`/,/g;   # replace any ` with commas that were converted from export
		}
		$template_file =~ s/\^$tag\^/$replace/;
      }
    }
	my $hidden_variables = qq/<input type="hidden" name="CELLID" value="@current_cell_record[$cell_fields{'Cells_CellID'}]"><input type="hidden" name="CELLLEADER" value="@current_cell_record[$cell_fields{Cells_LeaderName}]"><input type="hidden" name="MemberID" value="@current_cell_record[$cell_fields{'Cells_LeaderID'}]"><input type="hidden" name="LEADERID" value="@current_cell_record[$cell_fields{'Cells_LeaderID'}]">/;
	$template_file =~ s/<!-- Form Variables -->/$hidden_variables/; # for backwards compatibility
	$template_file =~ s/<!-- Session -->/$hidden_variables/;

	# this is an extra step
	# because of backwards compatiblity, there is the possiblity of a '*' tacked onto the end of each tag
	# it is no longer needed, so just get rid of it
	my $member_tags = get_tags( $member_band );
	foreach my $tag ( @$member_tags ) {
		$tag =~ s/\*//gs;
	}

    # getting ready to seek memberinfo file for specific member information
    open( MEMINFO, "<$database_files_dir$member_data_file") or error( "Could not open $database_files_dir$member_data_file for seeking: $!",'die' , $this_script_name);
    my @bands; # this is the container for the new bands
    foreach my $rec (@CellMem) {
        foreach my $key ( keys(%member_indexes) ) { # for each wanted member field
            if ( $key == $rec ) {
                seek (MEMINFO, $member_indexes{$key}, 0);
                my $line = <MEMINFO>;
				chomp $line;
				my @current_member_record = split /$delimiter/,$line;
                my $new_band = $member_band; # creating the new band
				my $replace;
				foreach my $tag (@$member_tags) {
					if ( $tag eq 'ANNIVERSARY' ) {
                        $replace = sday(@current_member_record[$member_fields{'Mem_Anniversary'}],1);
                    }
                    elsif ( $tag eq 'BIRTHDAY' ) {
                        $replace = sday(@current_member_record[$member_fields{'Mem_DOB'}],0);
                    }
                    else  { $replace = @current_member_record[$member_fields{$tag}]; }
                    if ( $replace =~ /^\s+$/s || $replace eq '' ) {$replace='&nbsp;';}
     			    $replace =~ s/`/,/g;   # replace any ` with commas that were converted from export
                    $new_band =~ s/\^$tag\*\^/$replace/g; #replacing my tags with member info
                }
                push( @bands, $new_band ); # putting a new member info line in an array
            }
        }
    }
    close( MEMINFO ) or error( "Could not close $database_files_dir$member_data_file: $!", 'die' , $this_script_name);

    my $to_be_printed = join /\n/,@bands; # joining all the new member info rows togther into one scalar
    $template_file =~ s/<!-- Exc MemberInfo -->.*<!-- Exc MemberInfo -->/$to_be_printed/is; # putting the member info in the correct spot in the html report form
	print_html_header();
	print $template_file;
	exit;

# end of the main execution block
############################################################################

# generate_login_list()--------------------------------------------------------
# params: none
# returns: reference to list array
# 11/07/2003 10:35AM
sub generate_login_list
{
	my $this_function = whoami();
	my @list;
	open( CELLIN, "<$database_files_dir$cell_data_file") or error ("$this_function: Could not open $database_files_dir$cell_data_file: $!",'die', $this_script_name);
	my $firstline = <CELLIN>; # the first line is always the fields names so skip it
	while( my $record = <CELLIN> ) {
		push ( @list, $record );
	}
	return \@list;
} # end generate_login_list()

# generate_login_page() -----------------------------------------------------------
# function: generate the dynamic login page by parsing the cell file and sticking cell leader, cell name, meeting info in a list
# returns:  nada
# credits: format: lastname, firstname [Cell Name] MeetsDay MeetsTime
#   10/25/02 4:20:PM
# modified: 11/07/2003
# 	- made it compatible with generate_login_list() so that it prints whatever is in that list instead of all cell records
# 	- params: \@list
#---------------------------------------------------------------------------
sub generate_login_page {
	my $list = shift;
	my $warning = shift;
	my @modded_list;
	my( $name, $lname, $fname );
	foreach my $record ( @$list ) {
		my @cell_record = split /$delimiter/, $record;
		$name = @cell_record[$cell_fields{'Cells_LeaderName'}];
	  	if ( $name =~/\s(\S+)\Z/ ) { $lname = $1 }  # grabs everything between the last whitespace and the end of the line
	  	else  { $lname = ' ' } # or fails and stores space into lastname variable
	  	if ( $name=~s/\s\S+\Z// ) { $fname = $name } # grabs whatever is leftover
	  	else  { $fname = ' ' } # or fails and stores space into firstname variable
	  	push (@modded_list, "$lname, $fname [@cell_record[$cell_fields{Cells_Name}]] @cell_record[$cell_fields{Cells_MeetsDay}] @cell_record[$cell_fields{Cells_MeetsTime}]" );
	}
	my $append = join "\n<option>",@modded_list;
	$append = "<option>$append</option>";
	print_html_header();
	print <<"(END1)";
<html>
<head>
<title>Cell Leader Login</title>
</head>
<body>
<form method="post" action="$cgi_url$this_script_name">
<input name="DYNA" type=hidden value="dyna_gen">
<center>
<table border="0" cellpadding="0" cellspacing="2">
  </tr>
  <tr  height="24" bgcolor="#808080">
    <td colspan="2"><font face="arial, sans-serif" color="#ffffff"><b>&nbsp;cell leader login</b></font></td>
  </tr>
  <tr><td>&nbsp;</td><td colspan="2"><font face="arial, sans-serif" color="#000000" size="-1">$warning</font></td>
  <tr>
    <td><font face="arial, sans-serif" size="-1" color="#666666">leader / group name:</font></td>
    <td><select name="LOGIN" size="1">
	<option>
	$append
	</select></td>
  </tr>
  <tr>
    <td><font face="arial, sans-serif" size="-1" color="#666666">password:</font></td>
    <td><input align="left" name="PSWD" type="password"></td>
  </tr>
  <tr>
    <td align="right"><br><br></td>
    <td><input type="submit" value="Login"></td>
  </tr>
</table>
</center>
</form>
</body>
</html>

(END1)
}
#---end generate_login_page()

# sday() -------------------------------------------------------------------
# function: Calculates when birthday or anniversary is
# returns:  birth (or anniversary) date if it is within cell week, else a couple of spaces
# credits:  if birthday/anniversary falls within cell week, returns string: "bday: mm/dd/yyyy"
#           also uses global variable to limit showing of yyyy
# 12/21/00 3:29:PM

sub sday {
    my $ret;
	my $smon;
	my $smday;
	my $syear;
    #my ($smon,$smday,$syear) = split /\//,@_[0];
	if    ($datesequence eq 'MDY') { ( $smon, $smday, $syear ) = (@_[0] =~ /$datefetch/); }
	elsif ($datesequence eq 'DMY') { ( $smday, $smon, $syear ) = (@_[0] =~ /$datefetch/); }
	elsif ($datesequence eq 'YMD') { ( $syear, $smon, $smday ) = (@_[0] =~ /$datefetch/); }
	elsif ($datesequence eq 'YDM') { ( $syear, $smday, $smon ) = (@_[0] =~ /$datefetch/); }

    if ( $syear<1900 ) { # need some sort of check to make sure there is a DOB/ANNIVERS date and this will work for now
        return "  ";
    }
    my $a = @_[1];
	my $p; # temp variable
	my( $nowmday, $nowmon );
	($p,$p,$p,$nowmday,$nowmon,$p,$p,$p,$p)=localtime();
	my ( $now, $days, $later, $actual );
	$now = POSIX::mktime( 0, 0, 0, $nowmday, $nowmon, 70);
    $days = 14*24*60*60;
    $later = $now + $days;
    $actual = POSIX::mktime(0,0,0,$smday,$smon-1,70);
    if ( $actual>=$now ) {
        #print "greater than now<br>";
    }
    if ( $actual<=$later ) {
        #print "less than later<br>";
    }
    if ( ($actual>=$now) && ($actual<=$later) ) {
        if ( $a==0 ) {
            # birthday so return bday: mm/dd/yyyy
			if( $birthdayYear )
			{
				if ( $datesequence eq 'MDY' ) {	$ret = 'Bday: '.$smon.$datesep.$smday.$datesep.$syear; }
				if ( $datesequence eq 'DMY' ) {	$ret = 'Bday: '.$smday.$datesep.$smon.$datesep.$syear; }
				if ( $datesequence eq 'YDM' ) {	$ret = 'Bday: '.$syear.$datesep.$smday.$datesep.$smon; }
				if ( $datesequence eq 'YMD' ) {	$ret = 'Bday: '.$syear.$datesep.$smon.$datesep.$smday; }
			}
			else  {
				$ret = 'Bday: '.$smon.'/'.$smday;
			}
        }
        else  { # anniversary so return anniv: mm/dd/yyyy
			if( $anniversaryYear )
			{
				if ( $datesequence eq 'MDY' ) {	$ret = 'Anniv: '.$smon.$datesep.$smday.$datesep.$syear; }
				if ( $datesequence eq 'DMY' ) {	$ret = 'Anniv: '.$smday.$datesep.$smon.$datesep.$syear; }
				if ( $datesequence eq 'YDM' ) {	$ret = 'Anniv: '.$syear.$datesep.$smday.$datesep.$smon; }
				if ( $datesequence eq 'YMD' ) {	$ret = 'Anniv: '.$syear.$datesep.$smon.$datesep.$smday; }
			}
			else  {
				$ret = 'Anniv: '.$smon.'/'.$smday;
			}
        }
    }
    else  { # didn't fit in range so return spaces
        $ret = "  ";
    }
    return $ret;
}
#--- end sday()

#---------------------------------------------------------------------------
# Imported subroutines
# build_keyword_values()--------------------------------------------------------
# 12/12/2003 6:36PM
sub build_keyword_values
{
	$template_keywords{'SCRIPT_LOCATION'} = "$cgi_url$this_script_name";
	$template_keywords{'LocationOfScript'} = "$cgi_url$this_script_name";
	$template_keywords{'SCRIPT_LOCATION_exinfo'} = "$cgi_url$member_info_script_name";
	$template_keywords{'SCRIPT_LOCATION_exform'} = "$cgi_url$cell_leader_form_script_name";
	$template_keywords{'SCRIPT_LOCATION_exwebreport'} = "$cgi_url$web_report_script_name";
	$template_keywords{'SCRIPT_LOCATION_exsubmit'} = "$cgi_url$cell_leader_form_submit_script_name";
	$template_keywords{'LocationOfScript_exinfo'} = "$cgi_url$member_info_script_name";
	$template_keywords{'LocationOfScript_exform'} = "$cgi_url$cell_leader_form_script_name";
	$template_keywords{'LocationOfScript_exwebreport'} = "$cgi_url$web_report_script_name";
	$template_keywords{'LocationOfScript_exsubmit'} = "$cgi_url$cell_leader_form_submit_script_name";
	$template_keywords{'CGIPATH'} = "$cgi_url";
} # end build_keyword_values()

# build_field_hash()--------------------------------------------------------
# 10/31/2003 10:20AM
# params: \%hash, $line_containing_fields
sub build_field_hash($$)
{
	my $hash = shift;
	my $field_line = shift;
	my $i = 0;
	foreach my $field ( split /$delimiter/, $field_line ) {
		chomp( $field );
		$hash->{ $field } = $i;
		$i++;
	}
} # end build_field_hash()

# whoami()--------------------------------------------------------
# 10/31/2003 10:55AM
sub whoami
{
	(caller(1))[3];

} # end whoami()

# setup_directories()--------------------------------------------------------
# uses globals: $cgi_url, $cgi_path, $database_files_dir, $this_script_name
# uses functions: error()
# 10/28/2003 9:06AM
sub setup_directories($)
{
	my $this_function = whoami();
	my $this_script_name = shift;
	# get cgi path and url and set $files_dir if it is not set already
	# if $cgi_url and $cgi_path are not set already, figure out what they need to be
	if( $cgi_url eq '' ) {
		$cgi_url = $ENV{'SCRIPT_NAME'}; # FixMe: maybe need to find a better way to get the full url?
		$cgi_url =~ s/$this_script_name\/*//;
	}
	if( $cgi_path eq '' ) {
		$cgi_path = $0;
		$cgi_path =~ s/$this_script_name//;
		$cgi_path =~ s/\\/\//g; # replaces all back slashes with forward slashes
	}
	$database_files_dir = $cgi_path if $database_files_dir eq '';

	# check to make sure $cgi_path and $database_files_dir exist and are directories
	#if( !(-d $cgi_path) ) {
	#	error( "$this_function: '$cgi_path' does not appear to be a valid directory.", 'exit' );
	#}
	#if( !(-d $database_files_dir) ) {
	#	error( "$this_function: '$database_files_dir' does not appear to be a valid directory.", 'exit' );
	#}
} # end setup_directories()

# read_query_string()--------------------------------------------------------
# uses globals: %form_params
# uses functions: error()
# 10/28/2003 9:06AM
sub read_query_string
{
	my $this_function = whoami();
	# grab the environment and put it into the %form_params hash
	my $buffer;
	if( uc($ENV{'REQUEST_METHOD'}) eq 'GET' ) {
		$buffer = $ENV{'QUERY_STRING'};
	}
	elsif( uc($ENV{'REQUEST_METHOD'}) eq 'POST' ) {
		error( "\$ENV{'CONTENT_LENGTH'} is an unreasonable value: $ENV{CONTENT_LENGTH}", 'die' ) if( $ENV{'CONTENT_LENGTH'} > $post_length_max );
		sysread( STDIN, $buffer, $ENV{'CONTENT_LENGTH'} );
	}
	else {
		error( "$this_function: $ENV{'REQUEST_METHOD'} not supported", 'exit' );
	}
	my @pairs = split(/&/, $buffer);
	foreach my $pair (@pairs) {
		my($name, $value) = split(/=/, $pair);
		$name =~ tr/+/ /;
		$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		if( $value ne '' ) {
			$form_params{$name} = $value;
		}
	}
} # end read_query_string()

# print_html_header()--------------------------------------------------------
# uses globals: $html_header_printed
# 08/11/2003 7:23PM
# lets the script caller know that what follows should be interpreted as html if it has not been told already
sub print_html_header()
{
	if( !$html_header_printed ) {
		print "Content-type: text/html\n\n";
		$html_header_printed = 1;
	}
} # end print_html_header()

# get_tags()--------------------------------------------------------
# 08/25/2003 4:16PM
# reduces a file that contains valid tags to just a list of the tags
# returns a reference to the array
sub get_tags($)
{
	my $src = shift;
	$src =~ s{
      ^.*?\^     # everything from beginning of line to first '^' char
         |
      \^.*?\^    # everything between two '^' chars
		 |
	  \^.*?$	 # everything from last '^' to end
    } [^]gsx;
	$src =~ s{
		^\^      # the first '^'
		|
		\^$      # the last '^'
	} []gsx;
	my @tags = split /\^/,$src;
	foreach my $i ( @tags ) {
		chomp $i;
	}
	return \@tags;
} # end get_tags()

# error()--------------------------------------------------------
# 08/11/2003 7:17PM
# exits the script gracefully displaying an error message in the browser and in the error log (if needed)
# usage: error( "Message", 'die or exit', $script_name )
sub error($$$)
{
	my $message = shift;
	my $function = shift;
	my $this_script_name = shift;
	print_html_header();
	print <<"(END ERROR)";
<html>
	<head>
		<title>$this_script_name</title>
		<script LANGUAGE="JavaScript">
<!--
		    function GoBack() { window.history.go(-1) }
//-->
		</script>
	</head>
	<body bgcolor="#ffffff" text="#000000">
		<table border="0" width="100%">
		  <tr>
		    <td><h2><b>An error occured:</b></h2></td>
			</tr>
			<tr>
				<td nowrap><font color="#ff0000" size="+1">$message</font></td>
			</tr>
			<tr>
				<td>&nbsp;</td>
			</tr>
			<tr>
				<td>
					<form><input type=button value="&lt;&lt; Back" onClick="GoBack()"></form>
				</td>
		  </tr>
		</table>
	</body>
</html>
(END ERROR)
    if ( $function eq 'die' || $function eq '' ) { die $message; }
    else  { exit 0; }
} # end error()

# define all exported functions
# debug_print_array()--------------------------------------------------------
# 10/29/2003 10:01AM
sub debug_print_array($)
{
	my $array = shift;
	foreach ( @$array ) {
		print "$_<br>\n";
	}
} # end debug_print_array()

# debug_print_hash()--------------------------------------------------------
# 10/29/2003 10:02AM
sub debug_print_hash($)
{
	my $hash = shift;
	while ( my( $key, $value ) = each %$hash ) {
		print "$key => $value<br>\n";
	}
} # end debug_print_hash()

# check_server_updating()--------------------------------------------------------
# 12/05/2003 10:03AM
sub check_server_updating($)
{
	my $this_function = (caller(0))[3];
	my $this_script_name = shift;
	if ( -e "$database_files_dir$lock_file" ) {
		error("The server is being updated.",'exit', $this_script_name);
	}
} # end check_server_updating()

# get_field_info()--------------------------------------------------------
# 12/05/2003 9:54AM
sub get_field_info($$$)
{
	my $this_function = (caller(0))[3];
	my $data_file = shift;
	my $data_fields = shift;
	my $script_name = shift;

	open( DATA, "$database_files_dir$data_file" ) or error( "Could not open $database_files_dir$data_file: $!", 'die', $script_name );
	my $field_names = <DATA>;
	$field_names =~ s/\s*$//;  # removes the trailing spaces or eol
    #print_html_header();
	#print "[",$field_names,"]";
	build_field_hash( $data_fields, $field_names );
	close( DATA );
	if( $debug ) {
		print_html_header();
		print "[",scalar(localtime), "] $data_file fields:<br>\n";
		debug_print_hash( $data_fields );
		print "<br>\n";
	}
} # end get_field_info()

# build_picklist_options()--------------------------------------------------------
# 12/10/2003 2:47PM
sub build_picklist_options
{
	my $this_function = (caller(0))[3];
	my $picklist_fieldname = shift;
	my $selected_value = shift;
	if( $picklist_fieldname =~ /^Mem_ContactType\d/ ) {
		$picklist_fieldname = 'Mem_ContactType';
	}
	elsif( $picklist_fieldname =~ /^Mem_ContactResp\d/ ) {
		$picklist_fieldname = 'Mem_ContactResp';
	}
	my $picklist = $picklists{$picklist_fieldname};

	my $selected;
	my $return_value;
	foreach my $item ( @$picklist ) {
		if( $selected_value eq $item ) {
			$selected = 'selected';
		}
		else {
			$selected = '';
		}
		$return_value .= "<option $selected>$item</option>\n";
	}
	return $return_value;
} # end build_picklist_options()

# read_picklist_table()--------------------------------------------------------
# 12/10/2003 2:53PM
sub read_picklist_table
{
	my $this_function = (caller(0))[3];
	# if unable to open the $picklists_file, just exit the function.
	open( PICKLISTS, "$database_files_dir$picklists_file" ) or return 0; #ExLib::error( "$this_function: Could not open $database_files_dir$picklists_file: $!", 'die', $this_script_name );
	<PICKLISTS>;
	while( my $line = <PICKLISTS> ) {
		chomp $line;
		my( $field, $item ) = split /$delimiter/, $line;
		if( !exists($picklists{$field}) ) {
			$picklists{$field} = [];
		}
		push( @{$picklists{$field}}, $item );
	}
	close( PICKLISTS );
	if( $debug ) {
		foreach my $item ( sort keys %picklists ) {
			print "$item<br>\n";
			debug_print_array( $picklists{$item} );
			print "<br>\n";
		}
	}
	return 1;
} # end read_picklist_table()
