#!/usr/bin/perl -w
###############################################################################
# $Id$
###############################################################################
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to You under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
###############################################################################

=head1 NAME

VCL::utils

=head1 SYNOPSIS

 use VCL::utils;

=head1 DESCRIPTION

 This module contains general VCL utility subroutines.

=cut

###############################################################################
package VCL::utils;

# Specify the lib path using FindBin
use FindBin;
use lib "$FindBin::Bin/..";

# Configure inheritance
use base qw();

# Specify the version of this module
our $VERSION = '2.5';

# Specify the version of Perl to use
use 5.008000;

use strict;
use warnings;
use diagnostics;

use Mail::Mailer;
use File::Find;
use Time::Local;
use DBI;
use DBI::Const::GetInfoType;
use diagnostics;
use Net::Ping::External qw(ping);
use Fcntl qw(:DEFAULT :flock);
use FindBin;
use Getopt::Long;
use Carp;
use Term::ANSIColor 2.00 qw(:constants :pushpop color colored);
use Text::Wrap;
use English;
use List::Util qw(min max);
use HTTP::Headers;
use RPC::XML::Client;
use Scalar::Util 'blessed';
use Storable qw(dclone);
use Data::Dumper;
use Cwd;
use Sys::Hostname;
use XML::Simple;
use Time::HiRes qw(gettimeofday tv_interval);
use Crypt::OpenSSL::RSA;
use B qw(svref_2object);
use Socket;
use Net::Netmask;

BEGIN {
	$ENV{PERL_RL} = 'Perl';
};

use Term::ReadLine;

require Exporter;
our @ISA = qw(Exporter);

our @EXPORT = qw(
	_pingnode
	add_imageid_to_newimages
	add_reservation_account
	call_check_crypt_secrets
	character_to_ascii_value
	check_blockrequest_time
	check_endtimenotice_interval
	check_messages_need_validating
	check_time
	clear_next_image_id
	clearfromblockrequest
	convert_to_datetime
	convert_to_epoch_seconds
	create_management_node_directory
	database_execute
	database_select
	delete_computerloadlog_reservation
	delete_management_node_cryptsecret
	delete_request
	delete_reservation_account
	delete_variable
	delete_vcld_semaphore
	determine_remote_connection_target
	escape_file_path
	format_array_reference
	format_data
	format_hash_keys
	format_number
	get_all_reservation_ids
	get_affiliation_info
	get_array_intersection
	get_block_request_image_info
	get_caller_trace
	get_calling_subroutine
	get_changelog_info
	get_changelog_remote_ip_address_info
	get_database_names
	get_database_table_columns
	get_database_table_names
	get_code_ref_package_name
	get_code_ref_subroutine_name
	get_collapsed_hash_reference
	get_computer_current_private_ip_address
	get_computer_current_state_name
	get_computer_grp_members
	get_computer_ids
	get_computer_info
	get_computer_nathost_info
	get_computer_private_ip_address_info
	get_computers_controlled_by_mn
	get_connectlog_info
	get_connectlog_remote_ip_address_info
	get_copy_speed_info_string
	get_current_file_name
	get_current_image_contents_no_data_structure
	get_current_package_name
	get_current_reservation_lastcheck
	get_current_subroutine_name
	get_file_size_info_string
	get_group_name
	get_image_active_directory_domain_info
	get_image_info
	get_imagemeta_info
	get_imagerevision_cleanup_info
	get_imagerevision_info
	get_imagerevision_loaded_info
	get_imagerevision_names
	get_imagerevision_names_recently_reserved
	get_imagerevision_reservation_info
	get_local_user_info
	get_managable_resource_groups
	get_management_node_ad_domain_credentials
	get_management_node_blockrequests
	get_management_node_computer_ids
	get_management_node_id
	get_management_node_info
	get_management_node_cryptkey_pubkey
	get_management_node_cryptsecret_info
	get_management_node_cryptsecret_value
	get_management_node_requests
	get_management_node_vmhost_ids
	get_management_node_vmhost_info
	get_message_variable_info
	get_module_info
	get_nathost_assigned_public_ports
	get_natport_ranges
	get_next_image_default
	get_os_info
	get_production_imagerevision_info
	get_provisioning_osinstalltype_info
	get_provisioning_table_info
	get_random_mac_address
	get_request_by_computerid
	get_request_current_state_name
	get_request_end
	get_request_info
	get_request_log_info
	get_reservation_accounts
	get_reservation_computerloadlog_entries
	get_reservation_computerloadlog_time
	get_reservation_connect_method_info
	get_reservation_management_node_hostname
	get_reservation_vcld_process_name_regex
	get_request_loadstate_names
	get_resource_groups
	get_user_group_member_info
	get_user_info
	get_variable
	get_vcld_semaphore_info
	get_vmhost_assigned_vm_info
	get_vmhost_assigned_vm_provisioning_info
	get_vmhost_info
	getnewdbh
	getpw
	hash_to_xml_string
	help
	hostname_to_ip_address
	insert_nathost
	insert_natport
	insert_reload_request
	insert_request
	insert_vcld_semaphore
	insertloadlog
	ip_address_to_hostname
	ip_address_to_network_address
	is_inblockrequest
	is_ip_assigned_query
	is_management_node_process_running
	is_public_ip_address
	is_request_deleted
	is_valid_dns_host_name
	is_valid_ip_address
	is_variable_set
	kill_child_processes
	mail
	makedatestring
	nmap_port
	normalize_file_path
	notify
	notify_via_im
	notify_via_oascript
	parent_directory_path
	pfd
	populate_reservation_natport
	preplogfile
	prune_array_reference
	prune_hash_child_references
	prune_hash_reference
	read_file_to_array
	remove_array_duplicates
	rename_vcld_process
	reservation_being_processed
	round
	run_command
	run_scp_command
	run_ssh_command
	set_logfile_path
	set_management_node_cryptkey_pubkey
	set_managementnode_state
	set_reservation_lastcheck
	set_variable
	setnextimage
	setup_confirm
	setup_get_array_choice
	setup_get_hash_choice
	setup_get_hash_multiple_choice
	setup_get_input_file_path
	setup_get_input_string
	setup_get_menu_choice
	setup_print_break
	setup_print_error
	setup_print_ok
	setup_print_warning
	setup_print_wrap
	set_production_imagerevision
	sleep_uninterrupted
	sort_by_file_name
	stopwatch
	string_to_ascii
	switch_vmhost_id
	update_blockrequest_processing
	update_changelog_request_user_remote_ip
	update_changelog_reservation_remote_ip
	update_changelog_reservation_user_remote_ip
	update_computer_imagename
	update_computer_lastcheck
	update_computer_private_ip_address
	update_computer_procnumber
	update_computer_procspeed
	update_computer_public_ip_address
	update_computer_ram
	update_computer_state
	update_computer_vmhost_id
	update_connectlog
	update_currentimage
	update_image_name
	update_image_type
	update_lastcheckin
	update_log_ending
	update_log_loaded_time
	update_preload_flag
	update_request_checkuser
	update_request_state
	update_reservation_lastcheck
	update_reservation_natlog
	update_reservation_password
	update_sublog_ipaddress
	wrap_string
	xml_string_to_hash
	xmlrpc_call
	yaml_deserialize
	yaml_serialize

	$CONF_FILE_PATH
	$DAEMON_MODE
	$DATABASE
	$DEFAULTHELPEMAIL
	$EXECUTE_NEW
	$FQDN
	$LOGFILE
	$MYSQL_SSL
	$MYSQL_SSL_CERT
	$PIDFILE
	$PROCESSNAME
	$WINDOWS_ROOT_PASSWORD
	$SERVER
	$SETUP_MODE
	$TOOLS
	$VERBOSE
	$WRTPASS
	$WRTUSER
	$XMLRPC_USER
	$XMLRPC_PASS
	$XMLRPC_URL
	%ERRORS
	%OPTIONS
);

our %ERRORS = (
	'OK' => 0,
	'WARNING' => 1,
	'CRITICAL' => 2,
	'UNKNOWN' => 3,
	'DEPENDENT' => 4,
	'MAILMASTERS' => 5,
	'DEBUG' => 6
);

our $PROCESSNAME;
our $LOGFILE;
our $PIDFILE;
our $FQDN;

our $SERVER;
our $DATABASE;
our $WRTUSER;
our $WRTPASS;
our $MYSQL_SSL;
our $MYSQL_SSL_CERT;

our $JABBER;
our $JABBER_SERVER;
our $JABBER_USER;
our $JABBER_PASSWORD;
our $JABBER_RESOURCE;
our $JABBER_PORT;

our $DEFAULTHELPEMAIL;
our $RETURNPATH;

our $WINDOWS_ROOT_PASSWORD;

our $XMLRPC_USER;
our $XMLRPC_PASS;
our $XMLRPC_URL;

our $BIN_PATH = $FindBin::Bin;
our $TOOLS = "$FindBin::Bin/../tools";
our $VERBOSE;
our $CONF_FILE_PATH;
our $DAEMON_MODE;
our $SETUP_MODE;
our $EXECUTE_NEW;


INIT {
	# Parse config file and set globals
	
	# Set Getopt pass_through so this module doesn't erase parameters that other modules may use
	Getopt::Long::Configure('pass_through');
	
	# Set a default config file path
	my $hostname = hostname();
	$hostname =~ s/\..*//g;
	my $cwd = getcwd();
	$CONF_FILE_PATH = "$cwd/$hostname.conf";
	if (!-f $CONF_FILE_PATH) {
		if ($BIN_PATH && $BIN_PATH =~ /dev/) {
			$CONF_FILE_PATH = "/etc/vcl/vcldev.conf";
		}
		else {
			$CONF_FILE_PATH = "/etc/vcl/vcld.conf";
		}
	}

	# Store the command line options in hash
	our %OPTIONS;
	GetOptions(\%OPTIONS,
		'config=s' => \$CONF_FILE_PATH,
		'daemon!' => \$DAEMON_MODE,
		'logfile=s' => \$LOGFILE,
		'help' => \&help,
		'setup!' => \$SETUP_MODE,
		'verbose!' => \$VERBOSE,
		'exn!' => \$EXECUTE_NEW,
	);
	
	my %parameters = (
		'log'							=> \$LOGFILE,
		'pidfile'					=> \$PIDFILE,
		'fqdn'						=> \$FQDN,
		'database'					=> \$DATABASE,
		'server'						=> \$SERVER,
		'lockerwrtuser'			=> \$WRTUSER,
		'wrtpass'					=> \$WRTPASS,
		'xmlrpc_username'			=> \$XMLRPC_USER,
		'xmlrpc_pass'				=> \$XMLRPC_PASS,
		'xmlrpc_url'				=> \$XMLRPC_URL,
		'enable_mysql_ssl'		=> \$MYSQL_SSL,
		'mysql_ssl_cert'			=> \$MYSQL_SSL_CERT,
		'returnpath'				=> \$RETURNPATH,
		'jabber'						=> \$JABBER,
		'jabserver'					=> \$JABBER_SERVER,
		'jabuser'					=> \$JABBER_USER,
		'jabpass'					=> \$JABBER_PASSWORD,
		'jabport'					=> \$JABBER_PORT,
		'jabresource'				=> \$JABBER_RESOURCE,
		'processname'				=> \$PROCESSNAME,
		'windows_root_password'	=> \$WINDOWS_ROOT_PASSWORD,
		'verbose'					=> \$VERBOSE,
		'defaulthelpemail'		=> \$DEFAULTHELPEMAIL,
	);
	
	# Make sure the config file exists
	if (!-f $CONF_FILE_PATH) {
		if (!$SETUP_MODE) {
			print STDERR "FATAL: vcld configuration file does not exist: $CONF_FILE_PATH\n";
			help();
		}
	}
	elsif (!open(CONF, $CONF_FILE_PATH)) {
		print STDERR "FATAL: failed to open vcld configuration file: $CONF_FILE_PATH, $!\n";
		exit;
	}
	
	my @conf_file_lines = <CONF>;
	close(CONF);
	
	my $line_number = 0;
	foreach my $line (@conf_file_lines) {
		$line_number++;
		
		$line =~ s/[\s]*$//g;
		
		# Skip commented and blank lines
		if ($line =~ /^\s*#/ || $line !~ /\w/) {
			next;
		}
		
		my ($parameter, $value) = $line =~ /\s*([^=]+)=(.+)/;
		if (!defined($parameter) || !defined($value)) {
			#print STDERR "WARNING: ignoring line $line_number in $CONF_FILE_PATH: $line\n";
			next;
		}
		
		# Remove any leading and trailing spaces
		for ($parameter, $value) {
			s/^\s+//;
			s/\s+$//;
		}
		
		$parameter = lc($parameter);
		
		if (my $variable_ref = $parameters{$parameter}) {
			if (defined($$variable_ref)) {
				#print STDOUT "INFO: ignoring previously set parameter: $parameter\n";
			}
			else {
				$$variable_ref = $value;
				#print STDOUT "set parameter: '$parameter' = '$value'\n";
			}
		}
		else {
			#print STDERR "WARNING: unsupported parameter found on line $line_number in $CONF_FILE_PATH: " . string_to_ascii($parameter) . "\n";
		}
	}
	
	if (!$FQDN) {
		print STDERR "FATAL: FQDN parameter must be configured in $CONF_FILE_PATH\n";
		exit;
	}
	
	$PROCESSNAME = 'vcld' if !$PROCESSNAME;
	$PIDFILE = "/var/run/$PROCESSNAME.pid" if !$PIDFILE;
	$LOGFILE = "/var/log/$PROCESSNAME.log" if !defined($LOGFILE);
	$WINDOWS_ROOT_PASSWORD = "clOudy" if !defined($WINDOWS_ROOT_PASSWORD);
	$DEFAULTHELPEMAIL = "vcl_help\@example.org" if !$DEFAULTHELPEMAIL;
	
	# Can't be both daemon mode and setup mode, use setup if both are set
	if ($SETUP_MODE) {
		$DAEMON_MODE = 0;
	}
	elsif (!defined($DAEMON_MODE)) {
		$DAEMON_MODE = 1;
	}
	elsif (!defined($EXECUTE_NEW)) {
		$EXECUTE_NEW = 0;
	}
	$ENV{execute_new} = $EXECUTE_NEW if $EXECUTE_NEW;
	
	# Set boolean variables to 0 or 1, they may be set to 'no' or 'yes' in the conf file
	for ($MYSQL_SSL, $JABBER, $VERBOSE, $DAEMON_MODE, $SETUP_MODE) {
		if (!$_ || $_ =~ /no/i) {
			$_ = 0;
		}
		else {
			$_ = 1;
		}
	}
	
	if ($JABBER) {
		# Jabber is enabled - import required module
		eval {
			require "Net/Jabber.pm";
			import Net::Jabber qw(client);
		};
		if ($EVAL_ERROR) {
			print STDERR "FATAL: failed to load Jabber module, error:\n$EVAL_ERROR\n";
			exit;
		}
	}
} ## end INIT

#//////////////////////////////////////////////////////////////////////////////

=head2 help

 Parameters  : None
 Returns     : Nothing, terminates program
 Description : Displays a help message and exits.

=cut

sub help {
	my $message = <<"END";
============================================================================
Please read the README and INSTALLATION files in the source directory.
Documentation is available at http://cwiki.apache.org/VCL.

Command line options:
-conf=<path> | Specify vcld configuration file (default: /etc/vcl/vcld.conf)
-log=<path>  | Specify vcld log file (default: /var/log/vcld.log)
-setup       | Run management node setup
-verbose     | Run vcld in verbose mode
-nodaemon    | Run vcld in non-daemon mode
-exn         | Use persistent SSH connections (experimental)
-help        | Display this help information
============================================================================
END

	print $message;
	exit 1;
} ## end sub help

#//////////////////////////////////////////////////////////////////////////////

=head2 preplogfile

 Parameters  : nothing
 Returns     : nothing
 Description : writes header to global log file

=cut

sub preplogfile {
	my $currenttime = makedatestring();
	
	#Print the vcld process info
	my $process_info = <<EOF;
============================================================================
VCL Management Node Daemon (vcld) | $currenttime
============================================================================
bin path:      $BIN_PATH
config file:   $CONF_FILE_PATH
log file:      $LOGFILE
pid file:      $PIDFILE
daemon mode:   $DAEMON_MODE
setup mode:    $SETUP_MODE
verbose mode:  $VERBOSE
============================================================================
EOF

	if ($LOGFILE) {
		if (!open(LOGFILE, ">>$LOGFILE")) {
			die "Failed to open log file: $LOGFILE";
		}
		print LOGFILE $process_info;
		close(LOGFILE);
	} else {
        print STDOUT $process_info;
    }
}

#//////////////////////////////////////////////////////////////////////////////

=head2 notify

 Parameters  : $error, $LOG, $string, $data
 Returns     : true
 Description : based on error value write string and/or data to
               provide or default log file

=cut

sub notify {
	my $error  = shift;
	my $log    = shift;
	my $string = shift;
	my @data   = @_;

	# Just return if DEBUG and verbose isn't enabled
	return if ($error == 6 && !$VERBOSE);

	# Get the current time
	my $currenttime = makedatestring();
	
	# Open the log file for writing if passed as an argument or set globally
	# If not, print to STDOUT
	$log = $LOGFILE if (!$log);
	
	# Get info about the subroutine which called this subroutine
	my ($package, $filename, $line, $sub) = caller(0);
	
	# Assemble the caller information
	my $caller_info;
	if (caller(1)) {
		$sub = (caller(1))[3];
	}

	# Remove leading path from filename
	$filename =~ s/.*\///;

	# Remove the leading package path from the sub name (VC::...)
	$sub =~ s/.*:://;
	
	$caller_info = "$filename:$sub($line)";

	# Format the message string
	# Remove Windows carriage returns from the message string for consistency
	$string =~ s/\r//gs;
	
	## Remove newlines from the beginning and end of the message string
	#$string =~ s/^\n+//;
	#$string =~ s/\n+$//;
	
	# Remove any spaces from the beginning or end of the string
	$string =~ s/(^\s+)|(\s+$)//gs;
	
	# Remove any spaces from the beginning or end of the each line
	#$string =~ s/\s*\n\s*/\n/gs;
	
	# Remove blank lines
	$string =~ s/\n{2,}/\n/gs;
	
	# Replace consecutive spaces with a single space to keep log file concise as long as string doesn't contain a quote
	if ($string !~ /[\'\"]/gs && $string !~ /\s:\s/gs) {
		$string =~ s/[ \t]+/ /gs;
	}
	
	# Assemble the process identifier string
	my $process_identifier;
	$process_identifier .= "|$PID|";
	$process_identifier .= $ENV{request_id} if defined $ENV{request_id};
	$process_identifier .= "|";
	$process_identifier .= $ENV{reservation_id} if defined $ENV{reservation_id};
	$process_identifier .= "|";
	$process_identifier .= $ENV{state} || 'vcld';
	$process_identifier .= "|$filename:$sub|$line";

	# Assemble the log message
	my $log_message = "$currenttime$process_identifier|$string";

	# Format the data if WARNING or CRITICAL, and @data was passed
	my $formatted_data;
	if (@data && ($error == 1 || $error == 2)) {
		# Add the data to the message body if it was passed
		$formatted_data = "DATA:\n" . format_data(\@data, 'DATA');
		chomp $formatted_data;
	}

	# Assemble an email message body if CRITICAL
	my $body;
	my $body_separator = '-' x 72;
	
	my $sysadmin = '';
	my $shared_mail_box = '';
	
	if ($error == 2 || $error == 5) {
		my $caller_trace = get_caller_trace(999);
		if ($caller_trace !~ /get_management_node_info/) {
			my $management_node_info = get_management_node_info();
			if ($management_node_info) {
				$sysadmin = $management_node_info->{SYSADMIN_EMAIL} if $management_node_info->{SYSADMIN_EMAIL};
				$shared_mail_box = $management_node_info->{SHARED_EMAIL_BOX} if $management_node_info->{SHARED_EMAIL_BOX};
			}
		}
	}
	
	# WARNING
	if ($error == 1) {
		my $caller_trace = get_caller_trace();
		$log_message = "\n---- WARNING ---- \n$log_message\n$caller_trace\n\n";
	}

	# CRITICAL
	elsif ($error == 2) {
		my $caller_trace = get_caller_trace(15);
		$log_message = "\n---- CRITICAL ---- \n$log_message\n$caller_trace\n\n";
		if ($sysadmin) {
			
			# Assemble the e-mail message body
			$body = <<"END";
$string
$body_separator
time: $currenttime
caller: $caller_info
$caller_trace
$body_separator
END
			
			# Add the reservation info to the message if the DataStructure object is defined in %ENV
			if ($ENV{data}) {
				my $reservation_info_string = $ENV{data}->get_reservation_info_string();
				if ($reservation_info_string) {
					$reservation_info_string =~ s/\s+$//;
					$body .= "$reservation_info_string\n";
					$body .= "$body_separator\n";
				}
			}
			
			# Get the previous several log file entries for this process
			my $log_history_count = 100;
			my $log_history       = "RECENT LOG ENTRIES FOR THIS PROCESS:\n";
			$log_history .= `grep "|$PID|" $log | tail -n $log_history_count` if $log;
			chomp $log_history;
			$body .= $log_history;
			
			# Add the formatted data to the message body if data was passed
			$body .= "\n\nDATA:\n$formatted_data\n" if $formatted_data;
			
			my ($management_node_short_name) = $FQDN =~ /^([^.]+)/;
			my $subject = "PROBLEM -- $management_node_short_name|";
			
			# Assemble the process identifier string
			if (defined $ENV{request_id} && defined $ENV{reservation_id} && defined $ENV{state}) {
				$subject .= "$ENV{request_id}:$ENV{reservation_id}|$ENV{state}|$filename";
			}
			else {
				$subject .= "$caller_info";
			}
			
			if (defined($ENV{data})) {
				my $blockrequest_name = $ENV{data}->get_blockrequest_name(0);
				$subject .= "|$blockrequest_name" if (defined $blockrequest_name);
				
				my $computer_name = $ENV{data}->get_computer_short_name(0);
				$subject .= "|$computer_name" if (defined $computer_name);
				
				my $vmhost_hostname = $ENV{data}->get_vmhost_short_name(0);
				$subject .= ">$vmhost_hostname" if (defined $vmhost_hostname);
				
				my $image_name = $ENV{data}->get_image_name(0);
				$subject .= "|$image_name" if (defined $image_name);
				
				my $user_name = $ENV{data}->get_user_login_id(0);
				$subject .= "|$user_name" if (defined $user_name);
			}
			
			my $from    = "root\@$FQDN";
			my $to      = $sysadmin;
			
			mail($to, $subject, $body, $from);
		}
	} ## end elsif ($error == 2)  [ if ($error == 1)
	
	# MAILMASTERS - only for email notifications
	elsif ($error == 5 && $shared_mail_box) {
		my $to      = $shared_mail_box;
		my $from    = "root\@$FQDN";
		my $subject = "Informational -- $filename";
		
		# Assemble the e-mail message body
		$body = <<"END";
$string

Time: $currenttime
PID: $PID
Caller: $caller_info

END
		
		mail($to, $subject, $body, $from);
	}

	# Add the process identifier to every line of the log message
	chomp $log_message;
	$log_message =~ s/\n([^\n])/\n$process_identifier| $1/g;
	
	# Check if the logfile path has been set and not running in daemon mode and redirect output to log file
	# No need to redirect in daemon mode because STDOUT is redirected by vcld
	if (!$DAEMON_MODE && $log) {
		open(OUTPUT, ">>$log");
		print OUTPUT "$log_message\n";
		close OUTPUT;
	}
	else {
		open(STDOUT, ">>$log");
		
		# ARK - for testing competing reservations
		#if ($ENV{reservation_id}) {
		#	if ($ENV{reservation_id} == 3115) {
		#		print colored($log_message, "YELLOW");
		#	}
		#	elsif ($ENV{reservation_id} == 3116) {
		#		print colored($log_message, "CYAN");
		#	}
		#	else {
		#		print colored($log_message, "MAGENTA");
		#	}
		#	print "\n";
		#	return 1;
		#}
		print STDOUT "$log_message\n";
	}
} ## end sub notify

#//////////////////////////////////////////////////////////////////////////////

=head2  makedatestring

 Parameters  : empty
 Returns     : current time in date_time format
 Description :

=cut

sub makedatestring {
	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime();
	$year += 1900;
	$mon++;
	my $datestring = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $mday, $hour, $min, $sec);
	return $datestring;
}

#//////////////////////////////////////////////////////////////////////////////

=head2  convert_to_datetime

 Parameters  : time in epoch format
 Returns     : date in datetime format
 Description : accepts time in epoch format (10 digit) and returns time in
               datetime format

=cut

sub convert_to_datetime {
	my ($epochtime) = shift;

	if (!defined($epochtime) || $epochtime == 0) {
		$epochtime = time();
	}

	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($epochtime);
	$year += 1900;
	$mon++;
	my $datestring = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $mday, $hour, $min, $sec);
	return $datestring;

} ## end sub convert_to_datetime

#//////////////////////////////////////////////////////////////////////////////

=head2  convert_to_epoch_seconds

 Parameters  : datetime
 Returns     : time in epoch format
 Description : takes input(optional) and returns epoch 10 digit string of
               the supplied date_time or the current time

=cut

sub convert_to_epoch_seconds {
	my ($date_time) = shift;
	if (!defined($date_time)) {
		return time();
	}
	#somehow we got a null timestamp, set it to current time
	if ($date_time =~ /0000-00-00 00:00:00/) {
		$date_time = makedatestring;
	}

	#format received: year-mon-mday hr:min:sec
	my ($vardate, $vartime) = split(/ /, $date_time);
	my ($yr, $mon, $mday) = split(/-/, $vardate);
	my ($hr, $min, $sec)  = split(/:/, $vartime);
	$mon = $mon - 1;    #time uses 0-11 for months :(
	my $epoch_time = timelocal($sec, $min, $hr, $mday, $mon, $yr);
	return $epoch_time;
} ## end sub convert_to_epoch_seconds


#//////////////////////////////////////////////////////////////////////////////

=head2  check_endtimenotice_interval

 Parameters  : endtime
 Returns     : scalar: 2week, 1week, 2day, 1day, 30min, or 0
 Description : used to send a notice to owner regarding how far out the end of
               their reservation is

=cut

sub check_endtimenotice_interval {
	my $end = $_[0];
	notify($ERRORS{'WARNING'}, 0, "endtime not set") if (!defined($end));
	
	my $now      = convert_to_epoch_seconds();
	my $epochend = convert_to_epoch_seconds($end);
	my $epoch_until_end = $epochend - $now;
	
	notify($ERRORS{'OK'}, 0, "endtime= $end epoch_until_end= $epoch_until_end");
	
	my $diff_seconds = $epoch_until_end;
	
	my $diff_weeks = int($epoch_until_end/604800);
	$diff_seconds -= $diff_weeks * 604800;
	
	my $diff_days = int($diff_seconds/86400);
	my $total_days = int($epoch_until_end/86400);
	$diff_seconds -= $diff_days * 86400;
	
	my $diff_hours = int($diff_seconds/3600);
	$diff_seconds -= $diff_hours * 3600;
	
	my $diff_minutes = int($diff_seconds/60);
	$diff_seconds -= $diff_minutes * 60;
	
	notify($ERRORS{'OK'}, 0, "End Time is in: $diff_weeks week\(s\) $diff_days day\(s\) $diff_hours hour\(s\) $diff_minutes min\(s\) and $diff_seconds sec\(s\)");
	
	#flag on: 2 & 1 week; 2,1 day, 1 hour, 30,15,10,5 minutes
	#ignore over 2weeks away
	if ($diff_weeks >= 2) {
		return 0;
	}
	#2 week: between 14 days and a 14 day -6 minutes window
	elsif ($total_days >= 13 && $diff_hours >= 23 && $diff_minutes >= 55) {
		return "2 weeks";
	}
	#Ignore: between 7 days and 14 day - 6 minute window
	elsif ($total_days >=7) {
		return 0;
	}
	# 1 week notice: between 7 days and a 7 day -6 minute window
	elsif ($total_days >= 6 && $diff_hours >= 23 && $diff_minutes >= 55) {
		return "1 week";
	}
	# Ignore: between 2 days and 7 day - 15 minute window
	elsif ($total_days >= 2) {
		return 0;
	}
	# 2 day notice: between 2 days and a 2 day -6 minute window
	elsif ($total_days >= 1 && $diff_hours >= 23 && $diff_minutes >= 55) {
		return "2 days";
	}
	# 1 day notice: between 1 days and a 1 day -6 minute window
	elsif ($total_days >= 0 && $diff_hours >= 23 && $diff_minutes >= 55) {
		return "24 hours";
	}
	
	return 0;
} ## end sub check_endtimenotice_interval

#//////////////////////////////////////////////////////////////////////////////

=head2 check_blockrequest_time

 Parameters  : start, end, and expire times
 Returns     : 0 or 1 and task
 Description : check current time against all three tasks
               expire time overides end, end overrides start

=cut

sub check_blockrequest_time {
	my ($start_datetime, $end_datetime, $expire_datetime) = @_;

	# Check the arguments
	if (!$start_datetime) {
		notify($ERRORS{'WARNING'}, 0, "start time argument was not passed correctly");
		return;
	}
	if (!$end_datetime) {
		notify($ERRORS{'WARNING'}, 0, "end time argument was not passed correctly");
		return;
	}
	if (!$expire_datetime) {
		notify($ERRORS{'WARNING'}, 0, "expire time argument was not passed correctly");
		return;
	}

	# Get the current time in epoch seconds
	my $current_time_epoch_seconds = time();

	my $expire_time_epoch_seconds = convert_to_epoch_seconds($expire_datetime);
	my $expire_delta_minutes      = int(($expire_time_epoch_seconds - $current_time_epoch_seconds) / 60);
	#notify($ERRORS{'DEBUG'}, 0, "expire: $expire_datetime, epoch: $expire_time_epoch_seconds, delta: $expire_delta_minutes minutes");

	# If expire time is in the past, remove it
	if ($expire_delta_minutes < 0) {
		# Block request has expired
		notify($ERRORS{'OK'}, 0, "block request expired " . abs($expire_delta_minutes) . " minutes ago, returning 'expire'");
		return "expire";
	}

	if ($start_datetime =~ /^-?\d*$/ || $end_datetime =~ /^-?\d*$/) {
		notify($ERRORS{'DEBUG'}, 0, "block request is not expired but has no block times assigned to it, returning 0");
		return 0;
	}

	# Convert the argument datetimes to epoch seconds for easy calculation
	my $start_time_epoch_seconds = convert_to_epoch_seconds($start_datetime);
	my $end_time_epoch_seconds   = convert_to_epoch_seconds($end_datetime);

	# Calculate # of seconds away start, end, and expire times are from now
	# Positive value means time is in the future
	my $start_delta_minutes = int(($start_time_epoch_seconds - $current_time_epoch_seconds) / 60);
	my $end_delta_minutes   = int(($end_time_epoch_seconds - $current_time_epoch_seconds) / 60);

	#notify($ERRORS{'DEBUG'}, 0, "start:  $start_datetime,  epoch: $start_time_epoch_seconds,  delta: $start_delta_minutes minutes");
	#notify($ERRORS{'DEBUG'}, 0, "end:    $end_datetime,    epoch: $end_time_epoch_seconds,    delta: $end_delta_minutes minutes");
	
	# End time it is less than 1 minute
	if ($end_delta_minutes < 0) {
		# Block request end time is reached
		notify($ERRORS{'OK'}, 0, "block request end time has been reached ($end_delta_minutes minutes from now), returning 'end'");
		return "end";
	}

	# if 1min to 6 hrs in advance: start assigning resources
	if ($start_delta_minutes <= (6 * 60)) {
		# Block request within start window
		notify($ERRORS{'OK'}, 0, "block request start time is within start window ($start_delta_minutes minutes from now), returning 'start'");
		return "start";
	}


	#notify($ERRORS{'DEBUG'}, 0, "block request does not need to be processed now, returning 0");
	return 0;

} ## end sub check_blockrequest_time

#//////////////////////////////////////////////////////////////////////////////

=head2 check_time

 Parameters  : $request_start, $request_end, $reservation_lastcheck, $request_state_name, $request_laststate_name
 Returns     : start, preload, end, poll, old, remove, or 0
 Description : based on the input return a value used by vcld

=cut

sub check_time {
	my ($request_start, $request_end, $reservation_lastcheck, $request_state_name, $request_laststate_name, $serverrequest, $reservation_cnt, $changelog_timestamp) = @_;
	
	# Check the arguments
	if (!defined($request_state_name)) {
		notify($ERRORS{'WARNING'}, 0, "\$request_state_name argument is not defined");
		return 0;
	}
	if (!defined($request_laststate_name)) {
		notify($ERRORS{'WARNING'}, 0, "\$request_laststate_name argument is not defined");
		return 0;
	}
	
	# Get the current time epoch seconds
	my $current_time_epoch_seconds = time();
	
	# If lastcheck isn't set, set it to now
	if (!defined($reservation_lastcheck) || !$reservation_lastcheck) {
		$reservation_lastcheck = makedatestring($current_time_epoch_seconds);
	}
	
	if (!defined($changelog_timestamp) || !$changelog_timestamp) {
		$changelog_timestamp = makedatestring($current_time_epoch_seconds);
	}
	
	# First convert to datetime in case epoch seconds was passed
	if ($reservation_lastcheck !~ /\d{4}-\d{2}-\d{2}\s\d{2}:\d{2}:\d{2}/) {
		$reservation_lastcheck = convert_to_datetime($reservation_lastcheck);
	}
	if ($request_end !~ /\d{4}-\d{2}-\d{2}\s\d{2}:\d{2}:\d{2}/) {
		$request_end = convert_to_datetime($request_end);
	}
	if ($request_start !~ /\d{4}-\d{2}-\d{2}\s\d{2}:\d{2}:\d{2}/) {
		$request_start = convert_to_datetime($request_start);
	}

	# Convert times to epoch seconds
	my $lastcheck_epoch_seconds  = convert_to_epoch_seconds($reservation_lastcheck);
	my $start_time_epoch_seconds = convert_to_epoch_seconds($request_start);
	my $end_time_epoch_seconds   = convert_to_epoch_seconds($request_end);
	my $changelog_epoch_seconds   = convert_to_epoch_seconds($changelog_timestamp);

	# Calculate time differences from now in seconds
	# These will be positive if in the future, negative if in the past
	my $lastcheck_diff_seconds = $lastcheck_epoch_seconds - $current_time_epoch_seconds;
	my $start_diff_seconds     = $start_time_epoch_seconds - $current_time_epoch_seconds;
	my $end_diff_seconds       = $end_time_epoch_seconds - $current_time_epoch_seconds;
	my $changelog_diff_seconds = $changelog_epoch_seconds - $current_time_epoch_seconds;
	
	# Calculate the time differences from now in minutes
	# These will be positive if in the future, negative if in the past
	my $lastcheck_diff_minutes = round($lastcheck_diff_seconds / 60);
	my $start_diff_minutes     = round($start_diff_seconds / 60);
	my $end_diff_minutes       = round($end_diff_seconds / 60);
	
	my $preload_window_minutes_prior_high = 35;
	my $preload_window_minutes_prior_low = 25;

	# Print the time differences
	#notify($ERRORS{'OK'}, 0, "reservation lastcheck difference: $lastcheck_diff_minutes minutes ($lastcheck_diff_seconds seconds)");
	#notify($ERRORS{'OK'}, 0, "request start time difference:    $start_diff_minutes minutes");
	#notify($ERRORS{'OK'}, 0, "request end time difference:      $end_diff_minutes minutes");
	#notify($ERRORS{'OK'}, 0, "changelog timestamp difference:   $changelog_diff_seconds seconds");

	# Check the state, and then figure out the return code
	if ($request_state_name =~ /(new|imageprep|reload|tovmhostinuse|test)/) {
		if ($start_diff_minutes > 0) {
			# Start time is either now or in future, $start_diff_minutes is positive
			my $preload_start_minutes = ($start_diff_minutes - $preload_window_minutes_prior_high);
			if ($start_diff_minutes > $preload_window_minutes_prior_high) {
				if (($preload_start_minutes <= 5 || $start_diff_minutes % 5 == 0) && ($start_diff_seconds % 60) >= 50) {
					notify($ERRORS{'DEBUG'}, 0, "$request_state_name request start time is $start_diff_minutes minutes from now, preload process will begin in $preload_start_minutes minutes ($preload_window_minutes_prior_high minutes prior to request start time), returning 0");
				}
				return "0";
			}
			elsif ($start_diff_minutes >= $preload_window_minutes_prior_low && $start_diff_minutes <= $preload_window_minutes_prior_high) {
				notify($ERRORS{'DEBUG'}, 0, "$request_state_name request start time is $start_diff_minutes minutes from now, returning 'preload'");
				return "preload";
			}
			else {
				if (($start_diff_minutes <= 5 || $start_diff_minutes % 5 == 0) && ($start_diff_seconds % 60) >= 50) {
					notify($ERRORS{'DEBUG'}, 0, "$request_state_name request will be processed in $start_diff_minutes minutes, returning 0");
				}
				return "0";
			}
		} ## end if ($start_diff_minutes > 0)
		else {
			# Start time is in past, $start_diff_minutes is negative
			
			#Start time is fairly old - something is off
			#send warning to log for tracking purposes
			if ($start_diff_minutes < -17) {
				notify($ERRORS{'WARNING'}, 0, "reservation start time was in the past 17 minutes ($start_diff_minutes), returning 'start'");
			}
			else {
				notify($ERRORS{'DEBUG'}, 0, "reservation start time was $start_diff_minutes minutes ago, returning 'start'");
			}
			
			return "start";
			
		} ## end else [ if ($start_diff_minutes > 0)
	}
	elsif ($request_state_name =~ /(tomaintenance)/) {
		# Only display this once per hour at most, tomaintenance can be far into the future
		if ($start_diff_minutes > 0) {
			if ($start_diff_minutes % 60 == 0 && ($start_diff_seconds % 60) >= 50) {
				notify($ERRORS{'DEBUG'}, 0, "$request_state_name request will be processed in $start_diff_minutes minutes, returning 0");
			}
			return "0";
		}
		else {
			# Start time is in past, $start_diff_minutes is negative
			notify($ERRORS{'DEBUG'}, 0, "$request_state_name request will be processed now, returning 'start'");
			return "start";
		}
	}
	elsif ($request_state_name =~ /(inuse)/) {
		if ($end_diff_minutes <= 10) {
			notify($ERRORS{'DEBUG'}, 0, "reservation will end in 10 minutes or less ($end_diff_minutes), returning 'end'");
			return "end";
		}
		elsif ($lastcheck_epoch_seconds < $changelog_epoch_seconds && $changelog_diff_seconds < 0) {
			notify($ERRORS{'DEBUG'}, 0, "reservation lastcheck $reservation_lastcheck is older than most recent changelog timestamp $changelog_timestamp, returning 'poll'");
			return "poll";
		}
		else {
			# End time is more than 10 minutes in the future
			if ($serverrequest) {	
				my $server_inuse_check_time = ($ENV{management_node_info}->{SERVER_INUSE_CHECK} * -1);
				if ($lastcheck_diff_minutes <= $server_inuse_check_time) {
					return "poll";
				}
				else {
					return 0;
				}
			}
			elsif ($reservation_cnt > 1) {
				my $cluster_inuse_check_time = ($ENV{management_node_info}->{CLUSTER_INUSE_CHECK} * -1);; 
				if ($lastcheck_diff_minutes <= $cluster_inuse_check_time) {
					return "poll";
				}
				else {
					return 0;
				}
			}
			else {
				#notify($ERRORS{'DEBUG'}, 0, "reservation will end in more than 10 minutes ($end_diff_minutes)");
				my $general_inuse_check_time = ($ENV{management_node_info}->{GENERAL_INUSE_CHECK} * -1);
				if ($lastcheck_diff_minutes <= $general_inuse_check_time) {
					notify($ERRORS{'DEBUG'}, 0, "reservation was last checked more than $general_inuse_check_time minutes ago ($lastcheck_diff_minutes), returning 'poll'");
					return "poll";
				}
				else {
					#notify($ERRORS{'DEBUG'}, 0, "reservation has been checked within the past $general_inuse_check_time minutes ($lastcheck_diff_minutes), returning 0");
					return 0;
				}
			}
		} ## end else [ if ($end_diff_minutes <= 10)
	}
	elsif ($request_state_name =~ /(complete|failed)/) {
		# Don't need to keep requests in database if laststate was...
		if ($request_laststate_name =~ /image|deleted|makeproduction|reload|tomaintenance|tovmhostinuse/) {
			notify($ERRORS{'DEBUG'}, 0, "request laststate is '$request_laststate_name', returning 'remove'");
			return "remove";
		}
		elsif ($end_diff_minutes < 0) {
			notify($ERRORS{'DEBUG'}, 0, "reservation end time was in the past ($end_diff_minutes), returning 'remove'");
			return "remove";
		}
		else {
			# End time is now or in the future
			#notify($ERRORS{'DEBUG'}, 0, "reservation end time is either right now or in the future ($end_diff_minutes), returning 0");
			return "0";
		}
	}    # Close if state is complete or failed
	# Just return start for all other states
	else {
		notify($ERRORS{'DEBUG'}, 0, "request state is '$request_state_name', returning 'start'");
		return "start";
	}

} ## end sub check_time

#//////////////////////////////////////////////////////////////////////////////

=head2 mail

 Parameters  : $to, $subject,  $mailstring, $from
 Returns     : 1(success) or 0(failure)
 Description : send an email

=cut

sub mail {
	my ($to,      $subject,  $mailstring, $from) = @_;
	my ($package, $filename, $line,       $sub)  = caller(0);

	# Mail::Mailer relies on sendmail as written, this causes a "die" on Windows
	# TODO: Rework this subroutine to not rely on sendmail
	my $osname = lc($^O);
	if ($osname =~ /win/i) {
		notify($ERRORS{'OK'}, 0, "sending mail from Windows not yet supported\n-----\nTo: $to\nSubject: $subject\nFrom: $from\n$mailstring\n-----");
		return;
	}

	# Wrap text for lines longer than 72 characters
	#$Text::Wrap::columns = 72;
	#$mailstring = wrap('', '', $mailstring);

	# compare requestor and owner, if same only mail one
	if (!(defined($from))) {
		$from = $DEFAULTHELPEMAIL;
	}
	
	my $mailer;
	my $mailer_options = '';
	if (defined($RETURNPATH)) {
		$mailer_options = "-f $RETURNPATH";
	}
	
	eval {
		$mailer = Mail::Mailer->new("sendmail", $mailer_options);
	};
	if ($EVAL_ERROR) {
		notify($ERRORS{'WARNING'}, 0, "failed to send mail, error:\n$EVAL_ERROR");
		return;
	}
	
	my $shared_mail_box = '';
	my $management_node_info = get_management_node_info();
	if ($management_node_info) {
		$shared_mail_box = $management_node_info->{SHARED_EMAIL_BOX} if $management_node_info->{SHARED_EMAIL_BOX};
	}

	my $mail_args = {From => $from, To => $to, Subject => $subject};
	if ($shared_mail_box) {
		$mail_args->{Bcc} = $shared_mail_box;
	}
	if($mailstring =~ /<html>/ || $mailstring =~ /<html .*>/) {
		$mail_args->{'Content-Type'} = "text/html";
		notify($ERRORS{'DEBUG'}, 0, "Encountered message containing <html> tag, adding Content-Type header");
	}
	if ($mailer->open($mail_args)) {
		print $mailer $mailstring;
		$mailer->close();
		notify($ERRORS{'OK'}, 0, "SUCCESS -- Sending mail To: $to, $subject");
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "NOTICE --  Problem sending mail to: $to");
	}
} ## end sub mail

#//////////////////////////////////////////////////////////////////////////////

=head2 update_preload_fla

 Parameters  : request id, flag 1,0
 Returns     : 1 success 0 failure
 Description : update preload flag

=cut

sub update_preload_flag {
	my ($request_id, $flag) = @_;

	my ($package, $filename, $line, $sub) = caller(0);

	notify($ERRORS{'WARNING'}, 0, "request id is not defined")   unless (defined($request_id));
	notify($ERRORS{'WARNING'}, 0, "preload flag is not defined") unless (defined($flag));

	my $update_statement = "
	UPDATE
   request
	SET
	preload = $flag
	WHERE
   id = $request_id
	";

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		# Update successful
		notify($ERRORS{'OK'}, $LOGFILE, "preload flag updated for request_id $request_id ");
		return 1;
	}
	else {
		notify($ERRORS{'CRITICAL'}, 0, "unable to update preload flag updated for request_id $request_id");
		return 0;
	}
} ## end sub update_preload_flag

#//////////////////////////////////////////////////////////////////////////////

=head2 update_request_state

 Parameters  : $request_id, $state_name, $laststate_name, $force (optional)
 Returns     : boolean
 Description : Updates the request state and laststate. If the state is being
               updated to pending, the laststate argument must match the current
               state. This prevents problems if the state was updated via the
               website after the running vcld process was launched:
               OK - Current: inuse/reserved --> Argument: pending/inuse
               Not OK - Current: image/inuse --> Argument: pending/inuse
               
               This can be overridden by passing the $force argument and should
               only be done for testing.

=cut

sub update_request_state {
	my ($request_id, $state_name, $laststate_name, $force) = @_;
	
	# Check the passed parameters
	if (!defined($request_id)) {
		notify($ERRORS{'WARNING'}, 0, "unable to update request state, request id argument was not supplied");
		return;
	}
	if (!defined($state_name)) {
		notify($ERRORS{'WARNING'}, 0, "unable to update request $request_id state, state name argument not supplied");
		return;
	}
	if (!defined($laststate_name)) {
		notify($ERRORS{'WARNING'}, 0, "unable to update request $request_id state to $state_name, last state name argument not supplied");
		return;
	}
	
	
	my $update_statement = <<EOF;
UPDATE
request,
state state,
state laststate,
state currentstate,
state currentlaststate
SET
request.stateid = state.id,
request.laststateid = laststate.id
WHERE
request.id = $request_id
AND request.stateid = currentstate.id
AND request.laststateid = currentlaststate.id
AND state.name = '$state_name'
AND laststate.name = '$laststate_name'
AND currentstate.name != 'maintenance'
EOF
	
	if (!$force) {
		if ($state_name eq 'pending') {
			# Avoid: deleted/inuse --> pending/inuse
			$update_statement .= "AND laststate.name = currentstate.name\n";
		}
		elsif ($state_name !~ /(complete|failed|maintenance)/) {
			# New state is not pending
			# Avoid: pending/image --> inuse/inuse
			$update_statement .= "AND currentstate.name = 'pending'\n";
			$update_statement .= "AND currentlaststate.name = '$laststate_name'\n";
		}
	}
	
	# Call the database execute subroutine
	my $result = database_execute($update_statement);
	if (defined($result)) {
		my $rows_updated = (sprintf '%d', $result);
		if ($rows_updated) {
			notify($ERRORS{'OK'}, $LOGFILE, "request $request_id state updated to $state_name/$laststate_name");
			return 1;
		}
		else {
			my ($current_state_name, $current_laststate_name) = get_request_current_state_name($request_id);
			if ($state_name eq $current_state_name && $laststate_name eq $current_laststate_name) {
				notify($ERRORS{'OK'}, $LOGFILE, "request $request_id state already set to $current_state_name/$current_laststate_name");
				return 1;
			}
			elsif ($current_state_name eq 'deleted' || $current_laststate_name eq 'deleted') {
				notify($ERRORS{'OK'}, $LOGFILE, "request $request_id has been deleted, state not set to $state_name/$laststate_name, current state: $current_state_name/$current_laststate_name");
				return 1;
			}
			else {
				notify($ERRORS{'WARNING'}, $LOGFILE, "unable to update request $request_id state to $state_name/$laststate_name, current state: $current_state_name/$current_laststate_name, SQL statement:\n$update_statement");
				return;
			}
		}
		return $rows_updated;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update request $request_id state to $state_name/$laststate_name");
		return;
	}
} ## end sub update_request_state

#//////////////////////////////////////////////////////////////////////////////

=head2 update_computer_state

 Parameters  : $computer_id, $state_name, $log
 Returns     : 1 success 0 failure
 Description : update computer state

=cut

sub update_computer_state {
	my ($computer_id, $state_name, $log) = @_;

	my ($package, $filename, $line, $sub) = caller(0);

	notify($ERRORS{'WARNING'}, $log, "computer id is not defined") unless (defined($computer_id));
	notify($ERRORS{'WARNING'}, $log, "statename is not defined")   unless (defined($state_name));
	return 0 unless (defined $computer_id && defined $state_name);

	my $update_statement = "
	UPDATE
	computer,
	state
	SET
	computer.stateid = state.id
	WHERE
	state.name = \'$state_name\'
	AND computer.id = $computer_id
	";

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		# Update successful
		notify($ERRORS{'OK'}, $LOGFILE, "computer $computer_id state updated to: $state_name");
		return 1;
	}
	else {
		notify($ERRORS{'CRITICAL'}, 0, "unable to update states for computer $computer_id");
		return 0;
	}
} ## end sub update_computer_state

#//////////////////////////////////////////////////////////////////////////////

=head2 update_computer_lastcheck

 Parameters  : $computer_id, $datestring, $log
 Returns     : 1 success 0 failure
 Description : update computer state

=cut

sub update_computer_lastcheck {
	my ($computer_id, $datestring, $log) = @_;

	my ($package, $filename, $line, $sub) = caller(0);
	$log = 0 unless (defined $log);

	notify($ERRORS{'WARNING'}, $log, "computer id is not defined") unless (defined($computer_id));
	return 0 unless (defined $computer_id);

	unless (defined($datestring)) {
		$datestring = makedatestring;
	}

	my $update_statement = "
	UPDATE
	computer
	SET
	computer.lastcheck = '$datestring'
	WHERE
	computer.id = $computer_id
	";

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		# Update successful
		notify($ERRORS{'DEBUG'}, $log, "computer $computer_id lastcheck updated to: $datestring");
		return 1;
	}
	else {
		notify($ERRORS{'CRITICAL'}, $log, "unable to update datestring for computer $computer_id");
		return 0;
	}
} ## end

#//////////////////////////////////////////////////////////////////////////////

=head2 update_computer_procnumber

 Parameters  : $computer_id, $cpu_count
 Returns     : boolean
 Description : Updates the computer.procnumber value for the specified computer.

=cut

sub update_computer_procnumber {
	my ($computer_id, $cpu_count) = @_;

	if (!$computer_id || !$cpu_count) {
		notify($ERRORS{'WARNING'}, 0, "computer ID and CPU count arguments were not supplied correctly");
		return;
	}

	my $update_statement = <<EOF;
UPDATE
computer
SET
computer.procnumber = '$cpu_count'
WHERE
computer.id = $computer_id
EOF

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		notify($ERRORS{'DEBUG'}, 0, "updated the procnumber value to $cpu_count for computer ID $computer_id");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update the procnumber value to $cpu_count for computer ID $computer_id");
		return 0;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 update_computer_procspeed

 Parameters  : $computer_id, $cpu_speed
 Returns     : boolean
 Description : Updates the computer.procspeed value for the specified computer.
               The $cpu_speed argument should contain an integer value of the
               CPU speed in MHz.

=cut

sub update_computer_procspeed {
	my ($computer_id, $cpu_speed_mhz) = @_;

	if (!$computer_id || !$cpu_speed_mhz) {
		notify($ERRORS{'WARNING'}, 0, "computer ID and CPU speed arguments were not supplied correctly");
		return;
	}

	my $update_statement = <<EOF;
UPDATE
computer
SET
computer.procspeed = '$cpu_speed_mhz'
WHERE
computer.id = $computer_id
EOF

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		notify($ERRORS{'DEBUG'}, 0, "updated the procspeed value to $cpu_speed_mhz for computer ID $computer_id");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update the procspeed value to $cpu_speed_mhz for computer ID $computer_id");
		return 0;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 update_computer_ram

 Parameters  : $computer_id, $ram_mb
 Returns     : boolean
 Description : Updates the computer.ram value for the specified computer.
               The $ram_mb argument should contain an integer value of the
               RAM in MB.

=cut

sub update_computer_ram {
	my ($computer_id, $ram_mb) = @_;

	if (!$computer_id || !$ram_mb) {
		notify($ERRORS{'WARNING'}, 0, "computer ID and RAM arguments were not supplied correctly");
		return;
	}

	my $update_statement = <<EOF;
UPDATE
computer
SET
computer.ram = '$ram_mb'
WHERE
computer.id = $computer_id
EOF

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		notify($ERRORS{'DEBUG'}, 0, "updated the RAM value to $ram_mb for computer ID $computer_id");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update the RAM value to $ram_mb for computer ID $computer_id");
		return 0;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 update_reservation_password

 Parameters  : $reservation_id, $password
 Returns     : 1 success 0 failure
 Description : updates password field for reservation id

=cut

sub update_reservation_password {
	my ($reservation_id, $password) = @_;
	
	if (!$reservation_id) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	if (!$password) {
		notify($ERRORS{'WARNING'}, 0, "password argument was not supplied");
		return;
	}
	
	my $update_statement = "UPDATE reservation SET pw = \'$password\'	WHERE id = $reservation_id";

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		# Update successful
		notify($ERRORS{'OK'}, $LOGFILE, "password updated for reservation $reservation_id: $password");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update password for reservation $reservation_id");
		return 0;
	}
} ## end sub update_reservation_password

#//////////////////////////////////////////////////////////////////////////////

=head2 is_request_deleted

 Parameters  : $request_id
 Returns     : boolean
 Description : Checks if the request state or laststate is deleted.

=cut

sub is_request_deleted {
	my ($request_id) = @_;
	if (!defined($request_id)) {
		notify($ERRORS{'WARNING'}, 0, "request ID argument was not specified");
		return;
	}
	
	my ($state_name, $laststate_name) = get_request_current_state_name($request_id, 1);
	if (!$state_name || !$laststate_name) {
		notify($ERRORS{'OK'}, 0, "request $request_id state data could not be retrieved, assuming request is deleted and was removed from the database, returning true");
		return 1;
	}
	
	if ($state_name =~ /(deleted)/ || $laststate_name =~ /(deleted)/) {
		notify($ERRORS{'DEBUG'}, 0, "request $request_id state: $state_name/$laststate_name, returning true");
		return 1;
	}
	else {
		#notify($ERRORS{'DEBUG'}, 0, "request $request_id state: $state_name/$laststate_name, returning false");
		return 0;
	}
} ## end sub is_request_deleted

#//////////////////////////////////////////////////////////////////////////////

=head2 get_reservation_accounts

 Parameters  : $reservation_id
 Returns     : hash reference
 Description : Used for server loads, provides list of users for group access

=cut

sub get_reservation_accounts {
	my ($reservation_id) = @_;
	if (!defined($reservation_id)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return 0;
	}
	
	my $select_statement = <<EOF;
SELECT DISTINCT
reservationaccounts.userid AS reservationaccounts_userid,
reservationaccounts.password AS reservationaccounts_password,
affiliation.name AS affiliation_name,
user.unityid AS user_name

FROM
reservationaccounts,
affiliation,
user

WHERE
user.id = reservationaccounts.userid
AND affiliation.id = user.affiliationid
AND reservationaccounts.reservationid = $reservation_id
EOF
	
	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);
	
	my $reservation_accounts = {};
	for my $row (@selected_rows) {
		my $user_id = $row->{reservationaccounts_userid};
		$reservation_accounts->{$user_id}{"userid"} = $user_id;
		$reservation_accounts->{$user_id}{"password"} = $row->{reservationaccounts_password};
		$reservation_accounts->{$user_id}{"affiliation"} = $row->{affiliation_name};
		$reservation_accounts->{$user_id}{"username"} = $row->{user_name};
	}
	
	return $reservation_accounts;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_current_reservation_lastcheck

 Parameters  : @reservation_ids
 Returns     : string
 Description : Retrieves the current value of reservation.lastcheck from the
               database. Either a single reservation ID or multiple reservation
               IDs may be passed as the argument. If a single reservation ID is
               passed, a string is returned containing the reservation.lastcheck
               value. If multiple reservation IDs are passed, a hash reference
               is returned with the keys set to the reservation IDs.

=cut

sub get_current_reservation_lastcheck {
	my @reservation_ids = @_;

	# Check the passed parameter
	if (!@reservation_ids) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not specified");
		return;
	}
	
	my $reservation_id_string = join(', ', @reservation_ids);

	# Create the select statement
	my $select_statement = <<EOF;
SELECT
reservation.id,
reservation.lastcheck
FROM
reservation
WHERE
reservation.id IN ($reservation_id_string)
EOF

	my @selected_rows = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (!@selected_rows) {
		notify($ERRORS{'WARNING'}, 0, "failed to retrieve current reservation lastcheck for reservations: $reservation_id_string");
		return;
	}
	elsif (scalar(@selected_rows) == 1) {
		my $row = $selected_rows[0];
		return $row->{lastcheck};
	}
	else {
		my $reservation_lastcheck_info = {};
		for my $row (@selected_rows) {
			$reservation_lastcheck_info->{$row->{id}} = $row->{lastcheck};
		}
		return $reservation_lastcheck_info;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 add_reservation_account

 Parameters  : $reservation_id, $userid, $password
 Returns     : boolean
 Description : Adds an entry to the reservationaccounts table.

=cut

sub add_reservation_account {
	my ($reservation_id, $user_id, $password) = @_;
	
	if (!$reservation_id) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not specified");
		return;
	}
	elsif (!$user_id) {
		notify($ERRORS{'WARNING'}, 0, "user ID argument was not specified");
		return;
	}
	
	my $password_string;
	if ($password) {
		$password_string = "'$password'";
	}
	else {
		$password_string = 'NULL';
	}
	
	my $statement = <<EOF;
INSERT IGNORE INTO 
reservationaccounts
(
	reservationid,
	userid,
	password
)
VALUES
(
	'$reservation_id',
	'$user_id',
	$password_string
)
ON DUPLICATE KEY UPDATE password = $password_string
EOF
	
	if (!database_execute($statement)) {
		notify($ERRORS{'OK'}, 0, "failed to add user $user_id to reservationaccounts table");
		return;
	}
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 delete_reservation_account

 Parameters  : $reservation_id, $userid
 Returns     : boolean
 Description : Deletes an entry from the reservationaccounts table.

=cut

sub delete_reservation_account {
	my ($reservation_id, $user_id) = @_;
	
	if (!$reservation_id) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not specified");
		return;
	}
	elsif (!$user_id) {
		notify($ERRORS{'WARNING'}, 0, "user ID argument was not specified");
		return;
	}
	
	my $statement = <<EOF;
DELETE FROM
reservationaccounts
WHERE
reservationid = '$reservation_id'
AND userid = '$user_id' 
EOF

	if (!database_execute($statement)) {
		notify($ERRORS{'OK'}, 0, "failed to delete user $user_id from reservationaccounts table");
		return;
	}
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_next_image_default

 Parameters  : $computerid
 Returns     : imageid,imagerevisionid,imagename
 Description : Looks for any upcoming reservations for supplied computerid, if
               starttime is within 50 minutes return that imageid. Else fetch
               and return next image

=cut

sub get_next_image_default {
	my ($computerid) = @_;
	my ($calling_package, $calling_filename, $calling_line, $calling_sub) = caller(0);

	if (!defined($computerid)) {
		notify($ERRORS{'WARNING'}, 0, "$calling_sub $calling_package missing mandatory variable: computerid ");
		return 0;
	}

	my $select_statement = "
	SELECT DISTINCT
	req.start AS starttime,
	ir.imagename AS imagename,
	res.imagerevisionid AS imagerevisionid,
	res.imageid AS imageid
	FROM
	reservation res,
	request req,
	image i,
	state s,
	imagerevision ir
   WHERE
	res.requestid = req.id
	AND req.stateid = s.id
	AND i.id = res.imageid
	AND ir.id = res.imagerevisionid
	AND res.computerid = $computerid
	AND (s.name = \'new\' OR s.name = \'reload\' OR s.name = \'imageprep\')
   ";

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);
	my @ret_array;

	# Check to make sure 1 or more rows were returned
	if (scalar @selected_rows > 0) {
		# Loop through list of upcoming reservations
		# Based on the start time load the next one

		my $now = time();

		# It contains a hash
		for (@selected_rows) {
			my %reservation_row = %{$_};
			# $reservation_row{starttime}
			# $reservation_row{imagename}
			# $reservation_row{imagerevisionid}
			# $reservation_row{imageid}
			my $epoch_start = convert_to_epoch_seconds($reservation_row{starttime});
			my $diff        = $epoch_start - $now;
			# If start time is less than 50 minutes from now return this image
			notify($ERRORS{'OK'}, 0, "get_next_image_default : diff= $diff image= $reservation_row{imagename} imageid=$reservation_row{imageid}");
			if ($diff < (50 * 60)) {
				notify($ERRORS{'OK'}, 0, "get_next_image_default : future reservation detected diff= $diff image= $reservation_row{imagename} imageid=$reservation_row{imageid}");
				push(@ret_array, $reservation_row{imagename}, $reservation_row{imageid}, $reservation_row{imagerevisionid});
				return @ret_array;
			}
		} ## end for (@selected_rows)
	} ## end if (scalar @selected_rows > 0)

	# No upcoming reservations - fetch next image information
	my $select_nextimage = "
	SELECT DISTINCT
	imagerevision.imagename AS imagename,
	imagerevision.id AS imagerevisionid,
	image.id AS imageid
	FROM
	image,
	computer,
	imagerevision
   WHERE
	imagerevision.imageid = computer.nextimageid
	AND imagerevision.production = 1
	AND computer.nextimageid = image.id
	AND computer.id = $computerid
	";

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @next_selected_rows = database_select($select_nextimage);

	# Check to make sure at least 1 row were returned
	if (scalar @next_selected_rows == 0) {
		notify($ERRORS{'WARNING'}, 0, "get_next_image_default failed to fetch next image for computerid $computerid");
		return 0;
	}
	elsif (scalar @next_selected_rows > 1) {
		notify($ERRORS{'WARNING'}, 0, "" . scalar @next_selected_rows . " rows were returned from database select");
		return 0;
	}
	notify($ERRORS{'OK'}, 0, "get_next_image_default : returning next image=$next_selected_rows[0]{imagename} imageid=$next_selected_rows[0]{imageid}");
	push(@ret_array, $next_selected_rows[0]{imagename}, $next_selected_rows[0]{imageid}, $next_selected_rows[0]{imagerevisionid});
	return @ret_array;

} ## end sub get_next_image

#//////////////////////////////////////////////////////////////////////////////

=head2 setnextimage

 Parameters  : $computerid, $image
 Returns     : 1 success, 0 failed
 Description : updates nextimageid on provided computerid

=cut

sub setnextimage {
	my ($computerid, $imageid) = @_;
	my ($package, $filename, $line, $sub) = caller(0);
	notify($ERRORS{'WARNING'}, 0, "computerid: node is not defined") if (!(defined($computerid)));
	notify($ERRORS{'WARNING'}, 0, "imageid: node is not defined")    if (!(defined($imageid)));

	my $update_statement = " UPDATE computer SET nextimageid = $imageid WHERE id = $computerid ";

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "unable to update nextimageid");
		return 0;
	}
} ## end sub setnextimage

#//////////////////////////////////////////////////////////////////////////////

=head2 nmap_port

 Parameters  : $hostname, $port
 Returns     : boolean
 Description : use nmap port scanning tool to determine if port is open

=cut

sub nmap_port {
	my ($hostname, $port) = @_;
	
	if (!$hostname) {
		notify($ERRORS{'WARNING'}, 0, "hostname argument was not specified");
		return;
	}
	if (!defined($port)) {
		notify($ERRORS{'WARNING'}, 0, "port argument was not specified");
		return;
	}
	
	# Determine which string to use as the connection target
	my $remote_connection_target = determine_remote_connection_target($hostname);
	my $hostname_string = $remote_connection_target;
	$hostname_string .= " ($hostname)" if ($hostname ne $remote_connection_target);

	my $command = "/usr/bin/nmap $remote_connection_target -P0 -p $port -T Aggressive -n";

	my ($exit_status, $output) = run_command($command, 1);
	if (!defined($output)) {
		notify($ERRORS{'WARNING'}, 0, "failed to run nmap command on management node: '$command'");
		return;
	}
	elsif (grep(/(open|filtered)/i, @$output)) {
		notify($ERRORS{'DEBUG'}, 0, "port $port is open on $hostname_string");
		return 1;
	}
	elsif (grep(/(nmap:|warning)/i, @$output)) {
		notify($ERRORS{'WARNING'}, 0, "error occurred running nmap command: '$command', output:\n" . join("\n", @$output));
		return;
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "port $port is closed on $hostname_string");
		return 0;
	}
} ## end sub nmap_port

#//////////////////////////////////////////////////////////////////////////////

=head2 _pingnode

 Parameters  : $node
 Returns     : boolean
 Description : Uses Net::Ping::External to check if a node is responding to ICMP
               echo ping.

=cut

sub _pingnode {
	my ($node) = @_;
	if (!$node) {
		notify($ERRORS{'WARNING'}, 0, "node argument was not supplied");
		return;
	}
	
	my $node_string = $node;
	my $remote_connection_target;
	if (is_valid_ip_address($node, 0)) {
		$remote_connection_target = $node;
	}
	else {
		$remote_connection_target = determine_remote_connection_target($node);
		if ($remote_connection_target) {
			$node_string .= " ($remote_connection_target)";
			$node = $remote_connection_target;
		}
	}
	
	my $result = ping(host => $remote_connection_target, timeout => 1);

	if ($result) {
		#notify($ERRORS{'DEBUG'}, 0, "$node_string is responding to ping");
		return 1;
	}
	else {
		#notify($ERRORS{'DEBUG'}, 0, "$node_string is NOT responding to ping");
		return 0;
	}
} ## end sub _pingnode

#//////////////////////////////////////////////////////////////////////////////

=head2 getnewdbh

 Parameters  : none
 Returns     : 0 failed or database handle
 Description : gets a databasehandle

=cut

sub getnewdbh {
	#my $caller_trace = get_caller_trace(7, 1);
	#notify($ERRORS{'DEBUG'}, 0, "called from: $caller_trace");

	my ($database) = @_;
	$database = $DATABASE if !defined($database);

	my $dbh;

	# Try to use the existing database handle
	if ($ENV{dbh} && $ENV{dbh}->ping && $ENV{dbh}->{Name} =~ /^$database:/) {
		#notify($ERRORS{'DEBUG'}, 0, "using database handle stored in \$ENV{dbh}");
		return $ENV{dbh};
	}
	elsif ($ENV{dbh} && $ENV{dbh}->ping) {
		my ($stored_database_name) = $ENV{dbh}->{Name} =~ /^([^:]*)/;
		notify($ERRORS{'DEBUG'}, 0, "database requested ($database) does not match handle stored in \$ENV{dbh} (" . $ENV{dbh}->{Name} . ")");
	}
	elsif (defined $ENV{dbh}) {
		notify($ERRORS{'DEBUG'}, 0, "unable to use database handle stored in \$ENV{dbh}");
	}
	else {
		#notify($ERRORS{'DEBUG'}, 0, "\$ENV{dbh} is not defined, creating new database handle");
	}

	my $attempt      = 0;
	my $max_attempts = 5;
	my $retry_delay  = 2;
	
	# Assemble the data source string
	my $data_source;
	if ($MYSQL_SSL) {
		$data_source = "$database:$SERVER;mysql_ssl=1;mysql_ssl_ca_file=$MYSQL_SSL_CERT";
	}
	else {
		$data_source = "$database:$SERVER";
	}

	# Attempt to connect to the data source and get a database handle object
	my $dbi_result;
	while (!$dbh && $attempt < $max_attempts) {
		$attempt++;

		# Attempt to connect
		#notify($ERRORS{'DEBUG'}, 0, "attempting to connect to data source: $data_source, user: " . string_to_ascii($WRTUSER) . ", pass: " . string_to_ascii($WRTPASS));
		$dbh = DBI->connect(qq{dbi:mysql:$data_source}, $WRTUSER, $WRTPASS, {PrintError => 0});

		# Check if connect was successful
		if ($dbh && $dbh->ping) {
			# Set InactiveDestroy = 1 for all dbh's belonging to child processes
			# Set InactiveDestroy = 0 for all dbh's belonging to vcld
			if (!defined $ENV{vcld} || !$ENV{vcld}) {
				$dbh->{InactiveDestroy} = 1;
			}
			else {
				$dbh->{InactiveDestroy} = 0;
			}

			# Increment the dbh count environment variable if it is defined
			# This is only for development and testing to see how many handles a process creates
			$ENV{dbh_count}++ if defined($ENV{dbh_count});

			# Store the newly created database handle in an environment variable
			# Only store it if $ENV{dbh} is already defined
			# It's up to other modules to determine if $ENV{dbh} is defined, they must initialize it
			if (defined $ENV{dbh}) {
				$ENV{dbh} = $dbh;
				notify($ERRORS{'DEBUG'}, 0, "database handle stored in \$ENV{dbh}");
			}

			return $dbh;
		} ## end if ($dbh && $dbh->ping)

		# Something went wrong, construct a DBI result string
		$dbi_result = "DBI result: ";
		if (defined(DBI::err())) {
			$dbi_result = "(" . DBI::err() . ")";
		}
		if (defined(DBI::errstr())) {
			$dbi_result .= " " . DBI::errstr();
		}
		
		# Check for access denied
		if (DBI::err() == 1045 || DBI::errstr() =~ /access denied/i) {
			notify($ERRORS{'WARNING'}, 0, "unable to connect to database, $dbi_result");
			return 0;
		}
		
		# Either connect or ping failed
		if ($dbh && !$dbh->ping) {
			notify($ERRORS{'DEBUG'}, 0, "database connect succeeded but ping failed, attempt $attempt/$max_attempts, $dbi_result");
			$dbh->disconnect;
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "database connect failed, attempt $attempt/$max_attempts, $dbi_result");
		}
		
		notify($ERRORS{'DEBUG'}, 0, "sleeping for $retry_delay seconds");
		sleep $retry_delay;
		next;
	} ## end while (!$dbh && $attempt < $max_attempts)

	# Maximum number of attempts was reached
	notify($ERRORS{'WARNING'}, 0, "failed to connect to database, attempts made: $attempt/$max_attempts, $dbi_result");
	return 0;
} ## end sub getnewdbh

#//////////////////////////////////////////////////////////////////////////////

=head2 notify_via_oascript

 Parameters  : $node, $user, $message
 Returns     : 0 or 1
 Description : using apple oascript write supplied $message to finder

=cut

sub notify_via_oascript {
        my ($node, $user, $message) = @_;
        my ($package, $filename, $line, $sub) = caller(0);

        notify($ERRORS{'WARNING'}, 0, "node is not defined")    if (!(defined($node)));
        notify($ERRORS{'WARNING'}, 0, "message is not defined") if (!(defined($message)));
        notify($ERRORS{'WARNING'}, 0, "user is not defined")    if (!(defined($user)));

        # Escape new lines
        $message =~ s/\n/ /gs;
        $message =~ s/\'/\\\\\\\'/gs;
        notify($ERRORS{'DEBUG'}, 0, "message:\n$message");

        my $command = "/var/root/VCL/oamessage \"$message\"";

        if (run_ssh_command($node, $ENV{management_node_info}{keys}, $command)) {
                notify($ERRORS{'OK'}, 0, "successfully sent message to OSX user $user on $node");
                return 1;
        }
        else {
                notify($ERRORS{'WARNING'}, 0, "failed to send message to OSX user $user on $node");
                return 0;
        }

} ## end sub notify_via_oascript

#//////////////////////////////////////////////////////////////////////////////

=head2 getpw

 Parameters  : $password_length (optional), $include_special_characters (optional)
 Returns     : string 
 Description : Generates a random password.

=cut

sub getpw {
	my ($password_length, $include_special_characters) = @_;
	
	if (!$password_length) {
		$password_length = $ENV{management_node_info}{USER_PASSWORD_LENGTH} || 8;
	}
	if (!defined($include_special_characters)) {
		$include_special_characters = $ENV{management_node_info}{INCLUDE_SPECIAL_CHARS};
	}
	
	#Skip certain confusing chars like: iI1lL,0Oo Zz2
	my @character_set = (
		'A' .. 'H',
		'J' .. 'N',
		'P' .. 'Y',
		'a' .. 'h',
		'j' .. 'n',
		'p' .. 'y',
		'3' .. '9',
	);
	
	if ($include_special_characters) {
		my @special_characters = (
			'-',
			'_',
			'!',
			'%',
			'#',
			'$',
			'@',
			'+',
			'=',
			'{',
			'}',
			'?',
		);
		push @character_set, @special_characters;
	}
	my $character_set_size = (scalar(@character_set));
	
	my $password;
	srand;
	for (1 .. $password_length) {
		my $random_index = int(rand($character_set_size));
		$password .= $character_set[$random_index];
	}

	return $password;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_user_group_member_info

 Parameters  : $usergroupid
 Returns     : array of user group memebers
 Description : queries database and collects user members of supplied usergroupid

=cut

sub get_user_group_member_info {
	my ($user_group_id) = @_;
	
	if (!defined($user_group_id)) {
		notify($ERRORS{'WARNING'}, 0, "user group ID argument was not specified");
		return;
	}

	my $select_statement = <<EOF;
SELECT
user.*
FROM
user,
usergroupmembers
WHERE
user.id = usergroupmembers.userid
AND usergroupmembers.usergroupid = '$user_group_id'
EOF

	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);
	if (!@selected_rows) {
		notify($ERRORS{'DEBUG'}, 0, "no data was returned for user group ID $user_group_id, returning an empty list");
		return {};
	}
	
	my $user_group_member_info;
	for my $row (@selected_rows) {
		my $user_id = $row->{id};
		for my $column (keys %$row) {
			next if $column eq 'id';
			$user_group_member_info->{$user_id}{$column} = $row->{$column};
		}
	}
	
	#notify($ERRORS{'DEBUG'}, 0, "retrieved member info for user group ID $user_group_id:\n" . format_data($user_group_member_info));
	return $user_group_member_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2  notifyviaIM

 Parameters  : IM type, IM user ID, message string
 Returns     : 0 or 1
 Description : if Jabber enabled - send IM to user
               currently only supports jabber

=cut

sub notify_via_im {
	my ($im_type, $im_id, $im_message) = @_;
	
	notify($ERRORS{'WARNING'}, 0, "IM type is not defined") if (!(defined($im_type)));
	notify($ERRORS{'WARNING'}, 0, "IM id is not defined")   if (!(defined($im_id)));
	notify($ERRORS{'WARNING'}, 0, "IM message is not defined")  if (!(defined($im_message)));

	if ($im_type eq "jabber") {
		# Check if jabber functions are disabled on this management node
		if ($JABBER) {
			notify($ERRORS{'DEBUG'}, 0, "jabber functions are enabled on this management node");
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "jabber functions are disabled on this management node");
			return 1;
		}
		
		# Create a jabber client object
		my $jabber_client = new Net::Jabber::Client();
		if ($jabber_client) {
			notify($ERRORS{'DEBUG'}, 0, "jabber client object created");
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "failed to created jabber client object");
			return;
		}
		
		# Attempt to connect to the jabber server
		my $jabber_connect_result = $jabber_client->Connect(hostname => $JABBER_SERVER, port => $JABBER_PORT);
		if (!$jabber_connect_result) {
			notify($ERRORS{'DEBUG'}, 0, "connected to jabber server: $JABBER_SERVER, port: $JABBER_PORT, result: $jabber_connect_result");
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "failed to connect to jabber server: $JABBER_SERVER, port: $JABBER_PORT, result: $jabber_connect_result");
			return;
		}
		
		# Attempt to authenticate to jabber
		my @jabber_auth_result = $jabber_client->AuthSend(
			username => $JABBER_USER,
			password => $JABBER_PASSWORD,
			resource => $JABBER_RESOURCE
		);
		
		# Check the jabber authentication result
		if ($jabber_auth_result[0] && $jabber_auth_result[0] eq "ok") {
			notify($ERRORS{'DEBUG'}, 0, "authenticated to jabber server: $JABBER_SERVER, user: $JABBER_USER, resource: $JABBER_RESOURCE");
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "failed to authenticate to jabber server: $JABBER_SERVER, user: $JABBER_USER, resource: $JABBER_RESOURCE");
			return;
		}
	
		# Create jabber message
		my $jabber_message = Net::Jabber::Message->new();
		$jabber_message->SetMessage(
			to      => $im_id,
			subject => "Notification",
			type    => "chat",
			body    => $im_message
		);
		
		# Attempt to send the jabber message
		my $jabber_send_result = $jabber_client->Send($jabber_message);
		if ($jabber_send_result) {
			notify($ERRORS{'OK'}, 0, "jabber message sent to $im_id");
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "failed to send jabber message to $JABBER_USER");
			return;
		}
		
	} ## end if ($im_type eq "jabber" && defined $jabberready)
	
	else {
		notify($ERRORS{'WARNING'}, 0, "IM type is not supported: $im_type");
		return 0;
	}
	
	return 1;
} ## end sub notify_via_im

#//////////////////////////////////////////////////////////////////////////////

=head2 insertloadlog

 Parameters  : $reservation_id, $computer_id, $loadstatename, $additional_info
 Returns     : boolean
 Description : Inserts an entry into the computerloadlog table.

=cut

sub insertloadlog {
	my ($reservation_id, $computer_id, $loadstatename, $additional_info) = @_;
	if (!defined($reservation_id)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	elsif (!defined($computer_id)) {
		notify($ERRORS{'WARNING'}, 0, "computer ID argument was not supplied");
		return;
	}
	elsif (!defined($loadstatename)) {
		notify($ERRORS{'WARNING'}, 0, "computerloadstate name argument was not supplied");
		return;
	}
	$additional_info = 'no additional info' unless defined($additional_info);

	# Escape any special characters in additional info
	$additional_info = quotemeta $additional_info;

	# Assemble the SQL statement
	my $insert_loadlog_statement = <<EOF;
INSERT INTO
computerloadlog
(
	reservationid,
	computerid,
	loadstateid,
	timestamp,
	additionalinfo
)
VALUES
(
	'$reservation_id',
	'$computer_id',
	(SELECT id FROM computerloadstate WHERE loadstatename = '$loadstatename'),
	NOW(),
	'$additional_info'
)
EOF

	# Execute the insert statement, the return value should be the id of the computerloadlog row that was inserted
	if (database_execute($insert_loadlog_statement)) {
		notify($ERRORS{'OK'}, 0, "inserted '$loadstatename' computerloadlog entry");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to insert '$loadstatename' computerloadlog entry");
		return;
	}
} ## end sub insertloadlog

#//////////////////////////////////////////////////////////////////////////////

=head2 database_select

 Parameters  : SQL select statement
 Returns     : array containing hash references to rows returned
 Description : gets information from the database

=cut

sub database_select {
	my ($select_statement, $database) = @_;
	
	my $calling_sub = (caller(1))[3] || 'undefined';
	
	# Initialize the database_select_calls element if not already initialized
	if (!ref($ENV{database_select_calls})) {
		$ENV{database_select_calls} = {};
	}
	
	# For performance tuning - count the number of calls
	$ENV{database_select_count}++;
	if (!defined($ENV{database_select_calls}{$calling_sub})) {
		$ENV{database_select_calls}{$calling_sub} = 1;
	}
	else {
		$ENV{database_select_calls}{$calling_sub}++;
	}
	
	$database = $DATABASE unless $database;
	
	my $dbh;
	if (!($dbh = getnewdbh($database))) {
		# Try again if first attempt failed
		if (!($dbh = getnewdbh($database))) {
			notify($ERRORS{'WARNING'}, 0, "unable to obtain database handle, " . DBI::errstr());
			return ();
		}
	}

	# Prepare the select statement handle
	my $select_handle;
	$select_handle = $dbh->prepare($select_statement);

	# Check the select statement handle
	if (!$select_handle) {
		notify($ERRORS{'WARNING'}, 0, "could not prepare select statement, $select_statement, " . $dbh->errstr());
		$dbh->disconnect if !defined $ENV{dbh};
		return ();
	}

	# Execute the statement handle
	if (!($select_handle->execute())) {
		(my $select_statement_condensed = $select_statement) =~ s/[\n\s]+/ /g;
		notify($ERRORS{'WARNING'}, 0, "failed to execute statement on $database database:\n$select_statement\n" .
			"---\n" .
			"copy/paste select statement:\n$select_statement_condensed\n" .
			"---\n" .
			"error: " . $dbh->errstr()
		);
		$select_handle->finish;
		$dbh->disconnect if !defined $ENV{dbh};
		return ();
	}

	# Fetch all the rows returned by the select query
	# An array reference is created containing hash refs because {} is passed to fetchall_arrayref
	my @return_rows = @{$select_handle->fetchall_arrayref({})};
	$select_handle->finish;
	$dbh->disconnect if !defined $ENV{dbh};
	
	return @return_rows;
} ## end sub database_select

#//////////////////////////////////////////////////////////////////////////////

=head2 database_execute

 Parameters  : $sql_statement, $database (optional)
 Returns     : boolean
 Description : Executes an SQL statement. If $sql_statement is an INSERT
               statement, the ID of the row inserted is returned.

=cut

sub database_execute {
	my ($sql_statement, $database) = @_;
	
	$ENV{database_execute_count}++;
	
	my $dbh;
	if (!($dbh = getnewdbh($database))) {
		# Try again if first attempt failed
		if (!($dbh = getnewdbh($database))) {
			notify($ERRORS{'WARNING'}, 0, "unable to obtain database handle, " . DBI::errstr());
			return;
		}
	}
	
	# Prepare the statement handle
	my $statement_handle = $dbh->prepare($sql_statement);
	
	# Check the statement handle
	if (!$statement_handle) {
		my $error_string = $dbh->errstr() || '<unknown error>';
		notify($ERRORS{'WARNING'}, 0, "could not prepare SQL statement, $sql_statement, $error_string");
		$dbh->disconnect if !defined $ENV{dbh};
		return;
	}
	
	# Execute the statement handle
	my $result = $statement_handle->execute();
	if (!defined($result)) {
		my $error_string = $dbh->errstr() || '<unknown error>';
		$statement_handle->finish;
		$dbh->disconnect if !defined $ENV{dbh};
		
		if (wantarray) {
			return (0, $error_string);
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "could not execute SQL statement: $sql_statement\n$error_string");
			return;
		}
	}
	
	#my $sql_warning_count = $statement_handle->{'mysql_warning_count'};
	#if ($sql_warning_count) {
	#	my $warnings = $dbh->selectall_arrayref('SHOW WARNINGS');
	#	notify($ERRORS{'WARNING'}, 0, "warning generated from SQL statement:\n$sql_statement\nwarnings:\n" . format_data($warnings));
	#}
	
	# Get the id of the last inserted record if this is an INSERT statement
	if ($sql_statement =~ /^\s*insert/i) {
		my $sql_insertid = $statement_handle->{'mysql_insertid'};
		my $sql_warning_count = $statement_handle->{'mysql_warning_count'};
		$statement_handle->finish;
		$dbh->disconnect if !defined $ENV{dbh};
		if ($sql_insertid) {
			return $sql_insertid;
		}
		else {
			return $result;
		}
	}
	else {
		$statement_handle->finish;
		$dbh->disconnect if !defined $ENV{dbh};
		return $result;
	}

} ## end sub database_execute

#//////////////////////////////////////////////////////////////////////////////

=head2 database_update

 Parameters  : $update_statement, $database (optional)
 Returns     : boolean
 Description : Executes an SQL UPDATE statement. Returns the number of rows
               updated. 0 is returned if the statement was successfully executed
               but no rows were updated. Undefined is returned if the statement
               failed to execute.

=cut

sub database_update {
	my ($update_statement, $database) = @_;
	if (!$update_statement) {
		notify($ERRORS{'WARNING'}, 0, "SQL UPDATE statement argument not supplied");
		return;
	}
	elsif ($update_statement !~ /^\s*UPDATE\s/i) {
		notify($ERRORS{'WARNING'}, 0, "invalid SQL UPDATE statement argument, it does not begin with 'UPDATE':\n$update_statement");
		return;
	}
	
	
	my $dbh = getnewdbh($database);
	if (!$dbh) {
		sleep_uninterrupted(3);
		$dbh = getnewdbh($database);
		if (!$dbh) {
			notify($ERRORS{'WARNING'}, 0, "unable to obtain database handle, " . DBI::errstr());
			return;
		}
	}
	
	# Prepare the statement handle
	my $statement_handle = $dbh->prepare($update_statement);
	
	# Check the statement handle
	if (!$statement_handle) {
		my $error_string = $dbh->errstr() || '<unknown error>';
		notify($ERRORS{'WARNING'}, 0, "failed to prepare SQL UPDATE statement, $update_statement, $error_string");
		$dbh->disconnect if !defined $ENV{dbh};
		return;
	}
	
	# Execute the statement handle
	my $result = $statement_handle->execute();
	
	if (!defined($result)) {
		my $error_string = $dbh->errstr() || '<unknown error>';
		$statement_handle->finish;
		$dbh->disconnect if !defined $ENV{dbh};
		notify($ERRORS{'WARNING'}, 0, "failed to execute SQL UPDATE statement: $update_statement\nerror:\n$error_string");
		return;
	}
	
	my $updated_row_count = $statement_handle->rows;
	$statement_handle->finish;
	$dbh->disconnect if !defined $ENV{dbh};
	
	$update_statement =~ s/[\n\s]+/ /g;
	notify($ERRORS{'DEBUG'}, 0, "returning number of rows affected by UPDATE statement: $updated_row_count\n$update_statement");
	return $updated_row_count;
}

#//////////////////////////////////////////////////////////////////////////////

=head2  get_request_info

 Parameters  : $request_id, $no_cache (optional)
 Returns     : hash reference
 Description : Retrieves all request/reservation information.

=cut


sub get_request_info {
	my ($request_id, $no_cache) = @_;
	if (!(defined($request_id))) {
		notify($ERRORS{'WARNING'}, 0, "request ID argument was not specified");
		return;
	}
	
	# Don't use cached info by default
	if (!$no_cache) {
		$no_cache = 1;
	}
	
	# Get a hash ref containing the database column names
	my $database_table_columns = get_database_table_columns();
	
	my %tables = (
		'request' => 'request',
		'serverrequest' => 'serverrequest',
		'reservation' => 'reservation',
		'state' => 'state',
		'laststate' => 'state',
	);
	
	# Construct the select statement
	my $select_statement = "SELECT DISTINCT\n";
	
	# Get the column names for each table and add them to the select statement
	for my $table_alias (keys %tables) {
		my $table_name = $tables{$table_alias};
		my @columns = @{$database_table_columns->{$table_name}};
		for my $column (@columns) {
			$select_statement .= "$table_alias.$column AS '$table_alias-$column',\n";
		}
	}
	
	# Remove the comma after the last column line
	$select_statement =~ s/,$//;
	
	# Complete the select statement
	$select_statement .= <<EOF;

FROM
request
LEFT JOIN (serverrequest) ON (serverrequest.requestid = request.id),
reservation,
state,
state laststate

WHERE
request.id = $request_id
AND reservation.requestid = request.id
AND state.id = request.stateid
AND laststate.id = request.laststateid

GROUP BY
reservation.id
EOF

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);
	
	# Check to make sure 1 or more rows were returned
	if (!@selected_rows) {
		notify($ERRORS{'WARNING'}, 0, "info for request $request_id could not be retrieved from the database, select statement:\n$select_statement");
		return;
	}

	# Build the hash
	my $request_info;
	my $request_state_name;
	
	for my $reservation_row (@selected_rows) {
		my $reservation_id = $reservation_row->{'reservation-id'};
		if (!$reservation_id) {
			notify($ERRORS{'WARNING'}, 0, "failed to retrieve request info, row does not contain a reservation-id value:\n" . format_data($reservation_row));
			return;
		}
		$request_info->{RESERVATIONID} = $reservation_id if (scalar @selected_rows == 1);
		
		# Loop through all the columns returned
		for my $key (keys %$reservation_row) {
			my $value = $reservation_row->{$key};
			
			# Split the table-column names
			my ($table, $column) = $key =~ /^([^-]+)-(.+)/;
			
			if ($table eq 'request') {
				$request_info->{$column} = $value;
			}
			elsif ($table eq 'reservation') {
				$request_info->{reservation}{$reservation_id}{$column} = $value;
			}
			elsif ($table eq 'serverrequest') {
				$request_info->{reservation}{$reservation_id}{serverrequest}{$column} = $value;
			}
			else {
				$request_info->{$table}{$column} = $value;
			}
		}
		
		$request_state_name = $request_info->{state}{name};
		
		# Store duration in epoch seconds format
		my $request_start_epoch = convert_to_epoch_seconds($request_info->{start});
		my $request_end_epoch = convert_to_epoch_seconds($request_info->{end});
		$request_info->{DURATION} = ($request_end_epoch - $request_start_epoch);
		
		# Add the image info to the hash
		my $image_id = $request_info->{reservation}{$reservation_id}{imageid};
		my $image_info = get_image_info($image_id, $no_cache);
		$request_info->{reservation}{$reservation_id}{image} = $image_info;
		
		# Add the imagerevision info to the hash
		my $imagerevision_id = $request_info->{reservation}{$reservation_id}{imagerevisionid};
		my $imagerevision_info = get_imagerevision_info($imagerevision_id, $no_cache);
		$request_info->{reservation}{$reservation_id}{imagerevision} = $imagerevision_info;
		
		# Add the computer info to the hash
		my $computer_id = $request_info->{reservation}{$reservation_id}{computerid};
		my $computer_info = get_computer_info($computer_id, $no_cache);
		$request_info->{reservation}{$reservation_id}{computer} = $computer_info;
		
		# Populate natport table for reservation
		# Make sure this wasn't called from populate_reservation_natport or else recursive loop will occur
		if (defined $ENV{reservation_id} && $ENV{reservation_id} eq $reservation_id) {
			my $caller_trace = get_caller_trace(5);
			if ($caller_trace !~ /populate_reservation_natport/) {
				if ($request_state_name =~ /(new|reserved|modified|test)/) {
					if (!populate_reservation_natport($reservation_id)) {
						notify($ERRORS{'CRITICAL'}, 0, "failed to populate natport table for reservation");
					}
					if (!update_reservation_natlog($reservation_id)) {
						notify($ERRORS{'CRITICAL'}, 0, "failed to populate natlog table for reservation");
					}
				}
			}
		}
		
		# Add the connect method info to the hash
		my $connect_method_info = get_reservation_connect_method_info($reservation_id, 0);
		$request_info->{reservation}{$reservation_id}{connect_methods} = $connect_method_info;
		
		# Add the managementnode info to the hash
		my $management_node_id = $request_info->{reservation}{$reservation_id}{managementnodeid};
		my $management_node_info = get_management_node_info($management_node_id, $no_cache);
		$request_info->{reservation}{$reservation_id}{managementnode} = $management_node_info;
		
		# Retrieve the user info and add to the hash
		my $user_id = $request_info->{userid};
		my $user_info = get_user_info($user_id, 0, $no_cache);
		$request_info->{user} = $user_info;
		
		my $imagemeta_root_access = $request_info->{reservation}{$reservation_id}{image}{imagemeta}{rootaccess};
		
		# If server request and logingroupid is set, add user group members to hash, set ROOTACCESS to 0
		if (my $login_group_id = $request_info->{reservation}{$reservation_id}{serverrequest}{logingroupid}) {
			my $login_group_member_info = get_user_group_member_info($login_group_id);
			for my $login_user_id (keys %$login_group_member_info) {
				$request_info->{reservation}{$reservation_id}{users}{$login_user_id} = get_user_info($login_user_id, 0, 1);
				$request_info->{reservation}{$reservation_id}{users}{$login_user_id}{ROOTACCESS} = 0;
			}
		}
		
		# If server request and admingroupid is set, add user group members to hash, set ROOTACCESS to the value configured in imagemeta
		if (my $admin_group_id = $request_info->{reservation}{$reservation_id}{serverrequest}{admingroupid}) {
			my $admin_group_member_info = get_user_group_member_info($admin_group_id);
			for my $admin_user_id (keys %$admin_group_member_info, $user_id) {
				$request_info->{reservation}{$reservation_id}{users}{$admin_user_id} = get_user_info($admin_user_id, 0, 1);
				$request_info->{reservation}{$reservation_id}{users}{$admin_user_id}{ROOTACCESS} = $imagemeta_root_access;
			}
		}
		
		# Add the request user to the hash, set ROOTACCESS to the value configured in imagemeta
		$request_info->{reservation}{$reservation_id}{users}{$user_id} = $user_info;
		$request_info->{reservation}{$reservation_id}{users}{$user_id}{ROOTACCESS} = $imagemeta_root_access;
		
		# For imaging reservations if imagemeta.rootaccess = 0, make sure the reservation user has root access ONLY IF the user is the image owner
		# The web frontend should not allow an image capture by anyone but the image owner if imagemeta.rootaccess = 0
		my $image_owner_id = $image_info->{ownerid};
		my $request_forimaging = $request_info->{forimaging};
		if ($request_forimaging && !$imagemeta_root_access) {
			my $image_name = $imagerevision_info->{imagename};
			my $image_owner_login_name = $image_info->{unityid};
			if ($user_id eq $image_owner_id) {
				notify($ERRORS{'OK'}, 0, "user $user_id is the owner of image $image_name, overriding imagemeta.rootaccess: $imagemeta_root_access --> 1");
				$request_info->{reservation}{$reservation_id}{users}{$user_id}{ROOTACCESS} = 1;
			}
			else {
				notify($ERRORS{'CRITICAL'}, 0, "capture attempted for image with root access disabled by a user other than the image owner\n" .
					"image: $image_name\n" .
					"imagemeta.rootaccess: $imagemeta_root_access\n" .
					"image owner ID: $image_owner_id\n" .
					"request user ID: $user_id"
				);
			}
		}
		
		# If server request or duration is greater >= 24 hrs disable user checks
		if ($request_info->{reservation}{$reservation_id}{serverrequest}{id}) {
			notify($ERRORS{'DEBUG'}, 0, "server request - disabling user checks");
			$request_info->{checkuser} = 0;
			$request_info->{reservation}{$reservation_id}{serverrequest}{ALLOW_USERS} = $request_info->{user}{unityid};
		}
		elsif ($request_info->{DURATION} >= (60 * 60 * 24)) {
			#notify($ERRORS{'DEBUG'}, 0, "request length > 24 hours, disabling user checks");
			$request_info->{checkuser} = 0;
		}
		
		$request_info->{reservation}{$reservation_id}{READY} = '0';
	}
	
	# Set some default non-database values for the entire request
	# All data ever added to the hash should be initialized here
	$request_info->{PID}              = $PID;
	$request_info->{PPID}             = getppid();
	$request_info->{PRELOADONLY}      = '0';
	$request_info->{CHECKTIME}        = '';
	$request_info->{NOTICEINTERVAL}   = '';
	$request_info->{RESERVATIONCOUNT} = scalar keys %{$request_info->{reservation}};
	$request_info->{UPDATED}          = '0';
	$request_info->{NOTICE_INTERVAL}  = '';
	
	if ($request_state_name eq 'image') {
		$request_info->{IMAGE_CAPTURE_TYPE} = 'Capture';
	}
	elsif ($request_state_name eq 'checkpoint') {
		$request_info->{IMAGE_CAPTURE_TYPE} = 'Checkpoint';
	}
	else {
		$request_info->{IMAGE_CAPTURE_TYPE} = '';
	}
	
	#notify($ERRORS{'DEBUG'}, 0, "retrieved request info:\n" . format_data($request_info));
	return $request_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2  get_request_log_info

 Parameters  : $request_id, $no_cache (optional)
 Returns     : hash reference
 Description : Retrieves data from the log and sublog tables for the request.
               A hash is constructed. Example:
               {
                 "computerid" => 3588,
                 "ending" => "none",
                 "finalend" => "0000-00-00 00:00:00",
                 "id" => 5354,
                 ...
                 "sublog" => {
                   74 => {
                     "IPaddress" => undef,
                     "blockEnd" => undef,
                     "blockRequestid" => undef,
                     "blockStart" => undef,
                     "computerid" => 3588,
                     "hostcomputerid" => undef,
                     "id" => 74,
                     "imageid" => 3081,
                     "imagerevisionid" => 9147,
                     "logid" => 5354,
                     "managementnodeid" => 8,
                     "predictivemoduleid" => 8
                   },
                   75 => {
                     "IPaddress" => undef,
                     ...
                   },
                 },
                 "userid" => 2870,
                 "wasavailable" => 0
               }

=cut

sub get_request_log_info {
	my ($request_id, $no_cache) = @_;
	if (!defined($request_id)) {
		notify($ERRORS{'WARNING'}, 0, "request ID argument was not specified");
		return;
	}
	
	if (!$no_cache && defined($ENV{log_info}{$request_id})) {
		return $ENV{log_info}{$request_id};
	}
	
	# Get a hash ref containing the database column names
	my $database_table_columns = get_database_table_columns();
	
	my %tables = (
		'log' => 'log',
		'sublog' => 'sublog',
	);
	
	# Construct the select statement
	my $select_statement = "SELECT DISTINCT\n";
	
	# Get the column names for each table and add them to the select statement
	for my $table_alias (keys %tables) {
		my $table_name = $tables{$table_alias};
		my @columns = @{$database_table_columns->{$table_name}};
		for my $column (@columns) {
			$select_statement .= "$table_alias.$column AS '$table_alias-$column',\n";
		}
	}
	
	# Remove the comma after the last column line
	$select_statement =~ s/,$//;
	
	# Complete the select statement
	$select_statement .= <<EOF;
FROM
request,
log,
sublog
WHERE
request.id = $request_id
AND log.id = request.logid
AND sublog.logid = log.id
EOF

	# Call the database select subroutine
	my @rows = database_select($select_statement);
	if (!@rows) {
		notify($ERRORS{'WARNING'}, 0, "log info for request $request_id could not be retrieved from the database, select statement:\n$select_statement");
		return;
	}

	# Build the hash
	my $log_info;

	for my $row (@rows) {
		my $sublog_id = $row->{'sublog-id'};
		if (!$sublog_id) {
			notify($ERRORS{'WARNING'}, 0, "failed to retrieve log info for request $request_id, row does not contain a 'sublog-id' value:\n" . format_data($row));
			return;
		}
		
		# Loop through all the columns returned
		for my $key (keys %$row) {
			my $value = $row->{$key};
			
			# Split the table-column names
			my ($table, $column) = $key =~ /^([^-]+)-(.+)/;
			
			if ($table eq 'log') {
				$log_info->{$column} = $value;
			}
			elsif ($table eq 'sublog') {
				$log_info->{$table}{$sublog_id}{$column} = $value;
			}
			else {
				$log_info->{$table}{$column} = $value;
			}
		}
	}
	
	$ENV{log_info}{$request_id} = $log_info;
	#notify($ERRORS{'DEBUG'}, 0, "retrieved log info for request $request_id:\n" . format_data($log_info));
	return $log_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 set_managementnode_state

 Parameters  : management node info, state
 Returns     : 1 or 0
 Description : sets a given management node to maintenance

=cut

sub set_managementnode_state {
	my ($mninfo, $state) = @_;

	if (!(defined($state))) {
		notify($ERRORS{'WARNING'}, 0, "state was not specified");
		return ();
	}
	if (!(defined($mninfo->{hostname}))) {
		notify($ERRORS{'WARNING'}, 0, "management node hostname was not specified");
		return ();
	}
	if (!(defined($mninfo->{id}))) {
		notify($ERRORS{'WARNING'}, 0, "management node ID was not specified");
		return ();
	}

	my $mn_ID = $mninfo->{id};
	my $mn_hostname = $mninfo->{hostname};

	# Construct the update statement
	my $update_statement = "
		UPDATE
		managementnode,
		state
		SET
		managementnode.stateid = state.id
		WHERE
		state.name = '$state' AND 
		managementnode.id = '$mn_ID'
	";


	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		# Update successful, return timestamp
		notify($ERRORS{'OK'}, 0, "Successfully updated management node $mn_hostname state to $state");
		return 1;
	}
	else {
		notify($ERRORS{'CRITICAL'}, 0, "unable to update database, management node $mn_hostname state to $state");
		return 0;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_management_node_requests

 Parameters  : $management_node_id
 Returns     : hash
 Description : gets request information for a particular management node

=cut


sub get_management_node_requests {
	my ($management_node_id) = @_;
	
	if (!(defined($management_node_id))) {
		notify($ERRORS{'WARNING'}, 0, "management node ID was not specified");
		return ();
	}

	my $select_statement = "
   SELECT DISTINCT

   request.id AS request_id,
   request.stateid AS request_stateid,
   request.laststateid AS request_laststateid,
   request.logid AS request_logid,
   request.start AS request_start,
   request.end AS request_end,
   request.daterequested AS request_daterequested,
   request.datemodified AS request_datemodified,
   request.preload AS request_preload,

   requeststate.name AS requeststate_name,

	requestlaststate.name AS requestlaststate_name,

   reservation.id AS reservation_id,
   reservation.requestid AS reservation_requestid,
   reservation.managementnodeid AS reservation_managementnodeid,
	reservation.lastcheck AS reservation_lastcheck,

	serverrequest.id AS serverrequest_serverrequestid,
	
	MAX(changelog.timestamp) AS changelog_timestamp

   FROM
   request
	LEFT JOIN (serverrequest) ON (serverrequest.requestid = request.id)
	LEFT JOIN (log, changelog) ON (request.logid = log.id AND changelog.logid = log.id AND changelog.remoteIP IS NOT NULL),
   reservation,
	state requeststate,
   state requestlaststate

   WHERE
   reservation.managementnodeid = $management_node_id
   AND reservation.requestid = request.id
   AND requeststate.id = request.stateid
	AND requestlaststate.id = request.laststateid

   GROUP BY
   reservation.id
   ";

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);
	
	# Build the hash
	my $requests = {};

	for (@selected_rows) {
		my %reservation_row = %{$_};

		# Grab the request and reservation IDs to make the code a little cleaner
		my $request_id     = $reservation_row{request_id};
		my $reservation_id = $reservation_row{reservation_id};

		# Loop through all the columns returned for the reservation
		foreach my $key (keys %reservation_row) {
			my $value = $reservation_row{$key};
			
			# Create another variable by stripping off the column_ part of each key
			# This variable stores the original (correct) column name
			(my $original_key = $key) =~ s/^.+_//;
			
			if ($key =~ /^request_/) {
				# Set the top-level key if not already set
				$requests->{$request_id}{$original_key} = $value if (!$requests->{$request_id}{$original_key});
			}
			elsif ($key =~ /requeststate_/) {
				$requests->{$request_id}{state}{$original_key} = $value if (!$requests->{$request_id}{state}{$original_key});
			}
			elsif ($key =~ /requestlaststate_/) {
				$requests->{$request_id}{laststate}{$original_key} = $value if (!$requests->{$request_id}{laststate}{$original_key});
			}
			elsif ($key =~ /reservation_/) {
				$requests->{$request_id}{reservation}{$reservation_id}{$original_key} = $value;
			}
			elsif ($key =~ /serverrequest_/) {
				$requests->{$request_id}{reservation}{$reservation_id}{$original_key} = $value;
			}
			elsif ($key =~ /changelog_/) {
				$requests->{$request_id}{log}{changelog}{$original_key} = $value;
			}
			else {
				notify($ERRORS{'WARNING'}, 0, "unknown key found in SQL data: $key");
			}
		}    # Close foreach key in reservation row
	}    # Close loop through selected rows
	
	#notify($ERRORS{'DEBUG'}, 0, "retrieved management node requests:\n" . format_data($requests));
	return $requests;
} ## end sub get_management_node_requests


#//////////////////////////////////////////////////////////////////////////////

=head2  get_image_info

 Parameters  : $image_identifier, $no_cache (optional), $ignore_error (optional)
 Returns     : hash reference
 Description : Retrieves info for the image specified by the argument. The
               argument can either be the image ID or image name.

=cut


sub get_image_info {
	my ($image_identifier, $no_cache, $ignore_error) = @_;
	if (!defined($image_identifier)) {
		notify($ERRORS{'WARNING'}, 0, "image identifier argument was not specified");
		return;
	}
	
	# Check if cached image info exists
	if (!$no_cache && defined($ENV{image_info}{$image_identifier})) {
		# Check the time the info was last retrieved
		my $data_age_seconds = (time - $ENV{image_info}{$image_identifier}{RETRIEVAL_TIME});
		if ($data_age_seconds < 600) {
			return $ENV{image_info}{$image_identifier};
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "retrieving current image info for '$image_identifier' from database, cached data is stale: $data_age_seconds seconds old");
		}
	}
	
	# Get a hash ref containing the database column names
	my $database_table_columns = get_database_table_columns();
	
	my @tables = (
		'image',
		'platform',
		'OS',
		'OStype',
		'imagetype',
		'module',
	);
	
	# Construct the select statement
	my $select_statement = "SELECT DISTINCT\n";
	
	# Get the column names for each table and add them to the select statement
	for my $table (@tables) {
		my @columns = @{$database_table_columns->{$table}};
		for my $column (@columns) {
			$select_statement .= "$table.$column AS '$table-$column',\n";
		}
	}
	
	# Remove the comma after the last column line
	$select_statement =~ s/,$//;
	
	# Complete the select statement
	$select_statement .= <<EOF;
FROM
image,
platform,
OS,
OStype,
imagetype,
module

WHERE
platform.id = image.platformid
AND OS.id = image.OSid
AND OS.type = OStype.name
AND image.imagetypeid = imagetype.id
AND module.id = OS.moduleid
AND 
EOF
	
	if ($image_identifier =~ /^\d+$/) {
		$select_statement .= "image.id = $image_identifier";
	}
	else {
		$image_identifier =~ s/(-v)\d+$/$1/g;
		$select_statement .= "image.name LIKE '$image_identifier\%'";
	}
	
	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (scalar @selected_rows == 0) {
		if ($ignore_error) {
			notify($ERRORS{'DEBUG'}, 0, "image does NOT exist in the database: $image_identifier");
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select statement:\n$select_statement");
		}
		return;
	}
	elsif (scalar @selected_rows > 1) {
		notify($ERRORS{'WARNING'}, 0, scalar @selected_rows . " rows were returned from database select statement:\n$select_statement");
		return;
	}

	# Get the single row returned from the select statement
	my $row = $selected_rows[0];
	
	# Construct a hash with all of the image info
	my $image_info;
	
	# Loop through all the columns returned
	for my $key (keys %$row) {
		my $value = $row->{$key};
		
		# Split the table-column names
		my ($table, $column) = $key =~ /^([^-]+)-(.+)/;
		
		# Add the values for the primary table to the hash
		# Add values for other tables under separate keys
		if ($table eq $tables[0]) {
			$image_info->{$column} = $value;
		}
		elsif ($table =~ /^(module|OStype)$/) {
			$image_info->{OS}{$table}{$column} = $value;
		}
		else {
			$image_info->{$table}{$column} = $value;
		}
	}
	
	# Retrieve the imagemeta info and add it to the hash
	my $imagemeta_id = $image_info->{imagemetaid};
	my $imagemeta_info = get_imagemeta_info($imagemeta_id);
	$image_info->{imagemeta} = $imagemeta_info;

	my $image_owner_id = $image_info->{ownerid};
	my $image_owner_user_info = get_user_info($image_owner_id);
	$image_info->{owner} = $image_owner_user_info;
	
	# TODO: Get rid of the IDENTITY key, it shouldn't be used anymore
	my $management_node_info = get_management_node_info();
	if ($management_node_info) {
		$image_info->{IDENTITY} = $management_node_info->{keys};
	}
	
	# Retrieve AD info if configured for the image
	my $image_id = $image_info->{id};
	my $domain_info = get_image_active_directory_domain_info($image_id, $no_cache);
	$image_info->{imagedomain} = $domain_info;
	
	#notify($ERRORS{'DEBUG'}, 0, "retrieved info for image '$image_identifier':\n" . format_data($image_info));
	$ENV{image_info}{$image_identifier} = $image_info;
	$ENV{image_info}{$image_identifier}{RETRIEVAL_TIME} = time;
	return $ENV{image_info}{$image_identifier};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_imagerevision_info

 Parameters  : $imagerevision_identifier, $no_cache (optional)
 Returns     : Hash reference
 Description : collects data from database on supplied $imagerevision_id

=cut

sub get_imagerevision_info {
	my ($imagerevision_identifier, $no_cache) = @_;
	if (!defined($imagerevision_identifier)) {
		notify($ERRORS{'WARNING'}, 0, "imagerevision identifier argument was not specified");
		return;
	}
	
	# Check if cached imagerevision info exists
	if (!$no_cache && defined($ENV{imagerevision_info}{$imagerevision_identifier})) {
		# Check the time the info was last retrieved
		my $data_age_seconds = (time - $ENV{imagerevision_info}{$imagerevision_identifier}{RETRIEVAL_TIME});
		if ($data_age_seconds < 600) {
			return $ENV{imagerevision_info}{$imagerevision_identifier};
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "retrieving current imagerevision info for '$imagerevision_identifier' from database, cached data is stale: $data_age_seconds seconds old");
		}
	}

	my $select_statement = <<EOF;
SELECT
imagerevision.*
FROM
imagerevision
WHERE
EOF

	# Check input value - complete select_statement
	if ($imagerevision_identifier =~ /^\d/) {
		$select_statement .= "imagerevision.id = '$imagerevision_identifier'";
	}
	else {
		$select_statement .= "imagerevision.imagename = \'$imagerevision_identifier\'";
	}

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (!@selected_rows) {
		notify($ERRORS{'WARNING'}, 0, "imagerevision '$imagerevision_identifier' was not found in the database, 0 rows were returned from database select statement:\n$select_statement");
		return;
	}
	elsif (scalar @selected_rows > 1) {
		notify($ERRORS{'WARNING'}, 0, scalar @selected_rows . " rows were returned from database select statement:\n$select_statement");
		return;
	}
	
	my $imagerevision_info = $selected_rows[0];
	
	# Retrieve the image info
	my $imagerevision_image_id = $imagerevision_info->{imageid};
	my $imagerevision_image_info = get_image_info($imagerevision_image_id);
	if (!$imagerevision_image_info) {
		notify($ERRORS{'WARNING'}, 0, "failed to retrieve imagerevision info, image info could not be retrieved for image ID: $imagerevision_image_id");
		return;
	}
	$imagerevision_info->{image} = $imagerevision_image_info;
	
	# Retrieve the imagerevision user info
	$imagerevision_info->{user} = get_user_info($imagerevision_info->{userid});
	
	# Add the info to %ENV so it doesn't need to be retrieved from the database again
	$ENV{imagerevision_info}{$imagerevision_identifier} = $imagerevision_info;
	$ENV{imagerevision_info}{$imagerevision_identifier}{RETRIEVAL_TIME} = time;
	#notify($ERRORS{'DEBUG'}, 0, "retrieved info from database for imagerevision '$imagerevision_identifier':\n" . format_data($ENV{imagerevision_info}{$imagerevision_identifier}));
	return $ENV{imagerevision_info}{$imagerevision_identifier};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_production_imagerevision_info

 Parameters  : $image_id, $no_cache (optional)
 Returns     : Hash containing imagerevision data for the production revision of an image
 Description :

=cut


sub get_production_imagerevision_info {
	my ($image_identifier, $no_cache) = @_;

	# Check the passed parameter
	if (!defined($image_identifier)) {
		notify($ERRORS{'WARNING'}, 0, "imagerevision identifier argument was not specified");
		return;
	}
	
	return $ENV{production_imagerevision_info}{$image_identifier} if (!$no_cache && $ENV{production_imagerevision_info}{$image_identifier});
	
	my $select_statement = <<EOF;
SELECT
id
FROM
imagerevision
WHERE
imagerevision.production = '1'
AND 
EOF

	# Check input value - complete select_statement
	if ($image_identifier =~ /^\d/) {
		$select_statement .= "imagerevision.imageid = '$image_identifier'";
	}
	else {
		# Assume $image_identifier is the image name, strip off '-v*' from the end
		# Otherwise query may fail if production version is not the exact revision passed as the argument
		$image_identifier =~ s/-v\d+$/-v%/;
		$select_statement .= "imagerevision.imagename LIKE \'$image_identifier\'";
	}

	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (!@selected_rows) {
		notify($ERRORS{'WARNING'}, 0, "production imagerevision for image '$image_identifier' was not found in the database, 0 rows were returned, select statement:\n$select_statement");
		return;
	}
	elsif (scalar @selected_rows > 1) {
		notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select statement:\n$select_statement");
		return;
	}
	
	my $imagerevision_id = $selected_rows[0]{id};
	
	my $imagerevision_info = get_imagerevision_info($imagerevision_id);
	
	my $image_name = $imagerevision_info->{imagename};
	$ENV{production_imagerevision_info}{$image_identifier} = $imagerevision_info;
	notify($ERRORS{'DEBUG'}, 0, "retrieved info from database for production revision for image identifier '$image_identifier', production image: '$image_name'");
	return $ENV{production_imagerevision_info}{$image_identifier};
	
} ## end sub get_production_imagerevision_info

#//////////////////////////////////////////////////////////////////////////////

=head2 set_production_imagerevision

 Parameters  : $imagerevision_id
 Returns     : boolean
 Description : Sets the production flag to 1 for the image revision specified by
               the argument. Sets production to 0 for all other revisions of the
               image. Sets image.name to imagerevision.imagename of the
               production revision. Sets the image.test flag to 0.
 
=cut

sub set_production_imagerevision {
	my ($imagerevision_id) = @_;
	if (!defined($imagerevision_id)) {
		notify($ERRORS{'WARNING'}, 0, "imagerevision ID argument was not supplied");
		return;
	}
	
	# Delete cached data
	delete $ENV{production_imagerevision_info};
	
	my $sql_statement = <<EOF;
UPDATE
image,
imagerevision imagerevision_production,
imagerevision imagerevision_others
SET
image.name = imagerevision_production.imagename,
image.test = 0,
image.lastupdate = NOW(),
imagerevision_production.production = 1,
imagerevision_others.production = 0
WHERE
imagerevision_production.id = $imagerevision_id
AND imagerevision_production.imageid = image.id
AND imagerevision_others.imageid = imagerevision_production.imageid
AND imagerevision_others.id != imagerevision_production.id
EOF
	
	# Call the database execute subroutine
	if (database_execute($sql_statement)) {
		notify($ERRORS{'OK'}, 0, "imagerevision $imagerevision_id set to production");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to set imagerevision $imagerevision_id to production");
		return 0;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_imagemeta_info

 Parameters  : $imagemeta_id, $no_cache (optional)
 Returns     : Hash reference
 Description :

=cut


sub get_imagemeta_info {
	my ($imagemeta_id, $no_cache) = @_;
	
	my $default_imagemeta_info = get_default_imagemeta_info();
	
	# Return defaults if nothing was passed as the imagemeta id
	if (!$imagemeta_id) {
		return $default_imagemeta_info;
	}
	
	if (!$no_cache && $ENV{imagemeta_info}{$imagemeta_id}) {
		return $ENV{imagemeta_info}{$imagemeta_id};
	}
	
	# If imagemetaid isnt' NULL, perform another query to get the meta info
	my $select_statement = <<EOF;
SELECT
imagemeta.*
FROM
imagemeta
WHERE
imagemeta.id = '$imagemeta_id'
EOF

	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);
	
	# Check to make sure 1 row was returned
	if (!@selected_rows || scalar @selected_rows > 1) {
		$ENV{imagemeta_info}{$imagemeta_id} = $default_imagemeta_info;
		
		notify($ERRORS{'WARNING'}, 0, "failed to retrieve imagemeta ID=$imagemeta_id, returning default imagemeta values");
		return $ENV{imagemeta_info}{$imagemeta_id};
	}

	# Get the single row returned from the select statement
	my $imagemeta_info = $selected_rows[0];
	
	for my $column (keys %$imagemeta_info) {
		if (!defined($imagemeta_info->{$column})) {
			$imagemeta_info->{$column} = $default_imagemeta_info->{$column};
		}
	}
	
	notify($ERRORS{'DEBUG'}, 0, "retrieved imagemeta info:\n" . format_data($imagemeta_info));
	$ENV{imagemeta_info}{$imagemeta_id} = $imagemeta_info;
	return $ENV{imagemeta_info}{$imagemeta_id};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_default_imagemeta_info

 Parameters  : 
 Returns     : Hash reference
 Description :

=cut


sub get_default_imagemeta_info {
	if ($ENV{imagemeta_info}{default}) {
		# Create a copy to ensure that the correct default data is returned
		# Other processes may use the same cached copy
		# If the same reference is returned for multiple processes, one process may alter the data
		my %default_imagemeta_info = %{$ENV{imagemeta_info}{default}};
		return \%default_imagemeta_info;
	}
	
	# Call the database select subroutine to retrieve the imagemeta table structure
	my $describe_imagemeta_statement = "DESCRIBE imagemeta";
	my @describe_imagemeta_rows = database_select($describe_imagemeta_statement);
	if (!@describe_imagemeta_rows) {
		notify($ERRORS{'WARNING'}, 0, "failed to retrieve imagemeta table structure, SQL statement:\n$describe_imagemeta_statement");
		return;
	}
	
	my $default_imagemeta_info;
	for my $describe_imagemeta_row (@describe_imagemeta_rows) {
		my $field = $describe_imagemeta_row->{Field};
		my $default_value = $describe_imagemeta_row->{Default};
		if (defined($default_value)) {
			$default_imagemeta_info->{$field} = $default_value;
		}
		else {
			$default_imagemeta_info->{$field} = '';
		}
	}
	
	$ENV{imagemeta_info}{default} = $default_imagemeta_info;
	
	my %default_imagemeta_info_copy = %{$ENV{imagemeta_info}{default}};
	#notify($ERRORS{'DEBUG'}, 0, "retrieved default imagemeta info:\n" . format_data(\%default_imagemeta_info_copy));
	return \%default_imagemeta_info_copy;
}


#//////////////////////////////////////////////////////////////////////////////

=head2  get_vmhost_info

 Parameters  : $vmhost_identifier, $no_cache (optional)
 Returns     : hash reference
 Description : Retrieves info from the database for the vmhost, vmprofile, and
               repository and datastore imagetypes. The $vmhost_identifier
               argument may be used to match vmhost.id, vmprofile.profilename,
               or computer.hostname.

=cut


sub get_vmhost_info {
	my ($vmhost_identifier, $no_cache) = @_;
	
	# Check the passed parameter
	if (!defined($vmhost_identifier)) {
		notify($ERRORS{'WARNING'}, 0, "VM host identifier argument was not specified");
		return;
	}
	
	return $ENV{vmhost_info}{$vmhost_identifier} if (!$no_cache && $ENV{vmhost_info}{$vmhost_identifier});
	
	my $management_node_id = get_management_node_id();
	
	# Get a hash ref containing the database column names
	my $database_table_columns = get_database_table_columns();
	
	my %tables = (
		'vmhost' => 'vmhost',
		'vmprofile' => 'vmprofile',
		'repositoryimagetype' => 'imagetype',
		'datastoreimagetype' => 'imagetype',
		'cryptsecret' => 'cryptsecret',
	);
	
	# Construct the select statement
	my $select_statement = "SELECT\n";
	
	# Get the column names for each table and add them to the select statement
	for my $table_alias (keys %tables) {
		my $table_name = $tables{$table_alias};
		my @columns = @{$database_table_columns->{$table_name}};
		for my $column (@columns) {
			$select_statement .= "$table_alias.$column AS '$table_alias-$column',\n";
		}
	}

	# Remove the comma after the last column line
	$select_statement =~ s/,$//;
	
	# Complete the select statement
	$select_statement .= <<EOF;
FROM
vmhost,
vmprofile
LEFT JOIN (cryptsecret, cryptkey) ON (
	vmprofile.secretid = cryptsecret.secretid AND
	cryptsecret.cryptkeyid = cryptkey.id AND
	cryptkey.hosttype = 'managementnode' AND
	cryptkey.hostid = $management_node_id
),
imagetype repositoryimagetype,
imagetype datastoreimagetype,
computer

WHERE
vmprofile.id = vmhost.vmprofileid
AND vmprofile.repositoryimagetypeid = repositoryimagetype.id
AND vmprofile.datastoreimagetypeid = datastoreimagetype.id
AND vmhost.computerid = computer.id
AND 
EOF
	
	if ($vmhost_identifier =~ /^\d+$/) {
		$select_statement .= "vmhost.id = '$vmhost_identifier'\n";
	}
	else {
		$select_statement .= "(\n";
		$select_statement .= "   computer.hostname REGEXP '$vmhost_identifier(\\\\.|\$)'\n";
		$select_statement .= "   OR vmprofile.profilename = '$vmhost_identifier'\n";
		$select_statement .= ")";
	}
	
	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (scalar @selected_rows == 0) {
		notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select statement:\n$select_statement");
		return;
	}
	
	my $row;
	if (scalar @selected_rows > 1) {
		my $vmhost_string;
		for my $selected_row (@selected_rows) {
			# Check if the vmprofile.profilename exactly matches the VM host identifier argument
			if ($selected_row->{'vmprofile-profilename'} eq $vmhost_identifier) {
				$row = $selected_row;
				last;
			}
			$vmhost_string .= "VM host ID: " . $selected_row->{'vmhost-id'};
			$vmhost_string .= ", computer ID: " . $selected_row->{'vmhost-computerid'};
			$vmhost_string .= ", VM profile ID: " . $selected_row->{'vmprofile-id'};
			$vmhost_string .= ", VM profile name: " . $selected_row->{'vmprofile-profilename'};
			$vmhost_string .= "\n";
		}
		if (!$row) {
			notify($ERRORS{'WARNING'}, 0, "unable to determine VM host from ambiguous argument: $vmhost_identifier, " . scalar @selected_rows . " rows were returned from database select statement:\n$select_statement\nrows:\n$vmhost_string");
			return;
		}
	}
	else {
		# Get the single row returned from the select statement
		$row = $selected_rows[0];
	}
	
	# Construct a hash with all of the vmhost info
	my $vmhost_info;
	
	# Loop through all the columns returned
	for my $key (keys %$row) {
		my $value = $row->{$key};
		
		# Split the table-column names
		my ($table, $column) = $key =~ /^([^-]+)-(.+)/;
		
		# Add the values for the vmhost table to the hash
		# Add values for other tables under separate keys
		if ($table eq 'vmhost') {
			$vmhost_info->{$column} = $value;
		}
		elsif ($table eq 'cryptsecret') {
			$vmhost_info->{vmprofile}{$table}{$column} = $value;
		}
		else {
			$vmhost_info->{$table}{$column} = $value;
		}
	}
	
	# Get the vmhost computer info and add it to the hash
	my $computer_id = $vmhost_info->{computerid};
	my $computer_info = get_computer_info($computer_id, $no_cache);
	if ($computer_info) {
		$vmhost_info->{computer} = $computer_info;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "unable to retrieve vmhost computer info, computer ID: $computer_id");
	}
	
	# Get the vmprofile image info and add it to the hash
	my $vmprofile_image_identifier = $vmhost_info->{vmprofile}{imageid};
	$vmprofile_image_identifier = 'noimage' if !$vmprofile_image_identifier;
	my $vmprofile_image_info = get_image_info($vmprofile_image_identifier);
	if ($vmprofile_image_info) {
		$vmhost_info->{vmprofile}{image} = $vmprofile_image_info;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "unable to retrieve vmprofile image info, image identifier: $vmprofile_image_identifier");
	}
	
	$vmhost_info->{vmprofile}{username} = '' if !$vmhost_info->{vmprofile}{username};
	$vmhost_info->{vmprofile}{password} = '' if !$vmhost_info->{vmprofile}{password};
	
	# Decrypt the vmhost password
	if ($vmhost_info->{vmprofile}{rsakey} && -f $vmhost_info->{vmprofile}{rsakey} && $vmhost_info->{vmprofile}{encryptedpasswd}) {
		# Read the private keyfile into a string
        local $/ = undef;
        open FH, $vmhost_info->{vmprofile}{rsakey} or
                notify($ERRORS{'WARNING'}, 0, "Could not read private keyfile (" . $vmhost_info->{vmprofile}{rsakey} . "): $!");
        my $key = <FH>;
        close FH;
		if ($key) {
			my $encrypted = $vmhost_info->{vmprofile}{encryptedpasswd};
			my $rsa = Crypt::OpenSSL::RSA->new_private_key($key);
			# Croak on an invalid key
			$rsa->check_key;
			# Use the same padding algorithm as the PHP code
			$rsa->use_pkcs1_oaep_padding;
			# Convert password from hex to binary, decrypt
			# and store in the vmprofile.password field
			$vmhost_info->{vmprofile}{password} = $rsa->decrypt(pack("H*", $encrypted));
			notify($ERRORS{'DEBUG'}, 0, "decrypted vmprofile password with key: " . $vmhost_info->{vmprofile}{rsakey});
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "unable to decrypt vmprofile password");    
		}
	}
	# Clean up the extraneous data
	delete $vmhost_info->{vmprofile}{rsakey};
	delete $vmhost_info->{vmprofile}{encryptedpassword};
	
	$vmhost_info->{vmprofile}{vmpath} = $vmhost_info->{vmprofile}{datastorepath} if !$vmhost_info->{vmprofile}{vmpath};
	$vmhost_info->{vmprofile}{virtualdiskpath} = $vmhost_info->{vmprofile}{vmpath} if !$vmhost_info->{vmprofile}{virtualdiskpath};
	
	my $vmhost_id = $vmhost_info->{id};
	
	notify($ERRORS{'DEBUG'}, 0, "retrieved VM host $vmhost_identifier info, VM host ID: $vmhost_id, computer: $vmhost_info->{computer}{hostname}, computer ID: $vmhost_info->{computer}{id}");
	$ENV{vmhost_info}{$vmhost_identifier} = $vmhost_info;
	
	
	if ($vmhost_identifier ne $vmhost_id) {
		$ENV{vmhost_info}{$vmhost_id} = $vmhost_info;
	}
	
	return $ENV{vmhost_info}{$vmhost_identifier};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 run_ssh_command

 Parameters  : $node, $identity_path, $command, $user, $port, $output_level, $timeout_seconds
               -or-
               Hash reference with the following keys:
                  node - node name (required)
                  command - command to be executed remotely (required)
                  identity_paths - string containing paths to identity key files separated by commas (optional)
                  user - user to run remote command as (optional, default is 'root')
                  port - SSH port number (optional, default is 22)
                  output_level - allows the amount of output to be controlled: 0, 1, or 2 (optional)
                  max_attempts - maximum number of SSH attempts to make
                  timeout_seconds - maximum number seconds SSH process can run before being terminated
 Returns     : If successful: array:
                  $array[0] = the exit status of the command
                  $array[1] = reference to array containing lines of output
               If failed: false
 Description : Runs an SSH command on the specified node.

=cut

sub run_ssh_command {
	my ($node, $identity_paths, $command, $user, $port, $output_level, $timeout_seconds) = @_;
	
	my $max_attempts = 3;
	
	if (ref($_[0]) eq 'HASH') {
		my $arguments = shift;
		
		$node = $arguments->{node};
		$command = $arguments->{command};
		$identity_paths = $arguments->{identity_paths} || '';
		$user = $arguments->{user} || 'root';
		$port = $arguments->{port} || '22';
		$output_level = $arguments->{output_level};
		$max_attempts = $arguments->{max_attempts} || 3;
		$timeout_seconds = $arguments->{timeout_seconds};
	}
	
	# Determine the output level if it was specified
	# Set $output_level to 0, 1, or 2
	if (!defined($output_level)) {
		$output_level = 2;
	}
	elsif ($output_level =~ /0|none/i) {
		$output_level = 0;
	}
	elsif ($output_level =~ /1|min/i) {
		$output_level = 1;
	}
	else {
		$output_level = 2;
	}
	
	# Check the arguments
	if (!defined($node) || !$node) {
		notify($ERRORS{'WARNING'}, 0, "computer node was not specified");
		return 0;
	}
	if (!defined($command) || !$command) {
		notify($ERRORS{'WARNING'}, 0, "command was not specified");
		return 0;
	}

	# Set default values if not passed as an argument
	$user = "root" if (!$user);
	$port = 22 if (!$port);
	$timeout_seconds = 0 if (!$timeout_seconds);
	
	if (!defined $identity_paths || length($identity_paths) == 0) {
		my $management_node_info = get_management_node_info();
		$identity_paths = $management_node_info->{keys}
	}
	
	# TESTING: use the new subroutine if $ENV{execute_new} is set and the command isn't one that's known to fail with the new subroutine
	my $calling_subroutine = get_calling_subroutine();
	if ($calling_subroutine && $calling_subroutine !~ /execute/) {
		if ($ENV{execute_new} && $command !~ /(vmkfstools|qemu-img|Convert-VHD|scp|reboot|shutdown)/) {
			return VCL::Module::OS::execute_new($node, $command, $output_level, $timeout_seconds, $max_attempts, $port, $user, '', $identity_paths);
		}
	}
	
	# Locate the path to the ssh binary
	my $ssh_path;
	if (-f '/usr/bin/ssh') {
		$ssh_path = '/usr/bin/ssh';
	}
	elsif (-f 'C:/cygwin/bin/ssh.exe') {
		$ssh_path = 'C:/cygwin/bin/ssh.exe';
	}
	elsif (-f 'D:/cygwin/bin/ssh.exe') {
		$ssh_path = 'D:/cygwin/bin/ssh.exe';
	}
	elsif (-f 'C:/cygwin64/bin/ssh.exe') {
		$ssh_path = 'C:/cygwin64/bin/ssh.exe';
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "unable to locate the SSH executable in the usual places");
		return 0;
	}
	
	# Format the identity path string
	if (defined $identity_paths && length($identity_paths) > 0) {
		# Add -i to beginning of string
		$identity_paths = "-i $identity_paths";
		
		# Split string on commas, add -i to each value after a comma
		$identity_paths =~ s/\s*,\s*/ -i /g;
		
		# Add a space to the end of the string
		$identity_paths .= ' ';
	}
	else {
		$identity_paths = '';
	}

	#notify($ERRORS{'DEBUG'}, 0, "ssh path: $ssh_path");
	#notify($ERRORS{'DEBUG'}, 0, "node: $node, identity file paths: $identity_paths, user: $user, port: $port");
	#notify($ERRORS{'DEBUG'}, 0, "command: $command");
	
	#if ($command =~ /['\\]/) {
	#	my @octals = map { "0" . sprintf("%o", $_) } unpack("C*", $command);
	#	my $octal_string = '\\' . join("\\", @octals);
	#	$command = "echo -e \"$octal_string\" | \$SHELL";
	#	notify($ERRORS{'DEBUG'}, 0, "octal command:\n$command");
	#}
	
	# Determine which string to use as the connection target
	my $remote_connection_target = determine_remote_connection_target($node);
	my $node_string = $remote_connection_target;
	$node_string .= " ($node)" if ($node ne $remote_connection_target);
	
	# Command argument is enclosed in single quotes in ssh command
	# Single quotes contained within the command argument won't work without splitting it up
	# Argument:
	#   echo 'foo bar' > file
	# Enclosed in single quotes
	#    'echo 'foo bar' > file'   <-- won't work
	# For each single quote in the argument, split the command by adding single quotes before and after
	# Enclose the original single quote in double quotes
	#    'echo '"'"'foo bar'"'"' > file'
	if ($command =~ /'/) {
		my $original_command = $command;
		$command =~ s/'/'"'"'/g;
		notify($ERRORS{'DEBUG'}, 0, "command argument contains single quotes, enclosed all single quotes in double quotes:\n" .
			"original command: '$original_command'\n" .
			"modified command: '$command'"
		);
	}
	
	# Assemble the SSH command
	# -i <identity_file>, Selects the file from which the identity (private key) for RSA authentication is read.
	# -l <login_name>, Specifies the user to log in as on the remote machine.
	# -p <port>, Port to connect to on the remote host.
	# -x, Disables X11 forwarding.
	# Dont use: -q, Quiet mode.  Causes all warning and diagnostic messages to be suppressed.
	my $ssh_command = "$ssh_path $identity_paths ";
	$ssh_command .= "-o StrictHostKeyChecking=no ";
	$ssh_command .= "-o UserKnownHostsFile=/dev/null ";
	$ssh_command .= "-o ConnectionAttempts=1 ";
	$ssh_command .= "-o ConnectTimeout=30 ";
	$ssh_command .= "-o BatchMode=no ";
	$ssh_command .= "-o PasswordAuthentication=no ";
	$ssh_command .= "-l $user ";
	$ssh_command .= "-p $port ";
	$ssh_command .= "-x ";
	$ssh_command .= "$remote_connection_target '$command' 2>&1";
	
	# Truncate command shown in vcld.log if it is very long
	my $max_command_output_length = 3000;
	my $beginning_characters_shown = 500;
	my $ending_characters_shown = 200;
	
	my $command_length = length($command);
	my $command_summary;
	my $command_chars_suppressed = ($command_length - $beginning_characters_shown - $ending_characters_shown - $max_command_output_length);
	if ($command_chars_suppressed > 0) {
		$command_summary = substr($command, 0, $beginning_characters_shown) . "<$command_chars_suppressed characters omitted>" . substr($command, -$ending_characters_shown);
	}
	else {
		$command_summary = $command;
	}
	
	my $ssh_command_length = length($ssh_command);
	my $ssh_command_summary;
	my $ssh_command_chars_suppressed = ($ssh_command_length - $beginning_characters_shown - $ending_characters_shown - $max_command_output_length);
	if ($ssh_command_chars_suppressed > 0) {
		$ssh_command_summary = substr($ssh_command, 0, $beginning_characters_shown) . "<$ssh_command_chars_suppressed characters omitted>" . substr($ssh_command, -$ending_characters_shown);
	}
	else {
		$ssh_command_summary = $ssh_command;
	}
	
	# Execute the command
	my $ssh_output = '';
	my $ssh_output_formatted = '';
	my $attempts = 0;
	my $exit_status = 255;
	
	my $banner_exchange_error_count = 0;
	my $banner_exchange_error_limit = 3;
	
	# Make multiple attempts if failure occurs
	while ($attempts < $max_attempts) {
		$attempts++;
		
		# Delay performing next attempt if this isn't the first attempt
		if ($attempts > 1) {
			my $delay_seconds = (2 * ($attempts - 1));
			notify($ERRORS{'DEBUG'}, 0, "sleeping for $delay_seconds seconds before making next SSH attempt") if $output_level;
			sleep $delay_seconds;
		}
		
		## Add -v (verbose) argument to command if this is the 2nd attempt
		#$ssh_command =~ s/$ssh_path/$ssh_path -v/ if $attempts == 2;
		
		# Print the SSH command, only display the attempt # if > 1
		if ($attempts == 1) {
			notify($ERRORS{'DEBUG'}, 0, "executing SSH command on $node_string: '$ssh_command_summary'") if $output_level;
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "attempt $attempts/$max_attempts: executing SSH command on $node_string: '$ssh_command_summary'") if $output_level;
		}
		
		# Enclose SSH command in an eval block and use alarm to eventually timeout the SSH command if it hangs
		my $start_time = time;
		eval {
			# Override the die and alarm handlers
			local $SIG{__DIE__} = sub{};
			
			local $SIG{__WARN__} = sub{
				my $warning_message = shift || '';
				notify($ERRORS{'WARNING'}, 0, "attempt $attempts/$max_attempts: warning was generated attempting to run SSH command on $node_string, command length: $ssh_command_length, warning message: $warning_message\nSSH command:\n$ssh_command_summary");
			};
			
			local $SIG{ALRM} = sub { die "alarm\n" };
			
			if ($timeout_seconds) {
				notify($ERRORS{'DEBUG'}, 0, "waiting up to $timeout_seconds seconds for SSH process to finish") if $output_level;
				alarm $timeout_seconds;
			}
			
			# Execute the command
			$ssh_output = `$ssh_command`;
			
			# Save the exit status
			$exit_status = $? >> 8;
			
			# Ignore the returned value of $? if it is -1
			# This likely means a Perl bug was encountered
			# Assume command was successful
			if ($? == -1) {
				notify($ERRORS{'DEBUG'}, 0, "exit status changed from $exit_status to 0, Perl bug likely encountered") if $output_level;
				$exit_status = 0;
			}
			
			if ($timeout_seconds) {
				# Cancel the timer
				alarm 0;
			}
		};
		
		my $duration = (time - $start_time);
		
		# Check if the timeout was reached
		if ($EVAL_ERROR && $EVAL_ERROR eq "alarm\n") {
			# Kill the child processes of this reservation process
			kill_child_processes($PID);
			
			if ($command =~ /testing/) {
				notify($ERRORS{'DEBUG'}, 0, "attempt $attempts/$max_attempts: SSH command timed out after $duration seconds, timeout threshold: $timeout_seconds seconds, command: $node_string:\n$ssh_command");
				return;
			}
			elsif ($max_attempts == 1 || $attempts < $max_attempts) {
				notify($ERRORS{'WARNING'}, 0, "attempt $attempts/$max_attempts: SSH command timed out after $duration seconds, timeout threshold: $timeout_seconds seconds, command: $node_string:\n$ssh_command");
			}
			else {
				notify($ERRORS{'CRITICAL'}, 0, "attempt $attempts/$max_attempts: SSH command timed out after $duration seconds, timeout threshold: $timeout_seconds seconds, command: $node_string:\n$ssh_command");
				return;
			}
			next;
		}
		elsif ($EVAL_ERROR) {
			notify($ERRORS{'CRITICAL'}, 0, "attempt $attempts/$max_attempts: eval error was generated attempting to run SSH command: $node_string:\n$ssh_command_summary, eval error: $EVAL_ERROR");
			next;
		}
		elsif (!defined($ssh_output)) {
			notify($ERRORS{'WARNING'}, 0, "attempt $attempts/$max_attempts: SSH output is not defined after attempting to run SSH command: $node_string:\n$ssh_command_summary, command length: $ssh_command_length");
			next;
		}
		
		# Strip out the key warning message from the output
		$ssh_output =~ s/\@{10,}.*man-in-the-middle attacks\.//igs;
		
		# Strip out known SSH warning messages
		#    Warning: Permanently added 'blade1b2-8' (RSA) to the list of known hosts.
		# 
		#    Warning: the RSA host key for 'vi1-62' differs from the key for the IP address '10.25.7.62'
		#    Offending key for IP in /root/.ssh/known_hosts:264
		#    Matching host key in /root/.ssh/known_hosts:3977
		#    Address x.x.x.x maps to y.y.org, but this does not map back to the address - POSSIBLE BREAK-IN ATTEMPT!
		$ssh_output =~ s/^(Warning:.*[\r\n]+)+//ig;
		$ssh_output =~ s/Offending key.*//ig;
		$ssh_output =~ s/Matching host key in.*//ig;
		$ssh_output =~ s/.*POSSIBLE BREAK-IN ATTEMPT.*//ig;
		$ssh_output =~ s/.*ssh-askpass:[^\n]*//ig;
		$ssh_output =~ s/.*bad permissions:[^\n]*//ig;
		
		# Remove any spaces from the beginning and end of the output
		$ssh_output =~ s/(^\s+)|(\s+$)//g;

		# Set the output string to none if no output was produced
		$ssh_output = '' if !$ssh_output;

		# Replace line breaks in the output with \n$pid| SSH output:
		my $pid = $$;
		$ssh_output_formatted = $ssh_output;

		# Get a slice of the SSH output if there are many lines
		my @ssh_output_formatted_lines = split("\n", $ssh_output_formatted);
		my $ssh_output_formatted_line_count = scalar @ssh_output_formatted_lines;
		if ($ssh_output_formatted_line_count > 50) {
			@ssh_output_formatted_lines = @ssh_output_formatted_lines[0 .. 49];
			push(@ssh_output_formatted_lines, "displayed first 50 of $ssh_output_formatted_line_count SSH output lines");
			$ssh_output_formatted = join("\n", @ssh_output_formatted_lines);
		}

		my $command_prefix = substr($command, 0, 10);
		$command_prefix .= "..." if (length($command) > 10);
		$ssh_output_formatted =~ s/\r//g;
		$ssh_output_formatted =~ s/^/ssh output ($command_prefix): /g;
		$ssh_output_formatted =~ s/\n/\nssh output ($command_prefix): /g;

		# Check the exit status
		# ssh exits with the exit status of the remote command or with 255 if an error occurred.
		# Check for vmware-cmd usage message, it returns 255 if the vmware-cmd usage output is returned
		if ($ssh_output_formatted =~ /ssh:.*(lost connection|reset by peer|no route to host|connection refused|connection timed out|resource temporarily unavailable|connection reset)/i) {
			notify($ERRORS{'WARNING'}, 0, "attempt $attempts/$max_attempts: failed to execute SSH command on $node_string: '$command', exit status: $exit_status, output:\n$ssh_output_formatted") if $output_level;
			next;
		}
		elsif ($ssh_output_formatted =~ /(Connection timed out during banner exchange)/i) {
			$banner_exchange_error_count++;
			if ($banner_exchange_error_count >= $banner_exchange_error_limit) {
				notify($ERRORS{'WARNING'}, 0, "failed to execute SSH command on $node_string, encountered $banner_exchange_error_count banner exchange errors");
				return ();
			}
			else {
				# Don't count against attempt limit
				$attempts--;
				my $banner_exchange_delay_seconds = ($banner_exchange_error_count * 2);
				notify($ERRORS{'DEBUG'}, 0, "encountered banner exchange error on $node_string, sleeping for $banner_exchange_delay_seconds seconds, command:\n$command\noutput:\n$ssh_output") if $output_level;
				sleep $banner_exchange_delay_seconds;
				next;
			}
		}
		elsif ($exit_status == 255 && $ssh_command !~ /(vmware-cmd|vim-cmd|vmkfstools|vmrun)/i) {
			notify($ERRORS{'WARNING'}, 0, "attempt $attempts/$max_attempts: failed to execute SSH command on $node_string: '$command', exit status: $exit_status, SSH exits with the exit status of the remote command or with 255 if an error occurred, output $output_level:\n$ssh_output_formatted") if $output_level;
			next;
		}
		else {
			# SSH command was executed successfully, actual command on node may have succeeded or failed
			
			# Split the output up into an array of lines
			my @output_lines = split(/[\r\n]+/, $ssh_output);
			
			# Print the output unless no_output is set
			notify($ERRORS{'DEBUG'}, 0, "command: '$command_summary', exit_status: $exit_status, output:\n" . join("\n", @output_lines)) if $output_level > 1;
			
			# Return the exit status and output
			return ($exit_status, \@output_lines);
		}
	} ## end while ($attempts < $max_attempts)

	# Failure, SSH command did not run at all
	notify($ERRORS{'WARNING'}, 0, "failed to run SSH command after $attempts attempts, command: $ssh_command_summary, exit status: $exit_status, output:\n$ssh_output_formatted") if $output_level;
	return ();

} ## end sub run_ssh_command

#//////////////////////////////////////////////////////////////////////////////

=head2 run_scp_command

 Parameters  : $path1, $path2, $identity_path, $port, $options
 Returns     : 1 success
 Description : assumes path1 or path2 contains the src and target
               example: copy from remote node to local file
               path1 = $user\@$node:<filename>
               path2 =  <localfilename>

               example: copy local file to remote node
               path1 =  <localfilename>
               path2 = $user\@$node:<filename>

=cut

sub run_scp_command {
	my ($path1, $path2, $identity_paths, $port, $options) = @_;
	my ($package, $filename, $line, $sub) = caller(0);

	if (!defined($path1) || !$path1) {
		notify($ERRORS{'WARNING'}, 0, "path1 was not specified");
		return 0;
	}
	if (!defined($path2) || !$path2) {
		notify($ERRORS{'WARNING'}, 0, "path2 was not specified");
		return 0;
	}
	
	# Escape spaces in the paths if they aren't already escaped
	$path1 =~ s/([^\\]) /$1\\ /g;
	$path2 =~ s/([^\\]) /$1\\ /g;
	
	# Determine which IP address or hostname should be used to connect to the target
	if ($path1 =~ /^([^:]+):/) {
		my $node = $1;
		my $connection_target = determine_remote_connection_target($node);
		if ($connection_target ne $node) {
			$path1 =~ s/^$node:/$connection_target:/;
		}
	}
	
	if ($path2 =~ /^([^:]+):/) {
		my $node = $1;
		my $connection_target = determine_remote_connection_target($node);
		if ($connection_target ne $node) {
			$path2 =~ s/^$node:/$connection_target:/;
		}
	}
	
	
	# Format the identity path string
	if ($identity_paths) {
		$identity_paths =~ s/^\s*/-i /;
		$identity_paths =~ s/\s*,\s*/ -i /g;
		$identity_paths .= ' ';
	}
	else {
		$identity_paths = '';
	}

	# Set default values if not passed as an argument
	$port = 22 if (!defined($port));

	# TODO: Add SCP path to config file and set global variable
	# Locate the path to the SCP binary
	my $scp_path;
	if (-f '/usr/bin/scp') {
		$scp_path = '/usr/bin/scp';
	}
	elsif (-f 'C:/cygwin/bin/scp.exe') {
		$scp_path = 'C:/cygwin/bin/scp.exe';
	}
	elsif (-f 'D:/cygwin/bin/scp.exe') {
		$scp_path = 'D:/cygwin/bin/scp.exe';
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "unable to locate the SCP executable in the usual places");
		return 0;
	}
	
	# could be hazardous not confirming optional input flags
	if (defined($options)) {
		$scp_path .= " $options ";
	}
	
	# Print the configuration if $VERBOSE
	if ($VERBOSE) {
		#notify($ERRORS{'OK'}, 0, "path1: $path1, path2: $path2 identity file path: $identity_path, port: $port");
		#notify($ERRORS{'OK'}, 0, "node: $node, identity file path: $identity_path, user: $user, port: $port");
		#notify($ERRORS{'OK'}, 0, "source path: $source_path");
		#notify($ERRORS{'OK'}, 0, "destination path: $destination_path");
	}

	# Assemble the SCP command
	# -B, Selects batch mode (prevents asking for passwords or passphrases).
	# -i <identity_file>, Selects the file from which the identity (private key) for RSA authentication is read.
	# -P <port>, Specifies the port to connect to on the remote host.
	# -p, Preserves modification times, access times, and modes from the original file.
	# -r, Recursively copy entire directories.
	# -v, Verbose mode.  Causes scp and ssh to print debugging messages about their progress.
	# Don't use -q, Disables the progress meter. Error messages are more descriptive without it
	my $scp_command = "$scp_path -o StrictHostKeyChecking=no -o UserKnownHostsFile=/dev/null -B $identity_paths-P $port -p -r $path1 $path2";

	# Redirect standard output and error output so all messages are captured
	$scp_command .= ' 2>&1';

	# Execute the command
	my $scp_output;
	my $attempts        = 0;
	my $max_attempts    = 3;
	my $scp_exit_status = 0;

	# Make multiple attempts if failure occurs
	while ($attempts < $max_attempts) {
		$attempts++;
		
		# Delay performing next attempt if this isn't the first attempt
		if ($attempts > 1) {
			my $delay = 2;
			notify($ERRORS{'DEBUG'}, 0, "sleeping for $delay seconds before making next SCP attempt");
			sleep $delay;
			notify($ERRORS{'DEBUG'}, 0, "attempt $attempts/$max_attempts: executing SCP command: $scp_command");
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "attempting to copy file via SCP: '$path1' --> '$path2'");
		}
		
		## Add -v (verbose) argument to command if this is the 2nd attempt
		#$scp_command =~ s/$scp_path/$scp_path -v/ if $attempts == 2;
		
		$scp_output = `$scp_command`;
		
		# Save the exit status
		$scp_exit_status = $?;
		
		# Strip out the key warning message
		$scp_output =~ s/\@{10,}.*man-in-the-middle attacks\.//igs;
		$scp_output =~ s/^\s+|\s+$//g;
		$scp_output =~ s/Warning:.*known hosts.*//ig;
		
		if ($scp_output && length($scp_output) > 0) {
			# Add a newline to the beginning of the output if something was generated
			# This is to make multi-line output more readable
			$scp_output = "\n" . $scp_output;
		}
		else {
			# Indicate there was no output if it is blank
			$scp_output = '';
		}
		
		# Check the output for known error messages
		# Be careful with "no such file" warnings, this may be displayed if the copy was successful but there is a problem with an identity key:
		#    Warning: Identity file /etc/vcl/bad.key not accessible: No such file or directory.
		if ($scp_exit_status != 0 && $scp_output =~ /permission denied|no such file|ambiguous target|is a directory|not known|no space/i) {
			notify($ERRORS{'WARNING'}, 0, "failed to copy via SCP: '$path1' --> '$path2'\nexit status: $scp_exit_status\ncommand: $scp_command\noutput:\n$scp_output");
			return 0;
		}
		elsif ($scp_output =~ /^(scp|ssh):/i) {
			notify($ERRORS{'WARNING'}, 0, "attempt $attempts/$max_attempts: error occurred while attempting to copy file via SCP: '$path1' --> '$path2'\ncommand: $scp_command\noutput:\n$scp_output");
			next;
		}
		else {
			notify($ERRORS{'OK'}, 0, "copied file via SCP: '$path1' --> '$path2'");
			return 1;
		}
	} ## end while ($attempts < $max_attempts)
	
	# Failure
	return 0;
} ## end sub run_scp_command

#//////////////////////////////////////////////////////////////////////////////

=head2 get_management_node_info

 Parameters  : Either a management node hostname or database ID
 Returns     : Hash containing data contained in the managementnode table
 Description :

=cut

sub get_management_node_info {
	# Get the management node identifier argument
	# If argument was not passed, assume management node is this machine
	my $management_node_identifier = shift;
	
	# If a management node identifier argument wasn't specified get the hostname of this management node
	if (!$management_node_identifier) {
		if ($FQDN) {
			$management_node_identifier = $FQDN;
		}
		else {
			$management_node_identifier = (hostname())[0];
		}
	}
	
	if (!defined($ENV{management_node_info}) || !ref($ENV{management_node_info}) || ref($ENV{management_node_info}) ne 'HASH') {
		notify($ERRORS{'DEBUG'}, 0, "initializing management node info hash reference");
		$ENV{management_node_info} = {};
	}
	
	if (defined($ENV{management_node_info}{$management_node_identifier})) {
		my $data_age_seconds = (time - $ENV{management_node_info}{$management_node_identifier}{RETRIEVAL_TIME});
		
		if ($data_age_seconds < 60) {
			#notify($ERRORS{'DEBUG'}, 0, "returning previously retrieved management node info for '$management_node_identifier'");
			return $ENV{management_node_info}{$management_node_identifier};
		}
		else {
			#notify($ERRORS{'DEBUG'}, 0, "retrieving current management node info for '$management_node_identifier' from database, cached data is stale: $data_age_seconds seconds old");
		}
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "management node info for '$management_node_identifier' is not stored in \$ENV{management_node_info}");
	}

	my $select_statement = "
SELECT
managementnode.*,
UNIX_TIMESTAMP(managementnode.lastcheckin) as lastcheckin_epoch,
resource.id AS resource_id,
state.name AS statename
FROM
managementnode,
resource,
resourcetype,
state
WHERE
managementnode.stateid = state.id
AND resource.resourcetypeid = resourcetype.id 
AND resource.subid =  managementnode.id
AND resourcetype.name = 'managementnode'
AND ";

	# Figure out if the ID or hostname was passed as the identifier and complete the SQL statement
	chomp $management_node_identifier;
	if ($management_node_identifier =~ /^\d+$/) {
		# Identifier only contains digits, assume it's the id
		$select_statement .= "managementnode.id = $management_node_identifier";
	}
	elsif ($management_node_identifier =~ /^[\d\.]+$/) {
		# Identifier contains digits and periods, assume it's the IP address
		$select_statement .= "managementnode.IPAddress like \'$management_node_identifier%\'";
	}
	else {
		# Assume hostname was specified
		$select_statement .= "managementnode.hostname REGEXP '^$management_node_identifier(\\\\.|\$)'";
	}
	
	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);
	
	# Check to make sure 1 row was returned
	if (scalar @selected_rows == 0) {
		notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select, management node identifier may be invalid: '$management_node_identifier'\n$select_statement");
		return ();
	}
	elsif (scalar @selected_rows > 1) {
		my @id_hostnames = map ("management node: id=$_->{id}, hostname=$_->{hostname}, IP=$_->{IPaddress}", @selected_rows);
		notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select, management node identifier may be ambiguous: '$management_node_identifier'\n" . join("\n", @id_hostnames));
		return ();
	}

	# Get the single returned row
	# It contains a hash
	my $management_node_info = $selected_rows[0];

	# Move the state name to a subkey to match get_request_info
	$management_node_info->{state}{name} = $management_node_info->{statename};
	delete $management_node_info->{statename};

	$management_node_info->{hostname} =~ /([-_a-zA-Z0-9]*)(\.?)/;
	my $shortname = $1;
	$management_node_info->{SHORTNAME} = $shortname;

	# Get the image library partner info if imagelibenable=1 and imagelibgroupid>0
	my $imagelib_enable    = $management_node_info->{imagelibenable};
	my $imagelib_group_id  = $management_node_info->{imagelibgroupid};
	my $management_node_id = $management_node_info->{id};
	if ($imagelib_enable && defined($imagelib_group_id) && $imagelib_group_id) {
		my $imagelib_statement = "
SELECT DISTINCT
managementnode.IPaddress
FROM
managementnode,
resource,
resourcegroup,
resourcegroupmembers
WHERE
resourcegroup.id = $imagelib_group_id
AND resourcegroupmembers.resourcegroupid = resourcegroup.id
AND resource.id = resourcegroupmembers.resourceid
AND resource.subid = managementnode.id
AND managementnode.id != $management_node_id
		";
		
		# Call the database select subroutine
		my @imagelib_rows = database_select($imagelib_statement);
		
		# Check to make sure 1 row was returned
		if (scalar @imagelib_rows == 0) {
			notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select, image library functions will be disabled");
			$management_node_info->{imagelibenable} = 0;
		}
		else {
			#notify($ERRORS{'DEBUG'}, 0, "imagelib partners found: " . scalar @imagelib_rows);
			# Loop through the rows, assemble a string separated by commas
			my $imagelib_ipaddress_string;
			for my $imagelib_row (@imagelib_rows) {
				$imagelib_ipaddress_string .= "$imagelib_row->{IPaddress},";
			}
			# Remove the trailing comma
			$imagelib_ipaddress_string =~ s/,$//;
			#notify($ERRORS{'DEBUG'}, 0, "image library partner IP address string: $imagelib_ipaddress_string");
			$management_node_info->{IMAGELIBPARTNERS} = $imagelib_ipaddress_string;
		} ## end else [ if (scalar @imagelib_rows == 0)
	} ## end if ($imagelib_enable && defined($imagelib_group_id...
	else {
		$management_node_info->{IMAGELIBPARTNERS} = 0;
		#notify($ERRORS{'DEBUG'}, 0, "image library sharing functions are disabled");
	}

	# Get the inuse timing checks for general and server based reservations
	my $general_inuse_check = get_variable('general_inuse_check') || 300;
	$management_node_info->{GENERAL_INUSE_CHECK} = round($general_inuse_check / 60);
	$ENV{management_node_info}{GENERAL_INUSE_CHECK} = $management_node_info->{GENERAL_INUSE_CHECK};

	my $server_inuse_check = get_variable('server_inuse_check') || 300;
	$management_node_info->{SERVER_INUSE_CHECK} = round($server_inuse_check / 60);
	$ENV{management_node_info}{SERVER_INUSE_CHECK} = $management_node_info->{SERVER_INUSE_CHECK};
	
	my $cluster_inuse_check = get_variable('cluster_inuse_check') || 300;
	$management_node_info->{CLUSTER_INUSE_CHECK} = round($cluster_inuse_check / 60);
	$ENV{management_node_info}{CLUSTER_INUSE_CHECK} = $management_node_info->{CLUSTER_INUSE_CHECK};

	my $user_password_length = get_variable('user_password_length') || 6;
	$management_node_info->{USER_PASSWORD_LENGTH} = $user_password_length;
	$ENV{management_node_info}{USER_PASSWORD_LENGTH} = $management_node_info->{USER_PASSWORD_LENGTH};

	my $user_password_include_spchar = get_variable('user_password_spchar') || 0;
	$management_node_info->{INCLUDE_SPECIAL_CHARS} = $user_password_include_spchar;
	$ENV{management_node_info}{INCLUDE_SPECIAL_CHARS} =  $management_node_info->{INCLUDE_SPECIAL_CHARS};

	# Get the OS name
	my $os_name = lc($^O);
	$management_node_info->{OSNAME} = $os_name;
	
	# Add the public IP address configuration variables
	$management_node_info->{PUBLIC_IP_CONFIGURATION} = $management_node_info->{publicIPconfiguration};
	$management_node_info->{PUBLIC_SUBNET_MASK} = $management_node_info->{publicSubnetMask};
	$management_node_info->{PUBLIC_DEFAULT_GATEWAY} = $management_node_info->{publicDefaultGateway};
	$management_node_info->{PUBLIC_DNS_SERVER} = $management_node_info->{publicDNSserver};
	
	# Add sysadmin and sharedMailBox email address values
	$management_node_info->{SYSADMIN_EMAIL} = $management_node_info->{sysadminEmailAddress};
	$management_node_info->{SHARED_EMAIL_BOX} = $management_node_info->{sharedMailBox};
	
	# Store the info in $ENV{management_node_info}
	# Add keys for all of the unique identifiers that may be passed as an argument to this subroutine
	$ENV{management_node_info}{$management_node_identifier} = $management_node_info;
	$ENV{management_node_info}{$management_node_info->{hostname}} = $management_node_info;
	$ENV{management_node_info}{$management_node_info->{SHORTNAME}} = $management_node_info;
	$ENV{management_node_info}{$management_node_info->{id}} = $management_node_info;
	$ENV{management_node_info}{$management_node_info->{IPaddress}} = $management_node_info;
	
	# Save the time when the data was retrieved
	$ENV{management_node_info}{$management_node_identifier}{RETRIEVAL_TIME} = time;
	
	#notify($ERRORS{'DEBUG'}, 0, "retrieved management node info: '$management_node_identifier' ($management_node_info->{SHORTNAME})");
	return $management_node_info;
} ## end sub get_management_node_info

#//////////////////////////////////////////////////////////////////////////////

=head2 update_computer_imagename

 Parameters  : $computerid, $imagename
 Returns     : 0 failed or 1 success
 Description : Updates currentimage on a node, based on imagename only

=cut
sub update_computer_imagename {
	my ($computerid, $imagename, $log) = @_;

	my ($package,    $filename, $line,            $sub)             = caller(0);

	# Check the passed parameters
	if (!(defined($computerid))) {
		notify($ERRORS{'WARNING'}, 0, "computer ID was not specified");
		return ();
	}
	if (!(defined($imagename))) {
		notify($ERRORS{'WARNING'}, 0, "image name was not specified");
		return ();
	}

	#get computer infomation based on imagename
	my $imagerevision_info;
	if ($imagerevision_info = get_imagerevision_info($imagename)) {
		notify($ERRORS{'DEBUG'}, 0, "successfully retreived image info for $imagename");
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to get_imagerevision_info for $imagename");
		return 0;
	}

	my $image_id  = $imagerevision_info->{imageid};
	my $imagerevision_id = $imagerevision_info->{id};

	if (update_currentimage($computerid, $image_id, $imagerevision_id)) {
		notify($ERRORS{'DEBUG'}, 0, "successfully updated computerid= $computerid image_id= $image_id imagerevision_id= $imagerevision_id");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update_currentimage imagename= $imagename computerid= $computerid");
		return 0;
	}

	return 0;

}

#//////////////////////////////////////////////////////////////////////////////

=head2 update_currentimage

 Parameters  : $computerid, $imageid, $imagerevisionid, $nextimagid(optional)
 Returns     : 0 failed or 1 success
 Description : Updates currentimage on a node, nextimageid = optional

=cut

sub update_currentimage {
	my ($computerid, $imageid,  $imagerevisionid, $nextimagid) = @_;
	my ($package,    $filename, $line,            $sub)             = caller(0);

	# Check the passed parameters
	if (!(defined($computerid))) {
		notify($ERRORS{'WARNING'}, 0, "computer ID was not specified");
		return ();
	}
	if (!(defined($imageid))) {
		notify($ERRORS{'WARNING'}, 0, "image ID was not specified");
		return ();
	}
	if (!(defined($imagerevisionid))) {
		notify($ERRORS{'WARNING'}, 0, "image revision ID was not specified");
		return ();
	}

	notify($ERRORS{'OK'}, 0, "updating computer $computerid: image=$imageid, imagerevision=$imagerevisionid");

	# Construct the update statement
	# If $nextimageid defined and set build slightly different statement
	my $update_statement = "
		UPDATE
		computer c, image i
		SET
		c.currentimageid = $imageid,
		c.imagerevisionid= $imagerevisionid
		WHERE
		c.id = $computerid
	";

	if (defined($nextimagid) && ($nextimagid)) {
		notify($ERRORS{'WARNING'}, 0, "*******NEXTIMAGE updating computer $computerid: image=$imageid, imagerevision=$imagerevisionid nextimageid = $imageid");
		$update_statement = "
			UPDATE
			computer c, image i
			SET
			c.currentimageid = $imageid,
			c.nextimageid = $imageid,
			c.imagerevisionid= $imagerevisionid
			WHERE
			c.id = $computerid
			";
	} ## end if (defined($nextimagid) && ($nextimagid...

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		# Update successful, return timestamp
		notify($ERRORS{'OK'}, 0, "updated currentimageid and imagerevision id for computer id $computerid");
		return 1;
	}
	else {
		notify($ERRORS{'CRITICAL'}, 0, "unable to update database, computerid $computerid currentimageid $imageid");
		return 0;
	}
} ## end sub update_currentimage

#//////////////////////////////////////////////////////////////////////////////

=head2  is_inblockrequest

 Parameters  : Updates currentimage on a node
 Returns     : 1 if successful, 0 otherwise
 Description : checks blockComputers table for supplied computerid

=cut


sub is_inblockrequest {
	my ($computerid) = @_;

	my ($package, $filename, $line, $sub) = caller(0);

	# Check the passed parameters
	if (!(defined($computerid))) {
		notify($ERRORS{'WARNING'}, 0, "computer ID was not specified");
		return ();
	}
	# Construct the select statement
	my $select_statement = "
		SELECT
		b.blockRequestid,c.blockTimeid
		FROM blockTimes b, blockComputers c
		WHERE
		c.blockTimeid=b.id AND c.computerid = $computerid
	";

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);

	# Check on what we return
	if (scalar @selected_rows == 0) {
		notify($ERRORS{'OK'}, 0, "zero rows were returned from database select");
		return 0;
	}
	elsif (scalar @selected_rows => 1) {
		notify($ERRORS{'OK'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
		return 1;
	}
} ## end sub is_inblockrequest

#//////////////////////////////////////////////////////////////////////////////

=head2 update_lastcheckin

 Parameters  : $management_node_id
 Returns     : 0 or 1
 Description : Updates lastcheckin for a management node

=cut


sub update_lastcheckin {
	my ($management_node_id) = @_;

	my ($package, $filename, $line, $sub) = caller(0);

	# Check the passed parameter
	if (!(defined($management_node_id))) {
		notify($ERRORS{'WARNING'}, 0, "management node ID was not specified");
		return ();
	}

	# Get current timestamp
	my $timestamp;

	# Construct the update statement
	my $update_statement = "
      UPDATE
		managementnode
		SET
		lastcheckin = NOW()
		WHERE
		id = $management_node_id
   ";

	my $get_unix_timestamp = "
	  SELECT
	    UNIX_TIMESTAMP() as EPOC_TIMESTAMP
    ";

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		# Update successful, return timestamp
		my @selected_rows = database_select($get_unix_timestamp);

		# Check to make sure 1 row was returned
		if (scalar @selected_rows == 0) {
			notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select");
			return 0;
		}
		elsif (scalar @selected_rows > 1) {
			notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
			return 0;
		}

		# Make sure we return undef if the column wasn't found
		if (defined $selected_rows[0]{EPOC_TIMESTAMP}) {
			$timestamp = $selected_rows[0]{EPOC_TIMESTAMP};
			return $timestamp;
		} else {
			notify($ERRORS{'CRITICAL'}, 0, "unable to get EPOC_TIMESTAMP from database");
			return 0;
		}
	}
	else {
		notify($ERRORS{'CRITICAL'}, 0, "unable to update database, management node id $management_node_id");
		return 0;
	}
} ## end sub update_lastcheckin

#//////////////////////////////////////////////////////////////////////////////

=head2 update_computer_private_ip_address

 Parameters  : $computer_identifier, $private_ip_address
 Returns     : boolean
 Description : Updates the computer.privateIPaddress value of the computer
					specified by the argument. The value can be set to null by
					passing 'null' as the argument. The $computer_identifier argument
					may either be the numeric computer.id value or the
					computer.hostname value.

=cut

sub update_computer_private_ip_address {
	my ($computer_identifier, $private_ip_address) = @_;
	
	if (!defined($computer_identifier)) {
		notify($ERRORS{'WARNING'}, 0, "computer identifier argument was not specified");
		return;
	}
	if (!defined($private_ip_address)) {
		notify($ERRORS{'WARNING'}, 0, "private IP address argument was not specified");
		return;
	}
	
	# Figure out the computer ID based on the $computer_identifier argument
	my $computer_id;
	if ($computer_identifier =~ /^\d+$/) {
		$computer_id = $computer_identifier;
	}
	else {
		$computer_id = get_computer_ids($computer_identifier);
		if (!$computer_id) {
			notify($ERRORS{'WARNING'}, 0, "failed to update computer private IP address, computer ID could not be determed from argument: $computer_identifier");
			return;
		}
	}
	
	my $computer_string = $computer_identifier;
	$computer_string .= " ($computer_id)" if ($computer_identifier ne $computer_id);
	
	# Delete cached data if previously set
	delete $ENV{computer_private_ip_address}{$computer_id};
	
	my $private_ip_address_text;
	if ($private_ip_address =~ /null/i) {
		$private_ip_address_text = 'NULL';
	}
	else {
		$private_ip_address_text = "'$private_ip_address'";
	}
	
	# Construct the update statement
	my $update_statement = <<EOF;
UPDATE
computer
SET
privateIPaddress = $private_ip_address_text
WHERE
computer.deleted != '1'
AND computer.id = '$computer_id'
EOF

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		if ($private_ip_address !~ /null/i) {
			$ENV{computer_private_ip_address}{$computer_id} = $private_ip_address;
		}
		notify($ERRORS{'OK'}, 0, "updated private IP address of computer $computer_string in database: $private_ip_address");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update private IP address of computer $computer_string in database: $private_ip_address");
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 update_computer_public_ip_address

 Parameters  : $computer_id, $public_ip_address
 Returns     : boolean
 Description : Updates the computer.IPaddress value of the computer specified by
               the argument.

=cut

sub update_computer_public_ip_address {
	my ($computer_id, $public_ip_address) = @_;
	
	if (!defined($computer_id)) {
		notify($ERRORS{'WARNING'}, 0, "computer ID argument was not specified");
		return;
	}
	if (!defined($public_ip_address)) {
		notify($ERRORS{'WARNING'}, 0, "public IP address argument was not specified");
		return;
	}

	# Construct the update statement
	my $update_statement = <<EOF;
UPDATE
computer
SET
IPaddress = '$public_ip_address'
WHERE
id = $computer_id
EOF

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		notify($ERRORS{'OK'}, 0, "updated public IP address of computer $computer_id in database: $public_ip_address");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update public IP address of computer $computer_id in database: $public_ip_address");
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 update_computer_vmhost_id

 Parameters  : $computer_id, $vmhost_id
 Returns     : boolean
 Description : Updates the computer.vmhostid value of the computer specified by
               the argument.

=cut

sub update_computer_vmhost_id {
	my ($computer_id, $vmhost_id) = @_;
	
	if (!defined($computer_id)) {
		notify($ERRORS{'WARNING'}, 0, "computer ID argument was not specified");
		return;
	}
	if (!defined($vmhost_id)) {
		notify($ERRORS{'WARNING'}, 0, "VM host ID argument was not specified");
		return;
	}

	# Construct the update statement
	my $update_statement = <<EOF;
UPDATE
computer
SET
vmhostid = '$vmhost_id'
WHERE
id = $computer_id
EOF

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		notify($ERRORS{'OK'}, 0, "updated VM host ID of computer $computer_id in database: $vmhost_id");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update VM host ID of of computer $computer_id in database: $vmhost_id");
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_request_end

 Parameters  : $request_id
 Returns     : Scalar containing end value for given request ID
 Description :

=cut

sub get_request_end {
	my ($request_id) = @_;

	my ($package, $filename, $line, $sub) = caller(0);

	# Check the passed parameter
	if (!(defined($request_id))) {
		notify($ERRORS{'WARNING'}, 0, "request ID was not specified");
		return ();
	}

	# Create the select statement
	my $select_statement = "
   SELECT
	request.end AS end
	FROM
	request
	WHERE
	request.id = $request_id
   ";

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (scalar @selected_rows == 0) {
		notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select");
		return ();
	}
	elsif (scalar @selected_rows > 1) {
		notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
		return ();
	}

	# Get the single returned row
	# It contains a hash
	my $end;

	# Make sure we return undef if the column wasn't found
	if (defined $selected_rows[0]{end}) {
		$end = $selected_rows[0]{end};
		return $end;
	}
	else {
		return undef;
	}
} ## end sub get_request_end

#//////////////////////////////////////////////////////////////////////////////

=head2 get_request_by_computerid

 Parameters  : $computer_id
 Returns     : hash containing values of assigned request/reservation
 Description :

=cut


sub get_request_by_computerid {
	my ($computer_id) = @_;

	# Check the passed parameter
	if (!defined($computer_id)) {
		notify($ERRORS{'WARNING'}, 0, "computer ID argument was not specified");
		return;
	}

	# Create the select statement
	my $select_statement = <<EOF;
SELECT DISTINCT
request.id AS request_id,
reservation.id AS reservation_id

FROM
request,
reservation

WHERE
request.id = reservation.requestid
AND reservation.computerid = $computer_id

ORDER BY
reservation.id
EOF

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (scalar @selected_rows == 0) {
		notify($ERRORS{'OK'}, 0, "$computer_id is not assigned to any reservations");
		return ();
	}

	my $computer_request_info;

	# It contains a hash
	for my $row (@selected_rows) {
		my $request_id = $row->{request_id};
		my $reservation_id = $row->{reservation_id};
		
		my $request_info = get_request_info($request_id);
		
		if (!$request_info) {
			# Request may have been deleted in this brief period
			if (is_request_deleted($request_id)) {
				notify($ERRORS{'OK'}, 0, "request was deleted before request info could be retrieved: $request_id");
				next;
			}
			else {
				notify($ERRORS{'WARNING'}, 0, "failed to retrieve request info, request ID: $request_id");
				return;
			}
		}
		
		my $data_structure;
		eval {$data_structure = new VCL::DataStructure({request_data => $request_info, reservation_id => $reservation_id});};
		if (my $exception = Exception::Class::Base->caught()) {
			notify($ERRORS{'WARNING'}, 0, "unable to create DataStructure object" . $exception->message);
			return;
		}
		
		notify($ERRORS{'DEBUG'}, 0, "retrieved info and DataStructure object for $request_id:$reservation_id");
		$computer_request_info->{$request_id}{data} = $data_structure;
	}

	return $computer_request_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_request_current_state_name

 Parameters  : $request_id, $suppress_warnings (optional)
 Returns     : String containing state name for a request
 Description :

=cut


sub get_request_current_state_name {
	my ($request_id, $suppress_warnings) = @_;

	# Check the passed parameter
	if (!(defined($request_id))) {
		notify($ERRORS{'WARNING'}, 0, "request ID was not specified");
		return ();
	}

	# Create the select statement
	my $select_statement = <<EOF;
SELECT
state.name AS state_name,
laststate.name AS laststate_name
FROM
request,
state,
state laststate
WHERE
request.id = $request_id
AND request.stateid = state.id
AND request.laststateid = laststate.id
EOF

	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);
	
	my $notify_type = ($suppress_warnings ? $ERRORS{'OK'} : $ERRORS{'WARNING'});
	# Check to make sure 1 row was returned
	if (!@selected_rows) {
		notify($notify_type, 0, "unable to determine current state of request $request_id, zero rows were returned from database select");
		return;
	}
	
	my $row = $selected_rows[0];
	my $state_name = $row->{state_name};
	my $laststate_name = $row->{laststate_name};
	#notify($ERRORS{'DEBUG'}, 0, "retrieved current state of request $request_id: $state_name/$laststate_name");
	
	if (wantarray) {
		return ($state_name, $laststate_name);
	}
	else {
		return $state_name;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_computer_current_state_name

 Parameters  : $computer_id
 Returns     : string
 Description :

=cut


sub get_computer_current_state_name {
	my ($computer_id) = @_;
	if (!(defined($computer_id))) {
		notify($ERRORS{'WARNING'}, 0, "computer ID argument was not specified");
		return;
	}

	# Create the select statement
	my $select_statement = <<EOF;
SELECT
state.name
FROM
state,
computer
WHERE
computer.stateid = state.id
AND computer.id = $computer_id
EOF

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @rows = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (!@rows) {
		notify($ERRORS{'WARNING'}, 0, "failed to retrieve current computer state, no rows were returned from database select statement:\n$select_statement");
		return;
	}
	
	my $row = $rows[0];
	my $state_name = $row->{name};
	notify($ERRORS{'DEBUG'}, 0, "retrieved current state of computer $computer_id: $state_name");
	return $state_name;
} ## end sub get_computer_current_state_name

#//////////////////////////////////////////////////////////////////////////////

=head2 update_log_ending

 Parameters  : $log_id, $log_ending
 Returns     : boolean
 Description : Updates log.ending to the value specified by the argument and
               log.finalend to the current time.

=cut

sub update_log_ending {
	my ($log_id, $log_ending) = @_;
	if (!defined($log_id)) {
		notify($ERRORS{'WARNING'}, 0, "log ID argument was not specified");
		return;
	}
	elsif (!defined($log_ending)) {
		notify($ERRORS{'WARNING'}, 0, "log ending argument was not specified");
		return;
	}
	
	# Construct the update statement
	my $update_statement = <<EOF;
UPDATE
log
SET
log.finalend = NOW(),
log.ending = '$log_ending'
WHERE
log.id = $log_id
EOF

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		notify($ERRORS{'DEBUG'}, 0, "updated log ID $log_id, set log.ending to '$log_ending', log.finalend to now");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update log ID $log_id, set log.ending to '$log_ending', log.finalend to now");
		return 0;
	}
} ## end sub update_log_ending

#//////////////////////////////////////////////////////////////////////////////

=head2 update_reservation_lastcheck

 Parameters  : $reservation_id or @reservation_ids
 Returns     : string
 Description : Updates reservation.lastcheck to the current time. The argument
               may be a single reservation ID or an array of IDs. The timestamp
               which lastcheck was set to is returned.

=cut

sub update_reservation_lastcheck {
	my @reservation_ids = @_;
	
	# Check the passed parameter
	if (!@reservation_ids) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID was not specified");
		return;
	}
	my $reservation_id_string = join(', ', @reservation_ids);
	
	# Must use an explicit timestamp, can't use NOW() because calling subroutine may need the exact value this is set to
	my $lastcheck = makedatestring();
	
	# Construct the update statement
	my $update_statement = <<EOF;
UPDATE
reservation
SET
reservation.lastcheck = '$lastcheck'
WHERE
reservation.id IN ($reservation_id_string)
AND reservation.lastcheck <= NOW()
EOF

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		notify($ERRORS{'DEBUG'}, 0, "updated reservation.lastcheck to '$lastcheck' for reservation IDs: $reservation_id_string");
		return $lastcheck;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update reservation.lastcheck to '$lastcheck' for reservation IDs: $reservation_id_string");
		return;
	}
} ## end sub update_reservation_lastcheck

#//////////////////////////////////////////////////////////////////////////////

=head2 set_reservation_lastcheck

 Parameters  : $lastcheck, @reservation_ids
 Returns     : string
 Description : Updates reservation.lastcheck to the time specified.

=cut

sub set_reservation_lastcheck {
	my ($reservation_lastcheck, @reservation_ids) = @_;
	
	# Check the passed parameter
	if (!$reservation_lastcheck) {
		notify($ERRORS{'WARNING'}, 0, "reservation lastcheck argument was not specified");
		return;
	}
	elsif (!@reservation_ids) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not specified");
		return;
	}
	
	my $reservation_id_string = join(", ", @reservation_ids);
	
	if ($reservation_lastcheck !~ /:/) {
		$reservation_lastcheck = convert_to_datetime($reservation_lastcheck);
	}
	my $reservation_lastcheck_epoch = convert_to_epoch_seconds($reservation_lastcheck);
	
	# Only allow the lastcheck time to be set in the future
	my $current_time_epoch = time;
	my $duration_seconds = ($reservation_lastcheck_epoch-$current_time_epoch);
	if ($duration_seconds < 0) {
		notify($ERRORS{'WARNING'}, 0, "reservation.lastcheck not set to $reservation_lastcheck for reservation IDs: $reservation_id_string, time is in the past");
		return;
	}
	elsif ($duration_seconds < (20*60)) {
		notify($ERRORS{'WARNING'}, 0, "reservation.lastcheck not set to $reservation_lastcheck for reservation IDs: $reservation_id_string, time is too close to the current time");
		return;
	}
	
	# Construct the update statement
	my $update_statement = <<EOF;
UPDATE
reservation
SET
reservation.lastcheck = '$reservation_lastcheck'
WHERE
reservation.id IN ($reservation_id_string)
EOF

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		notify($ERRORS{'DEBUG'}, 0, "reservation.lastcheck set to '$reservation_lastcheck' for reservation IDs: $reservation_id_string");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to set reservation.lastcheck to '$reservation_lastcheck' for reservation IDs: $reservation_id_string");
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 update_log_loaded_time

 Parameters  : $request_logid
 Returns     : 0 or 1
 Description : Updates the finalend and ending fields in the log table for the specified log ID

=cut

sub update_log_loaded_time {
	my ($request_logid) = @_;

	my ($package, $filename, $line, $sub) = caller(0);

	# Check the passed parameter
	if (!(defined($request_logid))) {
		notify($ERRORS{'WARNING'}, 0, "request log ID was not specified");
		return ();
	}

	# Construct the update statement
	# Use an IF clause to only update log.loaded if it is NULL
	# It should only be updated once to capture the time the image load was done
	my $update_statement = "
   UPDATE
   log
   SET
   log.loaded = IF(log.loaded IS NULL, NOW(), log.loaded)
   WHERE
   id = $request_logid
   ";

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		notify($ERRORS{'OK'}, 0, "updated log loaded time to now for log id: $request_logid");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update log loaded time to now for log id: $request_logid");
		return 0;
	}
} ## end sub update_log_loaded_time

#//////////////////////////////////////////////////////////////////////////////

=head2 update_image_name

 Parameters  : $image_id, $imagerevision_id, $new_image_name
 Returns     : boolean
 Description : Updates the image.name and imagerevision.imagename values in the
               database.

=cut

sub update_image_name {
	my ($image_id, $imagerevision_id, $new_image_name, $new_image_pretty_name) = @_;

	# Check the passed parameter
	unless (defined($image_id) && defined($imagerevision_id) && defined($new_image_name)) {
		notify($ERRORS{'WARNING'}, 0, "image ID, imagerevision ID, and new image name arguments were not specified");
		return;
	}

	# Construct the update statement
	my $update_statement = <<EOF;
UPDATE
image,
imagerevision
SET
image.name = \'$new_image_name\',
EOF

	if (defined($new_image_pretty_name)) {
		$update_statement .= <<EOF;
image.prettyname = \'$new_image_pretty_name\',
EOF
	}

$update_statement .= <<EOF;	
imagerevision.imagename = \'$new_image_name\'
WHERE
image.id = $image_id AND
imagerevision.id = $imagerevision_id
EOF

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		notify($ERRORS{'DEBUG'}, 0, "updated image.name and imagerevision.imagename in database to '$new_image_name' for image ID: $image_id, imagerevision ID: $imagerevision_id");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update image.name and imagerevision.imagename in database to '$new_image_name' for image ID: $image_id, imagerevision ID: $imagerevision_id");
		return 0;
	}
} ## end sub update_image_name

#//////////////////////////////////////////////////////////////////////////////

=head2 update_image_type

 Parameters  : $image_id, $image_type
 Returns     : boolean
 Description : Updates the image.imagetypeid value in the database. The
               $image_type argument may either be an imagetype ID or name.

=cut

sub update_image_type {
	my ($image_id, $image_type) = @_;

	# Check the passed parameter
	unless (defined($image_id) && defined($image_type)) {
		notify($ERRORS{'WARNING'}, 0, "image ID and image type arguments were not specified");
		return;
	}

	# Construct the update statement
	my $update_statement = <<EOF;
UPDATE
image
SET
EOF
	
	# Check if the $image_type argument is an integer (imagetype.id) or string (imagetype.name)
	if ($image_type =~ /^\d+$/) {
		$update_statement .= "image.imagetypeid = \'$image_type\'";
	}
	else {
		$update_statement .= "image.imagetypeid = (SELECT imagetype.id FROM imagetype WHERE imagetype.name = \'$image_type\')";
	}
	
	$update_statement .= <<EOF;
WHERE
image.id = $image_id
EOF

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		notify($ERRORS{'DEBUG'}, 0, "updated image type in database to $image_type for image ID: $image_id");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update image type in database to $image_type for image ID: $image_id");
		return 0;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 delete_computerloadlog_reservation

 Parameters  : $reservation_id_argument, $loadstate_regex (optional)
 Returns     : boolean
 Description : Deletes rows from the computerloadlog table.
               
               The $reservation_id argument may be either a single integer ID or
               a reference to an array of integer IDs.
               
               A $loadstate_regex argument can be specified to limit the rows
               removed to a certain loadstate names. The regex does not allow
               all of the functionality of a Perl regex such as (?!...).
               
               To delete multiple loadstate names, pass something such as:
               (begin|info)
               
               To delete all entries except certain loadstate names, precede the
               expression with an exclaimation mark:
               !(begin|info)              

=cut

sub delete_computerloadlog_reservation {
	my $reservation_id_argument = shift;
	my $loadstate_regex = shift;

	# Check the passed parameter
	if (!defined($reservation_id_argument)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument were not specified");
		return;
	}
	
	# Check if a single reservation ID was specified or an array of IDs
	my $reservation_id_string;
	if (ref($reservation_id_argument)) {
		$reservation_id_string = join(', ', @$reservation_id_argument);
	}
	else {
		$reservation_id_string = $reservation_id_argument;
	}
	
	# Construct the SQL statement
	my $sql_statement = <<EOF;
DELETE
computerloadlog
FROM
computerloadlog,
computerloadstate
WHERE
computerloadlog.reservationid IN ($reservation_id_string)
AND computerloadlog.loadstateid = computerloadstate.id
EOF

	
	# Check if loadstateid was specified
	# If so, only delete rows matching the loadstateid
	my $regex_string = '';
	if ($loadstate_regex) {
		if ($loadstate_regex =~ /^\!/) {
			$loadstate_regex =~ s/^\!//;
			$regex_string = " NOT matching loadstate regex '$loadstate_regex'";
			$sql_statement .= "AND computerloadstate.loadstatename NOT REGEXP '$loadstate_regex'";
		}
		else {
			$regex_string = " matching loadstate regex '$loadstate_regex'";
			$sql_statement .= "AND computerloadstate.loadstatename REGEXP '$loadstate_regex'";
		}
	}

	# Call the database execute subroutine
	if (database_execute($sql_statement)) {
		notify($ERRORS{'OK'}, 0, "deleted rows from computerloadlog$regex_string for reservation IDs: $reservation_id_string");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to delete from computerloadlog table for reservation IDs: $reservation_id_string");
		return 0;
	}
} ## end sub delete_computerloadlog_reservation

#//////////////////////////////////////////////////////////////////////////////

=head2 delete_request

 Parameters  : $request_id
 Returns     : 0 or 1
 Description : Deletes request and all associated reservations for a given
               request ID. This also deletes all computerloadlog rows associated
               with any of the reservations.

=cut

sub delete_request {
	my ($request_id) = @_;

	my ($package, $filename, $line, $sub) = caller(0);

	# Check the passed parameter
	if (!(defined($request_id))) {
		notify($ERRORS{'WARNING'}, 0, "request ID was not specified");
		return 0;
	}

	# Construct the SQL statement
	my $sql_computerloadlog_delete = "
	DELETE
	computerloadlog.*
	FROM
	request,
	reservation,
	computerloadlog
   WHERE
	request.id = $request_id
	AND reservation.requestid = request.id
	AND computerloadlog.reservationid = reservation.id
   ";

	# Construct the SQL statement
	my $sql_request_delete = "
	DELETE
	request.*,
	reservation.*
	FROM
	request,
	reservation
   WHERE
	request.id = $request_id
	AND reservation.requestid = request.id
   ";

	# Try to delete any associated entries in the computerloadlog table
	# There may not be any entries, but database_execute should still return 1
	if (!database_execute($sql_computerloadlog_delete)) {
		notify($ERRORS{'WARNING'}, 0, "unable to delete from computerloadlog table where request id=$request_id");
	}

	# Try to delete any associated entries in the request and reservation tables
	if (database_execute($sql_request_delete)) {
		notify($ERRORS{'DEBUG'}, 0, "request deleted: $request_id");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "unable to delete from request and reservation tables where request id=$request_id");
		return 0;
	}
} ## end sub delete_request

#//////////////////////////////////////////////////////////////////////////////

=head2 update_blockrequest_processing

 Parameters  : $blockrequest_id, $processing
 Returns     : 0 or 1
 Description : Updates the processing flag in the blockRequest table

=cut

sub update_blockrequest_processing {
	my ($blockrequest_id, $processing) = @_;

	my ($package, $filename, $line, $sub) = caller(0);

	# Check the arguments
	if (!defined($blockrequest_id)) {
		notify($ERRORS{'WARNING'}, 0, "blockrequest ID was not specified");
		return 0;
	}
	if (!defined($processing)) {
		notify($ERRORS{'WARNING'}, 0, "processing was not specified");
		return 0;
	}

	# Construct the update statement
	my $update_statement = "
      UPDATE
		blockRequest
		SET
		blockRequest.processing = $processing
		WHERE
		blockRequest.id = $blockrequest_id
   ";

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "unable to update blockRequest table, id=$blockrequest_id, processing=$processing");
		return 0;
	}
} ## end sub update_blockrequest_processing


#//////////////////////////////////////////////////////////////////////////////

=head2 clear_next_image_id

 Parameters  : $computer_id
 Returns     : 0 or 1
 Description : sets next_image_id to 0

=cut

sub clear_next_image_id {
	my ($computer_id) = @_;
	my ($package, $filename, $line, $sub) = caller(0);
	# Check the passed parameter
	if (!(defined($computer_id))) {
		notify($ERRORS{'WARNING'}, 0, "computer_id was not specified");
		return 0;
	}

	my $update_statement = "
	UPDATE
	computer,
	image
	SET
	computer.nextimageid = image.id
	WHERE
	image.name LIKE 'noimage'
	AND computer.id = $computer_id
	";

	if (database_execute($update_statement)) {
		notify($ERRORS{'OK'}, 0, "updated nextimageid to 0 for computer id $computer_id");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "unable to update database, failed to set nextimageid=0 for computerid $computer_id");
		return 0;
	}

}

#//////////////////////////////////////////////////////////////////////////////

=head2 clearfromblockrequest

 Parameters  : $computer_id
 Returns     : 0 or 1
 Description : removes provided computerid and blcok request id from blockcomputer table

=cut


sub clearfromblockrequest {
	my ($computer_id) = @_;
	my ($package, $filename, $line, $sub) = caller(0);
	# Check the passed parameter
	if (!(defined($computer_id))) {
		notify($ERRORS{'WARNING'}, 0, "computer_id was not specified");
		return 0;
	}

	# Construct the SQL statement
	my $sql_statement = "
	DELETE
	blockComputers
	FROM
	blockComputers
	WHERE
	computerid = $computer_id
	";

	# Call the database execute subroutine
	if (database_execute($sql_statement)) {
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "unable to delete from computerloadlog table where computerid = $computer_id");
		return 0;
	}
} ## end sub clearfromblockrequest

#//////////////////////////////////////////////////////////////////////////////

=head2 update_sublog_ipaddress

 Parameters  : $sublog_id, $computer_public_ip_address
 Returns     : boolean
 Description : Updates the sublog table with the public IP address of the
               computer.

=cut

sub update_sublog_ipaddress {
	my ($sublog_id, $computer_public_ip_address) = @_;
	if (!defined($sublog_id)) {
		notify($ERRORS{'WARNING'}, 0, "sublog ID argument was not specified");
		return;
	}
	elsif (!defined($computer_public_ip_address)) {
		notify($ERRORS{'WARNING'}, 0, "computer public IP address argument was not specified");
		return;
	}

	# Construct the SQL statement
	my $sql_statement = <<EOF;
UPDATE
sublog
SET
sublog.IPaddress = '$computer_public_ip_address'
WHERE
sublog.id = $sublog_id
EOF

	# Call the database execute subroutine
	if (database_execute($sql_statement)) {
		notify($ERRORS{'DEBUG'}, 0, "updated sublog table, sublog ID: $sublog_id, IP address: $computer_public_ip_address");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update sublog table, sublog ID: $sublog_id, IP address: $computer_public_ip_address");
		return 0;
	}
} ## end sub update_sublog_ipaddress

#//////////////////////////////////////////////////////////////////////////////

=head2 rename_vcld_process

 Parameters  : hash - Reference to hash containing request data
 Returns     : boolean
 Description : Renames running process based on request information. Appends the
               state name, request ID, and reservation ID to the process name.

=cut

sub rename_vcld_process {
	my ($input_data, $process_name) = @_;
	my ($package, $filename, $line, $sub) = caller(0);
	$filename =~ s/.*\///;

	# IMPORTANT: if you change the process name, check the checkonprocess subroutine
	# It looks for running reservation processes based on the process name
	
	# Check the argument
	my $data_structure;
	if (defined($input_data) && (ref $input_data) =~ /HASH/) {
		# Get a new data structure object
		eval {
			$data_structure = new VCL::DataStructure({request_data => $input_data, reservation_id => $input_data->{RESERVATIONID}});
			notify($ERRORS{'DEBUG'}, 0, "created DataStructure object from passed hash");
		};
		if (my $e = Exception::Class::Base->caught()) {
			notify($ERRORS{'WARNING'}, 0, "hash was passed but could not be turned into a DataStructure, " . $e->message);
			$data_structure = undef;
		}
	} ## end if (defined($input_data) && (ref $input_data...
	elsif (defined($input_data) && (ref $input_data) !~ /DataStructure/) {
		notify($ERRORS{'WARNING'}, 0, "passed parameter (" . ref($input_data) . ") is not a reference to a hash or DataStructure, it will be ignored");
		$data_structure = undef;
	}
	else {
		$data_structure = $input_data;
	}

	# Begin assembling a new process name
	my $new_process_name = "$PROCESSNAME";

	# Check if DataStructure, assemble process name with additional information
	if (defined $data_structure) {
		my $state_name = $data_structure->get_state_name();

		if ($state_name ne 'blockrequest') {
			my $request_id            = $data_structure->get_request_id();
			my $reservation_id        = $data_structure->get_reservation_id();
			my $request_state_name    = $data_structure->get_request_state_name();
			my $computer_short_name   = $data_structure->get_computer_short_name();
			my $vmhost_hostname       = $data_structure->get_vmhost_short_name(0);
			my $image_name            = $data_structure->get_image_name();
			my $user_login_id         = $data_structure->get_user_login_id();
			my $request_forimaging    = $data_structure->get_request_forimaging();
			my $reservation_count     = $data_structure->get_reservation_count();
			my $reservation_is_parent = $data_structure->is_parent_reservation();
			
			# !!! IMPORTANT !!!
			# If the reservation naming scheme is changed, always check get_reservation_vcld_process_name_regex to make sure it matches the new name pattern
			
			# Append the request and reservation IDs if they are set
			$new_process_name .= " '|$PID|$request_id|$reservation_id|";
			$new_process_name .= "$request_state_name|" if ($request_state_name);
			$new_process_name .= "'";
			$new_process_name .= " $computer_short_name" if ($computer_short_name);
			$new_process_name .= ">$vmhost_hostname" if ($vmhost_hostname);
			$new_process_name .= " $image_name" if ($image_name);
			$new_process_name .= " $user_login_id" if ($user_login_id && $user_login_id !~ /(vclreload)/);
			$new_process_name .= " (imaging)" if $request_forimaging;

			# Append cluster if there are multiple reservations for this request
			notify($ERRORS{'DEBUG'}, 0, "reservation count: $reservation_count");

			if ($reservation_count > 1) {
				if ($reservation_is_parent) {
					$new_process_name .= " (cluster=parent)";
				}
				else {
					$new_process_name .= " (cluster=child)";
				}
			} ## end if ($reservation_count > 1)
		} ## end if ($state_name ne 'blockrequest')
		else {
			my $blockrequest_id   = $data_structure->get_blockrequest_id();
			my $blockrequest_name = $data_structure->get_blockrequest_name();
			my $blocktime_id      = $data_structure->get_blocktime_id();
			
			# Append the IDs if they are set
			$new_process_name .= " $blockrequest_id:$blocktime_id";
			$new_process_name .= " '$blockrequest_name'";
		}
	} ## end if (defined $data_structure)
	else {
		#notify($ERRORS{'DEBUG'}, 0, "DataStructure object is NOT defined");
	}

	# Rename this process
	$0 = $new_process_name;
	notify($ERRORS{'OK'}, 0, "renamed process to \'$0\'");
} ## end sub rename_vcld_process

#//////////////////////////////////////////////////////////////////////////////

=head2 round

 Parameters  : number
 Returns     : rounded number
 Description : rounds to the nearest whole number

=cut


sub round {
	my ($number) = @_;
	if ($number >= 0) {
		return int($number + .5);
	}
	else {
		return int($number - .5);
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 set_logfile_path

 Parameters  : file path
 Returns     : 0 or 1
 Description : This subroutine is for testing purposes.  It sets vcld's logfile
               path to the parameter passed.  It is useful when running automated
               tests to isoloate logfile output.

=cut

sub set_logfile_path {
	my ($package, $filename, $line, $sub) = caller(0);
	($LOGFILE) = @_;
	#print STDOUT "log file path changed to \'$LOGFILE\'\n";
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_management_node_blockrequests

 Parameters  : $managementnode_id
 Returns     : hash containing block request info
 Description :

=cut

sub get_management_node_blockrequests {
	my ($managementnode_id) = @_;
	
	my ($package, $filename, $line, $sub) = caller(0);
	
	# Check the passed parameter
	if (!defined($managementnode_id)) {
		notify($ERRORS{'WARNING'}, 0, "management node ID was not specified");
		return;
	}
	
	# Create the select statement
	my $select_statement = "
	SELECT
	blockRequest.id AS blockRequest_id,
	blockRequest.name AS blockRequest_name,
	blockRequest.imageid AS blockRequest_imageid,
	blockRequest.numMachines AS blockRequest_numMachines,
	blockRequest.groupid AS blockRequest_groupid,
	blockRequest.repeating AS blockRequest_repeating,
	blockRequest.ownerid AS blockRequest_ownerid,
	blockRequest.managementnodeid AS blockRequest_managementnodeid,
	blockRequest.expireTime AS blockRequest_expireTime,
	blockRequest.processing AS blockRequest_processing,
	blockRequest.status AS blockRequest_status,
	
	blockTimes.id AS blockTimes_id,
	blockTimes.blockRequestid AS blockTimes_blockRequestid,
	blockTimes.start AS blockTimes_start,
	blockTimes.end AS blockTimes_end,
	blockTimes.processed AS blockTimes_processed
	
	FROM
	blockRequest
	
	LEFT JOIN
	blockTimes ON (
		blockRequest.id = blockTimes.blockRequestid 
	)
	
	WHERE
	blockRequest.managementnodeid = $managementnode_id AND
	blockRequest.status = 'accepted' AND
	blockTimes.processed = '0' AND
	(blockTimes.skip = '0' AND blockTimes.start < (NOW() + INTERVAL 360 MINUTE)) OR
	blockTimes.end < NOW() 
	";

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);

	# Check to make sure 1 or more rows were returned
	if (scalar @selected_rows == 0) {
		#Lets check to see if we have blockRequests that have expired and don't have any time ids
		$select_statement = "
			SELECT
			blockRequest.id AS blockRequest_id,
			blockRequest.name AS blockRequest_name,
			blockRequest.imageid AS blockRequest_imageid,
			blockRequest.numMachines AS blockRequest_numMachines,
			blockRequest.groupid AS blockRequest_groupid,
			blockRequest.repeating AS blockRequest_repeating,
			blockRequest.ownerid AS blockRequest_ownerid,
			blockRequest.managementnodeid AS blockRequest_managementnodeid,
			blockRequest.expireTime AS blockRequest_expireTime,
			blockRequest.processing AS blockRequest_processing,
			blockRequest.status AS blockRequest_status,
	
			blockTimes.id AS blockTimes_id,
			blockTimes.blockRequestid AS blockTimes_blockRequestid,
			blockTimes.start AS blockTimes_start,
			blockTimes.end AS blockTimes_end,
			blockTimes.processed AS blockTimes_processed
			
			FROM
			blockRequest
			LEFT JOIN
			blockTimes ON (
				blockRequest.id = blockTimes.blockRequestid
			)
			
			WHERE
			blockRequest.managementnodeid = $managementnode_id AND
			blockRequest.status = 'accepted' AND
			blockRequest.expireTime < NOW()
		";
		
		@selected_rows = database_select($select_statement);
		
		if (scalar @selected_rows == 0) {
			return 0;
		}
	}
	
	# Build the hash
	my %blockrequests;
	
	for (@selected_rows) {
		my %blockrequest_row = %{$_};
		
		# Get the blockRequest id and blockTimes id
		my $blockrequest_id = $blockrequest_row{blockRequest_id};
		my $blocktimes_id   = $blockrequest_row{blockTimes_id};
		$blocktimes_id = -1 if !$blocktimes_id;
		
		# Loop through all the columns returned for the blockrequest
		foreach my $key (keys %blockrequest_row) {
			my $value = $blockrequest_row{$key};
			
			# Create another variable by stripping off the column_ part of each key
			# This variable stores the original (correct) column name
			(my $original_key = $key) =~ s/^.+_//;
			
			$value = '-1' if (!defined($value));
			
			if ($key =~ /blockRequest_/) {
				$blockrequests{$blockrequest_id}{$original_key} = $value;
				if ($key =~ /_groupid/) {
					$blockrequests{$blockrequest_id}{groupname} = get_group_name($value);
				}
			}
			elsif ($key =~ /blockTimes_/) {
				$blockrequests{$blockrequest_id}{blockTimes}{$blocktimes_id}{$original_key} = $value;
			}
			else {
				notify($ERRORS{'WARNING'}, 0, "unknown key found in SQL data: $key");
			}
		} ## end foreach my $key (keys %blockrequest_row)
	
	} ## end for (@selected_rows)
	
	return \%blockrequests;

} ## end sub get_management_node_blockrequests

#//////////////////////////////////////////////////////////////////////////////

=head2 get_computers_controlled_by_mn

 Parameters  : $managementnode_id
 Returns     : hash containing computer info
 Description :

=cut

sub get_computers_controlled_by_mn {
	my (%managementnode) = @_;

	my %info;

	#set some local variables
	my $management_node_resourceid = $managementnode{resource_id};
	my $management_node_id         = $managementnode{id};
	my $management_node_hostname   = $managementnode{hostname};

	# Collect resource group this management node is a member of
	if ($info{managementnode}{resoucegroups} = get_resource_groups($management_node_resourceid)) {
		notify($ERRORS{'DEBUG'}, $LOGFILE, "retrieved management node resource groups from database");
	}
	else {
		notify($ERRORS{'CRITICAL'}, $LOGFILE, "unable to retrieve management node resource groups from database");
		return 0;
	}

	# Collect resource group management node grpcan control
	foreach my $mresgrp_id (keys %{$info{managementnode}{resoucegroups}} ) {

		my $grp_id = $info{managementnode}{resoucegroups}{$mresgrp_id}{groupid}; 

		notify($ERRORS{'DEBUG'}, $LOGFILE, "grp_id = $grp_id ");

		if ($info{manageable_resoucegroups}{$mresgrp_id} = get_managable_resource_groups($grp_id)) {
			notify($ERRORS{'DEBUG'}, $LOGFILE, "retrieved manageable resource groups from database for mresgrp_id= $grp_id groupname= $info{managementnode}{resoucegroups}{$mresgrp_id}{groupname}");

			foreach my $id (keys %{ $info{manageable_resoucegroups}{$grp_id} } ) {
				my $computer_group_id = $info{manageable_resoucegroups}{$grp_id}{$id}{groupid};
				if ($info{"manageable_computer_grps"}{$id}{"members"} = get_computer_grp_members($computer_group_id)) {
					notify($ERRORS{'DEBUG'}, $LOGFILE, "retrieved computers from computer groupname= $info{manageable_resoucegroups}{$grp_id}{$id}{groupname}");
				}
				else {
					notify($ERRORS{'DEBUG'}, $LOGFILE, "no computers in computer groupid= $computer_group_id}");
					delete $info{manageable_resoucegroups}{$grp_id}{$id};
				}
			}
		}
		else {
			notify($ERRORS{'DEBUG'}, $LOGFILE, "no manageable resource groups associated for resgrp_id= $mresgrp_id groupname= $info{managementnode}{resoucegroups}{$mresgrp_id}{groupname}");
			#delete $info{managementnode}{resoucegroups}{$mresgrp_id};
		}
	}

	#Build master list of computerids
	my %computer_list;

	foreach my $computergroup (keys %{ $info{manageable_computer_grps}}) {
		foreach my $computerid (keys %{ $info{manageable_computer_grps}{$computergroup}{members} }) {
			if (!(exists $computer_list{$computerid})) {
				# add to return list
				$computer_list{$computerid}{"computer_id"}=$computerid;
			}
		}
	}

	return \%computer_list;

}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_resource_groups

 Parameters  : $management_node_resourceid
 Returns     : hash containing list of resource groups id is a part of
 Description :

=cut

sub get_resource_groups {
	my ($resource_id) = @_;

	if (!defined($resource_id)) {
		notify($ERRORS{'WARNING'}, $LOGFILE, "resource_id was not supplied");
		return 0;
	}

	my $select_statement = "
   SELECT DISTINCT
	resourcegroupmembers.resourcegroupid AS resource_groupid,
	resourcegroup.name AS resource_groupname
	FROM 
	resourcegroupmembers, 
	resourcegroup
	WHERE 
	resourcegroup.id = resourcegroupmembers.resourcegroupid
	AND resourceid = $resource_id
	";

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (scalar @selected_rows == 0) {
		notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select for resource id $resource_id");
		return ();
	}

	#my %return_hash = %{$selected_rows[0]};
	my %return_hash;
	for (@selected_rows) {
		my %resgrps = %{$_};
		my $resgrpid = $resgrps{resource_groupid};
		$return_hash{$resgrpid}{"groupid"} = $resgrpid;
		$return_hash{$resgrpid}{"groupname"} = $resgrps{resource_groupname};
	}

	return \%return_hash;

}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_managable_resource_groups

 Parameters  : $management_node_grp_id
 Returns     : hash containing list of resource groups that can be controlled
 Description :

=cut

sub get_managable_resource_groups {
	my ($managing_resgrp_id) = @_;

	if (!defined($managing_resgrp_id)) {
		notify($ERRORS{'WARNING'}, $LOGFILE, "managing_resgrp_id resource_id was not supplied");
		return 0;
	}

	my $select_statement = "
   SELECT DISTINCT
	resourcemap.resourcegroupid2 AS resource_groupid,
	resourcegroup.name AS resource_groupname
	FROM 
	resourcemap,
	resourcegroup, 
	resourcetype 
	WHERE 
	resourcemap.resourcetypeid2 = resourcetype.id 
	AND resourcetype.name = 'computer'
	AND resourcegroup.id = resourcemap.resourcegroupid2
	AND resourcemap.resourcegroupid1 = $managing_resgrp_id 
	";

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (scalar @selected_rows == 0) {
		notify($ERRORS{'DEBUG'}, 0, "zero rows were returned from database select for resource id $managing_resgrp_id");
		return ();
	}
	my %return_hash;
   for (@selected_rows) {
        my %resgrps = %{$_};
        my $resgrpid = $resgrps{resource_groupid};
        $return_hash{$resgrpid}{"groupid"} = $resgrpid;
        $return_hash{$resgrpid}{"groupname"} = $resgrps{resource_groupname};
   }
   return \%return_hash;
}
#//////////////////////////////////////////////////////////////////////////////

=head2 get_computer_grp_members

 Parameters  : $computer_grp_id
 Returns     : hash containing list of of computer ids
 Description :

=cut

sub get_computer_grp_members {
	my ($computer_grp_id) = @_;

	if (!defined($computer_grp_id)) {
		notify($ERRORS{'WARNING'}, $LOGFILE, "computer_grp_id resource_id was not supplied");
		return 0;
	}

	my $select_statement = "
   SELECT DISTINCT
	resource.subid AS computer_id
   FROM 
	resourcegroupmembers,
	resourcetype,
	resource,
	computer
   WHERE 
	resourcegroupmembers.resourceid = resource.id 
	AND resourcetype.id = resource.resourcetypeid 
	AND resourcetype.name = 'computer' 
	AND resourcegroupmembers.resourcegroupid = $computer_grp_id
	AND computer.deleted != '1'
	AND computer.id = resource.subid
	";

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (scalar @selected_rows == 0) {
		notify($ERRORS{'DEBUG'}, 0, "zero rows were returned from database select for computer grp id $computer_grp_id");
		return ();
	}
	my %return_hash;
   for (@selected_rows) {
        my %computerids = %{$_};
        my $compid = $computerids{computer_id};
        $return_hash{$compid}{"computer_id"} = $compid;
   }
   return \%return_hash;

}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_user_info

 Parameters  : $user_identifier, $affiliation_identifier (optional), $no_cache (optional)
 Returns     : hash reference
 Description : Retrieves user information from the database. The user identifier
               argument can either be a user ID or unityid. A hash reference is
               returned.

=cut

sub get_user_info {
	my ($user_identifier, $affiliation_identifier, $no_cache) = @_;
	
	if (!defined($user_identifier)) {
		notify($ERRORS{'WARNING'}, 0, "user identifier argument was not specified");
		return;
	}
	
	# Check if cached user info exists
	if (!$no_cache && defined($ENV{user_info}{$user_identifier})) {
		# Check the time the info was last retrieved
		my $data_age_seconds = (time - $ENV{user_info}{$user_identifier}{RETRIEVAL_TIME});
		if ($data_age_seconds < 600) {
			return $ENV{user_info}{$user_identifier};
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "retrieving current user info for '$user_identifier' from database, cached data is stale: $data_age_seconds seconds old");
		}
	}
	
	# If affiliation identifier argument wasn't supplied, set it to % wildcard
	$affiliation_identifier = '%' if !$affiliation_identifier;
	
	my $select_statement = <<EOF;
SELECT DISTINCT
user.*,
adminlevel.name AS adminlevel_name,
affiliation.id AS affiliation_id,
affiliation.name AS affiliation_name,
affiliation.shibname AS affiliation_shibname,
affiliation.dataUpdateText AS affiliation_dataUpdateText,
affiliation.sitewwwaddress AS affiliation_sitewwwaddress,
affiliation.helpaddress AS affiliation_helpaddress,
affiliation.shibonly AS affiliation_shibonly,

IMtype.name AS IMtype_name,

localauth.passhash AS localauth_passhash,
localauth.salt AS localauth_salt,
localauth.lastupdated AS localauth_lastupdated,
localauth.lockedout AS localauth_lockedout

FROM
user
LEFT JOIN (adminlevel) ON (adminlevel.id = user.adminlevelid)
LEFT JOIN (affiliation) ON (affiliation.id = user.affiliationid)
LEFT JOIN (IMtype) ON (IMtype.id = user.IMtypeid)
LEFT JOIN (localauth) ON (localauth.userid = user.id)
WHERE
EOF
	
	# If the user identifier is all digits match it to user.id
	# Otherwise, match user.unityid
	if ($user_identifier =~ /^\d+$/) {
		$select_statement .= "user.id = $user_identifier";
	}
	else {
		$select_statement .= "user.unityid LIKE '$user_identifier'";
	}
	
	# If the affiliation identifier argument was specified add affiliation table clause
	if (defined($affiliation_identifier)) {
		if ($affiliation_identifier =~ /^\d+$/) {
			$select_statement .= "\nAND affiliation.id = $affiliation_identifier";
		}
		else {
			$select_statement .= "\nAND affiliation.name LIKE '$affiliation_identifier'";
		}
	}

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);
	
	# Check to make sure row was returned
	if (!@selected_rows) {
		notify($ERRORS{'WARNING'}, 0, "user was not found in the database: '$user_identifier'");
		return;
	}
	elsif (scalar @selected_rows > 1) {
		my $user_ids;
		for my $row (@selected_rows) {
			$user_ids->{$row->{id}} = $row->{unityid} . '@' . $row->{affiliation_name};
		}
		
		notify($ERRORS{'WARNING'}, 0, scalar @selected_rows . " rows were returned from database select for user: '$user_identifier', affiliation '$affiliation_identifier':\n" . format_data($user_ids) . "\nSQL statement:\n$select_statement");
		return;
	}
	
	# Transform the database row into a hash
	my $row = $selected_rows[0];
	my $user_info;
	
	# Loop through all the columns returned
	for my $key (keys %$row) {
		my $value = $row->{$key};
		
		# Create another variable by stripping off the column_ part of each key
		# This variable stores the original (correct) column name
		(my $original_key = $key) =~ s/^.+_//;
		
		if ($key =~ /^(.+)_/) {
			$user_info->{$1}{$original_key} = $value;
		}
		else {
			$user_info->{$original_key} = $value;
		}
	}
	
	my $user_id = $user_info->{id};
	my $user_login_id = $user_info->{unityid};
	my $user_affiliation_name = $user_info->{affiliation}{name};
	
	# Set the user's preferred name to the first name if it isn't defined
	if (!defined($user_info->{preferredname}) || $user_info->{preferredname} eq '') {
		$user_info->{preferredname} = $user_info->{firstname};
	}

	# Set the user's IMid to '' if it's NULL
	if (!defined($user_info->{IMid})) {
		$user_info->{IMid} = '';
	}
	
	$user_info->{FEDERATED_LINUX_AUTHENTICATION} = 0;
	if (!$user_info->{uid}) {
		# Set the user's UID to 500 + user.id if it's not configured in the database
		$user_info->{uid} = ($user_info->{id} + 500);
		notify($ERRORS{'DEBUG'}, 0, "UID value is not configured for $user_login_id\@$user_affiliation_name, setting UID=$user_info->{uid}, setting FEDERATED_LINUX_AUTHENTICATION=$user_info->{FEDERATED_LINUX_AUTHENTICATION}");
	}
	else {
		# Check if the user's affiliation is listed in the management node's NOT_STANDALONE list
		my $management_node_info = get_management_node_info() || return;
		my $not_standalone_list = $management_node_info->{NOT_STANDALONE} || '';
		my @standalone_affiliations = split(/[,;\s]+/, $not_standalone_list);
		if (@standalone_affiliations) {
			if (grep(/^\s*$user_affiliation_name\s*$/i, @standalone_affiliations)) {
				$user_info->{FEDERATED_LINUX_AUTHENTICATION} = 1;
				notify($ERRORS{'DEBUG'}, 0, "affiliation of $user_login_id\@$user_affiliation_name is in management node's 'Affiliations Using Federated Authentication for Linux Images' list: '$management_node_info->{NOT_STANDALONE}', setting FEDERATED_LINUX_AUTHENTICATION=$user_info->{FEDERATED_LINUX_AUTHENTICATION}");
			}
			else {
				notify($ERRORS{'DEBUG'}, 0, "affiliation of $user_login_id\@$user_affiliation_name is NOT in management node's 'Affiliations Using Federated Authentication for Linux Images' list: '$management_node_info->{NOT_STANDALONE}', setting FEDERATED_LINUX_AUTHENTICATION=$user_info->{FEDERATED_LINUX_AUTHENTICATION}");
			}
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "management node's 'Affiliations Using Federated Authentication for Linux Images' list is empty, setting FEDERATED_LINUX_AUTHENTICATION=$user_info->{FEDERATED_LINUX_AUTHENTICATION}");
		}
	}
	
	# If user's unityid is an email address, use only the first part
	if ($user_login_id =~ /(.+)@/) {
		my $corrected_unity_id = $1;
		notify($ERRORS{'DEBUG'}, 0, "user's unityid value contains '\@': $user_login_id, changing to $corrected_unity_id");
		$user_info->{unityid} = $corrected_unity_id;
	}

	# If usepublickeys =0 && sshpublickeys is defined, disable public keys by setting sshpublickeys=0
	if (!$user_info->{usepublickeys} && defined($user_info->{sshpublickeys})) {
		$user_info->{sshpublickeys} = 0;
	}
	
	#notify($ERRORS{'DEBUG'}, 0, "retrieved info for user '$user_identifier', affiliation: '$affiliation_identifier':\n" . format_data($user_info));
	$ENV{user_info}{$user_identifier} = $user_info;
	$ENV{user_info}{$user_identifier}{RETRIEVAL_TIME} = time;
	return $ENV{user_info}{$user_identifier};	
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_local_user_info

 Parameters  : none
 Returns     : hash reference
 Description : Retrieves info for all local users and returns a hash reference.
               The keys of the hash are user IDs.

=cut

sub get_local_user_info {
	my $select_statement = <<EOF;
SELECT
userid
FROM
localauth
EOF

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);
	
	# Check to make sure 1 row was returned
	if (scalar @selected_rows == 0) {
		notify($ERRORS{'OK'}, 0, "local user was not found in the database, 0 rows were returned");
		return;
	}
	
	# Transform the array of database rows into a hash
	my $local_user_info;
	for my $row (@selected_rows) {
		my $user_id = $row->{userid};
		
		my $user_info = get_user_info($user_id);
		$local_user_info->{$user_id} = $user_info;
	}
	
	notify($ERRORS{'DEBUG'}, 0, "retrieved local user info:\n" . format_data($local_user_info));
	return $local_user_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_group_name

 Parameters  : $group_id
 Returns     : scalar - group name
 Description :

=cut

sub get_group_name {
	my ($group_id) = @_;
	
	
	if (!defined($group_id)) {
		notify($ERRORS{'WARNING'}, $LOGFILE, "group_id was not supplied");
		return 0;
	}

	my $select_statement = <<EOF;
SELECT DISTINCT
usergroup.name
FROM
usergroup
WHERE
usergroup.id = $group_id
EOF

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @selected_rows = database_select($select_statement);
	
	# Check to make sure 1 row was returned
	if (scalar @selected_rows == 0) {
		notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select");
		return ();
	}
	elsif (scalar @selected_rows > 1) {
		notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
		return ();
	}
	
	# Get the single returned row
	# It contains a hash
	my $end;
	
	# Make sure we return undef if the column wasn't found
	if (defined $selected_rows[0]{name}) {
		my $groupname = $selected_rows[0]{name};
		return $groupname;
	}
	else {
		return undef;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_computer_info

 Parameters  : $computer_identifier, $no_cache (optional)
 Returns     : hash reference
 Description :

=cut

sub get_computer_info {
	my ($computer_identifier, $no_cache) = @_;
	if (!defined($computer_identifier)) {
		notify($ERRORS{'WARNING'}, 0, "computer identifier argument was not supplied");
		return;
	}
	
	if (!$no_cache && defined($ENV{computer_info}{$computer_identifier})) {
		return $ENV{computer_info}{$computer_identifier};
	}
	#notify($ERRORS{'DEBUG'}, 0, "retrieving info for computer $computer_identifier");
	
	my $calling_subroutine = get_calling_subroutine();
	
	# Get a hash ref containing the database column names
	my $database_table_columns = get_database_table_columns();
	
	my @tables = (
		'computer',
		'state',
		'provisioning',
		'module',
		'schedule',
		'platform',
		'resource',
		'resourcetype',
		'nathostcomputermap'
	);
	
	# Construct the select statement
	my $select_statement = "SELECT DISTINCT\n";
	
	# Get the column names for each table and add them to the select statement
	for my $table (@tables) {
		my @columns = @{$database_table_columns->{$table}};
		for my $column (@columns) {
			$select_statement .= "$table.$column AS '$table-$column',\n";
		}
	}

	# Add the column for predictive module info
   my @columns = @{$database_table_columns->{module}};
   for my $column (@columns) {
      $select_statement .= "predictivemodule.$column AS 'predictivemodule-$column',\n";
   }
	
	# Remove the comma after the last column line
	$select_statement =~ s/,$//;
	
	# Complete the select statement
	$select_statement .= <<EOF;
FROM
computer

LEFT JOIN (state) ON (state.id = computer.stateid)
LEFT JOIN (platform) ON (platform.id = computer.platformid)
LEFT JOIN (
   provisioning,
   module
)
ON (
   provisioning.id = computer.provisioningid
   AND module.id = provisioning.moduleid
)
LEFT JOIN (schedule) ON (schedule.id = computer.scheduleid)
LEFT JOIN (module AS predictivemodule) ON (predictivemodule.id = computer.predictivemoduleid)
LEFT JOIN (
   resource,
   resourcetype
)
ON (
   resource.subid = computer.id
   AND resource.resourcetypeid = resourcetype.id
   AND resourcetype.name = 'computer'
)
LEFT JOIN (nathostcomputermap) ON (nathostcomputermap.computerid = computer.id)

WHERE
computer.deleted != '1'
AND 
EOF

	# If the computer identifier is all digits match it to computer.id
	# Otherwise, match computer.hostname
	if ($computer_identifier =~ /^\d+$/) {
		$select_statement .= "computer.id = \'$computer_identifier\'";
	}
	else {
		$select_statement .= "computer.hostname REGEXP '$computer_identifier(\\\\.|\$)'";
	}
	
	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (scalar @selected_rows == 0) {
		notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select statement:\n$select_statement");
		return;
	}
	elsif (scalar @selected_rows > 1) {
		notify($ERRORS{'WARNING'}, 0, scalar @selected_rows . " rows were returned from database select statement:\n$select_statement");
		return;
	}

	# Get the single row returned from the select statement
	my $row = $selected_rows[0];
	
	# Construct a hash with all of the computer info
	my $computer_info;
	
	# Loop through all the columns returned
	for my $key (keys %$row) {
		my $value = $row->{$key};
		
		# Split the table-column names
		my ($table, $column) = $key =~ /^([^-]+)-(.+)/;
		
		# Add the values for the primary table to the hash
		# Add values for other tables under separate keys
		if ($table eq $tables[0]) {
			$computer_info->{$column} = $value;
		}
		elsif ($table eq 'module') {
			$computer_info->{provisioning}{$table}{$column} = $value;
		}
		elsif ($table eq 'predictivemodule' ) {
			$computer_info->{predictive}{module}{$column} = $value;
		}
		elsif ($table eq 'resourcetype') {
			$computer_info->{resource}{$table}{$column} = $value;
		}
		elsif ($table eq 'nathostcomputermap') {
			$computer_info->{nathost}{$table}{$column} = $value;
		}
		else {
			$computer_info->{$table}{$column} = $value;
		}
	}
	
	my $computer_id = $computer_info->{id};
	
	# Set the short name of the computer based on the hostname
	my $computer_hostname = $computer_info->{hostname};
	my ($computer_shortname) = $computer_hostname =~ /^([^\.]+)/;
	$computer_info->{SHORTNAME} = $computer_shortname;
	
	# Set the NODENAME key based on the type of computer
	# Use the full hostname if the computer type is lab
	# Use the short name otherwise
	my $computer_type = $computer_info->{type};
	if ($computer_type eq "lab") {
		$computer_info->{NODENAME} = $computer_hostname;
	}
	else {
		$computer_info->{NODENAME} = $computer_shortname;
	}
	
	# Get the imagerevision info and add it to the hash
	my $imagerevision_id = $computer_info->{imagerevisionid};
	if ($imagerevision_id && (my $imagerevision_info = get_imagerevision_info($imagerevision_id))) {
		$computer_info->{currentimagerevision} = $imagerevision_info;
		$computer_info->{currentimage} = $imagerevision_info->{image};
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "unable to retrieve image revision info for $computer_hostname, imagerevision ID=$imagerevision_id, attempting to retrieve image revision info for the 'noimage' image");
		
		my $imagerevision_info = get_imagerevision_info('noimage');
		if ($imagerevision_info) {
			$computer_info->{currentimagerevision} = $imagerevision_info;
			$computer_info->{currentimage} = $imagerevision_info->{image};
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "failed to retrieve 'noimage' image revision info for $computer_hostname");
		}
	}
	
	# Get the nextimage info
	if (my $next_image_id = $computer_info->{nextimageid}) {
		if (my $next_imagerevision_info = get_production_imagerevision_info($next_image_id)) {
			$computer_info->{nextimagerevision} = $next_imagerevision_info;
			$computer_info->{nextimage} = $next_imagerevision_info->{image};
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "failed to retrieve nextimage info for $computer_hostname, nextimageid=$next_image_id");
		}
	}
	
	# Check if the computer associated with this reservation has a vmhostid set
	if (my $vmhost_id = $computer_info->{vmhostid}) {
		if ($calling_subroutine !~ /(get_vmhost_info)/) {
			my $vmhost_info = get_vmhost_info($vmhost_id, $no_cache);
			
			if ($vmhost_info) {
				$computer_info->{vmhost} = $vmhost_info;
			}
			else {
				notify($ERRORS{'WARNING'}, 0, "vmhostid $vmhost_id is set for $computer_hostname but the vmhost info could not be retrieved");
			}
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "skipping retrieval of VM host $vmhost_id info for $computer_hostname to avoid recursion");
		}
	}
	
	# Check if the computer associated with this reservation is assigned a NAT host
	if (my $nathost_id = $computer_info->{nathost}{nathostcomputermap}{nathostid}) {
		if ($calling_subroutine !~ /(get_computer_nathost_info)/) {
			my $nathost_info = get_computer_nathost_info($computer_id, $no_cache);
			if ($nathost_info) {
				$computer_info->{nathost} = $nathost_info;
			}
			else {
				notify($ERRORS{'WARNING'}, 0, "$computer_hostname is mapped to NAT host $nathost_id but NAT host info could not be retrieved");
			}
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "skipping retrieval of NAT host $nathost_id info for $computer_hostname to avoid recursion");
		}
	}
	
	notify($ERRORS{'DEBUG'}, 0, "retrieved info for computer: $computer_hostname ($computer_id)");
	$ENV{computer_info}{$computer_identifier} = $computer_info;
	$ENV{computer_info}{$computer_identifier}{RETRIEVAL_TIME} = time;
	return $ENV{computer_info}{$computer_identifier};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_computer_nathost_info

 Parameters  : $computer_identifier
 Returns     : hash reference
 Description : Retrieves nathost info if a nathost is mapped to the computer via
               the nathostcomputermap table. Example:
               {
                 "HOSTNAME" => "nat1.vcl.org",
                 "datedeleted" => undef,
                 "deleted" => 0,
                 "id" => 2,
                 "publicIPaddress" => "x.x.x.x",
                 "internalIPaddress" => "x.x.x.x",
                 "nathostcomputermap" => {
                   "computerid" => 3591,
                   "nathostid" => 2
                 },
                 "resource" => {
                   "id" => 6185,
                   "resourcetype" => {
                     "id" => 16,
                     "name" => "managementnode"
                   },
                   "resourcetypeid" => 16,
                   "subid" => 8
                 },
                 "resourceid" => 6185
               }

=cut

sub get_computer_nathost_info {
	my ($computer_identifier, $no_cache) = @_;
	if (!defined($computer_identifier)) {
		notify($ERRORS{'WARNING'}, 0, "computer identifier argument was not supplied");
		return;
	}
	
	return $ENV{nathost_info}{$computer_identifier} if (!$no_cache && $ENV{nathost_info}{$computer_identifier});
	
	# Get a hash ref containing the database column names
	my $database_table_columns = get_database_table_columns();
	
	my @tables = (
		'nathost',
		'nathostcomputermap',
		'resource',
		'resourcetype',
	);
	
	# Construct the select statement
	my $select_statement = "SELECT DISTINCT\n";
	$select_statement .= "computer.id AS 'computer-id',\n";
	$select_statement .= "computer.hostname AS 'computer-hostname',\n";
	
	# Get the column names for each table and add them to the select statement
	for my $table (@tables) {
		my @columns = @{$database_table_columns->{$table}};
		for my $column (@columns) {
			$select_statement .= "$table.$column AS '$table-$column',\n";
		}
	}
	
	# Remove the comma after the last column line
	$select_statement =~ s/,$//;
	
	# Complete the select statement
	$select_statement .= <<EOF;
FROM
computer,
nathostcomputermap,
nathost,
resource,
resourcetype

WHERE
nathostcomputermap.computerid = computer.id
AND nathostcomputermap.nathostid = nathost.id
AND nathost.resourceid = resource.id
AND resource.resourcetypeid = resourcetype.id
AND
EOF

	# If the computer identifier is all digits match it to computer.id
	# Otherwise, match computer.hostname
	if ($computer_identifier =~ /^\d+$/) {
		$select_statement .= "computer.id = \'$computer_identifier\'";
	}
	else {
		$select_statement .= "computer.hostname REGEXP '$computer_identifier(\\\\.|\$)'";
	}
	
	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);

	if (!@selected_rows) {
		notify($ERRORS{'DEBUG'}, 0, "NAT host is not mapped to computer $computer_identifier");
		return {};
	}
	elsif (scalar @selected_rows > 1) {
		notify($ERRORS{'WARNING'}, 0, "unable to determine NAT host mapped to computer $computer_identifier, " . scalar @selected_rows . " rows were returned from database select statement:\n$select_statement");
		return;
	}
	
	# Get the single row returned from the select statement
	my $row = $selected_rows[0];
	
	# Construct a hash with all of the computer info
	my $nathost_info;
	
	# Loop through all the columns returned
	for my $key (keys %$row) {
		my $value = $row->{$key};
		
		# Split the table-column names
		my ($table, $column) = $key =~ /^([^-]+)-(.+)/;
		
		# Add the values for the primary table to the hash
		# Add values for other tables under separate keys
		if ($table eq $tables[0]) {
			$nathost_info->{$column} = $value;
		}
		elsif ($table eq 'resourcetype') {
			$nathost_info->{resource}{resourcetype}{$column} = $value;
		}
		else {
			$nathost_info->{$table}{$column} = $value;
		}
	}
	
	$nathost_info->{HOSTNAME} = '<unknown>';
	
	my $computer_id = $nathost_info->{computer}{id};
	my $resource_id = $nathost_info->{resource}{id};
	my $resource_type = $nathost_info->{resource}{resourcetype}{name};
	my $resource_subid = $nathost_info->{resource}{subid};
	if ($resource_type eq 'managementnode') {
		my $management_node_info = get_management_node_info($resource_subid) || {};
		$nathost_info->{HOSTNAME} = $management_node_info->{hostname};
	}
	elsif ($resource_type eq 'computer') {
		# Check if NAT host is the same computer as it is assigned to to avoid recursion
		if ($computer_id eq $resource_subid) {
			$nathost_info->{HOSTNAME} = $nathost_info->{computer}{hostname};
		}
		else {
			my $computer_info = get_computer_info($resource_subid, $no_cache) || {};
			$nathost_info->{HOSTNAME} = $computer_info->{hostname};
		}
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "NAT host resource type is not supported: $resource_type, resource ID: $resource_id");
	}
	
	#notify($ERRORS{'DEBUG'}, 0, "retrieved info for NAT host mapped to computer computer $computer_identifier:\n" . format_data($nathost_info));
	$ENV{nathost_info}{$computer_identifier} = $nathost_info;
	return $ENV{nathost_info}{$computer_identifier};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_nathost_assigned_public_ports

 Parameters  : $nathost_id
 Returns     : array
 Description : Retrieves a list of natport.publicport values for the nathost
               specified by the argument.

=cut

sub get_nathost_assigned_public_ports {
	my ($nathost_id) = @_;
	if (!defined($nathost_id)) {
		notify($ERRORS{'WARNING'}, 0, "nathost ID argument was not supplied");
		return;
	}
	
	my $select_statement = "SELECT publicport FROM natport WHERE nathostid = $nathost_id ORDER BY publicport ASC";
	my @selected_rows = database_select($select_statement);
	my @ports;
	for my $row (@selected_rows) {
		push @ports, $row->{publicport};
	}
	
	if (@ports) {
		notify($ERRORS{'DEBUG'}, 0, "retrieved assigned public ports for nathost $nathost_id: " . join(", ", @ports));
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "no public ports are assigned for nathost $nathost_id");
	}
	return @ports;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_natport_ranges

 Parameters  : none
 Returns     : array
 Description : Parses the 'natport_ranges' variable. Constucts an array of
               arrays. The child arrays are in the form:
               ($start_port, $end_port)

=cut

sub get_natport_ranges {
	return @{$ENV{natport_ranges}} if defined($ENV{natport_ranges});
	
	# Retrieve and parse the natport_ranges variable
	my $natport_ranges_variable = get_variable('natport_ranges') || '49152-65535';
	my @natport_range_strings = split(/[,;\n]+/, $natport_ranges_variable);
	my @natport_ranges;
	for my $natport_range_string (@natport_range_strings) {
		my ($start_port, $end_port) = $natport_range_string =~ /(\d+)-(\d+)/g;
		if (!defined($start_port)) {
			notify($ERRORS{'WARNING'}, 0, "unable to parse NAT port range: '$natport_range_string'");
			next;
		}
		
		# Make sure port range isn't backwards
		if ($end_port < $start_port) {
			my $start_port_temp = $start_port;
			$start_port = $end_port;
			$end_port = $start_port_temp;
		}
		
		push @natport_ranges, [$start_port, $end_port];
	}
	
	notify($ERRORS{'DEBUG'}, 0, "parsed natport_ranges variable:\n" . format_data(@natport_ranges));
	$ENV{natport_ranges} = \@natport_ranges;
	return @natport_ranges;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 populate_reservation_natport

 Parameters  : $reservation_id
 Returns     : boolean
 Description : Populates the natport table for a reservation if the computer is
               mapped to a nathost. The natport table is checked for each
               connect method port assigned to each connect method for the
               reservation.

=cut

sub populate_reservation_natport {
	my ($reservation_id) = @_;
	if (!defined($reservation_id)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	
	my $request_info = get_reservation_request_info($reservation_id, 0);
	my $computer_id = $request_info->{reservation}{$reservation_id}{computerid};
	my $computer_name = $request_info->{reservation}{$reservation_id}{computer}{SHORTNAME};
	my $imagerevision_id = $request_info->{reservation}{$reservation_id}{imagerevision}{id};
	
	my $nathost_info = $request_info->{reservation}{$reservation_id}{computer}{nathost};
	my $nathost_id = $nathost_info->{id};
	my $nathost_hostname = $nathost_info->{HOSTNAME};
	my $nathost_public_ip_address = $nathost_info->{publicIPaddress};
	
	# Make sure the nathost info is defined
	if (!defined($nathost_id)) {
		notify($ERRORS{'DEBUG'}, 0, "natport table does not need to be populated, computer $computer_id is not mapped to a NAT host");
		return 1;
	}
	notify($ERRORS{'DEBUG'}, 0, "computer $computer_id is mapped to NAT host $nathost_hostname ($nathost_hostname)");
	
	# Retrieve the connect method info - do not use cached info
	my $connect_method_info = get_reservation_connect_method_info($reservation_id, 1);
	
	# Retrieve the ports already assigned to the nathost
	my @assigned_ports = get_nathost_assigned_public_ports($nathost_id);
	
	# Put the assigned ports into a hash for easy checking
	my %assigned_port_hash = map { $_ => 1 } @assigned_ports;
	
	my %available_port_hash;
	
	# Retrieve the natport range pairs
	my @natport_ranges = get_natport_ranges();
	for my $natport_range (@natport_ranges) {
		my ($start_port, $end_port) = @$natport_range;
		if (!defined($start_port)) {
			notify($ERRORS{'WARNING'}, 0, "unable to parse NAT port range:\n" . format_data($natport_range));
			next;
		}
		
		# Loop through all of the ports in the range, check if already assigned
		for (my $port = $start_port; $port<=$end_port; $port++) {
			if (!defined($assigned_port_hash{$port})) {
				$available_port_hash{$port} = 1;
			}
		}
	}
	
	# Loop through the connect methods
	# Check if a public port has been assigned for each
	for my $connect_method_id (sort keys %$connect_method_info) {
		my $connect_method_port_info = $connect_method_info->{$connect_method_id}{connectmethodport};
		
		CONNECT_METHOD_PORT_ID: for my $connect_method_port_id (sort keys %$connect_method_port_info) {
			my $connect_method_port = $connect_method_port_info->{$connect_method_port_id};
			
			if (defined($connect_method_port->{natport})) {
				notify($ERRORS{'DEBUG'}, 0, "NAT public port is already assigned for connect method ID: $connect_method_id, port ID: $connect_method_port_id\n" . format_data($connect_method_port->{natport}));
				next CONNECT_METHOD_PORT_ID;
			}
			
			# Select a random port from the list of available ports
			my @available_ports = sort keys %available_port_hash;
			my $available_port_count = scalar(@available_ports);
			if (!$available_port_count) {
				notify($ERRORS{'CRITICAL'}, 0, "no NAT public ports are available for NAT host $nathost_hostname ($nathost_id)");
				return;
			}
			my $random_index =  int(rand($available_port_count));
			my $public_port = $available_ports[$random_index];
			
			# Remove the selected port from the available port hash
			delete $available_port_hash{$public_port};
			
			# Make multiple attempts, it's possible 2 reservations will attempt to assign the same public port at the same time
			# Using random ports helps avoid collisions
			# TODO: add semaphore
			my $attempt_limit = 5;
			for (my $attempt = 1; $attempt <= $attempt_limit; $attempt++) {
				sleep_uninterrupted(1);
				if (insert_natport($reservation_id, $nathost_id, $connect_method_port_id, $public_port)) {
					next CONNECT_METHOD_PORT_ID;
				}
			}
			notify($ERRORS{'CRITICAL'}, 0, "failed to insert natport entry after making $attempt_limit attempts:\n" .
				"connectmethod ID: $connect_method_id\n" .
				"connectmethodport ID: $connect_method_port_id\n" .
				"reservation ID: $reservation_id\n" .
				"nathost ID: $nathost_id\n" .
				"public port: $public_port"
			);
			return;
		}
	}
	
	# Get the connect method info again to verify all ports are assigned a NAT public port
	my $info_string = "";
	$connect_method_info = get_reservation_connect_method_info($reservation_id, 1);
	for my $connect_method_id (sort keys %$connect_method_info) {
		my $connect_method = $connect_method_info->{$connect_method_id};
		my $connect_method_name = $connect_method->{name};
		
		for my $connect_method_port_id (sort keys %{$connect_method->{connectmethodport}}) {
			my $connect_method_port = $connect_method->{connectmethodport}{$connect_method_port_id};
			my $protocol = $connect_method_port->{protocol};
			my $port = $connect_method_port->{port};
			
			my $nat_port = $connect_method_port->{natport};
			my $public_port = $nat_port->{publicport};
			if (!defined($nat_port)) {
				notify($ERRORS{'WARNING'}, 0, "NAT public port is not assigned for connect method ID: $connect_method_id, port ID: $connect_method_port_id");
				return;
			}
			$info_string .= "$connect_method_name: $nathost_public_ip_address:$public_port --> $computer_name:$port ($protocol)\n";
		}
	}
	notify($ERRORS{'DEBUG'}, 0, "NAT port forwarding information:\n$info_string");
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 insert_natport

 Parameters  : $reservation_id, $nathost_id, $connect_method_port_id, $public_port
 Returns     : boolean
 Description : Inserts an entry into the natport table.

=cut

sub insert_natport {
	my ($reservation_id, $nathost_id, $connect_method_port_id, $public_port) = @_;
	if (!defined($reservation_id)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	elsif (!defined($nathost_id)) {
		notify($ERRORS{'WARNING'}, 0, "nathost ID argument was not supplied");
		return;
	}
	elsif (!defined($connect_method_port_id)) {
		notify($ERRORS{'WARNING'}, 0, "connect method port ID argument was not supplied");
		return;
	}
	elsif (!defined($public_port)) {
		notify($ERRORS{'WARNING'}, 0, "public port argument was not supplied");
		return;
	}
	
	my $insert_statement = <<EOF;
INSERT IGNORE INTO
natport
(
   reservationid,
   nathostid,
   connectmethodportid,
   publicport
)
VALUES
(
   $reservation_id,
   $nathost_id,
   $connect_method_port_id,
   $public_port
)
ON DUPLICATE KEY UPDATE publicport = $public_port
EOF

	my $result = database_execute($insert_statement);
	if ($result) {
		notify($ERRORS{'DEBUG'}, 0, "inserted entry into natport table:\nreservation: $reservation_id\nnathost ID: $nathost_id\nconnectmethodport ID: $connect_method_port_id\npublic port: $public_port");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to insert entry into natport table\nreservation: $reservation_id\nnathost ID: $nathost_id\nconnectmethodport ID: $connect_method_port_id\npublic port: $public_port");
		return 0;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 insert_nathost

 Parameters  : $resource_type, $resource_identifier
 Returns     : boolean
 Description : Inserts an entry into the nathost table. The $resource_type
               argument must either be 'computer' or 'managementnode'.

=cut

sub insert_nathost {
	my ($resource_type, $resource_identifier) = @_;
	if (!defined($resource_type)) {
		notify($ERRORS{'WARNING'}, 0, "resource type argument was not supplied");
		return;
	}
	elsif ($resource_type !~ /^(computer|managementnode)$/) {
		notify($ERRORS{'WARNING'}, 0, "resource type argument is not valid: '$resource_type', it must either be 'computer' or 'managementnode'");
		return;
	}
	elsif (!defined($resource_identifier)) {
		notify($ERRORS{'WARNING'}, 0, "resource identifier argument was not supplied");
		return;
	}
	
	my $resource_id;
	my $public_ip_address;
	if ($resource_type eq 'computer') {
		my $computer_info = get_computer_info($resource_identifier);
		if (!$computer_info) {
			notify($ERRORS{'WARNING'}, 0, "failed to insert nathost, info could not be retrieved for computer '$resource_identifier'");
			return;
		}
		$resource_id = $computer_info->{resource}{id};
		$public_ip_address = $computer_info->{IPaddress};
	}
	elsif ($resource_type eq 'managementnode') {
		my $management_node_info = get_management_node_info($resource_identifier);
		if (!$management_node_info) {
			notify($ERRORS{'WARNING'}, 0, "failed to insert nathost, info could not be retrieved for management node '$resource_identifier'");
			return;
		}
		$resource_id = $management_node_info->{resource_id};
		$public_ip_address = $management_node_info->{IPaddress};
	}
	
	my $insert_statement = <<EOF;
INSERT IGNORE INTO
nathost
(
   resourceid,
   publicIPaddress
)
VALUES
(
   '$resource_id',
	'$public_ip_address'
)
ON DUPLICATE KEY UPDATE
resourceid=VALUES(resourceid),
publicIPaddress='$public_ip_address'
EOF

	if (database_execute($insert_statement)) {
		notify($ERRORS{'DEBUG'}, 0, "inserted entry into nathost table for $resource_type, resource ID: $resource_id, NAT host public IP address: $public_ip_address");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to insert entry into nathost table for $resource_type, resource ID: $resource_id, NAT host public IP address: $public_ip_address");
		return 0;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 update_reservation_natlog

 Parameters  : $reservation_id
 Returns     : boolean
 Description : Adds or updates an entry in the natlog table.

=cut

sub update_reservation_natlog {
	my ($reservation_id) = @_;
	if (!defined($reservation_id)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	
	my $insert_statement = <<EOF;
INSERT IGNORE INTO
natlog
(
   sublogid,
   nathostresourceid,
   publicIPaddress,
   publicport,
	internalIPaddress,
   internalport,
   protocol,
   timestamp
)
(
SELECT
   sublog.id,
   nathost.resourceid,
   nathost.publicIPaddress,
   natport.publicport,
	nathost.internalIPaddress,
   connectmethodport.port AS internalport,
   connectmethodport.protocol,
   NOW()
   FROM
   request,
   reservation,
   sublog,
   natport,
   nathost,
   connectmethodport
   WHERE
   reservation.id = $reservation_id
   AND reservation.requestid = request.id
   AND request.logid = sublog.logid
   AND sublog.computerid = reservation.computerid
   AND natport.reservationid = reservation.id
   AND natport.nathostid = nathost.id
   AND natport.connectmethodportid = connectmethodport.id
)
ON DUPLICATE KEY UPDATE
timestamp=VALUES(timestamp)
EOF

	if (database_execute($insert_statement)) {
		notify($ERRORS{'DEBUG'}, 0, "updated natlog table for reservation $reservation_id");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update natlog table for reservation $reservation_id");
		return 0;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_vcld_semaphore_info

 Parameters  : $semaphore_identifier
 Returns     : hash reference
 Description : Retrieves information for all rows in the vcldsemaphore table. A
               hash is constructed. The keys are the vcldsemaphore.identifier
               values:
                  {
                    "sem_3115" => {
                      "expires" => "2017-03-15 11:54:36",
                      "pid" => 13775,
                      "reservationid" => 3115
                    },
                    "sem_3116" => {
                      "expires" => "2017-03-15 11:54:35",
                      "pid" => 13769,
                      "reservationid" => 3116
                    }
                  }

=cut

sub get_vcld_semaphore_info {
	my @rows = database_select('SELECT * FROM vcldsemaphore');
	
	my $vcld_semaphore_info = {};
	for my $row (@rows) {
		my $semaphore_identifier = $row->{'identifier'};
		for my $column (keys %$row) {
			next if $column eq 'identifier';
			$vcld_semaphore_info->{$semaphore_identifier}{$column} = $row->{$column};
		}
	}
	
	notify($ERRORS{'DEBUG'}, 0, "retrieved vcld semaphore info:\n" . format_data($vcld_semaphore_info));
	return $vcld_semaphore_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 insert_vcld_semaphore

 Parameters  : $semaphore_identifier, $reservation_id, $semaphore_expire_seconds, $force (optional)
 Returns     : boolean
 Description : Attempts to insert a row into the vcldsemaphore table. The
					$semaphore_expire_seconds argument should contain an integer
					representing the number of seconds in the future when the
					semaphore can be deemed orphaned. The Semaphore.pm module should
					always clean up all rows added to the vcldsemaphore table when
					the semaphore object is destroyed. This is not guaranteed if a
					process dies abruptly with a KILL signal. If $expire_seconds is
					not provided, a default value of 600 seconds (10 minutes) will be
					used.

=cut

sub insert_vcld_semaphore {
	my ($semaphore_identifier, $reservation_id, $semaphore_expire_seconds, $force) = @_;
	if (!defined($semaphore_identifier)) {
		notify($ERRORS{'WARNING'}, 0, "semaphore identifier argument was not supplied");
		return;
	}
	elsif (!defined($reservation_id)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	elsif (!defined($semaphore_expire_seconds)) {
		notify($ERRORS{'WARNING'}, 0, "semaphore expire seconds argument was not supplied");
		return;
	}
	elsif ($semaphore_expire_seconds !~ /^\d+$/) {
		notify($ERRORS{'WARNING'}, 0, "semaphore expire seconds argument is invalid: $semaphore_expire_seconds");
		return;
	}
	
	my $insert_statement = <<EOF;
INSERT INTO
vcldsemaphore
(
   identifier,
	reservationid,
	pid,
	expires
	
)
VALUES
(
   '$semaphore_identifier',
	$reservation_id,
	$PID,
   TIMESTAMPADD(SECOND, $semaphore_expire_seconds, NOW())
)
EOF

	if ($force) {
		$insert_statement .= <<"EOF";
ON DUPLICATE KEY UPDATE
identifier = VALUES(identifier),
reservationid = VALUES(reservationid),
pid = $PID,
expires = TIMESTAMPADD(SECOND, $semaphore_expire_seconds, NOW())
EOF
	}

	# Execute the insert statement, the return value should be the id of the row
	my ($result, $insert_error) = database_execute($insert_statement);
	if ($result) {
		notify($ERRORS{'DEBUG'}, 0, "inserted row into vcldsemaphore table, identifier: $semaphore_identifier, semaphore expire seconds: $semaphore_expire_seconds");
		return 1;
	}
	elsif ($insert_error =~ /Duplicate/i) {
		notify($ERRORS{'OK'}, 0, "vcldsemaphore table already contains a row with procid = '$semaphore_identifier': $insert_error");
		return 0;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to insert row into vcldsemaphore table, identifier: $semaphore_identifier, error: $insert_error\nSQL statement:\n$insert_statement");
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 delete_vcld_semaphore

 Parameters  : $semaphore_identifier, $expires_datetime (optional)
 Returns     : boolean
 Description : Deletes an entry from the vcldsemaphore table with the
               semaphore.identifier value specified by the argument.
               
               If the $expires_datetime argument is NOT supplied, only entries
               with a vcldsemaphore.pid value matching the current process's PID
               will be deleted for safety.
               
               In order to delete or clean up entries created by other
               processes, the $expires_datetime argument is required. This
               argument must be specified when deleting entries made by other
               processes to prevent accidental deletion of entries with the same
               identifier created between the time the current process retrieves
               the info and calls this subroutine. When $expires_datetime is
               specified, entries with any vcldsemaphore.pid value will be
               deleted but the semaphore.expires value must match the argument. 

=cut

sub delete_vcld_semaphore {
	my ($semaphore_identifier, $expires_datetime) = @_;
	if (!defined($semaphore_identifier)) {
		notify($ERRORS{'WARNING'}, 0, "semaphore identifier argument was not supplied");
		return;
	}
	
	my $delete_statement .= <<"EOF";
DELETE 
FROM 
vcldsemaphore
WHERE
identifier = '$semaphore_identifier'
EOF
	
	my $where_string;
	if ($expires_datetime) {
		$delete_statement .= "AND expires = '$expires_datetime'";
		$where_string = ", expires: $expires_datetime";
	}
	else {
		$delete_statement .= "AND pid = $PID";
		$where_string = ", pid: $PID";
	}
	
	if (database_execute($delete_statement)) {
		notify($ERRORS{'OK'}, 0, "deleted vcldsemaphore with identifier: '$semaphore_identifier'$where_string");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to delete vcldsemaphore with identifier: '$semaphore_identifier'$where_string");
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_reservation_management_node_hostname

 Parameters  : $reservation_id, $no_cache (optional)
 Returns     : string
 Description : Returns the hostname of the management node assigned to the
               reservation specified by the argument.

=cut


sub get_reservation_management_node_hostname {
	my ($reservation_id, $no_cache) = @_;
	if (!defined($reservation_id)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	
	if (!$no_cache && defined($ENV{reservation_management_node_hostname}{$reservation_id})) {
		return $ENV{reservation_management_node_hostname}{$reservation_id};
	}
	
	my $select_statement = <<EOF;
SELECT
managementnode.hostname
FROM
reservation,
managementnode
WHERE
reservation.id = '$reservation_id'
AND reservation.managementnodeid = managementnode.id
EOF

	my @selected_rows = database_select($select_statement);
	if (!@selected_rows) {
		notify($ERRORS{'WARNING'}, 0, "failed to retrieve management node hostname for reservation $reservation_id");
		return;
	}
	
	my $row = $selected_rows[0];
	my $hostname = $row->{hostname};
	notify($ERRORS{'DEBUG'}, 0, "retrieved management node hostname for reservation $reservation_id: hostname");
	$ENV{reservation_management_node_hostname}{$reservation_id} = $hostname;
	return $hostname;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_reservation_request_id

 Parameters  : $reservation_id, $no_cache (optional)
 Returns     : integer
 Description : Retrieves the request ID assigned of a reservation.

=cut

sub get_reservation_request_id {
	my ($reservation_id, $no_cache) = @_;
	if (!defined($reservation_id)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	
	if (!$no_cache && defined($ENV{reservation_request_id}{$reservation_id})) {
		return $ENV{reservation_request_id}{$reservation_id};
	}
	
	my $select_statement = "SELECT requestid FROM reservation WHERE id = '$reservation_id'";
	my @selected_rows = database_select($select_statement);
	if (!@selected_rows) {
		notify($ERRORS{'WARNING'}, 0, "failed to retrieve request ID for reservation $reservation_id");
		return;
	}
	
	my $row = $selected_rows[0];
	my $request_id = $row->{requestid};
	notify($ERRORS{'DEBUG'}, 0, "retrieved reservation $reservation_id request ID: $request_id");
	$ENV{reservation_request_id}{$reservation_id} = $request_id;
	return $request_id;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_all_reservation_ids

 Parameters  : none
 Returns     : array
 Description : Retrieves the IDs of all reservations regardless of state or any
               other attributes.

=cut

sub get_all_reservation_ids {
	my @rows = database_select('SELECT id FROM reservation');
	my @reservation_ids = sort {$a <=> $b} map { $_->{id} } @rows;
	notify($ERRORS{'DEBUG'}, 0, "retrieved all reservation IDs currently defined in the database: " . join(', ', @reservation_ids));
	return @reservation_ids;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_reservation_request_info

 Parameters  : $reservation_id, $no_cache (optional)
 Returns     : hash reference
 Description : Retrieves the request info for a reservation.

=cut

sub get_reservation_request_info {
	my ($reservation_id, $no_cache) = @_;
	if (!defined($reservation_id)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	
	my $request_id = get_reservation_request_id($reservation_id, $no_cache);
	if (!$request_id) {
		notify($ERRORS{'WARNING'}, 0, "unable to retrieve request info for reservation $reservation_id, failed to determine request ID for reservation");
		return;
	}
	
	return get_request_info($request_id, $no_cache);
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_computer_ids

 Parameters  : $computer_identifier
 Returns     : If called in scalar context: integer
               If called in array context: array
 Description : Queries the computer table for computers matching the
               $computer_identifier argument. The argument may contain either
               the computer's hostname or IP address. Deleted computers are not
               considered.
               
               If called in scalar context:
               - returns an integer if a single computer matched the argument
               - returns null if no computers or multiple computers match the
                 argument
               
               If called in array context:
               - returns an array containing matching computer IDs
               - returns an empty array if no computers match the argument

=cut

sub get_computer_ids {
	my ($computer_identifier) = @_;
	
	if (!defined($computer_identifier)) {
		notify($ERRORS{'WARNING'}, $LOGFILE, "computer identifier argument was not supplied");
		return;
	}

	my $select_statement = <<EOF;
SELECT
id,
hostname
FROM
computer
WHERE
deleted = 0
AND (
   hostname REGEXP '^$computer_identifier(\\\\.|\$)'
   OR IPaddress = '$computer_identifier'
   OR privateIPaddress = '$computer_identifier'
)
EOF

	my @selected_rows = database_select($select_statement);
	my @computer_ids = map { $_->{id} } @selected_rows;
	my $computer_id_count = scalar(@computer_ids);
	
	if (!$computer_id_count) {
		notify($ERRORS{'WARNING'}, 0, "no computers were found matching argument: $computer_identifier");
		return;
	}
	
	if (wantarray) {
		notify($ERRORS{'DEBUG'}, 0, $computer_id_count . " computer" . ($computer_id_count == 1 ? ' was' : 's were') . " found matching argument: $computer_identifier, returning computer ID" . ($computer_id_count == 1 ? '' : 's') . ": " . join(", ", @computer_ids));
		return @computer_ids;
	}
	else {
		if ($computer_id_count > 1) {
			notify($ERRORS{'WARNING'}, 0, "multiple computers were found matching argument: $computer_identifier\n" . format_data(\@selected_rows));
			return;
		}
		else {
			my $computer_id = $computer_ids[0];
			#notify($ERRORS{'DEBUG'}, 0, "computer was found matching argument $computer_identifier, returning computer ID: $computer_id");
			return $computer_id;
		}
	}
}

##/////////////////////////////////////////////////////////////////////////////
#
#=head2 insert_reservation
#
# Parameters  : hash reference
# Returns     : array or integer
# Description : Inserts a reservation into the database. A hash reference
#               argument must be supplied with the following keys:
#                  state          : request state name
#                  user           : user identifier
#                  computer       : computer identifier
#                  imagerevision  : image revision identifier
#               
#               The following keys are optional:
#                  managementnode : management node identifier
#                                   (default: current management node)
#                  laststate      : request laststate name
#                                   (default: same as request.state)
#                  start_minutes  : minutes in future of request.start
#                                   (default: 0)
#                  end_minutes    : minutes in future of request.end
#                                   (default: 120)
#
#=cut
#
#sub insert_reservation {
#	my ($arguments) = @_;
#	if (!defined($arguments)) {
#		notify($ERRORS{'WARNING'}, 0, "argument hash reference was not supplied");
#		return;
#	}
#	elsif (!ref($arguments) || ref($arguments) ne 'HASH') {
#		notify($ERRORS{'WARNING'}, 0, "argument is not a hash reference:\n" . format_data($arguments));
#		return;
#	}
#	
#	my $managementnode_identifier 	= $arguments->{'managementnode'};
#	my $request_state_name 				= $arguments->{'state'};
#	my $request_laststate_name 		= $arguments->{'laststate'};
#	my $user_identifier 					= $arguments->{'user'};
#	my $computer_identifier 			= $arguments->{'computer'};
#	my $imagerevision_identifier 		= $arguments->{'imagerevision'};
#	my $future_start_minutes 			= $arguments->{'start_minutes'} || 0;
#	my $future_end_minutes 				= $arguments->{'end_minutes'} || 120;
#	
#	if (!defined($request_state_name)) {
#		notify($ERRORS{'WARNING'}, 0, "argument hash reference does not contain a required 'state' key");
#		return;
#	}
#	if (!defined($user_identifier)) {
#		notify($ERRORS{'WARNING'}, 0, "argument hash reference does not contain a required 'user' key");
#		return;
#	}
#	if (!defined($computer_identifier)) {
#		notify($ERRORS{'WARNING'}, 0, "argument hash reference does not contain a required 'computer' key");
#		return;
#	}
#	if (!defined($imagerevision_identifier)) {
#		notify($ERRORS{'WARNING'}, 0, "argument hash reference does not contain a required 'imagerevision' key");
#		return;
#	}
#	
#	$request_laststate_name = $request_state_name unless defined($request_laststate_name);
#	
#	# Retrieve current management node info if argument was not specified
#	my $management_node_info = get_management_node_info($managementnode_identifier);
#	if (!defined($management_node_info)) {
#		notify($ERRORS{'WARNING'}, 0, "failed to insert reservation, management node info could not be retrieved");
#		return;
#	}
#	my $management_node_id = $management_node_info->{id};
#	my $management_node_hostname = $management_node_info->{hostname};
#	
#	my $user_info = get_user_info($user_identifier);
#	if (!defined($user_info)) {
#		notify($ERRORS{'WARNING'}, 0, "failed to insert reservation, user info could not be retrieved");
#		return;
#	}
#	my $user_id = $user_info->{id};
#	my $user_unityid = $user_info->{unityid};
#	
#	my $computer_info = get_computer_info($computer_identifier);
#	if (!defined($computer_info)) {
#		notify($ERRORS{'WARNING'}, 0, "failed to insert reservation, computer info could not be retrieved");
#		return;
#	}
#	my $computer_id = $computer_info->{id};
#	my $computer_hostname = $computer_info->{hostname};
#	
#	my $imagerevision_info = get_imagerevision_info($imagerevision_identifier);
#	if (!defined($imagerevision_info)) {
#		notify($ERRORS{'WARNING'}, 0, "failed to insert reservation, image revision info could not be retrieved");
#		return;
#	}
#	my $imagerevision_id = $imagerevision_info->{id};
#	my $image_id = $imagerevision_info->{imageid};
#	my $image_name = $imagerevision_info->{imagename};
#	
#	notify($ERRORS{'DEBUG'}, 0, "attempting to insert reservation:\n" .
#		"request state: $request_state_name/$request_laststate_name\n" .
#		"management node: $management_node_hostname (ID: $management_node_id)\n" .
#		"user: $user_unityid (ID: $user_id)\n" .
#		"computer: $computer_hostname (ID: $computer_id)\n" .
#		"image: $image_name (ID: $image_id, imagerevision ID: $imagerevision_id)"
#	);
#	
#	# Only insert a log table entry if this reservation is tied to a user
#	# Don't insert for reload, tomaintenance, etc.
#	my $log_id;
#	my $sublog_id
#	if ($request_state_name =~ /^(new|inuse|reserved|timeout)$/) {
#		my $insert_log_statement = <<EOF;
#INSERT INTO log
#(userid, start, initialend, finalend, computerid, imageid)
#VALUES (
#	$user_id,
#	TIMESTAMPADD(MINUTE, $future_start_minutes, NOW()),
#	NOW(),
#	TIMESTAMPADD(MINUTE, $future_end_minutes, NOW()),
#	$computer_id,
#	$image_id
#)
#EOF
#		$log_id = database_execute($insert_log_statement);
#		if (!$log_id) {
#			notify($ERRORS{'WARNING'}, 0, "unable to insert reservation, failed to insert into log table");
#			return;
#		}
#		
#		
#		my $insert_sublog_statement = <<EOF;
#INSERT INTO sublog
#(logid, imageid, imagerevisionid, computerid, managementnodeid, predictivemoduleid)
#VALUES (
#	$log_id,
#	$image_id,
#	$imagerevision_id,
#	$computer_id,
#	$management_node_id,
#	(SELECT MIN(id) FROM module WHERE perlpackage = 'VCL::Module::Predictive::Level_0')
#)
#EOF
#		$sublog_id = database_execute($insert_sublog_statement);
#		if (!$sublog_id) {
#			notify($ERRORS{'WARNING'}, 0, "unable to insert reservation, failed to insert into sublog table");
#			return;
#		}
#	}
#	else {
#		notify($ERRORS{'DEBUG'}, 0, "log table entry not inserted, request state: $request_state_name");
#	}
#	
#	my $log_id_string = (defined($log_id) ? $log_id : 'NULL');
#	my $sublog_id_string = (defined($sublog_id) ? $sublog_id : 'NULL');
#	
#	my $insert_request_statement = <<EOF;
#INSERT INTO request
#(userid, stateid, laststateid, logid, start, end)
#VALUES (
#	$user_id,
#	(SELECT id FROM state WHERE name = '$request_state_name'),
#	(SELECT id FROM state WHERE name = '$request_laststate_name'),
#	$log_id_string,
#	TIMESTAMPADD(MINUTE, $future_start_minutes, NOW()),
#	TIMESTAMPADD(MINUTE, $future_end_minutes, NOW()),
#)
#EOF
#	my $request_id = database_execute($insert_request_statement);
#	if (!$request_id) {
#		notify($ERRORS{'WARNING'}, 0, "unable to insert reservation, failed to insert into request table");
#		return;
#	}
#	
#	my $insert_reservation_statement = <<EOF;
#INSERT INTO reservation
#(requestid, computerid, imageid, imagerevisionid, managementnodeid)
#VALUES (
#	$request_id,
#	$computer_id,
#	$image_id,
#	$imagerevision_id,
#	$management_node_id
#)
#EOF
#	my $reservation_id = database_execute($insert_reservation_statement);
#	if (!$reservation_id) {
#		notify($ERRORS{'WARNING'}, 0, "unable to insert reservation, failed to insert into reservation table");
#		return;
#	}
#	
#	if ($log_id) {
#		my $update_log_statement = "UPDATE log SET requestid = $request_id WHERE id = $log_id";
#		database_execute($update_log_statement);
#	}
#	
#	notify($ERRORS{'OK'}, 0, "inserted reservation:\n" .
#		"request ID: $request_id\n" .
#		"reservation ID: $reservation_id\n" .
#		"log ID: $log_id_string\n" .
#		"sublog ID: $sublog_id_string"
#	);
#	if (wantarray) {
#		return ($request_id, $reservation_id);
#	}
#	else {
#		return $reservation_id;
#	}
#}

#//////////////////////////////////////////////////////////////////////////////

=head2 insert_request

 Parameters  : $managementnode_id, $request_state_name, $request_laststate_name, $user_unityid, $computer_identifier, $image_id, $imagerevision_id, $start_minutes_in_future, $end_minutes_in_future
 Returns     : boolean
 Description :

=cut

sub insert_request {
	my ($managementnode_id, $request_state_name, $request_laststate_name, $user_unityid, $computer_identifier, $image_id, $imagerevision_id, $start_minutes_in_future, $end_minutes_in_future) = @_;


	if (!$request_state_name) {
		notify($ERRORS{'WARNING'}, 0, "missing mandatory request key: state_name");
		return 0;
	}
	if (!$request_laststate_name) {
		notify($ERRORS{'WARNING'}, 0, "missing mandatory request key: laststate_name");
		return 0;
	}
	if (!$user_unityid) {
		notify($ERRORS{'WARNING'}, 0, "missing mandatory request key: user_unityid");
		return 0;
	}

	if (!$computer_identifier) {
		notify($ERRORS{'WARNING'}, 0, "missing mandatory reservation key: computer_identifier");
		return 0;
	}
	if (!$image_id) {
		notify($ERRORS{'WARNING'}, 0, "missing mandatory reservation key: image_id");
		return 0;
	}
	if (!$imagerevision_id) {
		notify($ERRORS{'WARNING'}, 0, "missing mandatory reservation key: imagerevision_id");
		return 0;
	}
	if (!$managementnode_id) {
		notify($ERRORS{'WARNING'}, 0, "missing mandatory reservation key: managementnode_id");
		return 0;
	}
	
	my $computer_id;
	if ($computer_identifier =~ /^\d+$/) {
		$computer_id = $computer_identifier;
	}
	else {
		$computer_id = get_computer_ids($computer_identifier);
		if (!$computer_id) {
			notify($ERRORS{'WARNING'}, 0, "failed to insert request, computer ID could not be determined from argument: $computer_identifier");
			return;
		}
	}
	
	my $insert_request_statment = "
	INSERT INTO
	request
	(
      request.stateid,
      request.laststateid,
      request.userid,
      request.forimaging,
      request.test,
      request.preload,
      request.start,
      request.end,
      request.daterequested
	)
	VALUES
	(
      (SELECT id FROM state WHERE state.name = '$request_state_name'),
      (SELECT id FROM state WHERE state.name = '$request_laststate_name'),
      (SELECT id FROM user WHERE user.unityid = '$user_unityid'),
      '0',
      '0',
      '0',
      TIMESTAMPADD(MINUTE, $start_minutes_in_future, NOW()),
      TIMESTAMPADD(MINUTE, $end_minutes_in_future, NOW()),
      NOW()
   )
	";

	# Execute the request insert statement
	# If successful, the id of the newly inserted row is returned
	my $request_id = database_execute($insert_request_statment);
	if ($request_id) {
		notify($ERRORS{'OK'}, 0, "inserted new $request_state_name/$request_laststate_name request into request table, request id=$request_id");
	}
	else {
		notify($ERRORS{'CRITICAL'}, 0, "failed to insert new $request_state_name/$request_laststate_name request into request table");
		return 0;
	}

	my $insert_reservation_statment = "
	INSERT INTO
	reservation
	(
      reservation.requestid,
      reservation.computerid,
      reservation.imageid,
      reservation.imagerevisionid,
      reservation.managementnodeid
	)
	VALUES
	(
      '$request_id',
      '$computer_id',
      '$image_id',
      '$imagerevision_id',
      '$managementnode_id'
	)
	";

	# Execute the reservation insert statement
	# If successful, the id of the newly inserted row is returned
	my $reservation_id = database_execute($insert_reservation_statment);
	if ($reservation_id) {
		notify($ERRORS{'OK'}, 0, "inserted new reservation for request $request_id: $reservation_id");
	}
	else {
		notify($ERRORS{'CRITICAL'}, 0, "failed to insert new reservation for request $request_id");
		return 0;
	}

	return ($request_id, $reservation_id);
} ## end sub insert_request

#//////////////////////////////////////////////////////////////////////////////

=head2 insert_reload_request

 Parameters  : $request_data_hash_reference
 Returns     : nothing, always calls exit
 Description : Changes this request to a reload request then
               terminates. The vcld process will then pick up the reload
               request. It is important that this process sets the request
               laststate to 'reclaim' and that vcld does not alter it.

=cut

sub insert_reload_request {
	my ($request_data) = @_;
	my ($package,         $filename,         $line,         $sub)         = caller(0);
	my ($calling_package, $calling_filename, $calling_line, $calling_sub) = caller(0);

	# Store some hash variables into local variables
	my $request_id             = $request_data->{id};
	my $request_state_name     = $request_data->{state}{name};
	my $request_laststate_name = $request_data->{laststate}{name};
	my $reservation_id         = $request_data->{RESERVATIONID};
	my $computer_id            = $request_data->{reservation}{$reservation_id}{computer}{id};
	my $computer_type          = $request_data->{reservation}{$reservation_id}{computer}{type};
	my $managementnode_id      = $request_data->{reservation}{$reservation_id}{managementnode}{id};
	my $request_logid          = $request_data->{logid};
	my $user_unityid           = $request_data->{user}{unityid};
	my $image_id               = $request_data->{reservation}{$reservation_id}{image}{id};
	my $imagerevision_id       = $request_data->{reservation}{$reservation_id}{imagerevision}{id};

	# Assemble a consistent prefix for notify messages
	my $notify_prefix = "req=$request_id:";

	# Add an entry to the loadlog
	if ($computer_type eq "blade") {
		insertloadlog($reservation_id, $computer_id, "loadimageblade", "$calling_sub: switching request state to reload");
	}
	elsif ($computer_type eq "virtualmachine") {
		insertloadlog($reservation_id, $computer_id, "loadimagevmware", "$calling_sub: switching request state to reload");
	}
	else {
		insertloadlog($reservation_id, $computer_id, "info", "$calling_sub: switching request state to reload");
	}

	# Check to make sure computer state is not currently reload or reloading
	# It's possible for reclaimed cluster reservations to attempt to insert multiple reloads for child reservations
	# because only the parent can update the request state
	my $current_computer_state_name = get_computer_current_state_name($computer_id);
	if ($current_computer_state_name =~ /reload/) {
		notify($ERRORS{'WARNING'}, 0, "$notify_prefix current computer state is $current_computer_state_name, reload request will not be inserted");
		return 0;
	}

	# Modify computer state so reload will process
	if (update_computer_state($computer_id, "reload")) {
		notify($ERRORS{'OK'}, 0, "$notify_prefix setting computerid $computer_id into reload state");
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "$notify_prefix unable to set computerid $computer_id reload state");
	}

	# Attempt to create a new reload request
	my $request_id_reload;
	if ($request_id_reload = insert_request($managementnode_id, 'reload', $request_laststate_name, 'vclreload', $computer_id, $image_id, $imagerevision_id, '0', '30')) {
		notify($ERRORS{'OK'}, 0, "$notify_prefix inserted new reload request, id=$request_id_reload nodeid=$computer_id, imageid=$image_id, imagerevision_id=$imagerevision_id");
		insertloadlog($reservation_id, $computer_id, "info", "$calling_sub: created new reload request");
	}
	else {
		notify($ERRORS{'CRITICAL'}, 0, "$notify_prefix failed to insert new reload request");
		return 0;
	}

	return 1;
} ## end sub insert_reload_request

#//////////////////////////////////////////////////////////////////////////////

=head2 format_data

 Parameters  : $data
 Returns     : string
 Description : Formats the data argument using Data::Dumper.

=cut

sub format_data {
	my @data = @_;
	
	if (!(@data)) {
		return '<undefined>';
	}
	
	# If a string was passed which appears to be XML, convert it to a hash using XML::Simple
	if (scalar(@data) == 1 && defined($data[0]) && !ref($data[0]) && $data[0] =~ /^</) {
		my $xml_hashref = xml_string_to_hash($data[0]);
		return format_data($xml_hashref);
	}
	
	$Data::Dumper::Indent    = 1;
	$Data::Dumper::Purity    = 0;
	$Data::Dumper::Useqq     = 1;      # Use double quotes for representing string values
	$Data::Dumper::Terse     = 1;
	$Data::Dumper::Quotekeys = 1;      # Quote hash keys
	$Data::Dumper::Pair      = ' => '; # Specifies the separator between hash keys and values
	$Data::Dumper::Sortkeys  = 1;      # Hash keys are dumped in sorted order
	$Data::Dumper::Deparse   = 0;
	
	my $formatted_string = Dumper(@data);
	
	my @formatted_lines = split("\n", $formatted_string);
	
	map { $_ = ": $_" } @formatted_lines;
	
	return join("\n", @formatted_lines);
}

#//////////////////////////////////////////////////////////////////////////////

=head2 pfd

 Parameters  : $data
 Returns     : 1
 Description : Intended as a quick shortcut to call:
               print format_data($var) . "\n";
               This should only be used for development. Calls to this should
               not be committed to the repository.

=cut


sub pfd {
	print "\n";
	if (scalar(@_) > 1) {
		print format_data(\@_);
	}
	else {
		print format_data(shift);
	}
	print "\n\n";
}

#//////////////////////////////////////////////////////////////////////////////

=head2 format_hash_keys

 Parameters  : $hash_ref, $display_parent_keys, $display_values_hashref, $parents
 Returns     : hash reference
 Description : 

=cut

sub format_hash_keys {
	my ($hash_ref, $parents) = @_;
	if (!$hash_ref) {
		notify($ERRORS{'WARNING'}, 0, "hash reference argument was not supplied");
		return;
	}
	elsif (!ref($hash_ref) || ref($hash_ref) ne 'HASH') {
		notify($ERRORS{'WARNING'}, 0, "first argument is not a hash reference");
		return;
	}
	
	my $indent_character = ' ';
	
	my $return_string;
	if ($return_string) {
		$return_string .= "\n";
	}
	else {
		$return_string = '';
	}
	
	if (!defined($parents)) {
		$return_string .= "{\n";
		$return_string .= format_hash_keys($hash_ref, ['']);
		$return_string .= "}";
		return $return_string;
	}
	
	my $level = scalar(@$parents);
	
	for my $key (sort { lc($a) cmp lc($b) } keys %$hash_ref) {
		my $value = $hash_ref->{$key};
		my $type = ref($value);
		
		$return_string .= $indent_character x ($level * 3);
		
		if ($type eq 'HASH') {
			push @$parents, $key;
			
			$return_string .= "$key = {\n";
			$return_string .= format_hash_keys($value, $parents);
			$return_string .= $indent_character x ($level * 3);
			$return_string .= "},\n";
			
			pop @$parents;
		}
		elsif ($type eq 'ARRAY') {
			$return_string .= "$key => [],\n";
		}
		elsif ($type) {
			$return_string .= "<$type: $key>\n";
		}
		else {
			$return_string .= "$key = '',\n";
		}
	}
	
	return $return_string;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 format_array_reference

 Parameters  : $data, $max_depth, $parents
 Returns     : none
 Description : 

=cut

sub format_array_reference {
	my ($data, $max_depth, $parents) = @_;
	
	$parents = [] unless $parents;
	
	my $indent_character = ' ';
	my $indent_count = 3;
	
	if (!defined($data)) {
		return "<undef>,\n";
	}
	
	my $data_type = ref($data);
	if (!$data_type) {
		if (length($data) > 100) {
			$data = substr($data, 0, 100) . '<truncated>';
		}
		return "'" . $data . "',\n";
	}
	elsif ($data_type !~ /(ARRAY|HASH)/) {
		return "<ref:$data_type>,\n";
	}

	my $hash_ref;
	my $opening_char;
	my $closing_char;
	if ($data_type eq 'ARRAY') {
		$opening_char = '[';
		$closing_char = ']';
		for (my $index = 0; $index < scalar(@$data); $index++) {
			$hash_ref->{"[$index]"}	= $data->[$index];
		}
	}
	elsif ($data_type eq 'HASH') {
		$opening_char = '{';
		$closing_char = '}';
		$hash_ref = $data;
	}
	
	
	my $return_string = "$opening_char";
	
	if (!$max_depth || scalar(@$parents) < $max_depth) {
		$return_string .= "\n";
		for my $key (sort keys %$hash_ref) {
			my $value = $hash_ref->{$key};
			push @$parents, $key;
			$return_string .= $indent_character x (scalar(@$parents) * $indent_count);
			$return_string .= "$key = " . format_array_reference($value, $max_depth, $parents);
			pop @$parents;
		}
		$return_string .= $indent_character x (scalar(@$parents) * $indent_count);
	}
	$return_string .= "$closing_char,\n";
	
	return $return_string;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_caller_trace

 Parameters  : $level_limit - number of previous calls to return
 Returns     : multi-line string containing subroutine caller information
 Description :

=cut

sub get_caller_trace {
	my ($level_limit, $brief_output) = @_;
	$level_limit = 99 if !$level_limit;

	# Add one to make the argument usage more intuitive
	# One of the levels is the subroutine which called this
	$level_limit++;
	
	# Check if this subroutine was called from notify
	my $called_from_notify = ((caller(1))[3] =~ /notify$/)? 1 : 0;
	
	my $caller_trace = "";
	for (1 .. $level_limit) {
		my $caller_index = $_;
		if (caller($caller_index)) {
			my ($package_last, $filename_last, $line_last, $sub_last) = caller($caller_index - 1);
			my ($package,      $filename,      $line,      $sub)      = caller($caller_index);
			
			$filename_last =~ s/.*\///;
			$sub           =~ s/.*:://;
			
			if ($called_from_notify) {
				if ($sub =~ /notify$/) {
					next;
				}
				else {
					$caller_index--;
				}
			}
			
			if ($brief_output) {
				$caller_trace .= (($caller_index - 1) * -1) . ":$filename_last:$sub:$line_last;";
			}
			else {
				$caller_trace .= "(" . sprintf("% d", (($caller_index - 1) * -1)) . ") $filename_last, $sub (line: $line_last)\n";
			}
		} ## end if (caller($caller_index))
		else {
			last;
		}
	} ## end for (1 .. $level_limit)

	# Remove the trailing semicolon if brief output is used
	$caller_trace =~ s/;$//;

	# Chomp the trailing newline if brief output isn't used
	chomp $caller_trace;

	return $caller_trace;
} ## end sub get_caller_trace

#//////////////////////////////////////////////////////////////////////////////

=head2 get_calling_subroutine

 Parameters  : none
 Returns     : string
 Description : Returns the name of the subroutine which called the subroutine in
               which get_calling_subroutine is called.

=cut

sub get_calling_subroutine {
	for (my $i=2; $i<10; $i++) {
		my @caller = caller($i);
		
		if (!@caller) {
			return '';
		}
		
		my $calling_subroutine = $caller[3];
		
		# Ignore if subroutine includes _ANON_
		# This is a workaround for DataStructure.pm::can
		# DataStructure.pm::_automethod checks if DataStructure.pm::can is called
		if ($calling_subroutine =~ /_ANON_/) {
			#notify($ERRORS{'DEBUG'}, 0, "ignoring calling subroutine: $calling_subroutine");
			next;
		}
		else {
			return $calling_subroutine;
		}
	}
	
	notify($ERRORS{'WARNING'}, 0, "failed to determine calling subroutine");
	return '';
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_management_node_id

 Parameters  : none
 Returns     : integer
 Description : Retrieves the managementnode.id value of the local management
               node.

=cut

sub get_management_node_id {
	my $management_node_id;

	# Check the management_node_id environment variable
	if ($ENV{management_node_id}) {
		return $ENV{management_node_id};
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "management_node_id environment variable not set");
	}

	# If $management_node_id wasn't set using the env variable, try the subroutine
	my $management_node_info = get_management_node_info();
	if ($management_node_info && ($management_node_id = $management_node_info->{id})) {
		notify($ERRORS{'DEBUG'}, 0, "get_managementnode_info(): $management_node_id");
		$ENV{management_node_id} = $management_node_id;
		return $management_node_id;
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "get_management_node_info() failed");
	}

	notify($ERRORS{'WARNING'}, 0, "management node ID could not be determined");
	return 0;
} ## end sub get_management_node_id

#//////////////////////////////////////////////////////////////////////////////

=head2 get_database_names

 Parameters  : $no_cache (optional)
 Returns     : array
 Description : Retrieves an array containing the database names the user defined
               in vcld.conf has access to.

=cut

sub get_database_names {
	my $no_cache = shift;
	return @{$ENV{database_names}} if $ENV{database_names} && !$no_cache;
	
	my $select_statement = "
SELECT DISTINCT
SCHEMA_NAME
FROM
SCHEMATA
	";

	# Call the database select subroutine
	my @rows = database_select($select_statement, 'information_schema');

	# Check to make sure at least 1 row was returned
	if (scalar @rows == 0) {
		notify($ERRORS{'WARNING'}, 0, "unable to get database names, 0 rows were returned from database select statement:\n$select_statement");
		return 0;
	}

	
	my @database_names;
	map({push @database_names, $_->{SCHEMA_NAME}} @rows);
	
	$ENV{database_names} = \@database_names;
	
	return @{$ENV{database_names}};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_database_table_names

 Parameters  : $database_name (optional)
 Returns     : array
 Description : Retrieves the names of all tables in the database sorted
               alphabetically. The VCL database configured in vcld.conf is used
               if no $database_name argument is specified.

=cut

sub get_database_table_names {
	my $database_name = shift || $DATABASE;
	
	my $select_statement = <<EOF;
SELECT DISTINCT
TABLES.TABLE_NAME
FROM
TABLES
WHERE
TABLES.TABLE_SCHEMA = '$database_name'
EOF

	# Call the database select subroutine
	my @rows = database_select($select_statement, 'information_schema');

	if (!@rows) {
		notify($ERRORS{'WARNING'}, 0, "failed to retrieve database table columns");
		return;
	}
	
	my @database_columns = map { $_->{TABLE_NAME} } @rows;
	return sort { lc($a) cmp lc($b) } @database_columns;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_database_table_columns

 Parameters  : $no_cache (optional)
 Returns     : hash reference
 Description : Retrieves information for all tables and columns from the VCL
               database and constructs a hash. The hash keys are the table
               names. Each key contains an array reference containing the
               table's column names. Example:
               {
                  "OStype" => [
                    "id",
                    "name"
                  ],
                  "adminlevel" => [
                    "id",
                    "name"
                  ],
                 "affiliation" => [
                    "id",
                    "name",
                    "shibname",
                    ...
                  ],
               }

=cut

sub get_database_table_columns {
	my $no_cache = shift;
	return $ENV{database_table_columns} if $ENV{database_table_columns} && !$no_cache;
	
	my $database = 'information_schema';

	my $select_all_table_columns = "
SELECT DISTINCT
TABLES.TABLE_NAME,
COLUMNS.COLUMN_NAME
FROM
TABLES,
COLUMNS
WHERE
COLUMNS.TABLE_SCHEMA = \'$DATABASE\'
AND
TABLES.TABLE_NAME = COLUMNS.TABLE_NAME
	";

	# Call the database select subroutine
	my @rows = database_select($select_all_table_columns, $database);

	# Check to make sure 1 row was returned
	if (scalar @rows == 0) {
		notify($ERRORS{'WARNING'}, 0, "unable to get database table columns, 0 rows were returned from database select");
		return 0;
	}

	# Use the map function to populate a hash of arrays
	# The hash keys are the table names
	# The hash values are arrays of column names
	my %database_table_columns;
	map({push @{$database_table_columns{$_->{TABLE_NAME}}}, $_->{COLUMN_NAME}} @rows);
	
	$ENV{database_table_columns} = \%database_table_columns;
	
	return $ENV{database_table_columns};
}

#//////////////////////////////////////////////////////////////////////////////

sub switch_vmhost_id {
	my ($computer_id, $host_id) = @_;

	my ($package,        $filename,        $line,        $sub)        = caller(0);
	my ($caller_package, $caller_filename, $caller_line, $caller_sub) = caller(1);

	my $caller_info = "$caller_sub($line)";

	my $caller = scalar caller;
	notify($ERRORS{'OK'}, 0, "called from $caller_info");

	# Check the arguments
	if (!defined($computer_id)) {
		notify($ERRORS{'CRITICAL'}, 0, "computer_id is undefined");
		return 0;
	}

	if (!(defined($host_id)) || !$host_id) {
		notify($ERRORS{'WARNING'}, 0, "$host_id is either not defined or 0, using NULL");
		$host_id = 'NULL';
	}

	# Construct the update statement
	my $update_statement = "
      UPDATE
		computer
		SET
		vmhostid = $host_id
		WHERE
		computer.id = $computer_id
   ";

	# Call the database execute subroutine
	if (database_execute($update_statement)) {
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "unable to update computer table, id=$computer_id, vmhostid=$host_id");
		return 0;
	}
} ## end sub switch_vmhost_id

#//////////////////////////////////////////////////////////////////////////////

=head2 get_reservation_computerloadlog_entries

 Parameters  : $reservation_id
 Returns     : array
 Description : Retrieves computerloadlog info for a single reservation. An array
               of hashes is returned. The array is ordered from oldest entry to
               newest.
               [
                  {
                     "additionalinfo" => "beginning to process, state is test",
                     "computerid" => 3582,
                     "computerloadstate" => {
                     "loadstatename" => "begin"
                     },
                        "id" => 3494,
                        "loadstateid" => 54,
                        "reservationid" => 3115,
                        "timestamp" => "2014-12-17 16:09:11"
                  },
                  {
                     "additionalinfo" => "begin initial connection timeout (xxx seconds)",
                     "computerid" => 3582,
                     "computerloadstate" => {
                     "loadstatename" => "initialconnecttimeout"
                     },
                        "id" => 3495,
                        "loadstateid" => 56,
                        "reservationid" => 3115,
                        "timestamp" => "2014-12-17 16:09:14"
                  }
               ]

=cut

sub get_reservation_computerloadlog_entries {
	my ($reservation_id) = @_;
	if (!$reservation_id) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not passed");
		return;
	}

	my $select_statement = <<EOF;
SELECT
computerloadlog.*,
computerloadstate.loadstatename AS computerloadstate_loadstatename

FROM
computerloadlog,
computerloadstate

WHERE
computerloadlog.reservationid = $reservation_id
AND computerloadlog.loadstateid = computerloadstate.id

ORDER BY computerloadlog.timestamp ASC
EOF

	my @rows = database_select($select_statement);
	
	my @computerloadlog_info;
	for my $row (@rows) {
		for my $column (keys %$row) {
			my $value = $row->{$column};
			if ($column =~ /^([^_]+)_([^_]+)$/) {
				$row->{$1}{$2} = $value;
				delete $row->{$column};
			}
		}
		
		push @computerloadlog_info, $row;
	}
	
	#notify($ERRORS{'DEBUG'}, 0, "retrieved computerloadlog info for reservation $reservation_id:\n" . format_data(@computerloadlog_info));
	return @computerloadlog_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_reservation_computerloadlog_time

 Parameters  : $reservation_id, $loadstatename, $newest (optional)
 Returns     : string (datetime)
 Description : Retrieves the timestamp of a computerloadlog entry matching the
               $loadstatename argument for a reservation and returns the time in
               epoch seconds. By default, the timestamp of the oldest matching
               entry is returned. The newest may be returned by providing the
               $newest argument.

=cut

sub get_reservation_computerloadlog_time {
	my ($reservation_id, $loadstatename, $newest) = @_;
	if (!defined($reservation_id)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	if (!defined($loadstatename)) {
		notify($ERRORS{'WARNING'}, 0, "computerloadstate name argument was not supplied");
		return;
	}
	
	# Get all computerloadlog entries for the reservation
	my @computerloadlog_entries = get_reservation_computerloadlog_entries($reservation_id);
	if (!@computerloadlog_entries) {
		notify($ERRORS{'OK'}, 0, "computerloadlog entry does not exist for reservation $reservation_id");
		return;
	}
	
	my $timestamp;
	for my $computerloadlog_entry (@computerloadlog_entries) {
		if ($computerloadlog_entry->{computerloadstate}{loadstatename} eq $loadstatename) {
			$timestamp = $computerloadlog_entry->{timestamp};
			last unless $newest;
		}
	}
	
	my $type = ($newest ? 'newest' : 'oldest');
	if ($timestamp) {
		my $timestamp_epoch = convert_to_epoch_seconds($timestamp);
		notify($ERRORS{'DEBUG'}, 0, "retrieved $type timestamp of first '$loadstatename' computerloadlog entry for reservation $reservation_id: '$timestamp', returning $timestamp_epoch");
		return $timestamp_epoch;
	}
	else {
		notify($ERRORS{'OK'}, 0, "no '$loadstatename' computerloadlog entries exist for reservation $reservation_id");
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_request_loadstate_names

 Parameters  : $request_id
 Returns     : hash reference
 Description : Retrieves the computerloadlog entries for all reservations
               belonging to the request. A hash is constructed with keys set to
               the reservation IDs. The data of each key is a reference to an
               array containing the computerloadstate names. Example:
               {
                 3115 => [
                   "begin",
                 ],
                 3116 => [
                   "begin",
                   "nodeready"
                 ]
               }

=cut

sub get_request_loadstate_names {
	my ($request_id) = @_;
	if (!$request_id) {
		notify($ERRORS{'WARNING'}, 0, "request ID argument was not passed");
		return;
	}

	my $select_statement = <<EOF;
SELECT
reservation.id AS reservation_id,
computerloadstate.loadstatename

FROM
request,
reservation

LEFT JOIN (computerloadlog, computerloadstate) ON (
computerloadlog.reservationid = reservation.id
AND computerloadlog.loadstateid = computerloadstate.id
)

WHERE
request.id = $request_id
AND reservation.requestid = request.id
ORDER BY computerloadlog.timestamp ASC
EOF

	my @rows = database_select($select_statement);
	
	my $computerloadlog_info = {};
	for my $row (@rows) {
		my $reservation_id = $row->{reservation_id};
		my $loadstatename = $row->{loadstatename};
		$computerloadlog_info->{$reservation_id} = [] if !defined($computerloadlog_info->{$reservation_id});
		push @{$computerloadlog_info->{$reservation_id}}, $loadstatename if defined($loadstatename);
	}
	
	my $computerloadlog_string = '';
	for my $reservation_id (keys %$computerloadlog_info) {
		$computerloadlog_string .= "$reservation_id: ";
		$computerloadlog_string .= join(', ', @{$computerloadlog_info->{$reservation_id}});
		$computerloadlog_string .= "\n";
	}
	
	#notify($ERRORS{'DEBUG'}, 0, "retrieved computerloadstate names for request $request_id:\n$computerloadlog_string");
	return $computerloadlog_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 reservation_being_processed

 Parameters  :  reservation ID
 Returns     :  array or boolean
 Description :  Checks the computerloadlog table for rows matching the
                reservation ID and loadstate = begin.

=cut

sub reservation_being_processed {
	my ($reservation_id) = @_;

	# Make sure reservation ID was passed
	if (!$reservation_id) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not passed");
		return;
	}
	
	my $select_statement = <<EOF;
SELECT
reservation.id AS reservation_id,
computerloadlog.id AS reservation_computerloadlog_id,
MIN(parentreservation.id) AS parent_reservation_id,
parentcomputerloadlog.id AS parent_computerloadlog_id
FROM
reservation
LEFT JOIN (computerloadlog, computerloadstate) ON (
   computerloadlog.reservationid = reservation.id
   AND computerloadlog.loadstateid = computerloadstate.id
   AND computerloadstate.loadstatename = 'begin'
),
request,
reservation parentreservation
LEFT JOIN (computerloadlog parentcomputerloadlog, computerloadstate parentcomputerloadstate) ON (
   parentcomputerloadlog.reservationid = parentreservation.id
   AND parentcomputerloadstate.loadstatename = 'begin'
)
WHERE
reservation.id = $reservation_id
AND reservation.requestid = request.id
AND parentreservation.requestid = request.id
GROUP BY reservation.id
EOF

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @computerloadlog_rows = database_select($select_statement);
	
	# Check if at least 1 row was returned
	my $computerloadlog_exists = 0;
	my $parent_reservation_id;
	my $parent_computerloadlog_exists = 0;
	
	
	for my $row (@computerloadlog_rows) {
		$parent_reservation_id = $row->{parent_reservation_id} if !defined($parent_reservation_id);
		
		my $reservation_computerloadlog_id = $row->{reservation_computerloadlog_id};
		my $parent_computerloadlog_id = $row->{parent_computerloadlog_id};
		
		if ($reservation_computerloadlog_id) {
			$computerloadlog_exists = 1 if (!$computerloadlog_exists);
		}
		if ($parent_computerloadlog_id) {
			$parent_computerloadlog_exists = 1 if (!$parent_computerloadlog_exists);
		}
	}
	
	$parent_reservation_id = '<unknown>' if !defined($parent_reservation_id);
	
	# Check if a vcld process is running matching for this reservation
	my $reservation_process_name_regex = get_reservation_vcld_process_name_regex($reservation_id);
	my @processes_running = is_management_node_process_running($reservation_process_name_regex);
	
	my $info_string = "reservation ID: $reservation_id\n";
	$info_string .= "parent reservation ID: $parent_reservation_id\n";
	$info_string .= "reservation computerloadlog 'begin' entry exists: " . ($computerloadlog_exists ? 'yes' : 'no') . "\n";
	$info_string .= "parent reservation computerloadlog 'begin' entry exists: " . ($parent_computerloadlog_exists ? 'yes' : 'no') . "\n";
	$info_string .= "reservation process running: " . (@processes_running ? (join(", ", @processes_running)) : 'no');
	
	# Check the results and return
	if ($computerloadlog_exists && @processes_running) {
		#notify($ERRORS{'DEBUG'}, 0, "reservation $reservation_id is currently being processed, computerloadlog 'begin' entry exists and running process was found:\n$info_string");
		return (wantarray ? @processes_running : 1);
	}
	elsif (!$computerloadlog_exists && @processes_running) {
		notify($ERRORS{'DEBUG'}, 0, "computerloadlog 'begin' entry does NOT exist but running process was found: @processes_running, assuming reservation $reservation_id is currently being processed\n$info_string");
		return (wantarray ? @processes_running : 1);
	}
	elsif ($computerloadlog_exists && !@processes_running) {
		if ($reservation_id eq $parent_reservation_id) {
			#notify($ERRORS{'WARNING'}, 0, "$reservation_id is the parent reservation, computerloadlog 'begin' entry exists but running process was NOT found, assuming reservation $reservation_id is NOT currently being processed\n$info_string");
			return (wantarray ? () : 0);
		}
		else {
			# This is a child reservation, computerloadlog exists, no process running for this reservation
			if ($parent_computerloadlog_exists) {
				notify($ERRORS{'DEBUG'}, 0, "child reservation: $reservation_id, computerloadlog 'begin' entry exists but running process was NOT found, parent reservation $parent_reservation_id computerloadlog entry exists, assuming a process for this reservation already ran and parent reservation process is still running, returning true\n$info_string");
				return (wantarray ? () : 1);
			}
			else {
				notify($ERRORS{'DEBUG'}, 0, "child reservation: $reservation_id, computerloadlog 'begin' entry exists but running process was NOT found, parent reservation $parent_reservation_id computerloadlog entry does not exist, assuming this reservation is NOT currently being processed and has not been processed yet, returning false\n$info_string");
				return (wantarray ? () : 0);
			}
		}
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "reservation $reservation_id is NOT currently being processed\n$info_string");
		return (wantarray ? () : 0);
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 run_command

 Parameters  : $command, $no_output (optional), $timeout_seconds (optional)
 Returns     : array if command run, undefined if it didn't
 Description : Runs a command locally on the management node.
               If command completed successfully, an array containing
               the exit status and a reference to an array containing the
               lines of output of the command specified is returned.
               $array[0] = the exit status of the command
               $array[1] = reference to array containing lines of output
                           generated by the command
               If the command fails, an empty array is returned.

=cut

sub run_command {
	my ($command, $no_output, $timeout_seconds) = @_;
	
	my @output;
	my $output_string;
	my $exit_status;
	my $timeout_flag = 0;
	
	eval {
		# Override the die and alarm handlers
		local $SIG{__DIE__} = sub{};
		
		local $SIG{__WARN__} = sub {
			my $warning_message = shift || '';
			notify($ERRORS{'WARNING'}, 0, "warning was generated attempting to run command: $warning_message");
		};
		
		local $SIG{ALRM} = sub {
			$timeout_flag = 1;
			die;
		};
		
		if ($timeout_seconds) {
			notify($ERRORS{'DEBUG'}, 0, "waiting up to $timeout_seconds seconds for command to finish: '$command'");
			alarm $timeout_seconds;
		}
		
		$output_string = `$command 2>&1`;
		
		# Save the exit status
		$exit_status = $?;
		if ($exit_status >= 0) {
			$exit_status = $exit_status >> 8;
		}
		
		# Remove any trailing newlines from the output
		chomp $output_string;
		
		# Split the output string into an array of lines
		@output = split(/[\r\n]+/, $output_string);
	};
	
	if ($timeout_flag) {
		notify($ERRORS{'WARNING'}, 0, "command timed out after $timeout_seconds seconds: '$command'");
		kill_child_processes($PID);
		return;
	}
	elsif (!$no_output) {
		notify($ERRORS{'DEBUG'}, 0, "executed command: '$command', exit status: $exit_status, output:\n" . join("\n", @output));
	}
	
	return ($exit_status, \@output);
}
	
#//////////////////////////////////////////////////////////////////////////////

=head2 string_to_ascii

 Parameters  :  string
 Returns     :  string with special ASCII characters replaced with character
                names
 Description :  Takes the string passed, checks each character, and replaces
                special ASCII characters with the character name. For
                example, "This is a\r\nstring." would return
                "This[SP]is[SP]a[CR][LF]string."

=cut

sub string_to_ascii {
	my $string = shift;
	
	my %ascii_codes = (
		0 => 'NUL',
		1 => 'SOH',
		2 => 'STX',
		3 => 'ETX',
		4 => 'EOT',
		5 => 'ENQ',
		6 => 'ACK',
		7 => 'BEL',
		8 => 'BS',
		9 => 'HT',
		10 => 'LF',
		11 => 'VT',
		12 => 'FF',
		13 => 'CR',
		14 => 'SO',
		15 => 'SI',
		16 => 'DLE',
		17 => 'DC1',
		18 => 'DC2',
		19 => 'DC3',
		20 => 'DC4',
		21 => 'NAK',
		22 => 'SYN',
		23 => 'ETB',
		24 => 'CAN',
		25 => 'EM',
		26 => 'SUB',
		27 => 'ESC',
		28 => 'FS',
		29 => 'GS',
		30 => 'RS',
		31 => 'US',
		32 => 'SP',
		127 => 'DEL',
	);
	
	my $ascii_value_string;
	my $previous_code = -1;
	my $consecutive_count = 0;
	foreach my $ascii_code (unpack("C*", $string)) {
		if ($ascii_code != 10 && $ascii_code == $previous_code) {
			$consecutive_count++;
			next;
		}
		else {
			if ($consecutive_count > 1) {
				chop $ascii_value_string;
				$ascii_value_string .= "x$consecutive_count]";
			}
			$consecutive_count = 1;
		}
		
		if (my $code = $ascii_codes{$ascii_code}) {
			$ascii_value_string .= "[$code]";
			$ascii_value_string .= "\n" if $ascii_code == 10;
			$previous_code = $ascii_code;
		}
		elsif ($ascii_code > 126) {
			$ascii_value_string .= pack("C*", $ascii_code) . "<$ascii_code>";
			$previous_code = -1;
		}
		else {
			$ascii_value_string .= pack("C*", $ascii_code);
			$previous_code = -1;
		}
	}
	
	if ($consecutive_count > 1) {
		chop $ascii_value_string;
		$ascii_value_string .= "x$consecutive_count]";
	}
	
	if (defined($ascii_value_string)) {
		return $ascii_value_string;
	}
	else {
		return '';
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 character_to_ascii_value

 Parameters  : $character, $numeral_system (optional)
 Returns     : hex number 
 Description : Determines the ASCII value of a given character. A numeral system
               argument may be specified. Valid values are 'decimal', 'hex', or
               'oct'. By default, the decimal value is returned.

=cut

sub character_to_ascii_value {
	my ($character, $numeral_system) = @_;
	if (!defined($character)) {
		notify($ERRORS{'WARNING'}, 0, "character argument was not supplied");
		return;
	}
	elsif (length($character) != 1) {
		notify($ERRORS{'WARNING'}, 0, "length of character argument is not 1: " . length($character));
		return;
	}
	if (defined($numeral_system)) {
		if ($numeral_system =~ /hex/i) {
			$numeral_system = 'hexadecimal';
		}
		elsif ($numeral_system =~ /dec/i) {
			$numeral_system = 'decimal';
		}
		elsif ($numeral_system =~ /oct/i) {
			$numeral_system = 'octal';
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "numeral system specified by the argument is not supported: $numeral_system");
			return;
		}
	}
	else {
		$numeral_system = 'decimal';
	}
	
	if (defined($ENV{ascii_value}{$character}{$numeral_system})) {
		return $ENV{ascii_value}{$character}{$numeral_system};
	}
	
	my $decimal_value = unpack("C*", $character);
	my $values = {
		'decimal' => $decimal_value,
		'hexadecimal' => sprintf("%X", $decimal_value),
		'octal' => sprintf("%o", $decimal_value),
	};
	
	# Store the results in %ENV to avoid repetitive messages in vcld.log
	$ENV{ascii_value}{$character} = $values;
	
	my $string = "ASCII $numeral_system value of '$character': $values->{$numeral_system}";
	if ($numeral_system ne 'decimal') {
		$string .= " (decimal: $values->{decimal})";
	}
	if ($numeral_system ne 'hexadecimal') {
		$string .= " (hexadecimal: $values->{hexadecimal})";
	}
	if ($numeral_system ne 'octal') {
		$string .= " (octal: $values->{octal})";
	}
	
	notify($ERRORS{'DEBUG'}, 0, $string);
	return $values->{$numeral_system};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 add_imageid_to_newimages

 Parameters  : $ownerid, $resourceid, $virtual
 Returns     : 1, 0 
 Description : Calls the RPC::XML function defined in the arguments

=cut
sub add_imageid_to_newimages {
	my ($user_id, $resource_id, $is_vm_image) = @_;
	
	# Check the arguments
	if (!defined($user_id)) {
		notify($ERRORS{'WARNING'}, 0, "user ID argument was not specified");
		return;
	}
	elsif (!defined($resource_id)) {
		notify($ERRORS{'WARNING'}, 0, "resource ID argument was not specified");
		return;
	}
	elsif (!defined($is_vm_image)) {
		notify($ERRORS{'WARNING'}, 0, "'is vm image' argument was not specified");
		return;
	}
	
	my $method = "XMLRPCfinishBaseImageCapture";
	my @argument_string = ($method, $user_id, $resource_id, $is_vm_image); 
	my $response = xmlrpc_call(@argument_string);
	
	if (!defined($response)) {
		notify($ERRORS{'WARNING'}, 0, "failed to add image to owner's new images group, XML-RPC $method call failed");
		return;
	}
	elsif (!defined($response->value)) {
		notify($ERRORS{'WARNING'}, 0, "failed to add image to owner's new images group, XML-RPC $method response value is not defined:" . format_data($response));
		return;
	}
	
	my $status = $response->value->{status} || '<undefined>';
	my $error_message = $response->value->{errormsg} || '<undefined>';
	
	if ($status =~ /success/) {
		notify($ERRORS{'OK'}, 0, "added image to owner's new images group, user ID: $user_id, image resource ID: $resource_id, VM image: $is_vm_image");
		return 1;
	}
	
	my ($xmlrpc_username, $xmlrpc_affiliation) = $XMLRPC_USER =~ /^([^@]+)@?(.*)$/;
	my $xmlrpc_user_info = get_user_info($xmlrpc_username, $xmlrpc_affiliation) || {};
	my $xmlrpc_user_id = $xmlrpc_user_info->{id} || '<unknown>';
	
	notify($ERRORS{'WARNING'}, 0, "failed to add image to owner's new images group\n" .
		"make sure the value $xmlrpc_user_id (user ID of $XMLRPC_USER) is included in the \$xmlrpcBlockAPIUsers variable in the VCL website's conf.php file\n" .
		"image owner user ID: $user_id\n" .
		"image resource ID: $resource_id\n" .
		"VM image: $is_vm_image\n" .
		"XML-RPC method: $method\n" .
		"status: $status\n" .
		"error message: $error_message"
	);
	return 0;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 xmlrpc_call

 Parameters  : @arguments
 Returns     : RPC::XML::Client response value
 Description : Calls the RPC::XML function defined in the arguments

=cut

sub xmlrpc_call {
	my @arguments = @_;
	if (!@arguments) {
		notify($ERRORS{'WARNING'}, 0, "no arguments were passed to subroutine");
		return;
	}
	
	if (!$XMLRPC_URL || !$XMLRPC_USER || !$XMLRPC_PASS) {
		notify($ERRORS{'WARNING'}, 0, "unable to call " . join(", ", @arguments) . " function - RPC::XML values have not been set in the vcld.ini file");
		return;
	}
	
	# Create a Client object
	my $client;
	
	if (LWP::UserAgent->new->can('ssl_opts')) {
		notify($ERRORS{'DEBUG'}, 0, "RPC::XML version supports useragent options, setting verify_hostname to 0");
		$client = RPC::XML::Client->new($XMLRPC_URL, useragent => ['ssl_opts' => {verify_hostname => 0}]);
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "RPC::XML version does not support useragent options");
		$client = RPC::XML::Client->new($XMLRPC_URL);
	}
	
	$client->request->header('X-User' => $XMLRPC_USER);
	$client->request->header('X-Pass' => $XMLRPC_PASS);
	$client->request->header('X-APIVERSION' => 2);
	
	if (defined($client)) {
		notify($ERRORS{'DEBUG'}, 0, "created RPC::XML client object:\n" .
			"URL: $XMLRPC_URL\n" .
			"username: $XMLRPC_USER"
		);
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to create a new RPC::XML client object, error: " . ($RPC::XML::ERROR || '<none>'));
		return;
	}
	
	# Call send_request
	my $response = $client->send_request(@arguments);
	$ENV{rpc_xml_response} = $response;
	
	if (!ref($response)) {	
		notify($ERRORS{'WARNING'}, 0, "RPC::XML::Client::send_request failed\n" .
			"URL: $XMLRPC_URL\n" .
			"username: $XMLRPC_USER\n" .
			"password: $XMLRPC_PASS\n" ."error: " . ($RPC::XML::ERROR || '<none>') . "\n" .
			"arguments: " . join(", ", @arguments) . "\n" .
			"response: '$response'\n" . format_data($response)
			#"client: '$client'\n" . format_data($client)
		);
		
		$ENV{rpc_xml_error} = $response;
		$ENV{rpc_xml_error} =~ s/^RPC::XML::Client::send_request:\s*//;
		return;
	}
	
	# Check if fault occurred
	if ($response->is_fault) {
		notify($ERRORS{'WARNING'}, 0, "RPC::XML::Client::send_request fault occurred\n" .
			"URL: $XMLRPC_URL\n" .
			"username: $XMLRPC_USER\n" .
			"password: $XMLRPC_PASS\n" .
			"arguments: " . join(", ", @arguments) . "\n" .
			"fault code: " . $response->code . "\n" .
			"fault string: " . $response->string
		);
		$ENV{rpc_xml_error} = $response->string;
		return;
	}
	
	# Display the response details
	notify($ERRORS{'OK'}, 0, "called RPC::XML::Client::send_request:\n" .
		"arguments: " . join(", ", @arguments) . "\n" .
		"response value:\n" . format_data($response->value)
	);
	
	# Return the response
	return $response;

}

#//////////////////////////////////////////////////////////////////////////////

=head2 is_management_node_process_running

 Parameters  : $process_regex
 Returns     : array or hash reference
 Description : Determines if any processes matching the $process_regex
               argument are running on the management node. The $process_regex
               must be a valid Perl regular expression.
               
               The following command is used to determine if a process is
               running:
               ps -e -o pid,args | grep -P "$process_regex"
               
               The behavior is different than if the -P argument is not used.
               The following characters must be escaped with a backslash in
               order for a literal match to be found:
               | ( ) [ ] . +
               
               If these are not escaped, grep will interpret them as the
               corresponing regular expression operational character. For
               example:
               
               To match this literal string:
               |(foo)|
               Pass this:
               \|\(foo\)\|
               
               To match 'foo' or 'bar, pass this:
               (foo|bar)
               
               To match a pipe character ('|'), followed by either 'foo' or
               'bar, followed by another pipe character:
               |foo|
               Pass this:
               \|(foo|bar)\|
               
               The return value differs based on how this subroutine is called.
               If called in scalar context, a hash reference is returned. The
               hash keys are PIDs and the values are the full name of the
               process. If called in list context, an array is returned
               containing the PIDs.

=cut

sub is_management_node_process_running {
	my ($process_regex) = @_;
	
	# Check the arguments
	unless ($process_regex) {
		notify($ERRORS{'WARNING'}, 0, "process regex pattern argument was not specified");
		return;
	}
	
	my $command = "ps -e -o pid,args | grep -P \"$process_regex\"";
	my ($exit_status, $output) = run_command($command, 0);
	if (!defined($output)) {
		notify($ERRORS{'WARNING'}, 0, "failed to run command to determine if process is running: $command");
		return;
	}
	
	my $processes_running = {};
	for my $line (@$output) {
		my ($pid, $process_name) = $line =~ /^\s*(\d+)\s*(.*)/g;
		
		if (!defined($pid)) {
			notify($ERRORS{'DEBUG'}, 0, "ignoring line, it does not begin with a number: '$line'");
			next;
		}
		elsif ($pid eq $PID) {
			#notify($ERRORS{'DEBUG'}, 0, "ignoring line for the currently running process: $line");
			next;
		}
		elsif ($line =~ /grep -P/) {
			#notify($ERRORS{'DEBUG'}, 0, "ignoring line containing for this command: $line");
			next;
		}
		elsif ($line =~ /sh -c/) {
			# Ignore lines containing 'sh -c', probably indicating a duplicate process of a command run remotely
			#notify($ERRORS{'DEBUG'}, 0, "ignoring containing 'sh -c': $line");
			next;
		}
		else {
			#notify($ERRORS{'DEBUG'}, 0, "found matching process: $line");
			$processes_running->{$pid} = $process_name;
		}
	}
	
	my $process_count = scalar(keys %$processes_running);
	if ($process_count) {
		if (wantarray) {
			my @process_ids = sort keys %$processes_running;
			notify($ERRORS{'DEBUG'}, 0, "process is running, identifier: '$process_regex', returning array containing PIDs: @process_ids");
			return @process_ids;
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "process is running, identifier: '$process_regex', returning hash reference:\n" . format_data($processes_running));
			return $processes_running;
		}
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "process is NOT running, identifier: '$process_regex'");
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_reservation_vcld_process_name_regex

 Parameters  : $reservation_id
 Returns     : string
 Description : Returns a string containing a regular expression which should
               match a single reservation process. This regex is passed to
               is_management_node_process_running.

=cut

sub get_reservation_vcld_process_name_regex {
	my ($reservation_id) = @_;
	if (!defined($reservation_id)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not specified");
		return;
	}
	
	return "$PROCESSNAME .\\|[0-9]+\\|[0-9]+\\|$reservation_id\\|";
}

#//////////////////////////////////////////////////////////////////////////////

=head2 read_file_to_array

 Parameters  : File path
 Returns     : If successful: array containing lines in file
               If failed: false
 Description : Returns the contents of the file specified by the argument in an
               array. Each array element contains a line from the file.

=cut

sub read_file_to_array {
	my $file_path = shift;
	if (!$file_path) {
		notify($ERRORS{'WARNING'}, 0, "file path argument was not specified");
		return;
	}
	
	unless (open(FILE, $file_path)) {
		notify($ERRORS{'WARNING'}, 0, "unable to open file: $file_path, reason: $!");
		return;
	}
   
	my @file_contents = <FILE>;
	close FILE;
	
	return @file_contents;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 is_valid_ip_address

 Parameters  : $ip_address, $display_output (optional)
 Returns     : If valid: true
               If not valid: false
 Description : Determines if the argument is a valid IP address.

=cut

sub is_valid_ip_address {
	my ($ip_address, $display_output) = @_;
	if (!$ip_address) {
		notify($ERRORS{'WARNING'}, 0, "IP address argument was not specified");
		return;
	}
	$display_output = 1 unless defined($display_output);
	
	# Split up the IP address being checked into its octets
	my @octets = split(/\./, $ip_address);
	
	# Make sure 4 octets were found
	if (scalar @octets != 4) {
		notify($ERRORS{'DEBUG'}, 0, "IP address does not contain 4 octets: $ip_address, octets:\n" . join("\n", @octets)) if $display_output;
		return 0;
	}
	
	# Make sure address only contains digits
	if (grep(/\D/, @octets)) {
		notify($ERRORS{'DEBUG'}, 0, "IP address contains a non-digit: $ip_address") if $display_output;
		return 0;
	}
	
	# Make sure none of the octets is > 255
	if ($octets[0] > 255 || $octets[0] > 255 || $octets[0] > 255 || $octets[0] > 255) {
		notify($ERRORS{'DEBUG'}, 0, "IP address contains an octet > 255: $ip_address") if $display_output;
		return 0;
	}
	
	#notify($ERRORS{'DEBUG'}, 0, "IP address is valid: $ip_address") if $display_output;
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 is_valid_dns_host_name

 Parameters  : $dns_host_name
 Returns     : If valid: true
               If not valid: false
 Description : Determines if the argument is a valid DNS host name.

=cut

sub is_valid_dns_host_name {
	my $dns_host_name = shift;
	if (!$dns_host_name) {
		notify($ERRORS{'WARNING'}, 0, "DNS host name argument was not specified");
		return;
	}
	
	if (!$dns_host_name) {
		notify($ERRORS{'DEBUG'}, 0, "DNS host name argument was not specified");
		return 0;
	}
	
	if ((my $length = length($dns_host_name)) > 255) {
		notify($ERRORS{'DEBUG'}, 0, "DNS host name is too long ($length characters): $dns_host_name");
		return 0;
	}
	
	if (my @illegal_characters = $dns_host_name =~ /([^\da-z\.\-])/i) {
		notify($ERRORS{'DEBUG'}, 0, "DNS host name contains illegal characters: " . join(" ", @illegal_characters));
		return 0;
	}
	
	if ($dns_host_name =~ /\.\./i) {
		notify($ERRORS{'DEBUG'}, 0, "DNS host name contains contiguous periods: $dns_host_name");
		return 0;
	}
	
	if ($dns_host_name !~ /^[\da-z]/i) {
		notify($ERRORS{'DEBUG'}, 0, "DNS host name does not begin with a letter or digit: " . string_to_ascii($dns_host_name));
		return 0;
	}
	
	if (grep(/^\d+$/, split(/\./, $dns_host_name))) {
		notify($ERRORS{'DEBUG'}, 0, "DNS host name contains a section comprised only of digits: $dns_host_name");
		return 0;
	}
	
	notify($ERRORS{'DEBUG'}, 0, "DNS host name is valid: $dns_host_name");
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 is_public_ip_address

 Parameters  : IP address string
 Returns     : If public: true
               If not public: false
 Description : Determines if the argument is a valid public IP address. It will
               return true if the IP address is valid and not in any of the
               following ranges:
               Private:
                  10.0.0.0 - 10.255.255.255
                  172.16.0.0 - 172.16.31.255.255
                  192.168.0.0 - 192.168.255.255
               Loopback:
                  127.0.0.0 - 127.255.255.255
               Reserved:
                  0.0.0.0
                  169.254.0.1 - 169.254.255.254
                  191.255.0.0
                  223.255.255.0
                  240.0.0.0 - 255.255.255.254
               Multicast:
                  224.0.0.0 - 239.255.255.255
               Broadcast:
                  255.255.255.255

=cut

sub is_public_ip_address {
	my $ip_address = shift;
	if (!$ip_address) {
		notify($ERRORS{'WARNING'}, 0, "IP address argument was not specified");
		return;
	}
	
	# Split up the IP address being checked into its octets
	my @octets = split(/\./, $ip_address);
	
	# Make sure the address is valid
	unless (is_valid_ip_address($ip_address)) {
		notify($ERRORS{'WARNING'}, 0, "unable to determine if IP address is private, the address is not valid: $ip_address");
		return 0;
	}
	
	# Determine the type of address address
	# Private:
	# 10.0.0.0 - 10.255.255.255
	# 172.16.0.0 - 172.16.31.255.255
	# 192.168.0.0 - 192.168.255.255
	if (($octets[0] == 10) ||
		($octets[0] == 172 && ($octets[1] >= 16 && $octets[1] <= 31)) ||
		($octets[0] == 192 && $octets[1] == 168)
		) {
		notify($ERRORS{'DEBUG'}, 0, "private IP address: $ip_address, returning 0");
		return 0;
	}
	# Loopback:
	# 127.0.0.0 - 127.255.255.255
	elsif ($ip_address =~ /^127/) {
		notify($ERRORS{'DEBUG'}, 0, "loopback IP address: $ip_address, returning 0");
		return 0;
	}
	# Reserved:
	# 0.0.0.0
	# 169.254.0.1 - 169.254.255.254
	# 191.255.0.0
	# 223.255.255.0
	# 240.0.0.0 - 255.255.255.254
	elsif (($ip_address eq '0.0.0.0') ||
				($ip_address =~ /^169\.254/) ||
				($ip_address eq '191.255.0.0') ||
				($ip_address eq '223.255.255.0') ||
				($octets[0] >= 240 && $octets[0] <= 255)
	) {
		notify($ERRORS{'DEBUG'}, 0, "reserved IP address: $ip_address, returning 0");
		return 0;
	}
	# Multicast:
	# 224.0.0.0 - 239.255.255.255
	elsif ($octets[0] >= 224 && $octets[0] <= 239) {
		notify($ERRORS{'DEBUG'}, 0, "multicast IP address: $ip_address, returning 0");
		return 0;
	}
	# Broadcast:
	# 255.255.255.255
	elsif ($ip_address eq '255.255.255.255') {
		notify($ERRORS{'DEBUG'}, 0, "broadcast IP address: $ip_address, returning 0");
		return 0;
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "public IP address: $ip_address, returning 1");
		return 1;
	}
}
#//////////////////////////////////////////////////////////////////////////////

=head2 get_block_request_image_info

 Parameters  :  computer ID
 Returns     :  imagename imageid imagerevisionid
 Description :  Checks the blockcomputers table matching computer id

=cut
#//////////////////////////////////////////////////////////////////////////////

sub get_block_request_image_info {
	my ($computerid) = @_;

	my ($package, $filename, $line, $sub) = caller(0);

	# Check the passed parameters
	if (!(defined($computerid))) {
		notify($ERRORS{'WARNING'}, 0, "computer ID was not specified");
		return ();
	}
	# Construct the select statement
	my $select_statement = "
	SELECT DISTINCT
	image.name AS image_name,
	image.id AS image_id,
	imagerevision.id AS imagerevision_id,
	blockTimes.start AS starttime
	FROM
	image,
	imagerevision,
	blockComputers,
	blockTimes
	WHERE
	blockComputers.imageid = image.id
	AND imagerevision.imageid = image.id 
   AND imagerevision.production = 1
	AND blockTimes.id = blockComputers.blockTimeid
	AND blockComputers.computerid = $computerid 
	ORDER BY blockTimes.start LIMIT 1
	";

	# Call the database select subroutine
	# This will return an array of one or more rows based on the select statement
	my @block_image_info = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (scalar @block_image_info == 0) {
		notify($ERRORS{'WARNING'}, 0, "no block reservation image information existed for $computerid, 0 rows were returned");
		return;
	}

	if (scalar @block_image_info == 1) {
		my @ret_array;
		push (@ret_array, $block_image_info[0]{image_name},$block_image_info[0]{image_id},$block_image_info[0]{imagerevision_id});
		return @ret_array;
	}

	return;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_module_info

 Parameters  : Module ID (optional)
 Returns     : Array
 Description : Returns a hash reference containing information from the module
               table.
               
               An optional module ID argument can be supplied. If supplied, only
               the information for the specified module is returned.
               
               A hash reference is returned. The keys of the hash are the module IDs.
               Example showing the format of the data structure returned:
               
               my $module_info = get_module_info();
               $module_info->{15}
                  |--{description} = 'Provides OS support for standalone Unix lab machines'
                  |--{name} = 'os_unix_lab'
                  |--{perlpackage} = 'VCL::Module::OS::Linux::UnixLab'
                  |--{prettyname} = 'Unix Lab OS Module'
               $module_info->{15}
                  |--{description} = ''
                  |--{name} = 'os_win2008'
                  |--{perlpackage} = 'VCL::Module::OS::Windows::Version_6::2008'
                  |--{prettyname} = 'Windows Server 2008 OS Module'

=cut

sub get_module_info {
	# Create the select statement
	my $select_statement = "
   SELECT
	*
	FROM
	module
	";
	
	# Append a WHERE clause if a module ID argument was supplied
	my $module_id = shift;
	if ($module_id) {
		$select_statement .= "WHERE id = $module_id";
	}

	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);

	# Check to make sure rows were returned
	if (!@selected_rows) {
		notify($ERRORS{'WARNING'}, 0, "unable to retrieve rows from module table");
		return;
	}
	
	# Transform the array of database rows into a hash
	my %module_info_hash;
	for my $row (@selected_rows) {
		my $module_id = $row->{id};
		
		for my $key (keys %$row) {
			next if $key eq 'id';
			my $value = $row->{$key};
			$module_info_hash{$module_id}{$key} = $value;
		}
	}
	
	#notify($ERRORS{'DEBUG'}, 0, "retrieved module info:\n" . format_data(\%module_info_hash));
	return \%module_info_hash;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_current_package_name

 Parameters  : None
 Returns     : String
 Description : Returns a string containing the name of the Perl package which
               called get_current_package_name.

=cut

sub get_current_package_name {
	my $package_name = (caller(0))[0];
	return $package_name;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_current_file_name

 Parameters  : None
 Returns     : String
 Description : Returns a string containing the name of the file which
               called get_current_file_name.

=cut

sub get_current_file_name {
	my $file_name = (caller(0))[1];
	
	# Remove path leaving only file name
	$file_name =~ s/.*\///g;
	
	return $file_name;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_current_subroutine_name

 Parameters  : None
 Returns     : String
 Description : Returns a string containing the name of the subroutine which
               called get_current_subroutine_name.

=cut

sub get_current_subroutine_name {
	my $subroutine_name = (caller(1))[3];
	
	# Remove path leaving only sub name
	$subroutine_name =~ s/.*:://g;
	
	return $subroutine_name;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_affiliation_info

 Parameters  : $affiliation_identifier (optional)
 Returns     : hash reference
 Description : Returns a hash reference containing information from the
               affiliation table.
               
               If no $affiliation_identifier argument is supplied, a hash
               reference is returned with the hash keys corresponding to the
               affiliation.id values:
                  {
                    1 => {
                      "dataUpdateText" => "",
                      "helpaddress" => "vcl_help\@example.edu",
                      "id" => 1,
                      "name" => "Local",
                      "shibname" => undef,
                      "shibonly" => 0,
                      "sitewwwaddress" => undef,
                      "theme" => "default"
                    },
                    2 => {
                      "dataUpdateText" => "",
                      "helpaddress" => "vcl_help\@example.edu",
                      "id" => 2,
                      "name" => "Global",
                      "shibname" => undef,
                      "shibonly" => 0,
                      "sitewwwaddress" => undef,
                      "theme" => "default"
                    },
                    ...
                  }
               
               If the $affiliation_identifier argument is supplied, a hash
               reference is returned which only contains information for the
               matching affiliation:
                  {
                    "dataUpdateText" => "",
                    "helpaddress" => "vcl_help\@example.edu",
                    "id" => 2,
                    "name" => "Global",
                    "shibname" => undef,
                    "shibonly" => 0,
                    "sitewwwaddress" => undef,
                    "theme" => "default"
                  }

=cut

sub get_affiliation_info {
	my ($affiliation_identifier) = @_;
	
	# Create the select statement
	my $select_statement = <<EOF;
SELECT
*
FROM
affiliation
EOF
	
	# Append a WHERE clause if a affiliation identifier argument was supplied
	if ($affiliation_identifier && $affiliation_identifier =~ /^\d+$/) {
		$select_statement .= "WHERE id = $affiliation_identifier";
	}
	elsif ($affiliation_identifier) {
		$select_statement .= "WHERE name = '$affiliation_identifier'";
	}

	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);

	# Check to make sure rows were returned
	if (!@selected_rows) {
		notify($ERRORS{'WARNING'}, 0, "failed to retrieve rows from affiliation table");
		return;
	}
	
	# Transform the array of database rows into a hash
	my $affiliation_info = {};
	for my $row (@selected_rows) {
		my $affiliation_id = $row->{id};
		
		for my $key (keys %$row) {
			my $value = $row->{$key};
			$affiliation_info->{$affiliation_id}{$key} = $value;
		}
	}
	
	if ($affiliation_identifier) {
		my $affiliation_id = (keys %$affiliation_info)[0];
		$affiliation_info = $affiliation_info->{$affiliation_id};
		notify($ERRORS{'DEBUG'}, 0, "retrieved info for affiliation $affiliation_identifier:\n" . format_data($affiliation_info));
		return $affiliation_info;
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "retrieved affiliation info:\n" . format_data($affiliation_info));
		return $affiliation_info;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 format_number

 Parameters  : $number, $decimal_places (optional)
 Returns     : string
 Description : Formats a number with commas and rounds it to a number of
               decimal places.  The default number of decimal places is 0 so
               that numbers are rounded to the nearest integer.

=cut

sub format_number {
	my ($number, $decimal_places) = @_;
	$decimal_places = 0 if !$decimal_places;
	$number = sprintf("%." . $decimal_places . "f", $number);
	
	$number = reverse($number);
	$number =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
	
	return scalar reverse $number;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_file_size_info_string

 Parameters  : $bytes
 Returns     : string
 Description : 

=cut

sub get_file_size_info_string {
	my ($size_bytes, $separator) = @_;
	$separator = " - " if !$separator;
	
	my $size_kb = format_number(($size_bytes / 1024), 1);
	my $size_mb = format_number(($size_bytes / 1024 ** 2), 1);
	my $size_gb = format_number(($size_bytes / 1024 ** 3), 2);
	my $size_tb = format_number(($size_bytes / 1024 ** 4), 2);
	
	my $size_info;
	$size_info .= format_number($size_bytes) . " bytes$separator";
	$size_info .= "$size_kb KB$separator";
	$size_info .= "$size_mb MB$separator";
	$size_info .=  "$size_gb GB";
	$size_info .=  "$separator$size_tb TB" if ($size_tb >= 1);
	return $size_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_copy_speed_info_string

 Parameters  : $copied_bytes, $duration_seconds
 Returns     : string
 Description : Calculates various copy rates based on the amount of data copied
               and time the copy took.

=cut

sub get_copy_speed_info_string {
	my ($copied_bytes, $duration_seconds) = @_;
	
	# Avoid divide by zero errors
	if ($duration_seconds == 0) {
		$duration_seconds = 1;
	}

	my $minutes = ($duration_seconds / 60);
	$minutes =~ s/\..*//g;
	my $seconds = ($duration_seconds - ($minutes * 60));
	if (length($seconds) == 0) {
		$seconds = "00";
	}
	elsif (length($seconds) == 1) {
		$seconds = "0$seconds";
	}
	
	my $copied_bits = ($copied_bytes * 8);
	
	my $copied_kb = ($copied_bytes / 1024);
	my $copied_mb = ($copied_bytes / 1024 / 1024);
	my $copied_gb = ($copied_bytes / 1024 / 1024 / 1024);
	
	my $copied_kbit = ($copied_bits / 1024);
	my $copied_mbit = ($copied_bits / 1024 / 1024);
	my $copied_gbit = ($copied_bits / 1024 / 1024 / 1024);
	
	my $bytes_per_second = ($copied_bytes / $duration_seconds);
	my $kb_per_second = ($copied_kb / $duration_seconds);
	my $mb_per_second = ($copied_mb / $duration_seconds);
	my $gb_per_second = ($copied_gb / $duration_seconds);
	
	my $bits_per_second = ($copied_bits / $duration_seconds);
	my $kbit_per_second = ($copied_kbit / $duration_seconds);
	my $mbit_per_second = ($copied_mbit / $duration_seconds);
	my $gbit_per_second = ($copied_gbit / $duration_seconds);
	
	my $bytes_per_minute = ($copied_bytes / $duration_seconds * 60);
	my $kb_per_minute = ($copied_kb / $duration_seconds * 60);
	my $mb_per_minute = ($copied_mb / $duration_seconds * 60);
	my $gb_per_minute = ($copied_gb / $duration_seconds * 60);
	
	my $info_string;
	
	$info_string .= "data copied: " . get_file_size_info_string($copied_bytes) . "\n";
	$info_string .= "time to copy: $minutes:$seconds (" . format_number($duration_seconds) . " seconds)\n";
	$info_string .= "---\n";
	$info_string .= "bits copied:  " . format_number($copied_bits) . " ($copied_bits)\n";
	$info_string .= "bytes copied: " . format_number($copied_bytes) . " ($copied_bytes)\n";
	$info_string .= "MB copied:    " . format_number($copied_mb, 1) . "\n";
	$info_string .= "GB copied:    " . format_number($copied_gb, 2) . "\n";
	$info_string .= "---\n";
	$info_string .= "B/m:    " . format_number($bytes_per_minute) . "\n";
	$info_string .= "MB/m:   " . format_number($mb_per_minute, 1) . "\n";
	$info_string .= "GB/m:   " . format_number($gb_per_minute, 2) . "\n";
	$info_string .= "---\n";
	$info_string .= "B/s:    " . format_number($bytes_per_second) . "\n";
	$info_string .= "MB/s:   " . format_number($mb_per_second, 1) . "\n";
	$info_string .= "GB/s:   " . format_number($gb_per_second, 2) . "\n";
	$info_string .= "---\n";
	$info_string .= "Mbit/s: " . format_number($mbit_per_second, 1) . "\n";
	$info_string .= "Gbit/s: " . format_number($gbit_per_second, 2);
	
	return $info_string;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 create_management_node_directory

 Parameters  : $directory_path
 Returns     : boolean
 Description : Creates a directory on the management node.

=cut

sub create_management_node_directory {
	my ($directory_path) = @_;
	
	# Check if the directory already exists
	if (-d $directory_path) {
		notify($ERRORS{'OK'}, 0, "directory already exists on management node: $directory_path");
		return 1;
	}
	
	# Attempt to create the directory
	my $command = "mkdir -p -v \"$directory_path\" 2>&1 && ls -1d \"$directory_path\"";
	my ($exit_status, $output) = run_command($command, 1);
	if (!defined($output)) {
		notify($ERRORS{'WARNING'}, 0, "failed to run command to create directory on management node: $directory_path\ncommand: $command");
		return;
	}
	elsif (grep(/created directory/i, @$output)) {
		notify($ERRORS{'OK'}, 0, "created directory on management node: $directory_path");
		return 1;
	}
	elsif (grep(/mkdir: /i, @$output)) {
		notify($ERRORS{'WARNING'}, 0, "error occurred attempting to create directory on management node: $directory_path:\ncommand: $command\nexit status: $exit_status\noutput:\n" . join("\n", @$output));
		return;
	}
	elsif (grep(/^$directory_path/, @$output)) {
		notify($ERRORS{'OK'}, 0, "directory already exists on management node: $directory_path");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "unexpected output returned from command to create directory on management node: $directory_path:\ncommand: $command\nexit status: $exit_status\noutput:\n" . join("\n", @$output));
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 normalize_file_path

 Parameters  : $path
 Returns     : string
 Description : Normalizes a file or directory path:
               -spaces from the beginning and end of the path are removed
               -quotes from the beginning and end of the path are removed
               -trailing slashes are removed
               -escaped spaces are unescaped

=cut

sub normalize_file_path {
	# Get the path argument
	my $path = shift;
	if (!$path) {
		notify($ERRORS{'WARNING'}, 0, "path argument was not specified");
		return;
	}
	
	# Remove any spaces and quotes from the beginning and end of the path
	# Remove any slashes from the end of the path
	$path =~ s/(^['"\s]*|['"\s\\\/]*$)//g;
	
	# Unescape any spaces
	$path =~ s/\\+(\s)/$1/g;
	
	return $path;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 escape_file_path

 Parameters  : $path
 Returns     : string
 Description : Escapes special characters in a file or directory path with
               backslashes:
               -spaces are escaped

=cut

sub escape_file_path {
	# Get the path argument
	my $path = shift;
	if (!$path) {
		notify($ERRORS{'WARNING'}, 0, "path argument was not specified");
		return;
	}
	
	$path = normalize_file_path($path);
	
	# Call quotemeta to escape all special character
	$path = quotemeta $path;
	
	# Unescape wildcard *, +, characters or else subroutines will fail which accept a wildcard file path
	$path =~ s/\\+([\*\+\/\~])/$1/g;
	
	return $path;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 parent_directory_path

 Parameters  : $path
 Returns     : string
 Description : Returns the parent directory path of the path argument. The path
               returned is normalized.

=cut

sub parent_directory_path {
	# Get the path argument
	my $path = shift;
	if (!$path) {
		notify($ERRORS{'WARNING'}, 0, "path argument was not specified");
		return;
	}
	
	$path = normalize_file_path($path);
	
	# Remove everything after the last forward or backslash
	$path =~ s/\/[^\/\\]+$//g;
	
	return $path;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 setup_get_menu_choice

 Parameters  : $subref_hashref
 Returns     : subroutine reference
 Description : Accepts a hash reference which defines a 'vcld -setup' menu
               structure. The hash keys are the names of menu categories or menu
               items.
               
               If a hash key is the name of a menu category, its value must be a
               hash reference.
               
               If a hash key is the name of a menu item, its value must be a
               subroutine reference.

=cut

sub setup_get_menu_choice {
	my ($menu, $choices, $parent_menu_names) = @_;

	# Initialize the $choices array reference
	if (!$choices) {
		$choices = [];
	}
	
	if (!$parent_menu_names) {
		$parent_menu_names = [];
	}
	
	my $level = scalar(@$parent_menu_names);
	
	for my $name (sort keys %$menu) {
		my $value = $menu->{$name};
		my $type = ref($value);
		
		if ($type eq 'CODE') {
			push @$choices, { name => $name, sub_ref => $value, parent_menu_names => $parent_menu_names};
			
			print ' ' x ($level*3);
			print scalar(@$choices) . ": $name\n";
		}
		elsif ($type eq 'HASH') {
			print "\n" if ($level == 0 && scalar(@$choices) > 0);
			print ' ' x ($level*3);
			print "$name\n";
			
			# Recursively call this subroutine to add nested menu to choices
			setup_get_menu_choice($value, $choices, [@$parent_menu_names, $name]);
		}
	}
	
	# Check if this is a recursive call
	my $calling_subroutine = get_calling_subroutine();
	if ($calling_subroutine =~ /setup_get_menu_choice/) {
		return;
	}
	
	my $choice_index = setup_get_choice(scalar(@$choices));
	return if (!defined($choice_index));
	return @$choices[$choice_index];
}

#//////////////////////////////////////////////////////////////////////////////

=head2 setup_get_hash_choice

 Parameters  : $hash_ref, $display_key1 (optional), $display_key2 (optional)
 Returns     : $choice_name
 Description : Prompts the user to select an element from the hash. By default,
               the choices displayed are the top-level hash key values. If
               $hash_ref is a hash of hashes, the menu choices displayed may be
               the value of child hash values if $display_key1 is provided. If
               $display_key2 is provided, the choices will be a concatenation of
               2 child hash values.

=cut

sub setup_get_hash_choice {
	my ($hash_ref, $display_key1, $display_key2) = @_;
	
	my $choice_count = scalar(keys %$hash_ref);
	
	my %choices;
	for my $key (keys %$hash_ref) {
		my $display_name;
		if ($display_key1) {
			$display_name = $hash_ref->{$key}{$display_key1};
		}
		
		if ($display_key2) {
			if ($display_key2 =~ /^([^-]+)-([^-]+)$/) {
				$display_name .= " (" . $hash_ref->{$key}{$1}{$2} . ")";
			}
			else {
				my $display_key2_value = $hash_ref->{$key}{$display_key2};
				if (defined($display_key2_value) && length($display_key2_value) > 0) {
					$display_name .= " (" . $hash_ref->{$key}{$display_key2} . ")";
				}
			}
		}
		
		if (!$display_name) {
			$display_name = $key;
		}
		
		if ($choices{$display_name}) {
			notify($ERRORS{'WARNING'}, 0, "duplicate hash keys containing the value '$display_name', hash argument:\n" . format_data($hash_ref));
		}
		
		$choices{$display_name} = $key;
	}

	my $choice_index = setup_get_array_choice(sort keys %choices);
	return if (!defined($choice_index));
	
	my $choice_name = (sort keys %choices)[$choice_index];
	return $choices{$choice_name};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 setup_get_hash_multiple_choice

 Parameters  : $hash_ref, $argument_hash_ref (optional)
 Returns     : $hash_key
 Description : Given a hash reference structure, constructs a menu and retrieves
               user input.
               
               An optional hash reference can be supplied containing information
               to control how the menu is displayed. The hash may contain the
               following keys:
               * title - A string which will be displayed above the menu.
               * display_keys - An array reference containing strings. Each
                 array element may be a string enclosed in curly brackets. This
                 allows the menu items to be composed from any data elements
                 contained within the hash reference.
               
               Example:
               {
                  'title' => "Select VMs to be migrated off of $source_vmhost_computer_name",
                  'display_keys' => ['{SHORTNAME}', ' - ', '{currentimagerevision}{imagename}'],
               }
               
               This would result in menu entry names being assembled from:
               $hash_ref->{SHORTNAME} - $hash_ref->{currentimagerevision}{imagename}

=cut

sub setup_get_hash_multiple_choice {
	my $hash_ref = shift;
	if (!defined($hash_ref)) {
		notify($ERRORS{'WARNING'}, 0, "hash reference argument was not supplied");
		return;
	}
	elsif (!ref($hash_ref)) {
		notify($ERRORS{'WARNING'}, 0, "1st argument is not a reference, it must be a hash reference:\n$hash_ref");
		return;
	}
	elsif (ref($hash_ref) ne 'HASH') {
		notify($ERRORS{'WARNING'}, 0, "1st argument is a " . ref($hash_ref) . " reference, it must be a hash reference:\n" . format_data($hash_ref));
		return;
	}
	
	my $arguments = shift;
	if (defined($arguments)) {
		if (!ref($arguments)) {
			notify($ERRORS{'WARNING'}, 0, "2nd argument is not a reference, it must be a hash reference:\n$arguments");
			return;
		}
		elsif (ref($arguments) ne 'HASH') {
			notify($ERRORS{'WARNING'}, 0, "2nd argument is a " . ref($arguments) . " reference, it must be a hash reference:\n" . format_data($arguments));
			return;
		}
	}
	else {
		$arguments = {};
	}
	
	my $title = $arguments->{title};
	my @display_keys = (defined($arguments->{display_keys}) ? @{$arguments->{display_keys}} : ());
	
	my $entry_hash = {};
	my $max_entry_length = 0;
	for my $key (sort keys %$hash_ref) {
		my $entry_display_name;
		
		for my $display_key (@display_keys) {
			if ($display_key =~ /^{.+}$/) {
				my $hash_path = "\$hash_ref->{$key}$display_key";
				notify($ERRORS{'DEBUG'}, 0, "retrieving hash value: $hash_path");
				my $value = eval $hash_path;
				if ($EVAL_ERROR) {
					notify($ERRORS{'WARNING'}, 0, "error encountered evaluating hash path: '$hash_path'\n$EVAL_ERROR");
					return;
				}
				elsif (!defined($value)) {
					notify($ERRORS{'WARNING'}, 0, "unable to determine entry display name, hash does not contain key: '$hash_path'\," . format_data($hash_ref->{$key}));
					return;
				}
				else {
					notify($ERRORS{'DEBUG'}, 0, "retrieved entry display name component: $hash_path = '$value'");
					$entry_display_name .= $value;
				}
			}
			else {
				notify($ERRORS{'DEBUG'}, 0, "adding text to entry display name: '$display_key'");
				$entry_display_name .= $display_key;
			}
		}
		
		if (defined($entry_display_name) && defined($entry_hash->{$entry_display_name})) {
			notify($ERRORS{'WARNING'}, 0, "duplicate entry display names: '$entry_display_name', appending hash key: '$entry_display_name {$key}'");
			$entry_display_name = "$entry_display_name {$key}";
		}
		elsif (!defined($entry_display_name)) {
			$entry_display_name = $key;
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "choice entry name for hash key $key: '$entry_display_name'");
		}
		
		$entry_hash->{$entry_display_name}{key} = $key;
		$entry_hash->{$entry_display_name}{selected} = 0;
		$entry_hash->{$entry_display_name}{entry_display_name} = $entry_display_name;
		
		my $entry_display_name_length = length($entry_display_name);
		$max_entry_length = $entry_display_name_length if ($entry_display_name_length > $max_entry_length);
	}
	
	my $entry_index_hash = {};
	my $i = 1;
	for my $entry_display_name (sort keys %$entry_hash) {
		$entry_index_hash->{$i} = $entry_hash->{$entry_display_name};
		$entry_index_hash->{$i}{entry_index} = $i;
		$i++;
	}

	my $entry_count = scalar(keys %$entry_hash);
	my $entry_count_length = length($entry_count);
	my $no_print_entries = 0;
	
	# Adjust $max_entry_length to include:
	# [_]_x._
	$max_entry_length = $max_entry_length + 6 + $entry_count_length;
	
	while (1) {
		print "\n";
		if (defined($title)) {
			my $title_length = length($title);
			my $title_pad_string = '';
			if ($max_entry_length > $title_length) {
				$title_pad_string = ' ' x ($max_entry_length - $title_length);
			}
			print colored("$title$title_pad_string", 'BOLD UNDERLINE');
			print "\n";
		}
		my $selection_made = 0;
		#if (!$no_print_entries) {
			for my $entry_index (sort {$a<=>$b} keys %$entry_index_hash) {
				my $entry_display_name = $entry_index_hash->{$entry_index}{entry_display_name};
				my $selected = $entry_index_hash->{$entry_index}{selected};
				$selection_made = 1 if $selected;
				
				my $selection_string = '[';
				if ($selected) {
					$selection_string .= '*';
				}
				else {
					$selection_string .= ' ';
				}
				$selection_string .= '] ';
				
				my $entry_index_length = length($entry_index);
				my $entry_pad_length = ($entry_count_length - $entry_index_length);
				my $entry_pad_string = ' ' x $entry_pad_length;
				
				$selection_string .= "$entry_index. $entry_pad_string";
				$selection_string .= "$entry_display_name";
				if ($selected) {
					print colored($selection_string, 'BOLD');
				}
				else {
					print $selection_string;
				}
				print "\n";
			}
		#}
		
		#print "\n[" . join("/", @{$ENV{setup_path}}) . "]\n" if defined($ENV{setup_path});
		my $option_pad_string = ' ' x ($entry_count_length - 1);
		
		print "\n";
		print "[1";
		print "-$entry_count" if ($entry_count > 1);
		print "] - toggle selection (multiple may be entered)\n";
		print "  $option_pad_string\[a] - select all\n";
		print "  $option_pad_string\[n] - select none\n";
		print "  $option_pad_string\[i] - invert selected\n";
		print "  $option_pad_string\[d] - done making selections\n";
		print "  $option_pad_string\[c] - cancel\n";
		print "Make a selection";
		print " [d]" if $selection_made;
		print ": ";
		my $choice = <STDIN>;
		chomp $choice;
		
		$no_print_entries = 0;
		
		if ($choice =~ /^c$/i) {
			return;
		}
		elsif ($choice =~ /^d$/i || $selection_made && !length($choice)) {
			last;
		}
		elsif ($choice =~ /^a$/i) {
			for my $entry_index (keys %$entry_index_hash) {
				$entry_index_hash->{$entry_index}{selected} = 1;
			}
			next;
		}
		elsif ($choice =~ /^n$/i) {
			for my $entry_index (keys %$entry_index_hash) {
				$entry_index_hash->{$entry_index}{selected} = 0;
			}
			next;
		}
		elsif ($choice =~ /^i$/i) {
			for my $entry_index (keys %$entry_index_hash) {
				$entry_index_hash->{$entry_index}{selected} = !$entry_index_hash->{$entry_index}{selected};
			}
			next;
		}
		else {
			my @selected_entry_indexes = split(/[\s,]+/, $choice);
			for my $selected_entry_index (@selected_entry_indexes) {
				if ($selected_entry_index =~ /^(\d+)-(\d+)$/) {
					my $start_index = $1;
					my $end_index = $2;
					if ($start_index < 1 || $start_index > $entry_count) {
						print colored("*** Choice ignored: $selected_entry_index, starting index must be an integer between 1 and $entry_count ***", 'YELLOW ON_RED');
						print "\n";
						$no_print_entries = 1;
						next;
					}
					elsif ($end_index < $start_index || $end_index > $entry_count) {
						print colored("*** Choice ignored: $selected_entry_index, ending index must be an integer between " . ($start_index+1) . " and $entry_count ***", 'YELLOW ON_RED');
						print "\n";
						$no_print_entries = 1;
						next;
					}
					else {
						for (my $index = $start_index; $index <= $end_index; $index++) {
							$entry_index_hash->{$index}{selected} = !$entry_index_hash->{$index}{selected};
						}
					}
				}
				elsif ($selected_entry_index !~ /^\d+$/ || $selected_entry_index < 1 || $selected_entry_index > $entry_count) {
					print colored("*** Choice ignored: $selected_entry_index, it must be an integer between 1 and $entry_count ***", 'YELLOW ON_RED');
					print "\n";
					$no_print_entries = 1;
					next;
				}
				else {
					$entry_index_hash->{$selected_entry_index}{selected} = !$entry_index_hash->{$selected_entry_index}{selected};
				}
			}
		}
	}
	
	my @selected_keys;
	for my $entry_index (sort {$a<=>$b} keys %$entry_index_hash) {
		if ($entry_index_hash->{$entry_index}{selected}) {
			push @selected_keys, $entry_index_hash->{$entry_index}{key};
		}
	}
	
	return @selected_keys;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 setup_get_array_choice

 Parameters  : @choices
 Returns     : integer
 Description : Lists the elements in the @choices argument as a menu and accepts
               user input to select one of the elements. The array index
               corresponding to the user's choice is returned.

=cut

sub setup_get_array_choice {
	my (@choices) = @_;
	
	if (@choices) {
		notify($ERRORS{'DEBUG'}, 0, "choices argument:\n" . join("\n", @choices));
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "choices argument was either not supplied or is emptry");
		return;
	}
	
	my $choice_count = scalar(@choices);
	my $choice_count_length = length($choice_count);
	
	while (1) {
		for (my $i=1; $i<=$choice_count; $i++) {
			my $choice_length = length($i);
			my $pad = ($choice_count_length - $choice_length);
			print "$i. ";
			print " " x $pad;
			print "$choices[$i-1]\n";
		}
		
		print "\n[" . join("/", @{$ENV{setup_path}}) . "]\n" if defined($ENV{setup_path});
		print "Make a selection (1";
		print "-$choice_count" if ($choice_count > 1);
		print ", 'c' to cancel or when done): ";
		
		my $choice = <STDIN>;
		chomp $choice;
		
		if ($choice =~ /^c$/i) {
			return;
		}
		if ($choice !~ /^\d+$/ || $choice < 1 || $choice > $choice_count) {
			print "\n*** Choice must be an integer between 1 and $choice_count ***\n\n";
		}
		else {
			return ($choice - 1);
		}
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 setup_get_choice

 Parameters  : $choice_count
 Returns     : integer
 Description : Presents the 'Make a selection' prompt to the user loops until a
               valid choice is entered.

=cut

sub setup_get_choice {
	my ($choice_count) = @_;
	
	print "\n[" . join("/", @{$ENV{setup_path}}) . "]\n" if defined($ENV{setup_path});
	while (1) {
		print "Make a selection (1";
		print "-$choice_count" if ($choice_count > 1);
		print ", 'c' to cancel): ";
		
		my $choice = <STDIN>;
		if (!defined($choice)) {
			return;
		}
		
		chomp $choice;
		
		if ($choice =~ /^c$/i) {
			return;
		}
		if ($choice !~ /^\d+$/ || $choice < 1 || $choice > $choice_count) {
			print "*** Choice must be an integer between 1 and $choice_count ***\n";
		}
		else {
			return ($choice - 1);
		}
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 setup_get_input_string

 Parameters  : $message, $default_value (optional)
 Returns     : string
 Description : Prompts the user to enter a string.

=cut

sub setup_get_input_string {
	my ($message, $default_value) = @_;
	
	if ($message !~ /\n$/) {
		$message =~ s/\s+$//g;
		$message .= " ";
	}
	$message .= "('c' to cancel)";
	
	if ($default_value) {
		setup_print_wrap("$message [$default_value]: ", 0, 1);
	}
	else {
		setup_print_wrap("$message: ", 0, 1);
	}
	
	my $input = <STDIN>;
	chomp $input;
	if ($input =~ /^c$/i) {
		return;
	}
	elsif ($default_value && !length($input)) {
		return $default_value;
	}
	else {
		return $input;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 setup_get_input_file_path

 Parameters  : $message, $default_value (optional)
 Returns     : string
 Description : Prompts the user to enter a file path.

=cut

sub setup_get_input_file_path {
	my ($message, $default_value) = @_;
	
	# Check if a Term::ReadLine object has already been created
	my $term;
	if (defined($ENV{term_readline})) {
		$term = $ENV{term_readline};
	}
	else {
		$term = Term::ReadLine->new('ReadLine');
		if (!$term) {
			notify($ERRORS{'WARNING'}, 0, "failed to create Term::ReadLine object");
			return setup_get_input_string($message, $default_value);
		}
		$term->ornaments(0);
		
		my $attribs = $term->Attribs;
		if ($term->ReadLine =~ /Perl/) {
			$attribs->{completion_function} = \&_term_readline_complete_file_path;
		}
		
		$ENV{term_readline} = $term;
	}
	
	$message = '' unless $message;
	
	my $trailing_newline = 0;
	if ($message =~ /\n$/) {
		$trailing_newline = 1;
	}
	$message =~ s/[\s\n]*$//g;
	
	if ($message) {
		$message .= " ";
	}
	$message .= "('c' to cancel)";
	
	if ($trailing_newline) {
		$message .= "\n";
	}
	if ($default_value) {
		$message .=  "[$default_value]";
	}
	print "$message";
	
	my $input = $term->readline(": ");
	chomp $input;
	if ($input =~ /^c$/i) {
		return;
	}
	elsif ($default_value && !length($input)) {
		return $default_value;
	}
	else {
		return $input;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 _term_readline_complete_file_path

 Parameters  : $text
 Returns     : @files
 Description : 

=cut

sub _term_readline_complete_file_path {
	my ($text) = @_;
	my @files = glob "$text*";
	
	my @return_files;
	for my $file (@files) {
		if (-d $file) {
			$file .= '/';
		}
		
		push @return_files, $file;
	}
	
	# Do this twice to avoid "used only once" warning
	$readline::rl_completer_terminator_character = '';
	$readline::rl_completer_terminator_character = '';
	
	return @return_files;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 setup_confirm

 Parameters  : $message, $default_value (optional)
 Returns     : boolean
 Description : Displays the message to the user and loops until they enter Y or
               N.

=cut

sub setup_confirm {
	my ($message, $default_value) = @_;
	if (defined($message)) {
		$message =~ s/\s*$//g;
		$message .= ' ';
	}
	else {
		$message = '';
	}
	$message .= '(y/n)';
	
	my $default_yes = 0;
	my $default_no = 0;
	if (defined($default_value)) {
		if ($default_value =~ /^y$/i) {
			$message .= '[y]';
			$default_yes = 1;
		}
		elsif ($default_value =~ /^n$/i) {
			$message .= '[n]';
			$default_no = 1;
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "default value is not valid: '$default_value', it must be either 'y' or 'n'");
		}
	}
	
	while (1) {
		setup_print_wrap("$message? ");
		my $input = <STDIN>;
		$input =~ s/[\s\r\n]+$//g;
		
		if ((length($input) == 0 && $default_yes) || $input =~ /^y(es)?$/i) {
			return 1;
		}
		elsif ((length($input) == 0 && $default_no) || $input =~ /^n(o)?$/i) {
			return 0;
		}
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 setup_print_break

 Parameters  : $character (optional), $columns (optional)
 Returns     : true
 Description : Prints a horizontal line to stdout. Used to format the output
               from 'vcld -setup'.

=cut

sub setup_print_break {
	my $character = shift || '-';
	my $columns = shift || 100;
	$character =~ s/^(.).*/$1/;
	print $character x $columns . "\n";
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 setup_print_wrap

 Parameters  : $message, $columns (optional), $no_trailing_newline (optional)
 Returns     : true
 Description : Prints a message to STDOUT formatted to the column width. 100 is
               the default column value.

=cut

sub setup_print_wrap {
	my $message = shift || return;
	my $columns = shift || 100;
	my $no_trailing_newline = shift;
	
	# Save the leading and trailing lines then remove them from the string
	# This is done so wrap doesn't lose them
	my ($leading_newlines) = $message =~ /^(\n+)/;
	$message =~ s/^\n+//g;
	my ($trailing_newlines) = $message =~ /(\n+)$/;
	$message =~ s/\n+$//g;
	
	$| = 1;
	
	# Wrap text for lines
	local($Text::Wrap::columns) = $columns;
	print $leading_newlines if $leading_newlines;
	print wrap('', '', $message);
	if ($trailing_newlines) {
		print $trailing_newlines;
	}
	elsif (!$no_trailing_newline) {
		print "\n";
	}
	
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 setup_print_ok

 Parameters  : $message
 Returns     : true
 Description : 

=cut

sub setup_print_ok {
	my ($message) = @_;
	return unless defined($message);
	$message =~ s/[\s\n]+$//g;
	
	my $prefix = 'OK';
	print colored(" $prefix ", "BOLD WHITE ON_GREEN");
	print " ";
	setup_print_wrap($message, (100-length($prefix)-2));
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 setup_print_error

 Parameters  : $message
 Returns     : true
 Description : 

=cut

sub setup_print_error {
	my ($message) = @_;
	return unless defined($message);
	$message =~ s/[\s\n]+$//g;
	
	#print get_caller_trace() . "\n\n";
	
	my $prefix = 'ERROR';
	print colored(" $prefix ", "BOLD WHITE ON_RED");
	print " ";
	setup_print_wrap($message, (100-length($prefix)-2));
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 setup_print_warning

 Parameters  : $message
 Returns     : true
 Description : 

=cut

sub setup_print_warning {
	my ($message) = @_;
	return unless defined($message);
	$message =~ s/[\s\n]+$//g;
	
	my $prefix = 'WARNING';
	print colored(" $prefix ", "BLACK ON_YELLOW");
	print " ";
	setup_print_wrap($message, (100-length($prefix)-2));
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_os_info

 Parameters  : none
 Returns     : hash reference
 Description : Returns the contents of the OS table as a hash reference. The
               hash keys are the OS IDs.

=cut

sub get_os_info {
	# Create the select statement
	my $select_statement = <<EOF;
SELECT
OS.*,
module.name AS module_name,
module.prettyname AS module_prettyname,
module.perlpackage AS module_perlpackage
FROM
OS,
module
WHERE
OS.moduleid = module.id
EOF
	
	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);
	
	my %info;
	
	for my $row (@selected_rows) {
		my $os_id = $row->{id};
		
		foreach my $key (keys %$row) {
			my $value = $row->{$key};
			
			(my $original_key = $key) =~ s/^.+_//;
	
			if ($key =~ /module_/) {
				$info{$os_id}{module}{$original_key} = $value;
			}
			else {
				$info{$os_id}{$original_key} = $value;
			}
		}
	}
	
	#notify($ERRORS{'DEBUG'}, 0, "retrieved OS info:\n" . format_data(\%info));
	return \%info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 kill_child_processes

 Parameters  : $parent_pid
 Returns     : boolean
 Description : Kills all child processes belonging to the parent PID specified
               as the argument.

=cut

sub kill_child_processes {
	my @parent_pids = @_;
	if (!@parent_pids) {
		notify($ERRORS{'WARNING'}, 0, "parent PID argument not supplied");
		return;
	}
	
	my $parent_pid = $parent_pids[-1];
	my $parent_process_string = "parent PID: " . join(" > ", @parent_pids);
	
	# Make sure the parent vcld daemon process didn't call this subroutine for safety
	# Prevents all reservations being processed from being killed
	if ($ENV{vcld}) {
		notify($ERRORS{'CRITICAL'}, 0, "kill_child_processes subroutine called from the parent vcld process, not killing any processes for safety");
		return;
	}
	
	notify($ERRORS{'DEBUG'}, 0, "$parent_process_string: attempting to kill child processes");
	
	my $command = "ps -h --ppid $parent_pid -o pid,ppid,args | sort -r";
	my ($exit_status, $output) = run_command($command, 1);
	for my $line (@$output) {
		# Make sure the line only contains a PID
		my ($child_pid, $parent_pid, $child_command) = $line =~ /^\s*(\d+)\s+(\d+)\s+(.*)/;
		if (!defined($child_pid)) {
			notify($ERRORS{'WARNING'}, 0, "$parent_process_string: output line does not contain a PID:\nline: '$line'");
			next;
		}
		elsif ($child_command =~ /$command/) {
			# Ignore the pgrep command called to determine child processes
			notify($ERRORS{'DEBUG'}, 0, "ignoring process created by this subroutine: '$line'");
			next;
		}
		elsif ($child_command =~ /ssh -e none/) {
			# Ignore SSH sessions created for execute_new
			notify($ERRORS{'DEBUG'}, 0, "ignoring persistent SSH process: '$line'");
			next;
		}
		
		notify($ERRORS{'DEBUG'}, 0, "$parent_process_string, found child process: '$line'");
		
		# Recursively kill the child processes of the child process
		kill_child_processes(@parent_pids, $child_pid);
		
		my $kill_count = kill 9, $child_pid;
		if ($kill_count) {
			notify($ERRORS{'DEBUG'}, 0, "$parent_process_string, killed child process: $child_pid (kill count: $kill_count)");
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "$parent_process_string, kill command returned 0 attempting to kill child process: $child_pid");
		}
	}
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_reservation_connect_method_info

 Parameters  : $imagerevision_id, $no_cache (optional)
 Returns     : hash reference
 Description : Returns the connect methods for the reservation. Example:
               {
                4 => {
                  "RETRIEVAL_TIME" => "1417709281",
                  "connectmethodmap" => {
                    "OSid" => 36,
                    "OStypeid" => undef,
                    "autoprovisioned" => undef,
                    "connectmethodid" => 4,
                    "disabled" => 0,
                    "imagerevisionid" => undef
                  },
                  "connectmethodport" => {
                    35 => {
                      "connectmethodid" => 4,
                      "id" => 35,
                      "natport" => {
                        "connectmethodportid" => 35,
                        "nathostid" => 2,
                        "publicport" => 56305,
                        "reservationid" => 3115
                      },
                      "port" => 3389,
                      "protocol" => "TCP"
                    },
                    37 => {
                      "connectmethodid" => 4,
                      "id" => 37,
                      "natport" => {
                        "connectmethodportid" => 37,
                        "nathostid" => 2,
                        "publicport" => 63058,
                        "reservationid" => 3115
                      },
                      "port" => 3389,
                      "protocol" => "UDP"
                    }
                  },
                  "description" => "Linux xRDP (Remote Desktop Protocol)",
                  "id" => 4,
                  "name" => "xRDP",
                  "servicename" => "xrdp",
                  "startupscript" => undef
                }
              }

=cut

sub get_reservation_connect_method_info {
	my ($reservation_id, $no_cache) = @_;
	if (!defined($reservation_id)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	
	# Check if cached info exists
	if (!$no_cache && defined($ENV{connect_method_info}{$reservation_id})) {
		my $connect_method_id = (keys(%{$ENV{connect_method_info}{$reservation_id}}))[0];
		if ($connect_method_id) {
			# Check the time the info was last retrieved
			my $data_age_seconds = (time - $ENV{connect_method_info}{$reservation_id}{$connect_method_id}{RETRIEVAL_TIME});
			if ($data_age_seconds < 600) {
				return $ENV{connect_method_info}{$reservation_id};
			}
			else {
				notify($ERRORS{'DEBUG'}, 0, "retrieving current connect method info for reservation $reservation_id from database, cached data is stale: $data_age_seconds seconds old");
			}
		}
	}
	
	# Get a hash ref containing the database column names
	my $database_table_columns = get_database_table_columns();
	
	my @tables = (
		'connectmethod',
		'connectmethodport',
		'connectmethodmap',
		'natport',
	);
	
	# Construct the select statement
	my $select_statement = "SELECT DISTINCT\n";
	
	# Get the column names for each table and add them to the select statement
	for my $table (@tables) {
		my @columns = @{$database_table_columns->{$table}};
		for my $column (@columns) {
			$select_statement .= "$table.$column AS '$table-$column',\n";
		}
	}
	
	# Remove the comma after the last column line
	$select_statement =~ s/,$//;
	
	# Complete the select statement
	$select_statement .= <<EOF;
FROM
connectmethod,
connectmethodmap,

reservation
LEFT JOIN image ON (image.id = reservation.imageid)
LEFT JOIN OS ON (OS.id = image.OSid)
LEFT JOIN OStype ON (OStype.name = OS.type),

connectmethodport
LEFT JOIN natport ON (natport.connectmethodportid = connectmethodport.id AND natport.reservationid = $reservation_id)

WHERE
reservation.id = $reservation_id
AND connectmethodport.connectmethodid = connectmethod.id
AND connectmethodmap.connectmethodid = connectmethod.id
AND connectmethodmap.autoprovisioned IS NULL
AND (
	connectmethodmap.OStypeid = OStype.id
	OR connectmethodmap.OSid = OS.id 
	OR connectmethodmap.imagerevisionid = reservation.imagerevisionid
)

ORDER BY
connectmethod.id,
connectmethodmap.imagerevisionid,
connectmethodmap.OSid,
connectmethodmap.OStypeid,
connectmethodmap.disabled
EOF

	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);
	
	# Transform the array of database rows into a hash
	my $connect_method_info = {};
	
	my $timestamp = time;
	for my $row (@selected_rows) {	
		my $connectmethod_id = $row->{'connectmethod-id'};
		
		# Loop through all the columns returned
		for my $key (keys %$row) {
			next if $key eq 'connectmethod-connecttext';
			
			my $value = $row->{$key};
			
			# Split the table-column names
			my ($table, $column) = $key =~ /^([^-]+)-(.+)/;
			
			if ($table eq 'connectmethod') {
				$connect_method_info->{$connectmethod_id}{$column} = $value;
			}
			elsif ($table eq 'connectmethodport') {
				my $connectmethodport_id = $row->{"connectmethodport-id"};
				$connect_method_info->{$connectmethod_id}{'connectmethodport'}{$connectmethodport_id}{$column} = $value;
			}
			elsif ($table eq 'natport') {
				if (defined($value)) {
					my $connectmethodport_id = $row->{"connectmethodport-id"};
					$connect_method_info->{$connectmethod_id}{'connectmethodport'}{$connectmethodport_id}{'natport'}{$column} = $value;
				}
			}
			else {
				$connect_method_info->{$connectmethod_id}{$table}{$column} = $value;
			}
		}
		$connect_method_info->{$connectmethod_id}{RETRIEVAL_TIME} = $timestamp;
	}

	notify($ERRORS{'DEBUG'}, 0, "retrieved connect method info for reservation $reservation_id:\n" . format_data($connect_method_info));
	$ENV{connect_method_info}{$reservation_id} = $connect_method_info;
	return $ENV{connect_method_info}{$reservation_id};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_random_mac_address

 Parameters  : $prefix (optional)
 Returns     : string
 Description : Generates a random MAC address.

=cut

sub get_random_mac_address {
	my ($prefix) = @_;
	
	if ($prefix) {
		# Add a trailing colon if not supplied in the argument
		$prefix =~ s/:+$/:/;
		
		if ($prefix !~ /([a-f0-9]{2}:)+/i) {
			notify($ERRORS{'WARNING'}, 0, "invalid MAC address prefix argument: $prefix");
			return;
		}
		elsif (length($prefix) % 3 != 0) {
			notify($ERRORS{'WARNING'}, 0, "invalid MAC address prefix length: '$prefix'");
			return;
		}
		
	}
	else {
		$prefix = '52:54:';
	}
	
	my $random_octet_count = (6 - (length($prefix) / 3));
	
	# Remove the trailing colon
	$prefix =~ s/:+$//;
	
	my $mac_address = uc($prefix);
	
	for (my $i=0; $i<$random_octet_count; $i++) {
		$mac_address .= ":" . sprintf("%02X",int(rand(256)));
	}
	
	notify($ERRORS{'DEBUG'}, 0, "generated random MAC address: '$mac_address'");
	return $mac_address;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 xml_string_to_hash

 Parameters  : $xml_text, $force_array (optional)
 Returns     : hash reference
 Description : Converts XML text to a hash using XML::Simple:XMLin. The argument
               may be a string of XML text or array reference of lines of XML
               text.

=cut

sub xml_string_to_hash {
	my @arguments = @_;
	if (!@arguments) {
		notify($ERRORS{'WARNING'}, 0, "XML text argument was not specified");
		return;
	}
	
	my ($xml_text, $force_array) = @_;
	my $type = ref($xml_text);
	if ($type) {
		if ($type eq 'ARRAY') {
			$xml_text = join("\n", @$xml_text);
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "invalid argument type: $type");
			return;
		}
	}
	
	$force_array = 1 if !defined $force_array;
	
	# Override the die handler 
	local $SIG{__DIE__} = sub{};
	
	# Convert the XML to a hash using XML::Simple
	my $xml_hashref;
	eval {
		$xml_hashref = XMLin($xml_text, 'ForceArray' => $force_array, 'KeyAttr' => []);
	};
	
	if ($xml_hashref) {
		return $xml_hashref;
	}
	elsif ($EVAL_ERROR) {
		notify($ERRORS{'WARNING'}, 0, "failed to convert XML text to hash, error: $EVAL_ERROR\nXML text:$xml_text");
		return;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to convert XML text to hash, XML text:$xml_text");
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 hash_to_xml_string

 Parameters  : $xml_hashref, $root_name (optional)
 Returns     : string
 Description : Converts an XML hash reference to text to a hash using
               XML::Simple:XMLout.

=cut

sub hash_to_xml_string {
	my $xml_hashref = shift;
	if (!$xml_hashref) {
		notify($ERRORS{'WARNING'}, 0, "XML hash reference argument was not specified");
		return;
	}
	elsif (!ref($xml_hashref) || ref($xml_hashref) ne 'HASH') {
		notify($ERRORS{'WARNING'}, 0, "argument is not a hash reference");
		return;
	}
	
	my $root_name = shift;
	
	# Override the die handler 
	local $SIG{__DIE__} = sub{};
	
	# Convert the XML hashref to text using XML::Simple::XMLout
	my $xml_text;
	eval {
		$xml_text = XMLout($xml_hashref, 'RootName' => $root_name, 'KeyAttr' => []);
	};
	
	if ($xml_text) {
		return $xml_text;
	}
	elsif ($EVAL_ERROR) {
		notify($ERRORS{'WARNING'}, 0, "failed to convert XML hash reference to text, error: $EVAL_ERROR\nXML hash reference:" . format_data($xml_hashref));
		return;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to convert XML hash reference to text, XML hash reference:" . format_data($xml_hashref));
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 sort_by_file_name

 Parameters  : @file_paths
 Returns     : array
 Description : Sorts a list of file paths by file name. Directory paths are
               ignored. File names beginning with numbers are sorted
               numerically.
               Example:
               
               Input array:
                  /var/file_a.txt
                  /tmp/file_b.txt
                  /var/1 file.txt
                  100 file.txt
                  /tmp/99 data.txt
                  50 file.txt
               
               Sorted result:
                  /var/1 file.txt
                  50 file.txt
                  /tmp/99 data.txt
                  100 file.txt
                  /var/file_a.txt
                  /tmp/file_b.txt

=cut

sub sort_by_file_name {
	if (!defined($a) && !defined($b)) {
		my @file_paths = @_;
		if (scalar(@file_paths)) {
			#notify($ERRORS{'DEBUG'}, 0, "not called by sort, \$a and \$b are not defined, array argument was passed");
			return sort sort_by_file_name @file_paths;
		}
		else {
			return ();
		}
	}
	
	# Get the file names from the 2 file paths being compared
	my $a_file_name = ($a =~ /([^\/]+)$/g)[0];
	my $b_file_name = ($b =~ /([^\/]+)$/g)[0];
	
	# Check if both file names begin with a number
	my $a_number = ($a_file_name =~ /^(\d+)/g)[0];
	my $b_number = ($b_file_name =~ /^(\d+)/g)[0];
	
	# If both file names begin with a number, sort numerically
	# Otherwise, sort alphabetically
	if (defined($a_number) && defined($b_number) && $a_number != $b_number) {
		#notify($ERRORS{'DEBUG'}, 0, "numeric comparison - a: $a_file_name ($a_number), b: $b_file_name ($b_number)");
		return $a_number <=> $b_number;
	}
	else {
		#notify($ERRORS{'DEBUG'}, 0, "alphabetic comparison - a: $a_file_name, b: $b_file_name");
		return lc($a_file_name) cmp lc($b_file_name);
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_current_image_contents_no_data_structure

 Parameters  : node name
 Returns     : array
 Description : returns contents of currentimage.txt for given node

=cut

sub get_current_image_contents_no_data_structure {

   my ($computer_node_name) = @_;

   if (!defined($computer_node_name)) {
      notify($ERRORS{'WARNING'}, 0, "computer_node_name  argument was not supplied");
      return;
   }

   # Attempt to retrieve the contents of currentimage.txt
   my $cat_command = "cat ~/currentimage.txt";
   my ($cat_exit_status, $cat_output) = run_ssh_command($computer_node_name, $ENV{management_node_info}{keys}, $cat_command);
   if (!defined($cat_output)) {
      notify($ERRORS{'WARNING'}, 0, "failed to execute command to failed to retrieve currentimage.txt from $computer_node_name");
      return;
   }
   elsif ($cat_exit_status ne '0') {
      notify($ERRORS{'WARNING'}, 0, "failed to retrieve currentimage.txt from $computer_node_name, exit status: $cat_exit_status, output:\n@{$cat_output}");
      return;
   }
   else {
      notify($ERRORS{'DEBUG'}, 0, "retrieved currentimage.txt contents from $computer_node_name:\n" . join("\n", @$cat_output));
   }
   return @{$cat_output};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 is_ip_assigned_query

  Parameters  : IP address
  Returns     : boolean
  Description : checks if IP address exists in db

=cut

sub is_ip_assigned_query {
	
	my ($ip_address) = @_;

   if (!defined($ip_address)) {
      notify($ERRORS{'WARNING'}, 0, "IPaddress  argument was not supplied");
      return;
   }	

   my $select_statement = <<EOF;
SELECT
computer.id AS computer_id,
computer.hostname AS computer_hostname,
computer.stateid AS computer_stateid,
state.name AS state_name
FROM computer, state
WHERE
computer.IPaddress = '$ip_address' AND
computer.stateid = state.id AND
state.name != 'deleted' AND
computer.vmhostid IS NOT NULL
EOF

   # Call the database select subroutine
   my @selected_rows = database_select($select_statement);

   # Check to make sure 1 row was returned
   if (scalar @selected_rows == 0) {
      notify($ERRORS{'OK'}, 0, "zero rows were returned from database select statement $ip_address is available");
      return 0;
   }
	elsif (scalar @selected_rows >= 1) {
      notify($ERRORS{'OK'}, 0, scalar @selected_rows . " rows were returned from database select statement: $ip_address is assigned");
      return 1;
   }

	return 1;	
		
}

#//////////////////////////////////////////////////////////////////////////////

=head2 stopwatch

 Parameters  : $title (optional)
 Returns     : none
 Description : For vcld performance monitoring only. Every time stopwatch is
               called, it prints a message to STDOUT with the current time and
               the time elapsed since the last call.

=cut

sub stopwatch {
	my ($title) = @_;
	
	my ($seconds, $microseconds) = gettimeofday;
	
	if (!$ENV{'start'}) {
		$ENV{'start'} = [$seconds, $microseconds];
	}
	
	if (defined($ENV{'stopwatch_count'})) {
		$ENV{'stopwatch_count'}++;
	}
	else {
		$ENV{'stopwatch_count'} = 'a';
	}
	
	$ENV{'previous'} = $ENV{'current'} || $ENV{'start'};
	
	$ENV{'current'} = [$seconds, $microseconds];
	
	my $message = "[stopwatch] $ENV{'stopwatch_count'}: ";
	$message .= "$title " if defined($title);
	$title = '<none>' if !defined($title);
	
	my $previous_delta = sprintf("%.2f", tv_interval($ENV{'previous'}, $ENV{'current'}));
	my $start_delta = sprintf("%.2f", tv_interval($ENV{'start'}, $ENV{'current'}));
	
	$start_delta = 0 if $start_delta =~ /e/;
	$previous_delta = 0 if $previous_delta =~ /e/;
	
	$message .= "(previous/start: +$previous_delta/+$start_delta)";
	
	print "\n$message\n\n";
	
	my $info = {
		current => $ENV{'current'},
		previous => $ENV{'previous'},
		message => $message,
		start_delta => $start_delta,
		previous_delta => $previous_delta,
		title => "$ENV{'stopwatch_count'}: $title",
	};
	
	if (!$ENV{stopwatch}) {
		$ENV{stopwatch} = [];
	}
	
	push @{$ENV{stopwatch}}, $info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_management_node_computer_ids

 Parameters  : $management_node_identifier
 Returns     : hash reference
 Description : Retrieves a list of all computer IDs a particular management node
               controls.

=cut

sub get_management_node_computer_ids {
	my $management_node_identifier = shift || get_management_node_id{};
	if (!$management_node_identifier) {
		notify($ERRORS{'WARNING'}, 0, "management node identifier argument was not supplied");
		return;
	}
	
	my $select_statement = <<EOF;
SELECT DISTINCT
computer.id,
computer.hostname

FROM
managementnode       mn,
resource             mn_resource,
resourcetype         mn_resourcetype,
resourcegroup        mn_resourcegroup,
resourcegroupmembers mn_resourcegroupmembers,
computer,
resource             comp_resource,
resourcegroup        comp_resourcegroup,
resourcegroupmembers comp_resourceourcegroupmembers,
resourcemap

WHERE

mn.id = mn_resource.subid AND
mn_resource.resourcetypeid = mn_resourcetype.id AND
mn_resourcetype.name = 'managementnode' AND

mn_resource.id = mn_resourcegroupmembers.resourceid AND
mn_resourcegroupmembers.resourcegroupid = mn_resourcegroup.id AND

computer.id = comp_resource.subid AND
comp_resource.id = comp_resourceourcegroupmembers.resourceid AND
comp_resourceourcegroupmembers.resourcegroupid = comp_resourcegroup.id AND

resourcemap.resourcegroupid1 = mn_resourcegroup.id AND
resourcemap.resourcegroupid2 = comp_resourcegroup.id AND

computer.deleted = 0
EOF
	
	if ($management_node_identifier =~ /^\d+$/) {
		$select_statement .= "AND mn.id = $management_node_identifier";
	}
	else {
		$select_statement .= "AND mn.hostname = '$management_node_identifier'";
	}
	
	my @selected_rows = database_select($select_statement);
	
	my %computers = map { $_->{id} => $_->{hostname} } @selected_rows;
	my @computer_ids = keys %computers;
	my $computer_count = scalar(@computer_ids);
	#notify($ERRORS{'DEBUG'}, 0, "computers assigned to $management_node_identifier: $computer_count\n" . format_data(\%computers));
	notify($ERRORS{'DEBUG'}, 0, "computers assigned to $management_node_identifier: $computer_count\n" . join(', ', @computer_ids));
	return @computer_ids;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_management_node_vmhost_ids

 Parameters  : $management_node_identifier (optional)
 Returns     : array
 Description : Returns a list of all VM host IDs controlled by a particular
               management node. This list will include any VM host computers
               mapped to the management node as well as VM host computers which
               are assigned a VM which is mapped to the management node.

=cut

sub get_management_node_vmhost_ids {
	my $management_node_identifier = shift || $FQDN;
	
	if ($ENV{management_node_vmhost_ids}{$management_node_identifier}) {
		notify($ERRORS{'DEBUG'}, 0, "returning previously retrieved vmhost IDs assigned to management node: $management_node_identifier");
		return @{$ENV{management_node_vmhost_ids}{$management_node_identifier}};
	}
	notify($ERRORS{'DEBUG'}, 0, "retrieving vmhost IDs assigned to management node: $management_node_identifier");
	
	my $select_statement = <<EOF;
SELECT DISTINCT
vmhost.id

FROM
managementnode       mn,
resource             mn_resource,
resourcetype         mn_resourcetype,
resourcegroup        mn_resourcegroup,
resourcegroupmembers mn_resourcegroupmembers,
computer,
vmhost,
computer host,
resource             comp_resource,
resourcegroup        comp_resourcegroup,
resourcegroupmembers comp_resourceourcegroupmembers,
resourcemap

WHERE

mn.id = mn_resource.subid AND
mn_resource.resourcetypeid = mn_resourcetype.id AND
mn_resourcetype.name = 'managementnode' AND

mn_resource.id = mn_resourcegroupmembers.resourceid AND
mn_resourcegroupmembers.resourcegroupid = mn_resourcegroup.id AND

computer.deleted = 0 AND
host.deleted = 0 AND

computer.id = comp_resource.subid AND
comp_resource.id = comp_resourceourcegroupmembers.resourceid AND
comp_resourceourcegroupmembers.resourcegroupid = comp_resourcegroup.id AND
resourcemap.resourcegroupid1 = mn_resourcegroup.id AND
resourcemap.resourcegroupid2 = comp_resourcegroup.id

AND (
	(
		computer.type = 'virtualmachine' AND
		computer.vmhostid = vmhost.id
	)
	OR
	(
		computer.type = 'blade' AND
		vmhost.computerid = computer.id
	)
)
AND vmhost.computerid = host.id
EOF
	
	if ($management_node_identifier =~ /^\d+$/) {
		$select_statement .= "AND mn.id = $management_node_identifier";
	}
	else {
		$select_statement .= "AND mn.hostname = '$management_node_identifier'";
	}
	my @selected_rows = database_select($select_statement);
	
	my @vmhost_ids = map { $_->{id} } @selected_rows;
	
	notify($ERRORS{'DEBUG'}, 0, "vmhost IDs assigned to $management_node_identifier (" . scalar(@vmhost_ids) . "): " . join(', ', @vmhost_ids));
	$ENV{management_node_vmhost_ids}{$management_node_identifier} = \@vmhost_ids;
	return @{$ENV{management_node_vmhost_ids}{$management_node_identifier}};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_management_node_vmhost_info

 Parameters  : $management_node_identifier (optional)
 Returns     : hash
 Description : Retrieves information for all VM hosts assigned to a management
               node. The hash keys are vmhost.id values.

=cut

sub get_management_node_vmhost_info {
	my $management_node_identifier = shift || $FQDN;
	return $ENV{management_node_vmhost_info}{$management_node_identifier} if $ENV{management_node_vmhost_info}{$management_node_identifier};
	
	my @management_node_vmhost_ids = get_management_node_vmhost_ids($management_node_identifier);
	
	my $vmhost_info = {};
	for my $vmhost_id (@management_node_vmhost_ids) {
		$vmhost_info->{$vmhost_id} = get_vmhost_info($vmhost_id);
		$vmhost_info->{$vmhost_id}{hostname} = $vmhost_info->{$vmhost_id}{computer}{hostname};
		$vmhost_info->{$vmhost_id}{vmprofile_profilename} = $vmhost_info->{$vmhost_id}{vmprofile}{profilename};
	}
	
	$ENV{management_node_vmhost_info}{$management_node_identifier} = $vmhost_info;
	return $ENV{management_node_vmhost_info}{$management_node_identifier};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_vmhost_assigned_vm_info

 Parameters  : $vmhost_id, $no_cache (optional)
 Returns     : hash reference
 Description : Returns a hash reference containing all of the computer IDs
               assigned to a VM host.

=cut

sub get_vmhost_assigned_vm_info {
	my ($vmhost_id, $no_cache) = @_;
	if (!$vmhost_id) {
		notify($ERRORS{'WARNING'}, 0, "VM host ID argument was not supplied");
		return;
	}
	
	if (!$no_cache && defined($ENV{vmhost_assigned_vm_info}{$vmhost_id})) {
		return $ENV{vmhost_assigned_vm_info}{$vmhost_id};
	}
	
	my $select_statement = <<EOF;
SELECT
computer.id
FROM
computer
WHERE
computer.vmhostid = $vmhost_id
EOF
	
	my @selected_rows = database_select($select_statement);
	
	my $assigned_computer_info = {};
	for my $row (@selected_rows) {
		my $computer_id = $row->{id};
		my $computer_info = get_computer_info($computer_id);
		$assigned_computer_info->{$computer_id} = $computer_info if $computer_info;
	}
	
	$ENV{vmhost_assigned_vm_info}{$vmhost_id} = $assigned_computer_info;
	notify($ERRORS{'DEBUG'}, 0, "retrieved computer info for VMs assigned to VM host $vmhost_id: " . join(', ', sort keys %$assigned_computer_info));
	return $assigned_computer_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2  get_vmhost_assigned_vm_provisioning_info

 Parameters  : $vmhost_identifier, $no_cache (optional)
 Returns     : hash reference
 Description : For a given vmhost entry, retrieves the provisioning ID for all
               of the computers assigned to the VM host. This information can be
               used to attempt to determine which provisioning module should be
               used to control the VM host.
               
               There is currently no deterministic way to tie a VM host to a
               provisioning table type. It's possible to assign VMs with
               different computer.provisioningid values to the same VM host.
               This is usually done by mistake.
               
               This subroutine constructs a hash refererence with keys
               corresponding to provisioning.id values. Each key contains the
               provisioning table information.
               
               An 'ASSIGNED_COMPUTER_IDS' key is added containing a hash
               reference. The keys of this hash correspond to computer.id values
               of VMs assigned to the host with the corresponding
               computer.provisioningid value. An 'ASSIGNED_COMPUTER_COUNT' key
               is added containing the number of VMs.
               
               Example where VM host has multiple VM provisioning types
               assigned:
               
                  {
                    14 => {
                      "ASSIGNED_VM_COUNT" => 1,
                      "id" => 14,
                      "module" => {
                        "description" => "",
                        "id" => 33,
                        "name" => "provisioning_libvirt",
                        "perlpackage" => "VCL::Module::Provisioning::libvirt",
                        "prettyname" => "Libvirt Provisioning"
                      },
                      "moduleid" => 33,
                      "name" => "libvirt",
                      "prettyname" => "Libvirt"
                    },
                    8 => {
                      "ASSIGNED_VM_COUNT" => 27,
                      "id" => 8,
                      "module" => {
                        "description" => "",
                        "id" => 21,
                        "name" => "provisioning_vmware_vsphere",
                        "perlpackage" => "VCL::Module::Provisioning::VMware::VMware",
                        "prettyname" => "VMware Provisioning Module"
                      },
                      "moduleid" => 21,
                      "name" => "vmware",
                      "prettyname" => "VMware Server 2.x and ESX/ESXi"
                    }
                  }

=cut


sub get_vmhost_assigned_vm_provisioning_info {
	my ($vmhost_id, $no_cache) = @_;
	
	# Check the passed parameter
	if (!defined($vmhost_id)) {
		notify($ERRORS{'WARNING'}, 0, "VM host ID argument was not specified");
		return;
	}
	
	if (!$no_cache && defined($ENV{vmhost_assigned_vm_provisioning_info}{$vmhost_id})) {
		return $ENV{vmhost_assigned_vm_provisioning_info}{$vmhost_id};
	}
	
	my $vmhost_assigned_vm_info = get_vmhost_assigned_vm_info($vmhost_id, $no_cache) || return;

	my $vmhost_assigned_vm_provisioning_info = {};
	for my $computer_id (keys %$vmhost_assigned_vm_info) {
		my $provisioning_id = $vmhost_assigned_vm_info->{$computer_id}{provisioning}{id};
		if (!defined($vmhost_assigned_vm_provisioning_info->{$provisioning_id})) {
			$vmhost_assigned_vm_provisioning_info->{$provisioning_id} = $vmhost_assigned_vm_info->{$computer_id}{provisioning};
		}
		#$vmhost_assigned_vm_provisioning_info->{$provisioning_id}{ASSIGNED_COMPUTER_IDS}{$computer_id} = 1;
		$vmhost_assigned_vm_provisioning_info->{$provisioning_id}{ASSIGNED_VM_COUNT}++;
	}
	
	$ENV{vmhost_assigned_vm_provisioning_info}{$vmhost_id} = $vmhost_assigned_vm_provisioning_info;
	notify($ERRORS{'DEBUG'}, 0, "retrieved provisioning info for VMs assigned to VM host $vmhost_id:\n" . format_data($vmhost_assigned_vm_provisioning_info));
	return $vmhost_assigned_vm_provisioning_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 sleep_uninterrupted

 Parameters  : $seconds
 Returns     : none
 Description : A normal sleep call may be interrupted by a signal from a child
               process. This occurs whenever a child vcld reservation process
               exits. As a result, the intended sleep duration will be shorter
               than intended. This subroutine loops to make sure the sleep time
               is what is intended.

=cut

sub sleep_uninterrupted {
	my $seconds = shift;
	my $start_time = Time::HiRes::time;
	my $end_time = ($start_time + $seconds);
	
	#notify($ERRORS{'DEBUG'}, 0, "sleeping for $seconds seconds, end time: $end_time");
	my $loop_count = 0;
	while (1) {
		$loop_count++;
		my $current_time = Time::HiRes::time;
		my $sleep_seconds = ($end_time - $current_time);
		last if ($sleep_seconds <= 0);
		if ($loop_count > 1) {
			#notify($ERRORS{'DEBUG'}, 0, "loop $loop_count: sleep was interrupted\n" .
			#	"start time    : $start_time\n" .
			#	"current time  : $current_time\n" .
			#	"end time      : $end_time\n" .
			#	"sleep seconds : $sleep_seconds seconds"
			#);
		}
		Time::HiRes::sleep($sleep_seconds);
	}
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_imagerevision_cleanup_info

 Parameters  : none
 Returns     : hash reference
 Description : Retrieves various attribues from the database for all image
               revisions. A hash is constructed:
               "winxp-win_generator1485-v24" => {
                  "age" => 1270,
                  "datecreated" => "2010-07-19 13:24:44",
                  "deleted" => 1,
                  "imagename" => "winxp-win_generator1485-v24",
                  "production" => 0,
                  "productionrevision" => 28,
                  "revision" => 24
                  "image" => {
                     "deleted" => 1
                  },
               },

=cut

sub get_imagerevision_cleanup_info {
	return $ENV{imagerevision_cleanup_info} if $ENV{imagerevision_cleanup_info};
	
	my $sql = <<EOF;	
SELECT
imagerevision.imagename AS imagerevision_imagename,
imagerevision.datecreated AS imagerevision_datecreated,
TIMESTAMPDIFF(DAY, imagerevision.datecreated, NOW()) AS imagerevision_age,
imagerevision.production AS imagerevision_production,
imagerevision.revision AS imagerevision_revision,
image.deleted AS image_deleted,
imagerevision.deleted AS imagerevision_deleted,
productionimagerevision.revision AS imagerevision_productionrevision
FROM
image,
imagerevision,
imagerevision productionimagerevision
WHERE
imagerevision.imageid = image.id
AND productionimagerevision.imageid = imagerevision.imageid
AND productionimagerevision.production = 1
EOF
	
	my @rows = database_select($sql);
	my $imagerevision_count = scalar(@rows);
	my $imagerevision_cleanup_info = {};
	
	my $deleted_count = 0;
	
	for my $row (@rows) {
		my $imagerevision_imagename = $row->{imagerevision_imagename};
		for my $key (keys %$row) {
			my $value = $row->{$key};
			my ($table, $column) = $key =~ /^(\w+)_(\w+)$/;
			if ($table eq 'imagerevision') {
				$imagerevision_cleanup_info->{$imagerevision_imagename}{$column} = $value;
			}
			else {
				$imagerevision_cleanup_info->{$imagerevision_imagename}{$table}{$column} = $value;
			}
		}
		
		if ($row->{imagerevision_deleted} || $row->{image_deleted}) {
			$deleted_count++;
			$imagerevision_cleanup_info->{$imagerevision_imagename}{deleted} = 1;
		}
	}
	
	notify($ERRORS{'DEBUG'}, 0, "retrieved cleanup info for imagerevision entries in the database");
	$ENV{imagerevision_cleanup_info} = $imagerevision_cleanup_info;
	return $ENV{imagerevision_cleanup_info};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_imagerevision_reservation_info

 Parameters  : $imagerevision_identifier (optional)
 Returns     : hash
 Description : Retrieves info regarding the image revisions currently assigned
               to reservations. A hash reference is returned. The hash keys are
               imagerevision.imagename values. Image revisions not assigned to
               any reservations are not included in the hash. Result format:
               
               "winxp-Word2003Eclipseforclassroom1308-v11" => {
                 "id" => 8362,
                 "imagename" => "winxp-Word2003Eclipseforclassroom1308-v11",
                 "reservation" => {
                   2450746 => {
                     "id" => 2450746,
                     "request" => {
                       "end" => "2014-01-08 20:30:00",
                       "laststate" => {
                         "name" => "inuse"
                       },
                       "start" => "2014-01-05 20:15:00",
                       "state" => {
                         "name" => "pending"
                       }
                     },
                     "requestid" => 2356990
                   },
                   2450747 => {
                     "id" => 2450747,
                     "request" => {
                       "end" => "2014-01-08 20:45:00",
                       "laststate" => {
                         "name" => "inuse"
                       },
                       "start" => "2014-01-05 20:30:00",
                       "state" => {
                         "name" => "inuse"
                       }
                     },
                     "requestid" => 2356991
                   }
                 }
               }

=cut

sub get_imagerevision_reservation_info {
	my $imagerevision_identifier = shift;
	
	my $sql = <<EOF;	
SELECT
imagerevision.id AS imagerevision_id,
imagerevision.imagename AS imagerevision_imagename,
reservation.id AS reservation_id,
reservation.requestid AS reservation_requestid,
request.start AS request_start,
request.end AS request_end,
state.name AS state_name,
laststate.name AS laststate_name
FROM
imagerevision,
reservation,
request,
state,
state laststate
WHERE
reservation.imagerevisionid = imagerevision.id
AND reservation.requestid = request.id
AND request.stateid = state.id
AND request.laststateid = laststate.id
EOF
	
	if ($imagerevision_identifier) {
		if ($imagerevision_identifier =~ /^\d+$/) {
			$sql .= "AND imagerevision.id = '$imagerevision_identifier'";
		}
		else {
			$sql .= "AND imagerevision.imagename = '$imagerevision_identifier'";
		}
	}

	my @rows = database_select($sql);
	
	my $imagerevision_reservation_info = {};
	for my $row (@rows) {
		my $imagerevision_imagename = $row->{imagerevision_imagename};
		my $request_id = $row->{request_id};
		my $reservation_id = $row->{reservation_id};
		
		for my $key (keys %$row) {
			my $value = $row->{$key};
			my ($table, $column) = $key =~ /^(\w+)_(\w+)$/;
			if ($table eq 'imagerevision') {
				$imagerevision_reservation_info->{$imagerevision_imagename}{$column} = $value;
			}
			elsif ($table eq 'reservation') {
				$imagerevision_reservation_info->{$imagerevision_imagename}{$table}{$reservation_id}{$column} = $value;
			}
			elsif ($table eq 'request') {
				$imagerevision_reservation_info->{$imagerevision_imagename}{reservation}{$reservation_id}{$table}{$column} = $value;
			}
			elsif ($table =~ /state/) {
				$imagerevision_reservation_info->{$imagerevision_imagename}{reservation}{$reservation_id}{request}{$table}{$column} = $value;
			}
		}
	}
	
	#notify($ERRORS{'DEBUG'}, 0, "retrieved imagerevision reservation info:\n" . format_data($imagerevision_reservation_info));
	return $imagerevision_reservation_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_imagerevision_loaded_info

 Parameters  : $imagerevision_identifier (optional)
 Returns     : hash reference
 Description : Retrieves info regarding the image revisions currently loaded on
               computers. A hash reference is returned. The hash keys are
               imagerevision.imagename values. Image revisions not loaded on any
               computers according to computer.imagerevisionid are not included
               in the hash. Result format:
               
               "winxp-ICTN2531RHEL61onVMware2865-v6" => {
                 "computer" => {
                   508 => {
                     "hostname" => "vm-1",
                     "id" => 508,
                     "state" => {
                       "name" => "available"
                     }
                   },
                   554 => {
                     "hostname" => "vm-53",
                     "id" => 554,
                     "state" => {
                       "name" => "inuse"
                     }
                   },
                 },
                 "id" => 7452,
                 "imagename" => "winxp-ICTN2531RHEL61onVMware2865-v6"
               },

=cut

sub get_imagerevision_loaded_info {
	my $imagerevision_identifier = shift;
	
	my $sql = <<EOF;	
SELECT
imagerevision.id AS imagerevision_id,
imagerevision.imagename AS imagerevision_imagename,
computer.id AS computer_id,
computer.hostname AS computer_hostname,
state.name AS state_name
FROM
imagerevision,
computer,
state
WHERE
computer.imagerevisionid = imagerevision.id
AND computer.stateid = state.id
AND computer.deleted = 0
EOF
	
	if ($imagerevision_identifier) {
		if ($imagerevision_identifier =~ /^\d+$/) {
			$sql .= "AND imagerevision.id = '$imagerevision_identifier'";
		}
		else {
			$sql .= "AND imagerevision.imagename = '$imagerevision_identifier'";
		}
	}

	my @rows = database_select($sql);
	
	my $imagerevision_loaded_info = {};
	for my $row (@rows) {
		my $imagerevision_imagename = $row->{imagerevision_imagename};
		my $computer_id = $row->{computer_id};
		for my $key (keys %$row) {
			my $value = $row->{$key};
			my ($table, $column) = $key =~ /^(\w+)_(\w+)$/;
			if ($table eq 'imagerevision') {
				$imagerevision_loaded_info->{$imagerevision_imagename}{$column} = $value;
			}
			elsif ($table eq 'computer') {
				$imagerevision_loaded_info->{$imagerevision_imagename}{computer}{$computer_id}{$column} = $value;
			}
			elsif ($table eq 'state') {
				$imagerevision_loaded_info->{$imagerevision_imagename}{computer}{$computer_id}{state}{$column} = $value;
			}
		}
	}
	
	#notify($ERRORS{'DEBUG'}, 0, "retrieved imagerevision loaded computer info:\n" . format_data($imagerevision_loaded_info));
	return $imagerevision_loaded_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_imagerevision_names

 Parameters  : none
 Returns     : array
 Description : Retrieves a list of all image revision names from the database.

=cut

sub get_imagerevision_names {
	return @{$ENV{imagerevision_names}} if $ENV{imagerevision_names};
	
	my $sql = "SELECT imagerevision.imagename FROM imagerevision WHERE 1";
	my @rows = database_select($sql);
	my @imagerevision_names = map { $_->{imagename} } @rows;
	my $imagerevision_count = scalar(@imagerevision_names);
	notify($ERRORS{'DEBUG'}, 0, "retrieved $imagerevision_count imagerevision names from database");
	
	$ENV{imagerevision_names} = \@imagerevision_names;
	return @{$ENV{imagerevision_names}};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_imagerevision_names_recently_reserved

 Parameters  : $days
 Returns     : array
 Description : Retrieves a list of image revision names from the database which
               have been reserved in the last number of days specified by the
               argument. Image revisions included in the result have been
               reserved recently. Image revisions not included in the result
               have not been reserved recently.

=cut

sub get_imagerevision_names_recently_reserved {
	my $days = shift;
	if (!$days) {
		notify($ERRORS{'WARNING'}, 0, "days argument was not supplied");
		return;
	}
	
	my $sql = <<EOF;	
SELECT DISTINCT
imagerevision.imagename
FROM
image,
imagerevision,
log,
sublog
WHERE
imagerevision.imageid = image.id
AND sublog.imageid = image.id
AND sublog.logid = log.id
AND log.finalend >= DATE_SUB(NOW(), INTERVAL $days DAY)
EOF

	my @rows = database_select($sql);
	
	my @imagerevision_names = map { $_->{imagename} } @rows;
	my $imagerevision_count = scalar(@imagerevision_names);
	notify($ERRORS{'DEBUG'}, 0, "retrieved $imagerevision_count imagerevision names from database whose images were reserved within the past $days days");
	return @imagerevision_names;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_array_intersection

 Parameters  : $array_ref_1, $array_ref_2...
 Returns     : array
 Description : Finds the intersection of any number of arrays.

=cut

sub get_array_intersection {
	my @array_refs = @_;
	
	# Set the resulting intersection hash to the first array ref argument
	my $array_ref_1 = shift @array_refs;
	my $array_ref_1_type = ref($array_ref_1);
	if (!$array_ref_1_type || $array_ref_1_type ne 'ARRAY') {
		notify($ERRORS{'WARNING'}, 0, "first argument is not a reference to an array");
		return;
	}
	
	my @intersection = @$array_ref_1;
	
	my $loop = 0;
	for my $array_ref (@array_refs) {
		my @array = @$array_ref;
		my %hash = map { $_ => 1 } @array;
		@intersection = grep($hash{$_}, @intersection);
	}
	
	return sort @intersection;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_code_ref_package_name

 Parameters  : $code_ref
 Returns     : string
 Description : Determines the perl package name of a subroutine reference. The
               subroutine name is not included.

=cut

sub get_code_ref_package_name {
	my $code_ref = shift;
	if (!$code_ref || !ref($code_ref)) {
		return;
	}
	
	my $cv = svref_2object($code_ref) || return;
	my $gv = $cv->GV || return;
	my $st = $gv->STASH || return;
	return $st->NAME;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_code_ref_subroutine_name

 Parameters  : $code_ref
 Returns     : string
 Description : Determines the subroutine name of a subroutine reference. The
               perl package is not included.

=cut

sub get_code_ref_subroutine_name {
	my $code_ref = shift;
	if (!$code_ref || !ref($code_ref)) {
		return;
	}
	
	my $cv = svref_2object($code_ref) || return;
	my $gv = $cv->GV || return;
	return $gv->NAME;
}


#//////////////////////////////////////////////////////////////////////////////

=head2 is_variable_set

 Parameters  : variable name
 Returns     : If variable is set: 1
               If variable is not set: 0
               If an error occurred: undefined
 Description : Queries the variable table for the variable with the name
               specified by the argument. Returns true if the variable is set,
               false otherwise.

=cut

sub is_variable_set {
	my $variable_name = shift;
	
	# Check if 1st argument is a reference meaning this was called as an object method
	# If so, ignore 1st reference argument and call shift again
	if (ref($variable_name)) {
		$variable_name = shift;
	}
	
	# Check the argument
	if (!defined($variable_name)) {
		notify($ERRORS{'WARNING'}, 0, "variable name argument was not supplied");
		return;
	}
	
	# Construct the select statement
my $select_statement .= <<"EOF";
SELECT
variable.value
FROM
variable
WHERE
variable.name = '$variable_name'
EOF
	
	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);

	# Check to make 1 sure row was returned
	if (!@selected_rows) {
		notify($ERRORS{'DEBUG'}, 0, "variable is NOT set: $variable_name");
		return 0;
	}
	elsif (@selected_rows > 1) {
		notify($ERRORS{'WARNING'}, 0, "unable to get value of variable '$variable_name', multiple rows exist in the database for variable:\n" . format_data(\@selected_rows));
		return;
	}
	
	# Get the serialized value from the variable row
	my $database_value = $selected_rows[0]{value};
	
	if (defined($database_value)) {
		notify($ERRORS{'DEBUG'}, 0, "variable is set: $variable_name");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "unable to get value of variable '$variable_name', row returned:\n" . format_data(\@selected_rows));
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_variable

 Parameters  : $variable_name, $show_warnings (optional)
 Returns     : If successful: data stored in the variable table for the variable name specified
               If failed: false
 Description : Queries the variable table for the variable with the name
               specified by the argument. Returns the data stored for the
               variable. Values are deserialized before being returned if the
               value stored was a reference.
               
               Undefined is returned if the variable name does not exist in the
               variable table. A log message is displayed by default. To
               suppress the log message, supply the $show_warnings argument with
               a value of 0.

=cut

sub get_variable {
	# Check if 1st argument is a reference meaning this was called as an object method
	# If so, ignore 1st reference argument
	shift @_ if ($_[0] && ref($_[0]) && ref($_[0]) =~ /VCL/);
	
	# Check the argument
	my $variable_name = shift;
	if (!defined($variable_name)) {
		notify($ERRORS{'WARNING'}, 0, "variable name argument was not supplied");
		return;
	}
	
	my $show_warnings = shift;
	$show_warnings = 1 unless defined $show_warnings;
	
	# Construct the select statement
my $select_statement .= <<"EOF";
SELECT
variable.value,
variable.serialization
FROM
variable
WHERE
variable.name = '$variable_name'
EOF
	
	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);

	# Check to make 1 sure row was returned
	if (!@selected_rows) {
		notify($ERRORS{'OK'}, 0, "variable '$variable_name' is not set in the database") if $show_warnings;
		return;
	}
	elsif (@selected_rows > 1) {
		notify($ERRORS{'WARNING'}, 0, "unable to get value of variable '$variable_name', multiple rows exist in the database for variable:\n" . format_data(\@selected_rows));
		return;
	}
	
	# Get the serialized value from the variable row
	my $serialization_type = $selected_rows[0]{serialization};
	my $database_value = $selected_rows[0]{value};
	my $deserialized_value;
	
	# Deserialize the variable value if necessary
	if ($serialization_type eq 'none') {
		$deserialized_value = $database_value;
	}
	elsif ($serialization_type eq 'yaml') {
		# Attempt to deserialize the value
		$deserialized_value = yaml_deserialize($database_value);
		if (!defined($deserialized_value)) {
			notify($ERRORS{'WARNING'}, 0, "unable to deserialize variable '$variable_name' using YAML");
			return;
		}
		
		# Display the data type of the value retrieved from the variable table
		if (my $deserialized_data_type = ref($deserialized_value)) {
			notify($ERRORS{'DEBUG'}, 0, "data type of variable '$variable_name': $deserialized_data_type reference");
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "data type of variable '$variable_name': scalar");
		}
	}
	elsif ($serialization_type eq 'phpserialize') {
		# TODO: find Perl module to handle PHP serialized data
		# Add module to list of dependencies
		# Add code here to call PHP deserialize function
		notify($ERRORS{'CRITICAL'}, 0, "unable to get value of variable '$variable_name', PHP serialized data is NOT supported yet by the VCL backend, returning null");
		return;
	}
	else {
		notify($ERRORS{'CRITICAL'}, 0, "unable to get value of variable '$variable_name', serialization type '$serialization_type' is NOT supported by the VCL backend, returning null");
		return;
	}
	
	return $deserialized_value;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 yaml_deserialize

 Parameters  : Data
 Returns     : If successful: data structure
               If failed: false
 Description : 

=cut

sub yaml_deserialize {
	# Check if 1st argument is a reference meaning this was called as an object method
	# If so, ignore 1st reference argument and call shift again
	my $yaml_data_argument = shift;
	if (ref($yaml_data_argument)) {
		$yaml_data_argument = shift;
	}
	
	# Check to make sure argument was passed
	if (!defined($yaml_data_argument)) {
		notify($ERRORS{'WARNING'}, 0, "data argument was not passed");
		return;
	}
	
	my $deserialized_value;
	eval '$deserialized_value = YAML::Load($yaml_data_argument)';
	if ($EVAL_ERROR) {
		notify($ERRORS{'WARNING'}, 0, "unable to deserialize data using YAML::Load(), data value: $yaml_data_argument");
		return;
	}
	
	return $deserialized_value;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 set_variable

 Parameters  : variable name, variable value
 Returns     : If successful: true
               If failed: false
 Description : Inserts or updates a row in the variable table. The variable name
               and value arguments must be specified.
               
               The value can be a simple scalar such as a string or a reference
               to a complex data structure such as an array of hashes.
               
               Simple scalar values are stored in the variable.value column
               as-is and the variable.serialization column will be set to
               'none'.
               
               References are serialized using YAML before being stored. The
               variable.value column will contain the YAML representation of the
               data and the variable.serialization column will be set to 'yaml'.
               
               This subroutine will also update the variable.timestamp column.
               The variable.setby column is automatically set to the filename
               and line number which called this subroutine.

=cut

sub set_variable {
	# Check if 1st argument is a reference meaning this was called as an object method
	# If so, ignore 1st reference argument
	shift @_ if ($_[0] && ref($_[0]) && ref($_[0]) =~ /VCL/);
	
	my $variable_name = shift;
	
	# Get the 2nd argument containing the variable value
	my $variable_value = shift;
	
	# Check the arguments
	if (!defined($variable_name)) {
		notify($ERRORS{'WARNING'}, 0, "variable name argument was not supplied");
		return;
	}
	elsif (!defined($variable_value)) {
		notify($ERRORS{'WARNING'}, 0, "variable value argument was not supplied");
		return;
	}
	
	notify($ERRORS{'DEBUG'}, 0, "attempting to set variable: $variable_name");
	
	# Set serialization type to yaml if the value being stored is a reference
	# Otherwise, a simple scalar is being stored and serialization is not necessary
	my $serialization_type;
	if (ref($variable_value)) {
		$serialization_type = 'yaml';
	}
	else {
		$serialization_type = 'none';
	}
	
	# Construct a string indicating where the variable was set from
	my $management_node_name = get_management_node_info()->{SHORTNAME} || hostname;
	my @caller = caller(0);
	(my $calling_file) = $caller[1] =~ /([^\/]*)$/;
	my $calling_line = $caller[2];
	my $caller_string = "$management_node_name:$calling_file:$calling_line";
	
	# Attempt to serialize the value if necessary
	my $database_value;
	if ($serialization_type eq 'none') {
		$database_value = $variable_value;
	}
	else {
		# Attempt to serialize the value using YAML
		$database_value = yaml_serialize($variable_value);
		if (!defined($database_value)) {
			notify($ERRORS{'WARNING'}, 0, "unable to serialize variable '$variable_name' using YAML, value:\n" . format_data($variable_value));
			return;
		}
	}
	
	# Assemble an insert statement, if the variable already exists, update the existing row
	my $insert_statement .= <<"EOF";
INSERT INTO variable
(
name,
serialization,
value,
setby,
timestamp
)
VALUES
(
'$variable_name',
'$serialization_type',
'$database_value',
'$caller_string',
NOW()
)
ON DUPLICATE KEY UPDATE
name=VALUES(name),
serialization=VALUES(serialization),
value=VALUES(value),
setby=VALUES(setby),
timestamp=VALUES(timestamp)
EOF
	
	# Execute the insert statement, the return value should be the id of the row
	my $inserted_id = database_execute($insert_statement);
	if ($inserted_id) {
		notify($ERRORS{'OK'}, 0, "set variable '$variable_name', variable id: $inserted_id, serialization: $serialization_type");
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to set variable '$variable_name', serialization: $serialization_type");
		return;
	}
	
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 delete_variable

 Parameters  : variable name
 Returns     : If successful: true
               If failed: false
 Description : Deletes record related to variable name from variable table

=cut

sub delete_variable {
	# Check if 1st argument is a reference meaning this was called as an object method
	# If so, ignore 1st reference argument
	shift @_ if ($_[0] && ref($_[0]) && ref($_[0]) =~ /VCL/);
	
	my $variable_name = shift;
	
	# Check the arguments
	if (!defined($variable_name)) {
		notify($ERRORS{'WARNING'}, 0, "variable name argument was not supplied");
		return;
	}
	
	notify($ERRORS{'DEBUG'}, 0, "attempting to delete variable: $variable_name");
	
	# Assemble delete statement, if the variable already exists, update the existing row
	my $delete_statement .= <<"EOF";
DELETE 
FROM 
variable
WHERE
name = '$variable_name'
EOF
	
	# Execute the delete statement, the return value should be the id of the row
	if (database_execute($delete_statement)) {
		notify($ERRORS{'OK'}, 0, "deleted variable '$variable_name' from variable table");
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to delete variable '$variable_name'");
		return;
	}
	
	return 1;
}
#//////////////////////////////////////////////////////////////////////////////

=head2 yaml_serialize

 Parameters  : Data
 Returns     : If successful: string containing serialized representation of data
               If failed: false
 Description : 

=cut

sub yaml_serialize {
	# Check if 1st argument is a reference meaning this was called as an object method
	# If so, ignore 1st reference argument
	shift @_ if ($_[0] && ref($_[0]) && ref($_[0]) =~ /VCL/);
	
	# Check to make sure argument was passed
	my $data_argument = shift;
	if (!defined($data_argument)) {
		notify($ERRORS{'WARNING'}, 0, "data argument was not passed");
		return;
	}
	
	# Attempt to serialize the value using YAML::Dump()
	# Use eval because Dump() will call die() if it encounters an error
	my $serialized_data;
	eval '$serialized_data = YAML::Dump($data_argument)';
	if ($EVAL_ERROR) {
		notify($ERRORS{'WARNING'}, 0, "unable to serialize data using YAML::Dump(), data value: $data_argument");
		return;
	}
	
	# Escape all backslashes
	$serialized_data =~ s/\\/\\\\/g;
	
	# Escape all single quote characters with a backslash
	#   or else the SQL statement will fail because it is wrapped in single quotes
	$serialized_data =~ s/'/\\'/g;
	
	return $serialized_data;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 remove_array_duplicates

 Parameters  : @array
 Returns     : array
 Description : Removes duplicates from the array. Retains order.

=cut

sub remove_array_duplicates {
	my @array = @_;
	
	my $seen = {};
	my @pruned;
	for (my $i=0; $i < scalar(@array); $i++) {
		my $value = $array[$i];
		if (ref($value)) {
			notify($ERRORS{'WARNING'}, 0, "unable to remove duplicates from an array containing references, returning original array");
			return @array;
		}
		if (!defined($seen->{$value})) {
			$seen->{$value} = 1;
			push @pruned, $value;
		}
	}
	return @pruned
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_changelog_info

 Parameters  : $request_id, $age_limit_timestamp (optional)
 Returns     : hash reference
 Description : Retrieves all of the changelog entries for a request which have a
               changelog.remoteIP value. If the $age_limit_timestamp argument is
               supplied, only entries with timestamp values greater than or
               equal to the argument will be returned. A hash is constructed.
               The hash values are the changelog.id values:
               
               194 => {
                 "computerid" => 3574,
                 "end" => undef,
                 "id" => 194,
                 "logid" => 5354,
                 "other" => undef,
                 "remoteIP" => "1.2.3.4",
                 "reservation" => {
                   "lastcheck" => "2014-06-06 11:43:29"
                 },
                 "reservationid" => 3115,
                 "start" => undef,
                 "timestamp" => "2014-06-06 11:41:05",
                 "user" => {
                   "unityid" => "admin"
                 },
                 "userid" => 1,
                 "wasavailable" => undef
               },

=cut

sub get_changelog_info {
	my ($request_id, $age_limit_timestamp) = @_;
	if (!defined($request_id)) {
		notify($ERRORS{'WARNING'}, 0, "request ID argument was not supplied");
		return;
	}
	
	# Get a hash ref containing the database column names
	my $database_table_columns = get_database_table_columns();
	
	my %tables = (
		'changelog' => 'changelog',
	);
	
	# Construct the select statement
	my $select_statement = "SELECT DISTINCT\n";
	
	# Get the column names for each table and add them to the select statement
	for my $table_alias (keys %tables) {
		my $table_name = $tables{$table_alias};
		my @columns = @{$database_table_columns->{$table_name}};
		for my $column (@columns) {
			$select_statement .= "$table_alias.$column AS '$table_alias-$column',\n";
		}
	}
	
	# Complete the select statement
	$select_statement .= <<EOF;
user.unityid AS 'user-unityid',
reservation.lastcheck AS 'reservation-lastcheck'
FROM
log,
request,
changelog
LEFT JOIN (user) ON (changelog.userid = user.id)
LEFT JOIN (reservation) ON (changelog.reservationid = reservation.id)
WHERE
changelog.logid = log.id
AND log.id = request.logid
AND request.id = $request_id
AND changelog.remoteIP IS NOT NULL
EOF
	
	if ($age_limit_timestamp) {
		$select_statement .= "AND changelog.timestamp >= '$age_limit_timestamp'";
	}
	
	my @rows = database_select($select_statement);

	my $changelog_info = {};
	for my $row (@rows) {
		my $changelog_id = $row->{'changelog-id'};
		
		# Loop through all the columns returned
		for my $key (keys %$row) {
			my $value = $row->{$key};
			
			# Split the table-column names
			my ($table, $column) = $key =~ /^([^-]+)-(.+)/;
			
			if ($table eq 'changelog') {
				$changelog_info->{$changelog_id}{$column} = $value;
			}
			else {
				$changelog_info->{$changelog_id}{$table}{$column} = $value;
			}
		}
	}
	
	my $age_string = '';
	if ($age_limit_timestamp) {
		$age_string = " updated on or after $age_limit_timestamp";
	}
	
	if (scalar(%$changelog_info)) {
		notify($ERRORS{'DEBUG'}, 0, "retrieved changelog info for request $request_id$age_string:\n" . format_data($changelog_info));
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "no changelog entries exist for request $request_id$age_string");
	}
	return $changelog_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_changelog_remote_ip_address_info

 Parameters  : $request_id, $age_limit_timestamp (optional)
 Returns     : hash reference
 Description : Retrieves all of the changelog entries for a request which have a
               changelog.remoteIP value and organizes the results by remote IP
               address. If the $age_limit_timestamp argument is supplied, only
               entries with timestamp values greater than or equal to the
               argument will be returned. A hash is constructed. The hash values
               are the changelog.remoteIP values:

               "1.2.3.5" => [
                 {
                   "computerid" => 3574,
                   "end" => undef,
                   "id" => 199,
                   "logid" => 5354,
                   "other" => undef,
                   "remoteIP" => "1.2.3.5",
                   "reservation" => {
                     "lastcheck" => "2014-06-06 11:56:00"
                   },
                   "reservationid" => 3115,
                   "start" => undef,
                   "timestamp" => "2014-06-06 11:53:36",
                   "user" => {
                     "unityid" => "admin"
                   },
                   "userid" => 1,
                   "wasavailable" => undef
                 }
               ]

=cut

sub get_changelog_remote_ip_address_info {
	my ($request_id, $age_limit_timestamp) = @_;
	if (!defined($request_id)) {
		notify($ERRORS{'WARNING'}, 0, "request ID argument was not supplied");
		return;
	}
	
	my $changelog_remote_ip_info = {};
	
	my $changelog_info = get_changelog_info($request_id, $age_limit_timestamp);
	for my $changelog_id (keys %$changelog_info) {
		my $remote_ip = $changelog_info->{$changelog_id}{remoteIP};
		
		push @{$changelog_remote_ip_info->{$remote_ip}}, $changelog_info->{$changelog_id};
	}
	
	notify($ERRORS{'DEBUG'}, 0, "retrieved all changelog remote IP addresses for request $request_id: " . format_data($changelog_remote_ip_info));
	return $changelog_remote_ip_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 update_changelog_reservation_remote_ip

 Parameters  : $reservation_id, @remote_ip_addresses
 Returns     : boolean
 Description : Inserts a rows into the changelog table with the remoteIP value
               specified by the argument. If a changelog row already exists with
               the same reservationid and remoteIP values, the timestamp of that
               row is updated to the current time. The changelog.userid column
               is set to NULL.

=cut

sub update_changelog_reservation_remote_ip {
	my ($reservation_id, @remote_ip_addresses) = @_;
	if (!$reservation_id) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	if (!@remote_ip_addresses) {
		notify($ERRORS{'WARNING'}, 0, "remote IP address argument was not supplied");
		return;
	}
	
	for my $remote_ip (@remote_ip_addresses) {
		my $sql = <<EOF;
INSERT INTO changelog
(logid, reservationid, computerid, remoteIP, timestamp)
(
	SELECT
	log.id, reservation.id, reservation.computerid, '$remote_ip', NOW()
	FROM
	request,
	reservation,
	log
	WHERE
	reservation.id = $reservation_id
	AND request.id = reservation.requestid
	AND request.logid = log.id
)
ON DUPLICATE KEY UPDATE
changelog.timestamp=NOW(),
changelog.id=LAST_INSERT_ID(changelog.id)
EOF
		
		my $changelog_id = database_execute($sql);
		if ($changelog_id) {
			notify($ERRORS{'OK'}, 0, "updated changelog ID: $changelog_id, reservation: $reservation_id, remote IP: $remote_ip");
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "failed to update into changelog table, reservation: $reservation_id, remote IP: $remote_ip");
			return;
		}
	}
	
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 update_changelog_reservation_user_remote_ip

 Parameters  : $reservation_id, $user_id, @remote_ip_addresses
 Returns     : boolean
 Description : Inserts a rows into the changelog table with the reservationid,
               userid, and remoteIP values specified by the arguments. If a
               changelog row already exists with the same reservationid and
               remoteIP values, the timestamp of that row is updated to the
               current time.

=cut

sub update_changelog_reservation_user_remote_ip {
	my ($reservation_id, $user_id, @remote_ip_addresses) = @_;
	if (!defined($reservation_id)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	if (!defined($user_id)) {
		notify($ERRORS{'WARNING'}, 0, "user ID argument was not supplied");
		return;
	}
	elsif (!@remote_ip_addresses) {
		notify($ERRORS{'WARNING'}, 0, "remote IP address argument was not supplied");
		return;
	}
	
	for my $remote_ip (@remote_ip_addresses) {
		my $sql = <<EOF;
INSERT INTO changelog
(logid, userid, reservationid, computerid, remoteIP, timestamp)
(
	SELECT
	log.id, user.id, reservation.id, reservation.computerid, '$remote_ip', NOW()
	FROM
	request,
	reservation,
	log,
	user
	WHERE
	reservation.id = $reservation_id
	AND request.id = reservation.requestid
	AND request.logid = log.id
	AND user.id = $user_id
)
ON DUPLICATE KEY UPDATE
changelog.timestamp=NOW(),
changelog.id=LAST_INSERT_ID(changelog.id)
EOF
		
		my $changelog_id = database_execute($sql);
		if ($changelog_id) {
			notify($ERRORS{'OK'}, 0, "updated changelog ID: $changelog_id, reservation: $reservation_id, user ID: $user_id, remote IP: $remote_ip");
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "failed to update into changelog table, reservation: $reservation_id, user ID: $user_id, remote IP: $remote_ip");
			return;
		}
	}
	
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 update_changelog_request_user_remote_ip

 Parameters  : $request_id, $user_id, @remote_ip_addresses
 Returns     : boolean
 Description : Inserts a rows into the changelog table with the userid and
               remoteIP values specified by the arguments. The reservationid
               value is set to NULL.

=cut

sub update_changelog_request_user_remote_ip {
	my ($request_id, $user_id, @remote_ip_addresses) = @_;
	if (!defined($request_id)) {
		notify($ERRORS{'WARNING'}, 0, "request ID argument was not supplied");
		return;
	}
	if (!defined($user_id)) {
		notify($ERRORS{'WARNING'}, 0, "user ID argument was not supplied");
		return;
	}
	elsif (!@remote_ip_addresses) {
		notify($ERRORS{'WARNING'}, 0, "remote IP address argument was not supplied");
		return;
	}
	
	for my $remote_ip (@remote_ip_addresses) {
		my $sql = <<EOF;
INSERT INTO changelog
(logid, userid, remoteIP, timestamp)
(
	SELECT
	request.logid, $user_id, '$remote_ip', NOW()
	FROM
	request
	WHERE
	request.id = $request_id
)
ON DUPLICATE KEY UPDATE
changelog.timestamp=NOW(),
changelog.id=LAST_INSERT_ID(changelog.id)
EOF
		
		my $changelog_id = database_execute($sql);
		if ($changelog_id) {
			notify($ERRORS{'OK'}, 0, "updated changelog ID: $changelog_id, request: $request_id, user ID: $user_id, remote IP: $remote_ip");
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "failed to update into changelog table, request: $request_id, user ID: $user_id, remote IP: $remote_ip");
			return;
		}
	}
	
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_connectlog_info

 Parameters  : $request_id, $age_limit_timestamp (optional)
 Returns     : hash
 Description : Retrieves connectlog entries for a request and returns a hash
               reference organized by connectlog.id values:
               
               {
                 119 => {
                   "id" => 119,
                   "logid" => 5354,
                   "remoteIP" => "192.168.53.54",
                   "reservationid" => 3115,
                   "timestamp" => "2014-05-16 12:47:05",
                   "userid" => 1,
                   "verified" => 1
                 },
                 122 => {
                   "id" => 122,
                   "logid" => 5354,
                   "remoteIP" => "192.168.53.54",
                   "reservationid" => 3115,
                   "timestamp" => "2014-05-16 12:47:05",
                   "userid" => undef,
                   "verified" => 0
                 },

=cut

sub get_connectlog_info {
	my ($request_id, $age_limit_timestamp) = @_;
	if (!$request_id) {
		notify($ERRORS{'WARNING'}, 0, "request ID argument was not supplied");
		return;
	}
	
	my $select_statement = <<EOF;	
SELECT
connectlog.*
FROM
connectlog,
request
WHERE
request.id = $request_id
AND connectlog.logid = request.logid
EOF
	
	if ($age_limit_timestamp) {
		$select_statement .= "AND connectlog.timestamp >= '$age_limit_timestamp'";
	}
	
	my $connectlog_info = {};
	
	my @rows = database_select($select_statement);
	for my $row (@rows) {
		my $connectlog_id = $row->{id};
		$connectlog_info->{$connectlog_id} = $row;
	}
	
	my $age_string = '';
	if ($age_limit_timestamp) {
		$age_string = " updated on or after $age_limit_timestamp";
	}
	
	notify($ERRORS{'DEBUG'}, 0, "retrieved connectlog info for request $request_id$age_string:\n" . format_data($connectlog_info));
	return $connectlog_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_connectlog_remote_ip_address_info

 Parameters  : $request_id, $age_limit_timestamp (optional)
 Returns     : hash
 Description : Retrieves connectlog entries for a request and returns a hash
               reference organized by connectlog.remoteIP values. Each hash key
               contains an array reference of the connectlog entries which match
               the remoteIP key:
               {
                  "192.168.53.54" => [
                    {
                      "id" => 119,
                      "logid" => 5354,
                      "remoteIP" => "192.168.53.54",
                      "reservationid" => 3115,
                      "timestamp" => "2014-05-16 12:47:05",
                      "userid" => 1,
                      "verified" => 1
                    },
                    {
                      "id" => 122,
                      "logid" => 5354,
                      "remoteIP" => "192.168.53.54",
                      "reservationid" => 3115,
                      "timestamp" => "2014-05-16 12:47:05",
                      "userid" => undef,
                      "verified" => 0
                    }
                  ],
               }

=cut

sub get_connectlog_remote_ip_address_info {
	my ($request_id, $age_limit_timestamp) = @_;
	if (!$request_id) {
		notify($ERRORS{'WARNING'}, 0, "request ID argument was not supplied");
		return;
	}
	
	my $connectlog_remote_ip_info = {};
	my $connectlog_info = get_connectlog_info($request_id, $age_limit_timestamp);
	for my $connectlog_id (keys %$connectlog_info) {
		my $remote_ip = $connectlog_info->{$connectlog_id}{remoteIP};
		push @{$connectlog_remote_ip_info->{$remote_ip}}, $connectlog_info->{$connectlog_id};
	}
	
	my $age_string = '';
	if ($age_limit_timestamp) {
		$age_string = " updated on or after $age_limit_timestamp";
	}
	
	notify($ERRORS{'DEBUG'}, 0, "retrieved connectlog remote IP address info for request $request_id$age_string:\n" . format_data($connectlog_remote_ip_info));
	return $connectlog_remote_ip_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 update_connectlog

 Parameters  : $reservation_id, $remote_ip, $verified (optional), $user_id (optional)
 Returns     : boolean
 Description : Inserts into or updates the connectlog table. If an existing
               entry with the same reservation ID, user ID, and remote IP values
               exists, the timestamp is updated. The verified value is updated
               if the existing value is false and the verified argument is true.
               Otherwise, the verified value remains false.

=cut

sub update_connectlog {
	my ($reservation_id, $remote_ip, $verified, $user_id) = @_;
	
	if (!$reservation_id) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	if (!$remote_ip) {
		notify($ERRORS{'WARNING'}, 0, "remote IP address argument was not supplied");
		return;
	}
	
	$verified = 0 unless defined($verified);
	$user_id = 'NULL' unless defined($user_id) && $verified;
	
	my $sql = <<EOF;
INSERT INTO connectlog
(logid, reservationid, userid, remoteIP, verified, timestamp)
SELECT
request.logid,
$reservation_id,
$user_id,
'$remote_ip',
$verified,
NOW()
FROM
request,
reservation
WHERE
reservation.id = $reservation_id
AND reservation.requestid = request.id
EOF
	
	# Try to prevent duplicate rows if userid is NULL
	if ($user_id eq 'NULL') {
		$sql .= <<EOF;
AND NOT EXISTS (
   SELECT
	id
	FROM
	connectlog
	WHERE
	reservationid = $reservation_id
	AND remoteIP = '$remote_ip'
	AND userid IS NULL
)
EOF
	}

	$sql .= <<EOF;
ON DUPLICATE KEY UPDATE
connectlog.logid = LAST_INSERT_ID(connectlog.logid),
connectlog.timestamp = NOW(),
connectlog.verified = IF(VALUES(verified) = 1, 1, connectlog.verified)
EOF
	
	# If user ID argument wasn't provided, set it to 'NULL' for the log message
	$user_id = 'NULL' unless defined($user_id);
	
	my $connectlog_id = database_execute($sql);
	if ($connectlog_id) {
		notify($ERRORS{'OK'}, 0, "updated connectlog ID: $connectlog_id, reservation: $reservation_id, remote IP: $remote_ip, verified: $verified, user ID: $user_id");
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update into connectlog table, reservation: $reservation_id, remote IP: $remote_ip, verified: $verified, user ID: $user_id");
		return;
	}
	
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_computer_private_ip_address_info

 Parameters  : @computer_ids (optional)
 Returns     : hash reference
 Description : Retrieves the privateIPaddress value from the computer table for
               all computers in the database. Deleted computers are not
               included. A hash is constructed:
               {
                  "vcl-46.vcl.edu" => "10.10.7.46",
                  "vcl-47.vcl.edu" => "10.10.7.47",
                  "vcl-48.vcl.edu" => "10.10.7.48",
                  "vcl-49.vcl.edu" => "10.10.7.49",
                  "vcl-50.vcl.edu" => "10.10.7.50",
               }

=cut

sub get_computer_private_ip_address_info {
	my @computer_ids = @_;
	if (@computer_ids) {
		my @invalid_computer_ids = grep { $_ !~ /^\d+$/ } @computer_ids;
		if (@invalid_computer_ids) {
			notify($ERRORS{'WARNING'}, 0, "argument may only contain numberic computer IDs, the following values are not valid:\n" . join("\n", @invalid_computer_ids));
			return;
		}
	}
	
	
	my $select_statement = <<EOF;
SELECT
computer.hostname,
computer.privateIPaddress
FROM
computer
WHERE
computer.deleted = 0
EOF
	
	if (@computer_ids) {
		my $computer_id_string = join(', ', @computer_ids);
		$select_statement .= "AND computer.id IN ($computer_id_string)"
	}

	my $private_ip_address_info = {};
	my @rows = database_select($select_statement);
	for my $row (@rows) {
		my $hostname = $row->{hostname};
		my $private_ip_address = $row->{privateIPaddress};
		$private_ip_address_info->{$hostname} = $private_ip_address;
	}
	
	my $count = scalar(keys %$private_ip_address_info);
	notify($ERRORS{'DEBUG'}, 0, "retrieved private IP addresses for $count computers from the database");
	return $private_ip_address_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_computer_current_private_ip_address

 Parameters  : $computer_identifier, $no_cache (optional)
 Returns     : string
 Description : Retrieves the privateIPaddress value from the computer table for
               a single computer.
               
               Returns the private IP address if:
               - a single non-deleted or deleted computer matches the argument
                 (a warning is displayed if the computer is deleted)
               
               Returns null if:
               - no computers or multiple computers match the argument

=cut

sub get_computer_current_private_ip_address {
	my ($computer_identifier, $no_cache) = @_;
	if (!$computer_identifier) {
		notify($ERRORS{'WARNING'}, 0, "computer identifier argument was not supplied");
		return;
	}
	$no_cache = 0 unless defined($no_cache);
	
	# Figure out the computer ID based on the $computer_identifier argument
	my $computer_id;
	if ($computer_identifier =~ /^\d+$/) {
		$computer_id = $computer_identifier;
	}
	else {
		$computer_id = get_computer_ids($computer_identifier);
		if (!$computer_id) {
			notify($ERRORS{'WARNING'}, 0, "failed to retrieve current private IP address from database, computer ID could not be determed from argument: $computer_identifier");
			return;
		}
	}
	
	my $computer_string = $computer_identifier;
	$computer_string .= " ($computer_id)" if ($computer_identifier ne $computer_id);
	
	if (!$no_cache && defined($ENV{computer_private_ip_address}{$computer_id})) {
		notify($ERRORS{'DEBUG'}, 0, "returning cached private IP address for computer $computer_string: $ENV{computer_private_ip_address}{$computer_id}");
		return $ENV{computer_private_ip_address}{$computer_id};
	}
	
	my $select_statement = <<EOF;
SELECT
computer.hostname,
computer.privateIPaddress
FROM
computer
WHERE
computer.id = '$computer_id'
AND computer.deleted = 0
EOF
	
	my @rows = database_select($select_statement);
	if (!@rows) {
		notify($ERRORS{'WARNING'}, 0, "failed to retrieve private IP address from database for computer $computer_string");
		return;
	}
	
	my $row = $rows[0];
	my $private_ip_address = $row->{privateIPaddress};
	my $hostname = $row->{hostname};
	if ($private_ip_address) {
		$ENV{computer_private_ip_address}{$computer_id} = $private_ip_address;
		notify($ERRORS{'DEBUG'}, 0, "retrieved private IP address for computer $computer_string from database: $private_ip_address");
		return $private_ip_address;
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "private IP address for computer $computer_string is set to null in database");
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 hostname_to_ip_address

 Parameters  : $hostname
 Returns     : string
 Description : Calls gethostbyname on the management node to determine the IP
               address the hostname resolves to. The IP address is returned. If
               the hostname cannot be resolved or if an error occurs, null is
               returned.

=cut

sub hostname_to_ip_address {
	my ($hostname) = @_;
	
	my $packed_ip_address = gethostbyname($hostname);
	if (defined $packed_ip_address) {
		my $ip_address = inet_ntoa($packed_ip_address);
		notify($ERRORS{'DEBUG'}, 0, "resolved IP address from hostname $hostname --> $ip_address");
		return $ip_address;
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "unable to resolve IP address from hostname: $hostname");
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 ip_address_to_hostname

 Parameters  : $ip_address
 Returns     : string
 Description : Calls gethostbyaddr on the management node to determine the
               hostname an IP address resolves to. The hostname is returned. If
               the IP address cannot be resolved or if an error occurs, null is
               returned.

=cut

sub ip_address_to_hostname {
	my ($ip_address) = @_;
	
	my $hostname = gethostbyaddr(inet_aton($ip_address), AF_INET);
	if (defined $hostname) {
		notify($ERRORS{'DEBUG'}, 0, "resolved hostname from IP address $ip_address --> $hostname");
		return $hostname;
	}
	else {
		notify($ERRORS{'DEBUG'}, 0, "unable to resolve hostname from IP address: $ip_address");
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 update_request_checkuser

 Parameters  : $request_id, $checkuser
 Returns     : boolean
 Description : Updates the request.checkuser value. This allows modules to
               disable user connection checking.

=cut

sub update_request_checkuser {
	my ($request_id, $checkuser) = @_;
	if (!defined($request_id)) {
		notify($ERRORS{'WARNING'}, 0, "request ID argument was not supplied");
		return;
	}
	if (!defined($checkuser)) {
		$checkuser = 0;
	}

	# Construct the SQL statement
	my $sql_statement = <<EOF;
UPDATE
request
SET
checkuser = $checkuser
WHERE
request.id = $request_id
EOF

	# Call the database execute subroutine
	if (database_execute($sql_statement)) {
		notify($ERRORS{'OK'}, 0, "updated request.checkuser to $checkuser for request $request_id");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update request.checkuser to $checkuser for request $request_id");
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_provisioning_osinstalltype_info

 Parameters  : $provisioning_id
 Returns     : hash reference
 Description : Retrieves information for all of the OSinstalltypes mapped to a
               provisioning ID. A hash is returned:
               }
                  10 => {
                    "id" => 10,
                    "name" => "hyperv",
                    "provisioningOSinstalltype" => {
                      "OSinstalltypeid" => 10,
                      "provisioningid" => 8
                    }
                  },
                  4 => {
                    "id" => 4,
                    "name" => "vmware",
                    "provisioningOSinstalltype" => {
                      "OSinstalltypeid" => 4,
                      "provisioningid" => 8
                    }
                  }
               }

=cut

sub get_provisioning_osinstalltype_info {
	my ($provisioning_id) = @_;
	if (!defined($provisioning_id)) {
		notify($ERRORS{'WARNING'}, 0, "provisioning ID argument was not specified");
		return;
	}
	
	
	# Get a hash ref containing the database column names
	my $database_table_columns = get_database_table_columns();
	
	my @tables = (
		'provisioningOSinstalltype',
		'OSinstalltype',
	);
	
	# Construct the select statement
	my $select_statement = "SELECT DISTINCT\n";
	
	# Get the column names for each table and add them to the select statement
	for my $table (@tables) {
		my @columns = @{$database_table_columns->{$table}};
		for my $column (@columns) {
			$select_statement .= "$table.$column AS '$table-$column',\n";
		}
	}
	
	# Remove the comma after the last column line
	$select_statement =~ s/,$//;
	
	# Complete the select statement
	$select_statement .= <<EOF;
FROM
provisioningOSinstalltype,
OSinstalltype
WHERE
provisioningOSinstalltype.provisioningid = $provisioning_id
AND provisioningOSinstalltype.OSinstalltypeid = OSinstalltype.id
EOF

	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);
	
	my $info = {};
	for my $row (@selected_rows) {
		my $osinstalltype_id = $row->{'OSinstalltype-id'};
		
		# Loop through all the columns returned
		for my $key (keys %$row) {
			my $value = $row->{$key};
			
			# Split the table-column names
			my ($table, $column) = $key =~ /^([^-]+)-(.+)/;
			
			# Add the values for the primary table to the hash
			# Add values for other tables under separate keys
			if ($table eq 'OSinstalltype') {
				$info->{$osinstalltype_id}{$column} = $value;
			}
			else {
				$info->{$osinstalltype_id}{$table}{$column} = $value;
			}
		}
	}
	
	notify($ERRORS{'DEBUG'}, 0, "retrieved info for OSinstalltypes mapped to provisioning ID $provisioning_id: " . format_data($info));
	return $info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_provisioning_table_info

 Parameters  : none
 Returns     : hash reference
 Description : Retrieves information from the provisioning and module tables
               and assembles a hash. The hash keys are the provisioning.id
               values. Example:
               {
                 1 => {
                   "id" => 1,
                   "module" => {
                     "description" => "",
                     "id" => 1,
                     "name" => "provisioning_xCAT",
                     "perlpackage" => "VCL::Module::Provisioning::xCAT",
                     "prettyname" => "xCAT"
                   },
                   "moduleid" => 1,
                   "name" => "xcat",
                   "prettyname" => "xCAT"
                 },
                 13 => {
                   "id" => 13,
                   "module" => {
                     "description" => "",
                     "id" => 21,
                     "name" => "provisioning_vmware_vsphere",
                     "perlpackage" => "VCL::Module::Provisioning::VMware::VMware",
                     "prettyname" => "VMware Provisioning Module"
                   },
                   "moduleid" => 21,
                   "name" => "vmware_vsphere",
                   "prettyname" => "VMware vSphere"
                 },
                 15 => {
                   "id" => 15,
                   "module" => {
                     "description" => "",
                     "id" => 26,
                     "name" => "base_module",
                     "perlpackage" => "VCL::Module",
                     "prettyname" => "VCL Base Module"
                   },
                   "moduleid" => 26,
                   "name" => "none",
                   "prettyname" => "None"
                 },
               }

=cut

sub get_provisioning_table_info {
	return $ENV{provisioning_table_info} if (defined($ENV{provisioning_table_info}));
	
	# Get a hash ref containing the database column names
	my $database_table_columns = get_database_table_columns();
	
	my @tables = (
		'provisioning',
		'module',
	);
	
	# Construct the select statement
	my $select_statement = "SELECT DISTINCT\n";
	
	# Get the column names for each table and add them to the select statement
	for my $table (@tables) {
		my @columns = @{$database_table_columns->{$table}};
		for my $column (@columns) {
			$select_statement .= "$table.$column AS '$table-$column',\n";
		}
	}
	
	# Remove the comma after the last column line
	$select_statement =~ s/,$//;
	
	# Complete the select statement
	$select_statement .= <<EOF;
FROM
provisioning,
module
WHERE
provisioning.moduleid = module.id
EOF

	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);
	
	my $provisioning_table_info = {};
	for my $row (@selected_rows) {
		my $provisioning_id = $row->{'provisioning-id'};
		
		# Loop through all the columns returned
		for my $key (keys %$row) {
			my $value = $row->{$key};
			
			# Split the table-column names
			my ($table, $column) = $key =~ /^([^-]+)-(.+)/;
			
			# Add the values for the primary table to the hash
			# Add values for other tables under separate keys
			if ($table eq 'provisioning') {
				$provisioning_table_info->{$provisioning_id}{$column} = $value;
			}
			else {
				$provisioning_table_info->{$provisioning_id}{$table}{$column} = $value;
			}
		}
	}
	
	$ENV{provisioning_table_info} = $provisioning_table_info;
	notify($ERRORS{'DEBUG'}, 0, "retrieved provisioning info: " . format_data($provisioning_table_info));
	return $provisioning_table_info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 ip_address_to_network_address

 Parameters  : $ip_address, $subnet_mask
 Returns     : If called in array context: ($network_address, $network_bits)
               If called in scalar context: $network_address
 Description : Determines a network address and network bits.

=cut

sub ip_address_to_network_address {
	my ($ip_address, $subnet_mask) = @_;
	if (!defined($ip_address)) {
		notify($ERRORS{'WARNING'}, 0, "$ip_address argument was not supplied");
		return;
	}
	if (!defined($subnet_mask)) {
		notify($ERRORS{'WARNING'}, 0, "$subnet_mask argument was not supplied");
		return;
	}
	
	my $netmask_object = new Net::Netmask("$ip_address/$subnet_mask");
	if (!$netmask_object) {
		notify($ERRORS{'WARNING'}, 0, "failed to create Net::Netmask object, IP address: $ip_address, subnet mask: $subnet_mask");
		return;
	}
	
	my $network_address = $netmask_object->base();
	my $network_bits = $netmask_object->bits();
	notify($ERRORS{'DEBUG'}, 0, "$ip_address/$subnet_mask --> $network_address/$network_bits");
	if (wantarray) {
		return ($network_address, $network_bits);
	}
	else {
		return $network_address;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 determine_remote_connection_target

 Parameters  : $argument, $no_cache (optional)
 Returns     : string
 Description : Attempts to determine the string to use when connecting to a
               remote node. If an IP address is passed, the same IP address is
               always returned. If a hostname is passed, an attempt is made to
               retrieve the private IP address of the host. If successful, the
               private IP address is returned. Otherwise, the hostname argument
               is returned.

=cut

sub determine_remote_connection_target {
	my ($argument, $no_cache) = @_;
	if (!defined($argument)) {
		notify($ERRORS{'WARNING'}, 0, "remote connection argument was not supplied");
		return;
	}
	
	# Check if argument contains an '@' character: root@x.x.x.x
	# Remove anything preceeding it
	$argument =~ s/.*@([^@]+)$/$1/g;
	
	if (!$no_cache && defined($ENV{remote_connection_target}{$argument})) {
		return $ENV{remote_connection_target}{$argument};
	}
	
	# If an IP address was passed, use it
	if (is_valid_ip_address($argument, 0)) {
		$ENV{remote_connection_target}{$argument} = $argument;
		notify($ERRORS{'DEBUG'}, 0, "argument is a valid IP address, it will be used as the remote connection target: $ENV{remote_connection_target}{$argument}");
		return $ENV{remote_connection_target}{$argument};
	}
	
	# Attempt to retrieve the private IP address from the database
	my $database_private_ip_address = get_computer_current_private_ip_address($argument);
	if ($database_private_ip_address) {
		$ENV{remote_connection_target}{$argument} = $database_private_ip_address;
		notify($ERRORS{'DEBUG'}, 0, "private IP address is set in database for $argument, it will be used as the remote connection target: $ENV{remote_connection_target}{$argument}");
		return $ENV{remote_connection_target}{$argument};
	}
	
	# Private IP address could not be retrieved from the database or is set to NULL
	# Try to resolve the argument to an IP address
	# First make sure it is a valid hostname
	if (!is_valid_dns_host_name($argument)) {
		$ENV{remote_connection_target}{$argument} = $argument;
		notify($ERRORS{'WARNING'}, 0, "failed to reliably determine the remote connection target to use for '$argument', it is not a valid IP address or DNS hostname");
		return $ENV{remote_connection_target}{$argument};
	}
	
	# Check if the hostname includes a DNS suffix
	# If so, extract the short hostname and try to resolve that
	my $resolved_ip_address;
	if ($argument =~ /^([^\.]+)\./) {
		my $short_hostname = $1;
		notify($ERRORS{'DEBUG'}, 0, "hostname $argument contains a DNS suffix, attempting to resolve the hostname without its DNS suffix: $short_hostname");
		$resolved_ip_address = hostname_to_ip_address($short_hostname);
	}
	if (!$resolved_ip_address) {
		$resolved_ip_address = hostname_to_ip_address($argument);
	}
	
	if ($resolved_ip_address) {
		# Attempt to set the private IP address in the database
		# Only do this if a private IP was retrieved earlier to avoid additional warnings
		if ($database_private_ip_address) {
			update_computer_private_ip_address($argument, $resolved_ip_address);
		}
		
		$ENV{remote_connection_target}{$argument} = $resolved_ip_address;
		notify($ERRORS{'DEBUG'}, 0, "$argument resolves to IP address $resolved_ip_address, it will be used as the remote connection target");
		return $ENV{remote_connection_target}{$argument};
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to reliably determine the remote connection target to use for '$argument', it is not a valid IP address, a private IP address is not set in the database, and '$argument' does not resolve to an IP address on this management node");
		$ENV{remote_connection_target}{$argument} = $argument;
		return $ENV{remote_connection_target}{$argument};
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 wrap_string

 Parameters  : $string, $columns, $prefix
 Returns     : string
 Description : Formats a string to limit the number of characters per line. The
               $prefix argument may be used to add comment characters to the
               beginning of each line, while still adhering to the line width
               limit. If $prefix is set to '# ' (not including the single-quote
               characters), the string returned will be something like:
               # My first line...
               # Second line...

=cut

sub wrap_string {
	my ($string, $columns, $prefix) = @_;
	return '' unless defined($string);
	$columns = 80 unless $columns;
	$prefix = '' unless defined($prefix);
	
	# Wrap text for lines
	local($Text::Wrap::columns) = $columns;
	
	my $wrapped_string = wrap($prefix, $prefix, $string);
	return $wrapped_string;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 prune_hash_reference

 Parameters  : $hash_ref, $prune_regex
 Returns     : hash reference
 Description : 

=cut

sub prune_hash_reference {
	my ($hash_ref_argument, $prune_regex) = @_;
	if (!defined($hash_ref_argument)) {
		notify($ERRORS{'WARNING'}, 0, "hash reference argument was not supplied");
		return;
	}
	elsif (!ref($hash_ref_argument) || ref($hash_ref_argument) ne 'HASH') {
		notify($ERRORS{'WARNING'}, 0, "argument is not a hash reference:\n" . format_data($hash_ref_argument));
		return;
	}
	elsif (!defined($prune_regex)) {
		notify($ERRORS{'WARNING'}, 0, "prune regex argument was not supplied, returning original hash reference");
		return $hash_ref_argument;
	}
	
	# Create a clone if this wasn't recursively called
	my $calling_subroutine = get_calling_subroutine();
	my $hash_ref;
	if ($calling_subroutine =~ /^prune/) {
		$hash_ref = $hash_ref_argument;
	}
	else {
		$hash_ref = dclone($hash_ref_argument);
	}
	
	my $result = {};
	for my $key (keys %$hash_ref) {
		# Don't add keys which match the regex
		if ($key =~ /$prune_regex/) {
			next;
		}
		
		my $type = ref($hash_ref->{$key});
		if (!$type) {
			# If the value is not a reference, simply add it to the result
			$result->{$key} = $hash_ref->{$key};
			next;
		}
		elsif ($type eq 'HASH') {
			$result->{$key} = prune_hash_reference($hash_ref->{$key}, $prune_regex);
		}
		elsif ($type eq 'ARRAY') {
			$result->{$key} = prune_array_reference($hash_ref->{$key}, $prune_regex);
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "unsupported type: $type");
		}
	}
	return $result;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 prune_array_reference

 Parameters  : $array_ref, $prune_regex
 Returns     : array reference
 Description : 

=cut

sub prune_array_reference {
	my ($array_ref_argument, $prune_regex) = @_;
	if (!defined($array_ref_argument)) {
		notify($ERRORS{'WARNING'}, 0, "array reference argument was not supplied");
		return;
	}
	elsif (!ref($array_ref_argument) || ref($array_ref_argument) ne 'ARRAY') {
		notify($ERRORS{'WARNING'}, 0, "argument is not a array reference:\n" . format_data($array_ref_argument));
		return;
	}
	elsif (!defined($prune_regex)) {
		notify($ERRORS{'WARNING'}, 0, "prune regex argument was not supplied, returning original array reference");
		return $array_ref_argument;
	}
	
	# Create a clone if this wasn't recursively called
	my $calling_subroutine = get_calling_subroutine();
	my $array_ref;
	if ($calling_subroutine =~ /^prune/) {
		$array_ref = $array_ref_argument;
	}
	else {
		$array_ref = dclone($array_ref_argument);
	}
	
	my $result = [];
	for my $element (@$array_ref) {
		my $type = ref($element);
		if (!$type) {
			push @$result, $element;
		}
		elsif ($type eq 'ARRAY') {
			push @$result, prune_array_reference($element, $prune_regex);
		}
		elsif ($type eq 'HASH') {
			push @$result, prune_hash_reference($element, $prune_regex);
		}
		else {
			notify($ERRORS{'WARNING'}, 0, "unsupported type: $type");
		}
	}
	
	return $result;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 prune_hash_child_references

 Parameters  : $hash_ref
 Returns     : hash reference
 Description : Makes a copy of the hash reference. Removes all keys that contain
               references as data.

=cut

sub prune_hash_child_references {
	my ($hash_ref_argument) = @_;
	if (!defined($hash_ref_argument)) {
		notify($ERRORS{'WARNING'}, 0, "hash reference argument was not supplied");
		return;
	}
	elsif (!ref($hash_ref_argument) || ref($hash_ref_argument) ne 'HASH') {
		notify($ERRORS{'WARNING'}, 0, "argument is not a hash reference:\n" . format_data($hash_ref_argument));
		return;
	}
	
	# Create a clone
	my $hash_ref = dclone($hash_ref_argument);
	
	my $result = {};
	for my $key (keys %$hash_ref) {
		if (ref($hash_ref->{$key})) {
			next;
		}
		else {
			$result->{$key} = $hash_ref->{$key};
		}
	}
	return $result;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_image_active_directory_domain_info

 Parameters  : $image_id, $no_cache (optional)
 Returns     : Hash containing image domain columns
 Description : Gets the imagedomain information from the database

=cut

sub get_image_active_directory_domain_info {
	my ($image_id, $no_cache) = @_;
	if (!$image_id) {
		notify($ERRORS{'WARNING'}, 0, "image ID argument was not specified");
		return;
	}
	
	my $management_node_id = get_management_node_id();
	
	# Get a hash ref containing the database column names
	my $database_table_columns = get_database_table_columns();
	
	my @tables = (
		'addomain',
		'imageaddomain',
		'cryptsecret',
		#'cryptkey',
	);
	
	# Construct the select statement
	my $select_statement = "SELECT DISTINCT\n";
	
	# Get the column names for each table and add them to the select statement
	for my $table (@tables) {
		my @columns = @{$database_table_columns->{$table}};
		for my $column (@columns) {
			$select_statement .= "$table.$column AS '$table-$column',\n";
		}
	}
	
	# Remove the comma after the last column line
	$select_statement =~ s/,$//;
	
	# Complete the select statement
	$select_statement .= <<EOF;
FROM
imageaddomain,
addomain
LEFT JOIN (cryptsecret, cryptkey) ON (
	addomain.secretid = cryptsecret.secretid AND
	cryptsecret.cryptkeyid = cryptkey.id AND
	cryptkey.hosttype = 'managementnode' AND
	cryptkey.hostid = $management_node_id
)
WHERE
imageaddomain.imageid = $image_id
AND imageaddomain.addomainid = addomain.id
EOF
	
	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (scalar @selected_rows == 0) {
		notify($ERRORS{'DEBUG'}, 0, "image $image_id is not configured for Active Directory");
		return {};
	}

	# Get the single row returned from the select statement
	my $row = $selected_rows[0];
	
	# Loop through all the columns returned
	my $info;
	for my $key (keys %$row) {
		my $value = $row->{$key};
		
		# Split the table-column names
		my ($table, $column) = $key =~ /^([^-]+)-(.+)/;
		
		if ($value && $column =~ /(dnsServers)/) {
			my @value_array = split(/[,;]+/, $value);
			$value = \@value_array;
		}
		
		# Add the values for the primary table to the hash
		# Add values for other tables under separate keys
		if ($table eq $tables[0]) {
			$info->{$column} = $value;
		}
		elsif ($table eq 'cryptkey') {
			$info->{cryptsecret}{$table}{$column} = $value;
		}
		else {
			$info->{$table}{$column} = $value;
		}
	}
	
	notify($ERRORS{'DEBUG'}, 0, "retrieved Active Directory info for image $image_id:\n" . format_data($info));
	return $info;
} ## end sub get_image_active_directory_domain_info

#//////////////////////////////////////////////////////////////////////////////

=head2 get_collapsed_hash_reference

 Parameters  : $hash_reference
 Returns     : array
 Description : Takes a potentially multi-level hash reference and generates a
               new single-level hash with key names constructed by concatenating
               the levels of key names. Example:
               Argument:
               {
                  "match_extensions" => {
                     "tcp" => {
                        "dport" => 22,
                     },
                  },
                  "parameters" => {
                     "jump" => {
                        "target" => "ACCEPT",
                        },
                     "protocol" => "tcp",
                  },
               }
               
               Result:
               {
                  "{'match_extensions'}{'tcp'}{'dport'}" => 22,
                  "{'parameters'}{'jump'}{'target'}" => "ACCEPT",
                  "{'parameters'}{'protocol'}" => "tcp"
               }
               
               This is potentially useful when 2 multi-level hashes need to be
               compared. The hash keys in the resultant hash can be used in an
               eval block to check if another hash has a key with the same name
               and/or value.

=cut

sub get_collapsed_hash_reference {
	my ($hash_reference, @parent_keys) = @_;
	if (!defined($hash_reference)) {
		notify($ERRORS{'WARNING'}, 0, "hash reference argument was not specified");
		return;
	}
	elsif (!ref($hash_reference) || ref($hash_reference) ne 'HASH') {
		notify($ERRORS{'WARNING'}, 0, "argument is not a hash reference:\n" . format_data($hash_reference));
		return;
	}
	
	my %collapsed_hash;
	
	for my $key (keys %$hash_reference) {
		if (ref($hash_reference->{$key})) {
			if (ref($hash_reference->{$key}) eq 'HASH') {
				my $child_collapsed_hash_ref = get_collapsed_hash_reference($hash_reference->{$key}, (@parent_keys, $key)) || {};
				%collapsed_hash = (%collapsed_hash, %$child_collapsed_hash_ref);
			}
		}
		else {
			my $value = $hash_reference->{$key};
			
			my $key_path;
			for my $parent_key (@parent_keys) {
				$key_path .= "{'$parent_key'}";
			}
			$key_path .= "{'$key'}";
			
			$collapsed_hash{$key_path} = $value;
		}
	}
	return \%collapsed_hash;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_message_variable_info

 Parameters  : none
 Returns     : hash reference
 Description : Retrieves info for all 'adminmessage|' and 'usermessage|' entries
               from the variable table. A hash is constructed. The keys are the
               variable.name values:
               {
                  "usermessage|endtime_reached|Global" => {
                    "id" => 957,
                    "serialization" => "yaml",
                    "setby" => undef,
                    "timestamp" => "0000-00-00 00:00:00",
                    "value" => "---\nmessage: |\n  Your reservation of [image_prettyname]\nshort_message: ~\nsubject: 'VCL -- End of reservation'\n"
                  },
                  "usermessage|reserved|Global" => {
                    "id" => 973,
                    "serialization" => "yaml",
                    "setby" => undef,
                    "timestamp" => "0000-00-00 00:00:00",
                    "value" => "---\nmessage: |\n  The rer_affiliation_sitewwwaddress]..."
                  },
                  ...
               }

=cut

sub get_message_variable_info {
	my $select_statement = <<EOF;
SELECT
*
FROM
variable
WHERE
variable.name REGEXP '^(admin|user)message\\\\|'
EOF

	my @rows = database_select($select_statement);
	
	my $info = {};
	for my $row (@rows) {
		my $variable_name = $row->{name};
		$info->{$variable_name} = $row;
		delete $info->{$variable_name}{name};
	}
	
	notify($ERRORS{'DEBUG'}, 0, "retrieved info for all admin and user messages from the variable table:\n" . join("\n", sort keys %$info));
	return $info;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 check_messages_need_validating

 Parameters  : none
 Returns     : boolean
 Description : If the variable table has an entry named
               'usermessage_needs_validating' with a value is set to 1 the
               management node's name, this subroutine proceeds to:
               * Set value of 'usermessage_needs_validating' to its hostname so
                 that other management nodes don't attempt to validate the
                 messages at the same time
               * Retrieves all of the adminmessage and usermessage rows from the
                 variable table
               * Checks the subject, message, and short_message strings
                 contained in variable.value for invalid substitution
                 identifiers (strings such as [request_foo] which don't
                 correspond to a function that DataStructure.pm implements)
					* If any invalid identifiers are found, an 'invalidfields' key is
					  added to variable.value containing a hash reference:
                     {
								"message" => [
								  "[is_blah]"
								],
								"subject" => [
								  "[usr_login_id]"
								]
                     }
               
               After validating is complete, the 'usermessage_needs_validating'
               variable is deleted.

=cut

sub check_messages_need_validating {
	my $management_node_name = get_management_node_info()->{SHORTNAME} || hostname;
	my $validate_variable_name = 'usermessage_needs_validating';
	
	#...........................................................................
	# Check if any messages have been updated
	# Just get the id to minimize this query since it runs with every vcld daemon loop
	my $select_id_statement = <<EOF;
SELECT
id,
timestamp
FROM
variable
WHERE
variable.name = '$validate_variable_name'
EOF
	my @select_needs_validating_rows = database_select($select_id_statement);
	if (!@select_needs_validating_rows) {
		#notify($ERRORS{'DEBUG'}, 0, "admin and user message variables to NOT need to be validated, $validate_variable_name variable does NOT exist in the database");
		return 0;
	}
	my $validate_variable_id = $select_needs_validating_rows[0]->{id};
	my $validate_variable_timestamp = $select_needs_validating_rows[0]->{timestamp};
	notify($ERRORS{'DEBUG'}, 0, "$validate_variable_name variable exists in the database, ID: $validate_variable_id, attempting to update variable value to '$management_node_name'");
	
	
	#...........................................................................
	# Messages have been updated and need validation
	# Try to allow only a single management node to processing the validation
	# Set usermessage_needs_validating variable.value --> <management node name>
	my $update_needs_validating_statement = <<EOF;
UPDATE
variable
SET
value = '$management_node_name',
timestamp = NOW()
WHERE
variable.id = $validate_variable_id
AND variable.timestamp = '$validate_variable_timestamp'
AND (
   variable.value = '1'
	OR variable.value = '$management_node_name'
)
EOF
	my $updated_needs_validating_rows = database_update($update_needs_validating_statement);
	if (!defined($updated_needs_validating_rows)) {
		notify($ERRORS{'WARNING'}, 0, "failed to update value of $validate_variable_name variable (ID: $validate_variable_id) to '$management_node_name'");
		return;
	}
	elsif (!$updated_needs_validating_rows) {
		notify($ERRORS{'WARNING'}, 0, "no rows were affected in attempt to update value of $validate_variable_name variable (ID: $validate_variable_id) to '$management_node_name', another management node may have processed the verification and deleted the entry");
		return 0;
	}
	notify($ERRORS{'OK'}, 0, "updated the value of $validate_variable_name variable to '$management_node_name'");
	
	
	#...........................................................................
	# Check all of the admin and user messages
	my $message_variable_info = get_message_variable_info();
	for my $message_variable_name (sort keys %$message_variable_info) {
		my $yaml_string_value = $message_variable_info->{$message_variable_name}{value};
		my $hash_reference_value = yaml_deserialize($yaml_string_value);
		if (!defined($hash_reference_value)) {
			notify($ERRORS{'WARNING'}, 0, "unable to validate '$message_variable_name' variable, YAML string could not be deserialized:\n$yaml_string_value");
			next;
		}
		elsif (!ref($hash_reference_value) || ref($hash_reference_value) ne 'HASH') {
			notify($ERRORS{'WARNING'}, 0, "unable to validate '$message_variable_name' variable, deserialized value is not a hash reference:\n" . format_data($hash_reference_value));
			next;
		}
		
		my $invalid_message_info;
		for my $key ('subject', 'message', 'short_message') {
			my $input_string = $hash_reference_value->{$key} || next;
			notify($ERRORS{'DEBUG'}, 0, "validating substitution identifiers contained in '$message_variable_name' $key");
			my @invalid_substitution_identifiers = VCL::DataStructure::get_invalid_substitution_identifiers($input_string);
			if (@invalid_substitution_identifiers) {
				$invalid_message_info->{$key} = \@invalid_substitution_identifiers;
			}
		}
		
		if ($invalid_message_info) {
			notify($ERRORS{'WARNING'}, 0, "'$message_variable_name' variable's value contains invalid substitution identifiers, setting 'invalidfields' key in variable.value to:\n" . format_data($invalid_message_info));
			$hash_reference_value->{invalidfields} = $invalid_message_info;
			set_variable($message_variable_name, $hash_reference_value);
		}
		elsif (defined($hash_reference_value->{invalidfields})) {
			# No invalid identifiers were found, 'invalidfields' was previously set for the variable, remove it
			notify($ERRORS{'WARNING'}, 0, "'$message_variable_name' variable's value contains an 'invalidfields' key but no invalid substitution identifiers were found, removing the key");
			delete $hash_reference_value->{invalidfields};
			set_variable($message_variable_name, $hash_reference_value);
		}
	}
	
	delete_variable($validate_variable_name);
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_management_node_cryptkey_pubkey

 Parameters  : $management_node_id, $show_warnings (optional)
 Returns     : string
 Description : Retrieves the cryptkey.pubkey value for the management node.

=cut

sub get_management_node_cryptkey_pubkey {
	my ($management_node_id, $show_warnings) = @_;
	if (!defined($management_node_id)) {
		notify($ERRORS{'WARNING'}, 0, "management node ID argument was not supplied");
		return;
	}
	
	$show_warnings = 1 unless defined($show_warnings);
	
	my $select_statement = <<EOF;
SELECT
cryptkey.pubkey
FROM
cryptkey
WHERE
cryptkey.hosttype = 'managementnode'
AND cryptkey.hostid = $management_node_id
EOF
	
	my @rows = database_select($select_statement);
	if (!@rows) {
		if ($show_warnings) {
			notify($ERRORS{'WARNING'}, 0, "cryptkey table does NOT contain a row for management node ID $management_node_id");
		}
		else {
			notify($ERRORS{'DEBUG'}, 0, "cryptkey table does NOT contain a row for management node ID $management_node_id");
		}
		return;
	}
	
	my $row = $rows[0];
	my $public_key_string = $row->{pubkey};
	notify($ERRORS{'DEBUG'}, 0, "retrieved public key from cryptkey table for management node ID $management_node_id");
	return $public_key_string;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 set_management_node_cryptkey_pubkey

 Parameters  : $host_id, $public_key_string, $algorithm (optional), $algorithm_option (optional), $key_length (optional)
 Returns     : $cryptkey_id
 Description : Set or updates the cryptkey.pubkey value for the management node.

=cut

sub set_management_node_cryptkey_pubkey {
	my ($management_node_id, $public_key_string, $algorithm, $algorithm_option, $key_length) = @_;
	if (!defined($management_node_id)) {
		notify($ERRORS{'WARNING'}, 0, "management node ID argument was not supplied");
		return;
	}
	elsif (!defined($public_key_string)) {
		notify($ERRORS{'WARNING'}, 0, "public key string argument was not supplied");
		return;
	}
	$algorithm = 'RSA' unless $algorithm;
	$algorithm_option = 'OAEP' unless $algorithm_option;
	$key_length = 4096 unless $key_length;
	
	my $insert_statement = <<EOF;
INSERT INTO cryptkey
(hostid, hosttype, pubkey, algorithm, algorithmoption, keylength)
VALUES
(
	$management_node_id,
	'managementnode',
	'$public_key_string',
	'$algorithm',
	'$algorithm_option',
	$key_length
)
ON DUPLICATE KEY UPDATE
pubkey='$public_key_string',
algorithm='$algorithm',
algorithmoption='$algorithm_option',
keylength=$key_length
EOF
	
	my $cryptkey_id = database_execute($insert_statement);
	if ($cryptkey_id) {
		notify($ERRORS{'DEBUG'}, 0, "set public key in cryptkey table for management node ID $management_node_id, cryptkey ID");
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to execute insert statement to set public key in cryptkey table for management node ID $management_node_id");
		return;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_management_node_cryptsecret_info

 Parameters  : $management_node_id
 Returns     : hash reference
 Description : 

=cut

sub get_management_node_cryptsecret_info {
	my ($management_node_id) = @_;
	if (!defined($management_node_id)) {
		notify($ERRORS{'WARNING'}, 0, "management node ID argument was not supplied");
		return;
	}

	my $select_statement = <<EOF;
SELECT
cryptsecret.*
FROM
cryptsecret,
cryptkey
WHERE
cryptkey.hostid = $management_node_id
AND cryptkey.hosttype = 'managementnode'
AND cryptsecret.cryptkeyid = cryptkey.id
EOF
	
	my @rows = database_select($select_statement);
	if (scalar @rows == 0) {
		notify($ERRORS{'WARNING'}, 0, "failed to retrieve cryptsecret info from database for management node $management_node_id");
		return;
	}

	print format_data(\@rows) . "\n\n";
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_management_node_cryptsecret_value

 Parameters  : $management_node_id, $secret_id, $suppress_warning (optional)
 Returns     : boolean
 Description : Retrieves the cryptsecret.cryptsecret value matching the
               cryptsecret.secretid value from the database for the management
               node.

=cut

sub get_management_node_cryptsecret_value {
	my ($management_node_id, $secret_id, $suppress_warning) = @_;
	if (!defined($management_node_id)) {
		notify($ERRORS{'WARNING'}, 0, "management node ID argument was not supplied");
		return;
	}
	if (!defined($secret_id)) {
		notify($ERRORS{'WARNING'}, 0, "secret ID argument was not supplied");
		return;
	}

	my $select_statement = <<EOF;
SELECT
cryptsecret.cryptsecret
FROM
cryptsecret,
cryptkey
WHERE
cryptkey.hostid = $management_node_id
AND cryptkey.hosttype = 'managementnode'
AND cryptsecret.secretid = $secret_id
AND cryptsecret.cryptkeyid = cryptkey.id
EOF
	
	my @rows = database_select($select_statement);
	if (scalar @rows == 0) {
		notify($ERRORS{'WARNING'}, 0, "failed to retrieve cryptsecret from database for management node $management_node_id, secret ID: $secret_id") unless $suppress_warning;
		return;
	}

	my $cryptsecret = $rows[0]->{cryptsecret};	
	notify($ERRORS{'DEBUG'}, 0, "retrieved cryptsecret, management node ID: $management_node_id, secret ID: $secret_id");
	return $cryptsecret;
}

#//////////////////////////////////////////////////////////////////////////////

=head2 get_management_node_ad_domain_credentials

 Parameters  : $management_node_id, $domain_id, $no_cache (optional)
 Returns     : ($domain_dns_name, $username, $secret_id, $encrypted_password)
 Description : Attempts to retrieve the username, encrypted password, and secret
               ID for the domain from the addomain table. This is used if a
               computer needs to be removed from a domain but the reservation
               image is not configured for Active Directory. When this occurs,
               the credentials are not available from $self->data.

=cut

sub get_management_node_ad_domain_credentials {
	my ($management_node_id, $domain_id, $no_cache) = @_;
	if (!defined($management_node_id)) {
		notify($ERRORS{'WARNING'}, 0, "management node ID argument was not supplied");
		return;
	}
	elsif (!$domain_id) {
		notify($ERRORS{'WARNING'}, 0, "domain identifier name argument was not specified");
		return;
	}
	
	if (!$no_cache && defined($ENV{management_node_ad_domain_credentials}{$domain_id})) {
		notify($ERRORS{'DEBUG'}, 0, "returning cached Active Directory credentials for domain: $domain_id");
		return @{$ENV{management_node_ad_domain_credentials}{$domain_id}};
	}
	
	# Construct the select statement
	my $select_statement = <<EOF;
SELECT DISTINCT
domainDNSName,
username,
password,
secretid
FROM
addomain
WHERE
addomain.id = $domain_id
EOF
	
	# Call the database select subroutine
	my @selected_rows = database_select($select_statement);

	# Check to make sure 1 row was returned
	if (scalar @selected_rows == 0) {
		notify($ERRORS{'DEBUG'}, 0, "Active Directory domain does not exist in the database: $domain_id");
		return ();
	}

	# Get the single row returned from the select statement
	my $row = $selected_rows[0];
	my $domain_dns_name = $row->{domainDNSName};
	my $username = $row->{username};
	my $secret_id = $row->{secretid};
	my $encrypted_password = $row->{password};
	
	notify($ERRORS{'DEBUG'}, 0, "retrieved credentials for domain: $domain_id\n" .
		"domain DNS name    : '$domain_dns_name'\n" .
		"username           : '$username'\n" .
		"secret ID          : '$secret_id'\n" .
		"encrypted password : '$encrypted_password'"
	);
	$ENV{management_node_ad_domain_credentials}{$domain_id} = [$domain_dns_name, $username, $secret_id, $encrypted_password];
	return @{$ENV{management_node_ad_domain_credentials}{$domain_id}};
}

#//////////////////////////////////////////////////////////////////////////////

=head2 delete_management_node_cryptsecret

 Parameters  : $management_node_id, $secret_id (optional)
 Returns     : boolean
 Description : 

=cut

sub delete_management_node_cryptsecret {
	my ($management_node_id, $secret_id) = @_;
	if (!defined($management_node_id)) {
		notify($ERRORS{'WARNING'}, 0, "management node ID argument was not supplied");
		return;
	}

	my $delete_statement = <<EOF;
DELETE
cryptsecret.*
FROM
cryptsecret,
cryptkey
WHERE
cryptkey.hostid = $management_node_id
AND cryptkey.hosttype = 'managementnode'
AND cryptsecret.cryptkeyid = cryptkey.id
EOF
	if ($secret_id) {
		$delete_statement .= "AND cryptsecret.secretid = $secret_id";
	}
	
	if (database_execute($delete_statement)) {
		notify($ERRORS{'OK'}, 0, "deleted entries from cryptsecret table for management node ID $management_node_id" . ($secret_id ? ", secret ID: $secret_id" : ''));
		return 1;
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to delete entries from cryptsecret table for management node ID $management_node_id" . ($secret_id ? ", secret ID: $secret_id" : ''));
		return 1;
	}
}

#//////////////////////////////////////////////////////////////////////////////

=head2 call_check_crypt_secrets

 Parameters  : none
 Returns     : boolean
 Description : Calls XMLRPCcheckCryptSecrets function to update the cryptsecret
               table for the reservation.

=cut

sub call_check_crypt_secrets {
	my $reservation_id = shift;
	if (!defined($reservation_id)) {
		notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not supplied");
		return;
	}
	
	my $xmlrpc_function = 'XMLRPCcheckCryptSecrets';
	my @xmlrpc_arguments = (
		$xmlrpc_function,
		$reservation_id
	);
	
	my $response = xmlrpc_call(@xmlrpc_arguments);
	if (!defined($response)) {
		notify($ERRORS{'WARNING'}, 0, "failed to update cryptsecret table, $xmlrpc_function returned undefined");
		return;
	}
	elsif ($response->value->{status} =~ /success/) {
		notify($ERRORS{'OK'}, 0, "called XMLRPCcheckCryptSecrets, cryptsecret table successfully updated");
	}
	elsif ($response->value->{status} =~ /noupdate/) {
		notify($ERRORS{'OK'}, 0, "called XMLRPCcheckCryptSecrets, cryptsecret table does not need to be updated");
	}
	else {
		notify($ERRORS{'WARNING'}, 0, "failed to update cryptsecret table, $xmlrpc_function returned:\n" .
			"status        : " . format_data($response->value->{status}) . "\n" .
			"error code    : " . format_data($response->value->{errorcode}) . "\n" .
			"error message : " . format_data($response->value->{errormsg})
		);
		return;
	}
	return 1;
}

#//////////////////////////////////////////////////////////////////////////////


1;
__END__

=head1 SEE ALSO

L<http://cwiki.apache.org/VCL/>

=cut