SolutionsScripts.xml

<SCRIPT_LIBRARY>
	<CODE_SNIPPET NAME="SigniantCore">package SigniantCore; {

#
# Function:	getBaseDDSConfigPath()
#
# Description:	Get the path to the dds.conf/dds.cfg file
#
# Returns:	($path)
#
sub getBaseDDSConfigPath
{
	my($self) = @_;
	my $ddCfg = `dds_cfgutil configuration_file`;

	$ddCfg = trim($self, $ddCfg);

	return $ddCfg;
}

#
# Function:	readConfig($configFile)
#
# Parameters:	$configFile - path to file
#
# Description:	procedure to read the INI file
#
# Returns: 	(%ini)
#
sub readConfig
{
	my($self, $configFile) = @_;
	my(%ini);

	if($configFile eq "")
	{
		die("You need to specify a configuration file.");
	}

	open(CONFIG, $configFile) || die("Cannot open CONFIG file for reading!! ($configFile)");

	while(&lt;CONFIG&gt;)
	{
		my $line = $_;

		# Skip the line if it begins with a # or ;
		next if ($line =~ /^\s*[\#\;]/);

		# Remove any leading and trailing newlines, returns, or spaces
		$line = trim($self, $line);

		# Remove any leading spaces
		$line =~ s/^\s+//;

		next if ($line eq "");

		if($line=~ /^([^\=]*)\=(.*)$/)
		{
			my $key = trim($self, $1);
			my $val = trim($self, $2);
			$ini{$key} = $val;
		}
	}

	close (CONFIG);

	# hack if it&apos;s a signiant.ini file
	if($ini{"DTM_NODE_NAME"})
	{
		if(! $ini{"DBUSER"})
		{
			$ini{"DBUSER"} = "dtmuser";
		}

		if(! $ini{"DBURL"})
		{
			$ini{"DBURL"} = "jdbc:postgresql://127.0.0.1/DTM_DB";
		}
	}

	return (%ini);
}

#
# Function:	readDDSConfig($configFile)
#
# Parameters:	$configFile - path to file
#
# Description:	procedure to read the DDS config file
#
# Returns: 	(%ini)
#
sub readDDSConfig
{
	my($self, $configFile) = @_;
	my(%ini);

	if($configFile eq "")
	{
		die("You need to specify a configuration file.");
	}

	open(CONFIG, $configFile) || die("Cannot open CONFIG file for reading!! ($configFile)");

	while (&lt;CONFIG&gt;)
	{
		my $line = $_;
		$line =~ s/\n//g; #nuke new lines
		$line = trim($self, $line);

		my $key = "";
		my $val = "";

		if($line =~ /^(.*)\sis\s(.*)$/)
		{
			$key = $1;
			$val = $2;
		}
		elsif($line =~ /^(.*)\sare\s(.*)$/)
		{
			$key = $1;
			$val = $2;
		}

		$key = trim($self, $key);
		$val = trim($self, $val);

		if($key ne "")
		{
			$val =~ s/^\"//g;
			$val =~ s/\"$//g;
			$ini{$key} = $val;
		}
	}

	close (CONFIG);
	return (%ini);
}

#
# Function:	trim($str)
#
# Parameters:	$str - a string
#
# Description: 	Removes leading and trailing white space from a string
#
# Returns:	($trimmedStr)
#
sub trim
{
        my($self, $str) = @_;

        $str =~ s/^\s*//g; #trim start
        $str =~ s/\s*$//g; #trim end

        return($str);
}

}#end package</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SigniantDebugging">package SigniantDebugging; {

#
# Function: 	dumpSimpleHash(%theHash)
#
# Parameters:	%theHash - a hash
#
# Description: 	Dump all keys and values in a hash
#
sub dumpSimpleHash
{
	my($self, %theHash) = @_;
	my($key);

	foreach $key (sort keys %theHash)
	{
		print "$key = $theHash{$key}\n";
	}
}

#
# Function:	dumpComplexHash($depth, %theHash)
#
# Parameters:	$depth - starting depth for tabbing
# 		%theHash - a hash
#
# Description:	Dump all keys and values in a hash
#
sub dumpComplexHash
{
	my($self, $depth, %theHash) = @_;

	my $depthStr = "  " x $depth;

	foreach my $key (sort keys %theHash)
	{
		my $val = $theHash{$key};

		if($val =~ /HASH\(0x.*\)/)
		{
			print $depthStr . "$key = " . $val . "\n";
			dumpComplexHash($self, $depth + 1, %{$theHash{$key}});
		}
		else
		{
			print $depthStr . "$key = " . $val . "\n";
		}
	}
}

}#end package</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SigniantFilePath">package SigniantFilePath; {

#
# Function:	separatePathAndFile($filepath)
#
# Parameters:	$filepath - full path to the file
#
# Description:	Get the path and file name as separate elements
#
# Returns:	($justDir, $justName)
#
sub separatePathAndFile
{
	my ($self, $filepath) = @_;

	my $justDir = "";
	my $justFile = $filepath;

	if($filepath =~ /^(.*)[\/\\]([^\/\\]*)$/)
	{
		$justDir = $1;
		$justFile = $2;

		$justDir =~ s/\s*$//g; #trim end

		# strip the trailing slash and spaces
		while($justDir =~ /[\\\/]$/)
		{
			$justDir =~ s/\/$//;
			$justDir =~ s/\\$//;
			$justDir =~ s/\s*$//g; #trim end
		}
	}

	return($justDir, $justFile);
}

}#end package</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SigniantJobTemplateLibraryService">package SigniantJobTemplateLibraryService; {

use SOAP::Lite;

####################################################################################
# constructor
sub new
{
	my ($class) = @_;
	my $self = {
		_baseUrl   =&gt; undef,
		_username  =&gt; undef,
		_password  =&gt; undef,
		_lastError =&gt; undef
	};
	bless $self, $class;
	return $self;
}

####################################################################################
# general setup
sub setup
{
	my ( $self, $baseUrl, $username, $password ) = @_;
	if ( $baseUrl !~ /\/$/ )
	{
		$baseUrl .= "/";
	}
	$self-&gt;baseUrl($baseUrl);
	$self-&gt;username($username);
	$self-&gt;password($password);
	$self-&gt;lastError(" ");
	return "ok";
}

####################################################################################
# returns (rc, @jobNames)

sub getJobTemplateLibraryNames
{
	my ( $self, $jobGroup, $jobName, $action ) = @_;

	my $soapCall = SOAP::Lite-&gt;proxy( $self-&gt;baseUrl . "services/JobTemplateLibraryService" )-&gt;uri("");

	# Make the SOAP call
	my $soapResult = $soapCall-&gt;getJobTemplateLibraryNames( $self-&gt;username, $self-&gt;password, $jobName, $jobGroup, $action );

	# .. and handle the result.
	if ( $soapResult-&gt;fault )
	{
		showFault( $self, $soapResult );
		return (1);
	}
	else
	{
		return ( 0, split /,/, $soapResult-&gt;result );
	}

	return ( $soapResult-&gt;result() );
}

####################################################################################
# returns (rc)
sub newJobTemplateLibrary
{
	my ( $self, $jtlName ) = @_;

	my $soapCall = SOAP::Lite-&gt;proxy( $self-&gt;baseUrl . "services/JobTemplateLibraryService" )-&gt;uri("");

	# Make the SOAP call
	my $soapResult = $soapCall-&gt;newJobTemplateLibrary( $self-&gt;username, $self-&gt;password, $jtlName );

	# .. and handle the result.
	if ( $soapResult-&gt;fault )
	{
		showFault( $self, $soapResult );
		return (1);
	}

	return ( $soapResult-&gt;result() );
}

####################################################################################
# returns (rc)
sub importJobTemplateLibrary
{
	my ( $self, $jtlName, $jtlData ) = @_;

	my $soapCall = SOAP::Lite-&gt;proxy( $self-&gt;baseUrl . "services/JobTemplateLibraryService" )-&gt;uri("");

	# Make the SOAP call
	my $soapResult = $soapCall-&gt;importJobTemplateLibrary( $self-&gt;username, $self-&gt;password, $jtlName, $jtlData );

	# .. and handle the result.
	if ( $soapResult-&gt;fault )
	{
		showFault( $self, $soapResult );
		return ( 1, "" );
	}

	return ( 0, $soapResult-&gt;result() );
}

####################################################################################
# returns (rc, jtlXMLString)
sub exportJobTemplateLibrary
{
	my ( $self, $jtlName ) = @_;

	my $soapCall = SOAP::Lite-&gt;proxy( $self-&gt;baseUrl . "services/JobTemplateLibraryService" )-&gt;uri("");

	# Make the SOAP call
	my $soapResult = $soapCall-&gt;exportJobTemplateLibrary( $self-&gt;username, $self-&gt;password, $jtlName );

	# .. and handle the result.
	if ( $soapResult-&gt;fault )
	{
		showFault( $self, $soapResult );
		return ( 1, 0 );
	}

	return ( 0, $soapResult-&gt;result() );
}

#################################################
sub dumpComplexHashAsString
{
	my ( $self, $depth, %theHash ) = @_;
	my $outp     = "";
	my $depthStr = "  " x $depth;
	foreach my $key ( sort keys %theHash )
	{
		my $val = $theHash{$key};
		if ( $val =~ /HASH\(0x.*\)/ )
		{
			$outp .= $depthStr . "$key = " . $val . "\n";
			$outp .= dumpComplexHashAsString( $self, $depth + 1, %{ $theHash{$key} } );
		}
		else
		{
			$outp .= $depthStr . "$key = " . $val . "\n";
		}
	}

	return ($outp);
}

#################################################
sub showFault
{
	my ( $self, $soapResult ) = @_;
	my $err =
	    "Fault Code   : "
	  . $soapResult-&gt;faultcode . "\n"
	  . "Fault String : "
	  . $soapResult-&gt;faultstring . "\n"
	  . "Fault Detail      : "
	  . $soapResult-&gt;faultdetail . "\n"
	  . dumpComplexHashAsString( $self, 0, %{ $soapResult-&gt;faultdetail } ) . "\n";
	$self-&gt;lastError($err);
	print STDERR $err;
}

#################################################
############ accessor methods ###################
#################################################

#accessor method for baseUrl
sub baseUrl
{
	my ( $self, $baseUrl ) = @_;
	$self-&gt;{_baseUrl} = $baseUrl if defined($baseUrl);
	return $self-&gt;{_baseUrl};
}

#accessor method for username
sub username
{
	my ( $self, $username ) = @_;
	$self-&gt;{_username} = $username if defined($username);
	return $self-&gt;{_username};
}

#accessor method for password
sub password
{
	my ( $self, $password ) = @_;
	$self-&gt;{_password} = $password if defined($password);
	return $self-&gt;{_password};
}

#accessor method for lastError
sub lastError
{
	my ( $self, $lastError ) = @_;
	$self-&gt;{_lastError} = $lastError if defined($lastError);
	return $self-&gt;{_lastError};
}

}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SigniantPackage">package SigniantPackage; {

use SOAP::Lite;
use Data::Dumper;
use constant
{
	false	=&gt;	0,
	FALSE	=&gt;	0,
	true	=&gt;	1,
	TRUE	=&gt;	1,
};

our $PackageRC = 0;

################################################################################
#
# Routine:		GetPackage()
#
# Description:	Issues a SOAP web service call for a specific package and
#			returns the MX package object as a hash.
#
# Parameters:	$pkgID: The package ID to be queried.
#
# Returns:		%mxPkg:	The entire package object represented as a hash.
#
################################################################################
sub GetPackage($)
{
	my ($pkgID) = @_;

	main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: GetPackage",main::LOGDEBUG);

	my %mxPkg;  # hash structure to return contents of package

	#
	# create a soap handle ...
	#
	my $SOAPHANDLE = GetSoapHandle();

	#
	# define the argument value and type for the package ID parameter
	#
	my $obj = SOAP::Data-&gt;new(name =&gt; &apos;packageId&apos;, value =&gt; $pkgID, type =&gt; &apos;xs:long&apos;);

	#
	# issue SOAP request to GetPackage web service
	#
	#  note: if the package is note found (does not exist) an exception fault is returned
	#

	eval
	{
		my $RESULT = $SOAPHANDLE -&gt; getPackage($obj);

		if (defined($RESULT))
		{
			if ($RESULT-&gt;fault)
			{
				main::SigPrintLog("ERROR: getPackage web service call: SOAP call fault.",main::LOGERROR);
				ShowSoapFault( $RESULT );
				$PackageRC=1;
			}
			else
			{
				my $Data = $RESULT-&gt;valueof(&apos;//getPackageResponse/return&apos;);

				foreach my $field (keys %$Data)
			  	{
			   		my $value = $Data -&gt; {$field};

			 		$mxPkg{$field} = $value;

					$value =~ s/[\r\n]/ /g; # For print

					if ($main::DEBUG)
					{
						my $DumpStr = Dumper($mxPkg{$field});
						$DumpStr =~ s/[\n\r]//g;
						main::SigPrintLog("Package attribute: mxPkg{$field}: [" . $DumpStr . "]",main::LOGDEBUG);
					}
				}
			}
		}
		else
		{
			main::SigPrintLog("ERROR: getPackage web service call: Contents of SOAP request returned is undefined.",main::LOGERROR);
			$PackageRC=1;
		}
	};

	if ($@)
	{
		main::SigPrintLog("ERROR: getPackage web service call: $@",main::LOGERROR);
		$PackageRC=1;
	}

	# main::SigPrintLog("\"getPackage\" web service response..." . Dumper(%mxPkg),main::LOGDEBUG);

	main::SigPrintLog("&lt;&lt;&lt; Leaving subroutine: GetPackage",main::LOGDEBUG);

	return(%mxPkg);
}

################################################################################
#
# Routine:		GetPackageAgent()
#
# Description:	Retrieves the name of the controlling (source) agent for the
#			package distribution.
#
# Parameters:	%mxPkg:	The package object hash.
#
# Returns:		$name:	The name of the controlling agent.
#
################################################################################
sub GetPackageAgent(%)
{
	my (%mxPkg) = @_;

	main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: GetPackageAgent",main::LOGDEBUG);

	my $AgentName = "";
	my $AgentType = "";
	my $AgentOrg = "";

	if (!defined(%mxPkg))
	{
		main::SigPrintLog("ERROR: Package object is empty - cannot determine package agent.",main::LOGERROR);
		$PackageRC=1;
		return("","","");
	}

	if (!defined($mxPkg{&apos;agent&apos;} -&gt; {&apos;agentName&apos;}))
	{
		main::SigPrintLog("ERROR: Package agent is not defined in the package object.",main::LOGERROR);
		$PackageRC=1;
		return("","","");
	}

	if ($mxPkg{&apos;agent&apos;} -&gt; {&apos;agentName&apos;} eq "")
	{
		main::SigPrintLog("ERROR: Package agent is not defined in the package object.",main::LOGERROR);
		$PackageRC=1;
		return("","","");
	}

	#
	# The agent attribute in the Mx Pkg hash object is a pointer to a hash
	# with all the fields of the agent object as keys.
	#
	$AgentName = $mxPkg{&apos;agent&apos;} -&gt; {&apos;agentName&apos;};

	if (defined($mxPkg{&apos;agent&apos;} -&gt; {&apos;nodeType&apos;}))
	{
		$AgentType = $mxPkg{&apos;agent&apos;} -&gt; {&apos;nodeType&apos;};
	}

	if (defined($mxPkg{&apos;agent&apos;} -&gt; {&apos;organization&apos;} -&gt; {&apos;name&apos;} ))
	{
		$AgentOrg  = $mxPkg{&apos;agent&apos;} -&gt; {&apos;organization&apos;} -&gt; {&apos;name&apos;}
	}

	if ((lc($AgentType) eq "group") &amp;&amp; ($AgentOrg ne ""))
	{
		$AgentName = $AgentName . "!" . $AgentOrg;
	}

	main::SigPrintLog("&lt;&lt;&lt; Leaving subroutine: GetPackageAgent",main::LOGDEBUG);

	return($AgentName,$AgentType,$AgentOrg);
}

################################################################################
#
# Routine:		GetPackageFiles()
#
# Description:	Retrieves the list of files and directories in the package into an array.
#
# Parameters:	%mxPkg:	The package object hash.
#
# Returns:		@FilesArray:The list of files and directories in the package.
#
################################################################################
sub GetPackageFiles(%)
{
	my (%mxPkg) = @_;

	main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: GetPackageFiles",main::LOGDEBUG);

	my @files=();

	if (!defined(%mxPkg))
	{
		main::SigPrintLog("ERROR: Package object is empty - cannot determine package files.",main::LOGERROR);
		$PackageRC=1;
		return(@files);
	}

	#
	# Assign references to the files object to a local variable.
	#
	my $rfiles = $mxPkg{&apos;files&apos;};

	#
	# Check if the reference points to a hash (one file) or array (list of files).
	#
	if (ref($rfiles) eq "HASH")
	{
		$files[0] = $rfiles -&gt; {&apos;serverPath&apos;};
	}
	elsif (ref($rfiles) eq "ARRAY")
	{
		my $i=0;

		foreach my $rfileRec (@$rfiles)
		{
			$files[$i] = $rfileRec -&gt; {&apos;serverPath&apos;};
			$i++;
		}
	}

	main::SigPrintLog("Number of file &amp; directory paths in package: " . scalar(@files) . "",main::LOGDEBUG);

	return(@files);
}

################################################################################
#
# Routine:		GetPackageFilesInXML()
#
# Description:	Retrieves the list of files and directories in the package.
#
# Parameters:	%mxPkg:	The package object hash.
#
# Returns:		$XMLString:The list of files and directories in the package encapsulated in SigListXML format.
#
################################################################################
sub GetPackageFilesInXML(%)
{
	my (%mxPkg) = @_;

	main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: GetPackageFilesInXML",main::LOGDEBUG);

	#
	# Pull the list of files from the pkg structure into an array.
	#
	# The files attribute in the Mx Pkg object is either a reference
	# to array or hash depending on the number of files in the package.
	# If only one file exists in the package, the reference is to a hash.
	# If the package has multiple files, its a reference to and array of hashes.
	# The file object consists of two attributes (filename, size).
	#

	my @files;

	if (!defined(%mxPkg))
	{
		main::SigPrintLog("ERROR: Package object is empty - cannot determine package files.",main::LOGERROR);
		$PackageRC=1;
		return("");
	}

	#
	# Assign references to the files object to a local variable.
	#
	my $rfiles = $mxPkg{&apos;files&apos;};

	#
	# Check if the reference points to a hash (one file) or array (list of files).
	#
	if (ref($rfiles) eq "HASH")
	{
		$files[0]{&apos;V&apos;} = $rfiles -&gt; {&apos;serverPath&apos;};
		$files[0]{&apos;S&apos;} = $rfiles -&gt; {&apos;byteSize&apos;};

		if (lc($rfiles -&gt; {&apos;isDirectory&apos;}) eq "true")
		{
			$files[0]{&apos;T&apos;} = "D";
		}
		else
		{
			$files[0]{&apos;T&apos;} = "F";
		}

		if (defined($rfiles -&gt; {&apos;tag&apos;}))
		{
			$files[0]{&apos;MD&apos;} = "MXTAGTYPE=" . $rfiles -&gt; {&apos;tag&apos;};
		}
	}

	if (ref($rfiles) eq "ARRAY")
	{
		my $i=0;

		foreach my $rfileRec (@$rfiles)
		{
			$files[$i]{&apos;V&apos;} = $rfileRec -&gt; {&apos;serverPath&apos;};
			$files[$i]{&apos;S&apos;} = $rfileRec -&gt; {&apos;byteSize&apos;};

			if (lc($rfileRec -&gt; {&apos;isDirectory&apos;}) eq "true")
			{
				$files[$i]{&apos;T&apos;} = "D";
			}
			else
			{
				$files[$i]{&apos;T&apos;} = "F";
			}

			if (defined($rfileRec -&gt; {&apos;tag&apos;}))
			{
				$files[$i]{&apos;MD&apos;} = "MXTAGTYPE=" . $rfileRec -&gt; {&apos;tag&apos;};
			}

			$i++;
		}
	}

	#
	# If the reference does not point an array or hash, an empty file list is returned.
	#

	main::SigPrintLog("Number of file &amp; directory paths in package: " . scalar(@files) . "",main::LOGDEBUG);

	#
	# Build a SigXML filelist of type &apos;FILEDIR&apos;
	#
	# Note: - the SigList Type is set FILEDIR to indicate the list is
	# both files and directories (not expanded). When uploading a directory
	# with the MX client, only the directory name is stored in the package contents
	# and not all the inidividual file names.
	#
	# Once we get the type of file included in the SOAP MxFile object we can then
	# loop thru the array of items and determine if any directories are listed in
	# the package contents.
	#

	my $XMLString;

	if (main::SigListXMLCreate($XMLString, &apos;FILEDIR&apos;, \@files))
	{
	  	main::SigPrintLog("ERROR: Failed to create XML file list",main::LOGERROR);
	  	$PackageRC=1;
	}

	main::SigPrintLog("&lt;&lt;&lt; Leaving subroutine: GetPackageFilesInXML",main::LOGDEBUG);

	return($XMLString);
}

################################################################################
#
# Routine:		MergeFileLists()
#
# Description:	Merges 2 XML file lists and returns the merged list.
#
# Parameters:	$List1 - The primary list
#			$List2 - The secondary list (to be appended to primary list)
#
# Returns:		The merged/appended file list. If any error occurs, the primary
#			list is returned (unmerged).
#
################################################################################
sub MergeFileLists($$)
{
	main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: MergeFileLists",main::LOGDEBUG);

	my $List1 = @_[0];
	my $List2 = @_[1];
	my $MergedList;
	my $XMLPathListType1 = "";
	my $XMLPathListType2 = "";
	my @ElArray1;
	my @ElArray2;
	my $SigListXattrs1 = "";
	my $SigListXattrs2 = "";

	if (main::SigListXMLParse($List1,\$XMLPathListType1,\@ElArray1,\$SigListXattrs1 ) != 0)
	{
		SigPrintLog("ERROR: File List 1 XML specification is not parsable",main::LOGERROR);
		$PackageRC=1;
		return($List1);
	}

	if (main::SigListXMLParse($List2,\$XMLPathListType2,\@ElArray2,\$SigListXattrs2 ) != 0)
	{
		SigPrintLog("ERROR: File List 2 XML specification is not parsable",main::LOGERROR);
		$PackageRC=1;
		return($List1);
	}

	#
	# Search for DUPs and skip them...
	#
	for (my $i=0; $i &lt; scalar(@ElArray2); $i++)
	{
		my $MatchFound=FALSE;

		for (my $j=0; $j &lt; scalar(@ElArray1); $j++)
		{
			if ($ElArray2[$i]{&apos;V&apos;} eq $ElArray1[$j]{&apos;V&apos;})
			{
				$MatchFound=TRUE;
				last;
			}
		}

		if (!$MatchFound)
		{
			push(@ElArray1, $ElArray2[$i]);
		}
	}

	if (main::SigListXMLCreate($MergedList, &apos;FILEDIR&apos;, \@ElArray1) != 0)
	{
		main::SigPrintLog("ERROR: Creation of merged file list failed",main::LOGERROR);
		$PackageRC=1;
		return($List1);
	}
	else
	{
		return($MergedList);
	}

	main::SigPrintLog("&lt;&lt;&lt; Leaving subroutine: MergeFileLists",main::LOGDEBUG);
}

################################################################################
#
# Routine: 		CreatePackage()
#
# Description:	Issue a SOAP web-service call to create a package and return
#			MX package object as a hash.
#
# Parameters:	packageTitle
#			packageDescription
#			packageFiles
#			packageAgent
#			forwardable
#			notAvailableBefore
#			notAvailableAfter
#			archiveOn
#			creatorId
#			notifyOnDeliveryCC
#			notifyOnDeliveryBCC
#			notifyOnDownloadCC
#			notifyOnDownloadBCC
#			maintainPackage
#
# Returns:		%mxPkg:	The package object, represented as a hash.
#
################################################################################
sub CreatePackage($$$$$$$$$$$$$$)
{
	main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: CreatePackage",main::LOGDEBUG);

	my $packageTitle = @_[0];
	my $packageDescription = @_[1];
	my $packageFiles = @_[2];
	my $packageAgent = @_[3];
	my $forwardable = @_[4];
	my $notAvailableBefore = @_[5];
	my $notAvailableAfter = @_[6];
	my $archiveOn = @_[7];
	my $creatorId = @_[8];
	my $notifyOnDeliveryCC = @_[9];
	my $notifyOnDeliveryBCC = @_[10];
	my $notifyOnDownloadCC = @_[11];
	my $notifyOnDownloadBCC = @_[12];
	my $maintainPackage = @_[13];

	my %mxPkg;  # hash structure to return contents of package

	#
	# create a soap handle ...
	#
	my $SOAPHANDLE = GetSoapHandle();

	#
	# pull the list of files from the pkg structure into an array an build an XML filelist
	#
	my $XMLPathListType="";
	my $SigListXattrs="";
	my @filesObjsArray;

	my @ElArray;
	my @SOURCEPATHS;
	my @BASEPATHS;

	#
	# Translate package title into a multiline string if that is how it was passed in...
	#
	if (main::IsSigListXmlFormat($packageTitle))
	{
		my @packageTitleArray;

		if (main::SigListXMLParse($packageTitle,\$XMLPathListType,\@ElArray,\$SigListXattrs ) != 0)
		{
			main::SigPrintLog("ERROR: Package title XML specification is not parsable",main::LOGERROR,main::LOGSTDOUT);
			$PackageRC=1;
			return;
		}
		else
		{
			@packageTitleArray = main::SigListGetELementsByAttribute(\@ElArray,"V");
		}

		$packageTitle = join(" ",@packageTitleArray);
	}

	$packageTitle =~ s/[\n\r]//g;
	$packageTitle = main::GetUtf8String(main::SigEscapeXML($packageTitle));

	#
	# Translate package description into a multiline string if that is how it was passed in...
	#
	if (main::IsSigListXmlFormat($packageDescription ))
	{
		my @packageDescArray;

		if (main::SigListXMLParse($packageDescription ,\$XMLPathListType,\@ElArray,\$SigListXattrs ) != 0)
		{
			main::SigPrintLog("ERROR: Package title XML specification is not parsable",main::LOGERROR,main::LOGSTDOUT);
			$PackageRC=1;
			return;
		}
		else
		{
			@packageDescArray = main::SigListGetELementsByAttribute(\@ElArray,"V");
		}

		$packageDescription = main::SigArrayToMultiLineStr(\@packageDescArray);
	}

	$packageDescription = main::GetUtf8String(main::SigEscapeXML($packageDescription));

	#
	# Translate file list into XML if it&apos;s not already...
	#
	if (!main::IsSigListXmlFormat($packageFiles))
	{
		# SourceData is in legacy format...
		my @fileListArray = main::SolutionSplitPaths($packageFiles,&apos;,&apos;);
		main::SigListXMLCreate($packageFiles,&apos;FILEDIR&apos;,\@fileListArray);
	}

	if (main::SigListXMLParse($packageFiles,\$XMLPathListType,\@ElArray,\$SigListXattrs ) != 0)
	{
		main::SigPrintLog("ERROR: File List  XML specification is not parsable",main::LOGERROR);
		$PackageRC=1;
		return;
	}
	else
	{
		@SOURCEPATHS = sort { length($$a{&apos;V&apos;}) &lt;=&gt; length($$b{&apos;V&apos;}) } @ElArray;

		#main::SigPrintLog("Input Paths...\n",main::LOGDEBUG);

		for (my $i=0; $i &lt; scalar(@SOURCEPATHS); $i++)
		{
			$SOURCEPATHS[$i]{V} =~ s|\\|\/|g; # Normalize slashes to simplify pattern matching below
			#main::SigPrintLog("Path: " . $SOURCEPATHS[$i]{V} . "\n",main::LOGDEBUG);
			#main::SigPrintLog("Size: " . $SOURCEPATHS[$i]{S} . "\n",main::LOGDEBUG);
		}

		$BASEPATHS[0]{V}  = $SOURCEPATHS[0]{V}; # Seed with first element. Since it is the shortest, there can be no parent.
		$BASEPATHS[0]{S}  = $SOURCEPATHS[0]{S};
		$BASEPATHS[0]{T}  = $SOURCEPATHS[0]{T};
		$BASEPATHS[0]{MD} = $SOURCEPATHS[0]{MD};

		my $BasePaths=0;

		for (my $i=1; $i &lt; scalar(@SOURCEPATHS); $i++)
		{
			my $MatchFound = FALSE;
			my $j;

			for ($j=0; $j &lt; scalar(@BASEPATHS); $j++)
			{
				if (substr($SOURCEPATHS[$i]{V},0,length($BASEPATHS[$j]{V})) eq $BASEPATHS[$j]{V}) # Test prefix match
				{
					if (substr($SOURCEPATHS[$i]{V},length($BASEPATHS[$j]{V}),1) =~ m/[\/]/ ) # Test that prefix is a directory
					{
						$MatchFound=TRUE;
						last;
					}
				}
			}

			if ($MatchFound)
			{
				$BASEPATHS[$j]{S} += $SOURCEPATHS[$i]{S}; # Increment size of base path
			}
			else
			{
				$BasePaths++;

				$BASEPATHS[$BasePaths]{V}  = $SOURCEPATHS[$i]{V}; # New base path.
				$BASEPATHS[$BasePaths]{S}  = $SOURCEPATHS[$i]{S};
				$BASEPATHS[$BasePaths]{T}  = $SOURCEPATHS[$i]{T};
				$BASEPATHS[$BasePaths]{MD} = $SOURCEPATHS[$i]{MD};
			}
		}
	}

	#main::SigPrintLog("Optimized Paths...\n",main::LOGDEBUG);
	#for (my $i=0; $i &lt; scalar(@BASEPATHS); $i++)
	#{
	#	main::SigPrintLog("Path: " . $BASEPATHS[$i]{V} . "\n",main::LOGDEBUG);
	#	main::SigPrintLog("Size: " . $BASEPATHS[$i]{S} . "\n",main::LOGDEBUG);
	#}

	#
	# Build an array of SOAP data object with the list of files. Each SOAP data object
	# represents a complex types "mxFile" in the SOAP envelope sent to the server...
	#
	for (my $i=0; $i &lt; scalar(@BASEPATHS); $i++)
	{
		main::SigPrintLog("Filename: [" . $BASEPATHS[$i]{V} . "]",main::LOGDEBUG);

		my $File;
		my $IsDir = "";
		my $Size = "";

		$File = $BASEPATHS[$i]{V};
		$File = main::GetUtf8String($File);

		#
		# Determine type and size from the parallel arrays, if they are defined.
		# This makes an assumption that the incoming XML defines these attributes
		# for ALL elements or NO elements.
		#
		if (defined($BASEPATHS[$i]{T}))
		{
			if (lc($BASEPATHS[$i]{T}) eq "d")
			{
				$IsDir = "true";
			}
			elsif (lc($BASEPATHS[$i]{T}) eq "f")
			{
				$IsDir = "false";
			}
		}
		else
		{
			$IsDir = "";
		}

		if (defined($BASEPATHS[$i]{S}))
		{
			$Size = $BASEPATHS[$i]{S};
		}
		else
		{
			$Size = "";
		}

		my $StatusType = "READY";
		
		if (lc($maintainPackage) eq "yes")
		{
			$StatusType = "MAINTAINED";
		}

		if (defined($BASEPATHS[$i]{MD}))
		{
			my $TagType="";

			if ($BASEPATHS[$i]{MD} =~ m/MXTAGTYPE=THUMBNAIL/i)
			{
				$TagType = "THUMBNAIL";
			}
			elsif ($BASEPATHS[$i]{MD} =~ m/MXTAGTYPE=METADATA/i)
			{
				$TagType = "METADATA";
			}

			$File = main::SigEscapeXML($File);

			$filesObjsArray[$i] = \SOAP::Data-&gt;value(SOAP::Data-&gt;name("isDirectory" =&gt; $IsDir)-&gt;type(&apos;xs:boolean&apos;),
								SOAP::Data-&gt;name("serverPath" =&gt; $File)-&gt;type(&apos;xs:string&apos;),
								SOAP::Data-&gt;name("byteSize" =&gt; $Size)-&gt;type(&apos;xs:long&apos;),
								SOAP::Data-&gt;name("tag" =&gt; $TagType)-&gt;type(&apos;xs:string&apos;),
								SOAP::Data-&gt;name("status" =&gt; $StatusType)-&gt;type(&apos;xs:string&apos;));
								}
		else
		{
			$File = main::SigEscapeXML($File);

			$filesObjsArray[$i] = \SOAP::Data-&gt;value(SOAP::Data-&gt;name("isDirectory" =&gt; $IsDir)-&gt;type(&apos;xs:boolean&apos;),
								SOAP::Data-&gt;name("serverPath" =&gt; $File)-&gt;type(&apos;xs:string&apos;),
								SOAP::Data-&gt;name("byteSize" =&gt; $Size)-&gt;type(&apos;xs:long&apos;),
								SOAP::Data-&gt;name("status" =&gt; $StatusType)-&gt;type(&apos;xs:string&apos;));
								}
	}

	#
	# Define the arguments objects to pass to web service createPackage command
	#
	my $titleObj = SOAP::Data-&gt;new(name =&gt; &apos;title&apos;, value =&gt; $packageTitle, type =&gt; &apos;xs:string&apos;);
	my $descObj  = SOAP::Data-&gt;new(name =&gt; &apos;description&apos;, value =&gt; $packageDescription, type =&gt; &apos;xs:string&apos;);

	#
	# The agent is a complex type - must be an array of elemenets...
	#
	my @AgentObjArray=();

	#
	# If the agent is actually a load-balanced group, determine the group name and org ID...
	#
 	if ($packageAgent =~ m/!/)
	{
		my $orgId=$&apos;; #&apos;
		my $AgentGroup=$`;

		$AgentObjArray[0] = \SOAP::Data-&gt;value(
								SOAP::Data-&gt;name("agentName" =&gt; $AgentGroup)-&gt;type(&apos;xs:string&apos;),
						       	SOAP::Data-&gt;name("nodeType" =&gt; &apos;GROUP&apos;)-&gt;type(&apos;xs:string&apos;),
						       	SOAP::Data-&gt;name("organization" =&gt; \SOAP::Data-&gt;value(SOAP::Data-&gt;name("id" =&gt; $orgId)-&gt;type(&apos;xs:long&apos;)))
						      );
	}
	else
	{
		$AgentObjArray[0] = \SOAP::Data-&gt;value(
								SOAP::Data-&gt;name("agentName" =&gt; $packageAgent)-&gt;type(&apos;xs:string&apos;),
						       	SOAP::Data-&gt;name("nodeType" =&gt; &apos;HOST&apos;)-&gt;type(&apos;xs:string&apos;),
						      );
	}

	my $agentObj = SOAP::Data-&gt;new(name =&gt; &apos;agent&apos;, value =&gt; @AgentObjArray, type =&gt; &apos;tns:agentBase&apos;);

	my $filesObj = SOAP::Data-&gt;name("files" =&gt; @filesObjsArray);

	if (($forwardable eq "") || (lc($forwardable) eq "yes"))
	{
		$forwardable = "true";
	}
	else
	{
		$forwardable = "false";
	}

	my $forwardObj   = SOAP::Data-&gt;new(name =&gt; &apos;forwardable&apos;, value =&gt; $forwardable, type =&gt; &apos;xs:boolean&apos;);
	my $enableOnObj  = SOAP::Data-&gt;new(name =&gt; &apos;enableOn&apos;, value =&gt; ConvertTimeForSoap($notAvailableBefore), type =&gt; &apos;xs:dateTime&apos;);
	my $expireOnObj  = SOAP::Data-&gt;new(name =&gt; &apos;expireOn&apos;, value =&gt; ConvertTimeForSoap($notAvailableAfter), type =&gt; &apos;xs:dateTime&apos;);
	my $archiveOnObj = SOAP::Data-&gt;new(name =&gt; &apos;archiveOn&apos;, value =&gt; ConvertTimeForSoap($archiveOn), type =&gt; &apos;xs:dateTime&apos;);

	# set the creatorID to the logged_in_user_id value passed in to the job from the scheduler
	my $creatorIdObj = SOAP::Data-&gt;new(name =&gt; &apos;creatorId&apos;, value =&gt; $creatorId, type =&gt; &apos;xs:long&apos;);

	my $notifyOnDeliveryCCObj  = SOAP::Data-&gt;new(name =&gt; &apos;deliveryCopy&apos;, value =&gt; $notifyOnDeliveryCC, type =&gt; &apos;xs:string&apos;);
	my $notifyOnDeliveryBCCObj = SOAP::Data-&gt;new(name =&gt; &apos;deliveryBlindCopy&apos;, value =&gt; $notifyOnDeliveryBCC, type =&gt; &apos;xs:string&apos;);
	my $notifyOnDownloadCCObj  = SOAP::Data-&gt;new(name =&gt; &apos;downloadCopy&apos;, value =&gt; $notifyOnDownloadCC, type =&gt; &apos;xs:string&apos;);
	my $notifyOnDownloadBCCObj = SOAP::Data-&gt;new(name =&gt; &apos;downloadBlindCopy&apos;, value =&gt; $notifyOnDownloadBCC, type =&gt; &apos;xs:string&apos;);

	#
	# issue SOAP request to createPackage web service
	#
	eval
	{
		my $RESULT = $SOAPHANDLE -&gt; createPackage(
					$titleObj,
					$agentObj,
					$descObj,
					$filesObj,
					$forwardObj,
					$enableOnObj,
					$expireOnObj,
					$archiveOnObj,
					$creatorIdObj,
					$notifyOnDeliveryCCObj,
					$notifyOnDeliveryBCCObj,
					$notifyOnDownloadCCObj,
					$notifyOnDownloadBCCObj);

		if (defined $RESULT)
		{
			if ( $RESULT-&gt;fault )
			{
				main::SigPrintLog("ERROR: createPackage web service call - soap call fault .",main::LOGERROR);
				ShowSoapFault( $RESULT );
				$PackageRC=1;
			}
			else
			{
				#
				#  - Todo need a check for request did not fail, but empty record was returned
				#     ....getting a pkg that does not exist

				my $Data = $RESULT-&gt;valueof(&apos;//createPackageResponse/return&apos;);

				foreach my $field (keys %$Data)
			  	{
			   		my $value = $Data -&gt; {$field};
			 		$mxPkg{$field} = $value;

					if ($main::DEBUG)
					{
						my $DumpStr = Dumper($mxPkg{$field});
						$DumpStr =~ s/[\n\r]/ /g;
						main::SigPrintLog("Package attribute: mxPkg{$field}: [" . $DumpStr . "]",main::LOGDEBUG);
					}
				}
			}
		}
		else
		{
			main::SigPrintLog("ERROR: createPackage web service call - contents of soap request returned is undefined.",main::LOGERROR);
			$PackageRC=1;
		}

	};

	if ($@)
	{
		main::SigPrintLog("ERROR: createPackage web service call",main::LOGERROR);
		main::SigPrintLog("Error: $@ ",main::LOGERROR);
		$PackageRC=1;
	}

	main::SigPrintLog("&lt;&lt;&lt; Leaving subroutine: CreatePackage",main::LOGDEBUG);

	return(%mxPkg);
}

################################################################################
#
# Routine:		UpdatePackage()
#
# Description:	Issue a SOAP web-service call to update an existing package and
#			return the updated MX package object as a hash.
#
# Parameters:	PackageID
#			packageTitle
#			packageDescription
#			packageFiles
#			ExistingPackageFiles
#			packageFilesUpdateMode
#			AgentName
#			AgentType
#			AgentOrg
#			forwardable
#			notAvailableBefore
#			notAvailableAfter
#			archiveOn
#			creatorId
#			notifyOnDeliveryCC
#			notifyOnDeliveryBCC
#			notifyOnDownloadCC
#			notifyOnDownloadBCC
#			maintainPackage
#
# Returns:		%mxPkg:	The updated package object, represented as a hash.
#
################################################################################
sub UpdatePackage($$$$$$$$$$$$$$$$$$)
{
	main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: UpdatePackage",main::LOGDEBUG);

	my $PackageID = @_[0];
	my $packageTitle = @_[1];
	my $packageDescription = @_[2];
	my $packageFiles = @_[3];
	my $ExistingPackageFiles = @_[4];
	my $packageFilesUpdateMode = @_[5];
	my $AgentName = @_[6];
	my $AgentType = @_[7];
	my $AgentOrg = @_[8];
	my $forwardable = @_[9];
	my $notAvailableBefore = @_[10];
	my $notAvailableAfter = @_[11];
	my $archiveOn = @_[12];
	my $notifyOnDeliveryCC = @_[13];
	my $notifyOnDeliveryBCC = @_[14];
	my $notifyOnDownloadCC = @_[15];
	my $notifyOnDownloadBCC = @_[16];
	my $maintainPackage = @_[17];

	my %mxPkg = {};  # hash structure to return contents of package

	#
	# create a soap handle ...
	#
	my $SOAPHANDLE = GetSoapHandle();

	#
	# pull the list of files from the pkg structure into an array an build an XML filelist
	#
	my $XMLPathListType="";
	my $SigListXattrs="";
	my @filesObjsArray;

	my @ElArray;
	my @SOURCEPATHS;
	my @BASEPATHS;

	#
	# Translate package title into a multiline string if that is how it was passed in...
	#
	if (main::IsSigListXmlFormat($packageTitle))
	{
		my @packageTitleArray;

		if (main::SigListXMLParse($packageTitle,\$XMLPathListType,\@ElArray,\$SigListXattrs ) != 0)
		{
			main::SigPrintLog("ERROR: Package title XML specification is not parsable",main::LOGERROR,main::LOGSTDOUT);
			$PackageRC=1;
			return;
		}
		else
		{
			@packageTitleArray = main::SigListGetELementsByAttribute(\@ElArray,"V");
		}

		$packageTitle = join(" ",@packageTitleArray);
	}

	$packageTitle =~ s/[\n\r]//g;
	$packageTitle = main::GetUtf8String(main::SigEscapeXML($packageTitle));

	#
	# Translate package description into a multiline string if that is how it was passed in...
	#
	if (main::IsSigListXmlFormat($packageDescription))
	{
		my @packageDescArray;

		if (main::SigListXMLParse($packageDescription,\$XMLPathListType,\@ElArray,\$SigListXattrs ) != 0)
		{
			main::SigPrintLog("ERROR: Package title XML specification is not parsable",main::LOGERROR,main::LOGSTDOUT);
			$PackageRC=1;
			return;
		}
		else
		{
			@packageDescArray = main::SigListGetELementsByAttribute(\@ElArray,"V");
		}

		$packageDescription = main::SigArrayToMultiLineStr(\@packageDescArray);
	}

	$packageDescription = main::GetUtf8String(main::SigEscapeXML($packageDescription));

	#
	# Translate file list into XML if it&apos;s not already...
	#
	if (!main::IsSigListXmlFormat($packageFiles))
	{
		# SourceData is in legacy format...
		my @PackageFilesArray = main::SolutionSplitPaths($packageFiles,&apos;,&apos;);
		main::SigListXMLCreate($packageFiles,&apos;FILEDIR&apos;,\@PackageFilesArray);
	}

	if (lc($packageFilesUpdateMode) eq "append")
	{
		if (!main::IsSigListXmlFormat($ExistingPackageFiles))
		{
			my @ExistingFileListArray = main::SolutionSplitPaths($ExistingPackageFiles,&apos;,&apos;);
			main::SigListXMLCreate($ExistingPackageFiles,&apos;FILEDIR&apos;,\@ExistingFileListArray);
		}

		$packageFiles = MergeFileLists($ExistingPackageFiles,$packageFiles);
	}

	if (main::SigListXMLParse($packageFiles,\$XMLPathListType,\@ElArray,\$SigListXattrs ) != 0)
	{
		main::SigPrintLog("ERROR: File List XML specification is not parsable",main::LOGERROR);
		$PackageRC=1;
		return;
	}
	else
	{
		@SOURCEPATHS = sort { length($$a{&apos;V&apos;}) &lt;=&gt; length($$b{&apos;V&apos;}) } @ElArray;

		#main::SigPrintLog("Input Paths...\n",main::LOGDEBUG);
		for (my $i=0; $i &lt; scalar(@SOURCEPATHS); $i++)
		{
			$SOURCEPATHS[$i]{V} =~ s|\\|\/|g; # Normalize slashes to simplify pattern matching below
			#main::SigPrintLog("Path: " . $SOURCEPATHS[$i]{V} . "\n",main::LOGDEBUG);
			#main::SigPrintLog("Size: " . $SOURCEPATHS[$i]{S} . "\n",main::LOGDEBUG);
		}

		$BASEPATHS[0]{V}  = $SOURCEPATHS[0]{V}; # Seed with first element. Since it is the shortest, there can be no parent.
		$BASEPATHS[0]{S}  = $SOURCEPATHS[0]{S};
		$BASEPATHS[0]{T}  = $SOURCEPATHS[0]{T};
		$BASEPATHS[0]{MD} = $SOURCEPATHS[0]{MD};

		my $BasePaths=0;

		for (my $i=1; $i &lt; scalar(@SOURCEPATHS); $i++)
		{
			my $MatchFound = FALSE;
			my $j;

			for ($j=0; $j &lt; scalar(@BASEPATHS); $j++)
			{
				if (substr($SOURCEPATHS[$i]{V},0,length($BASEPATHS[$j]{V})) eq $BASEPATHS[$j]{V}) # Test prefix match
				{
					if (substr($SOURCEPATHS[$i]{V},length($BASEPATHS[$j]{V}),1) =~ m/[\/]/ ) # Test that prefix is a directory
					{
						$MatchFound=TRUE;
						last;
					}
				}
			}

			if ($MatchFound)
			{
				$BASEPATHS[$j]{S} += $SOURCEPATHS[$i]{S}; # Increment size of base path
			}
			else
			{
				$BasePaths++;

				$BASEPATHS[$BasePaths]{V}  = $SOURCEPATHS[$i]{V}; # New base path.
				$BASEPATHS[$BasePaths]{S}  = $SOURCEPATHS[$i]{S};
				$BASEPATHS[$BasePaths]{T}  = $SOURCEPATHS[$i]{T};
				$BASEPATHS[$BasePaths]{MD} = $SOURCEPATHS[$i]{MD};
			}
		}
	}

	#main::SigPrintLog("Optimized Paths...\n",main::LOGDEBUG);
	#for (my $i=0; $i &lt; scalar(@BASEPATHS); $i++)
	#{
	#	main::SigPrintLog("Path: " . $BASEPATHS[$i]{V} . "\n",main::LOGDEBUG);
	#	main::SigPrintLog("Size: " . $BASEPATHS[$i]{S} . "\n",main::LOGDEBUG);
	#}

	#
	# Build an array of SOAP data object with the list of files. Each SOAP data object
	# represents a complex types "mxFile" in the SOAP envelope sent to the server...
	#
	for (my $i=0; $i &lt; scalar(@BASEPATHS); $i++)
	{
		main::SigPrintLog("Filename: [" . $BASEPATHS[$i]{V} . "]",main::LOGDEBUG);

		my $File;
		my $IsDir = "";
		my $Size = "";

		$File = $BASEPATHS[$i]{V};
		$File = main::GetUtf8String($File);

		#
		# Determine type and size from the parallel arrays, if they are defined.
		# This makes an assumption that the incoming XML defines these attributes
		# for ALL elements or NO elements.
		#
		if (defined($BASEPATHS[$i]{T}))
		{
			if (lc($BASEPATHS[$i]{T}) eq "d")
			{
				$IsDir = "true";
			}
			elsif (lc($BASEPATHS[$i]{T}) eq "f")
			{
				$IsDir = "false";
			}
		}
		else
		{
			$IsDir = "";
		}

		if (defined($BASEPATHS[$i]{S}))
		{
			$Size = $BASEPATHS[$i]{S};
		}
		else
		{
			$Size = "";
		}

		my $StatusType = "READY";

		if (lc($maintainPackage) eq "yes")
		{
			$StatusType = "MAINTAINED";
		}

		if (defined($BASEPATHS[$i]{MD}))
		{
			my $TagType="";

			if ($BASEPATHS[$i]{MD} =~ m/MXTAGTYPE=THUMBNAIL/i)
			{
				$TagType = "THUMBNAIL";
			}
			elsif ($BASEPATHS[$i]{MD} =~ m/MXTAGTYPE=METADATA/i)
			{
				$TagType = "METADATA";
			}

			$File = main::SigEscapeXML($File);
			
			$filesObjsArray[$i] = \SOAP::Data-&gt;value(SOAP::Data-&gt;name("isDirectory" =&gt; $IsDir)-&gt;type(&apos;xs:boolean&apos;),
								SOAP::Data-&gt;name("serverPath" =&gt; $File)-&gt;type(&apos;xs:string&apos;),
								SOAP::Data-&gt;name("byteSize" =&gt; $Size)-&gt;type(&apos;xs:long&apos;),
								SOAP::Data-&gt;name("tag" =&gt; $TagType)-&gt;type(&apos;xs:string&apos;),
								SOAP::Data-&gt;name("status" =&gt; $StatusType)-&gt;type(&apos;xs:string&apos;));
								}
		else
		{
			$File = main::SigEscapeXML($File);

			$filesObjsArray[$i] = \SOAP::Data-&gt;value(SOAP::Data-&gt;name("isDirectory" =&gt; $IsDir)-&gt;type(&apos;xs:boolean&apos;),
								SOAP::Data-&gt;name("serverPath" =&gt; $File)-&gt;type(&apos;xs:string&apos;),
								SOAP::Data-&gt;name("byteSize" =&gt; $Size)-&gt;type(&apos;xs:long&apos;),
								SOAP::Data-&gt;name("status" =&gt; $StatusType)-&gt;type(&apos;xs:string&apos;));
								}
	}

	#
	# Define the objects to pass to web service updatePackage command
	#
	my $packageIdObj = SOAP::Data-&gt;new(name =&gt; &apos;packageId&apos;, value =&gt; $PackageID, type =&gt; &apos;xs:long&apos;);
	my $titleObj = SOAP::Data-&gt;new(name =&gt; &apos;title&apos;, value =&gt; $packageTitle, type =&gt; &apos;xs:string&apos;);
	my $descObj  = SOAP::Data-&gt;new(name =&gt; &apos;description&apos;, value =&gt; $packageDescription, type =&gt; &apos;xs:string&apos;);

	#
	# The agent is a complex type - must be an array of elemenets...
	#
	my @AgentObjArray=();

	if ($AgentOrg eq "") # HOST
	{
		$AgentObjArray[0] = \SOAP::Data-&gt;value(
							SOAP::Data-&gt;name("agentName" =&gt; $AgentName)-&gt;type(&apos;xs:string&apos;),
							SOAP::Data-&gt;name("nodeType" =&gt; $AgentType)-&gt;type(&apos;xs:string&apos;)
						      );
	}
	else # GROUP
	{
		$AgentObjArray[0] = \SOAP::Data-&gt;value(
							SOAP::Data-&gt;name("agentName" =&gt; $AgentName)-&gt;type(&apos;xs:string&apos;),
							SOAP::Data-&gt;name("nodeType" =&gt; $AgentType)-&gt;type(&apos;xs:string&apos;),
							SOAP::Data-&gt;name("organization" =&gt; \SOAP::Data-&gt;value(SOAP::Data-&gt;name("id" =&gt; $AgentOrg)-&gt;type(&apos;xs:long&apos;)))
						      );
	}

	my $agentObj = SOAP::Data-&gt;new(name =&gt; &apos;agent&apos;, value =&gt; @AgentObjArray, type =&gt; &apos;tns:agentBase&apos;);

	my $filesObj = SOAP::Data-&gt;name(&apos;files&apos; =&gt; @filesObjsArray);

	if (($forwardable eq "") || (lc($forwardable) eq "yes"))
	{
		$forwardable = "true";
	}
	else
	{
		$forwardable = "false";
	}

	my $forwardObj   = SOAP::Data-&gt;new(name =&gt; &apos;forwardable&apos;, value =&gt; $forwardable, type =&gt; &apos;xs:boolean&apos;);
	my $enableOnObj  = SOAP::Data-&gt;new(name =&gt; &apos;enableOn&apos;, value =&gt; ConvertTimeForSoap($notAvailableBefore), type =&gt; &apos;xs:dateTime&apos;);
	my $expireOnObj  = SOAP::Data-&gt;new(name =&gt; &apos;expireOn&apos;, value =&gt; ConvertTimeForSoap($notAvailableAfter), type =&gt; &apos;xs:dateTime&apos;);
	my $archiveOnObj = SOAP::Data-&gt;new(name =&gt; &apos;archiveOn&apos;, value =&gt; ConvertTimeForSoap($archiveOn), type =&gt; &apos;xs:dateTime&apos;);

	my $notifyOnDeliveryCCObj  = SOAP::Data-&gt;new(name =&gt; &apos;deliveryCopy&apos;, value =&gt; $notifyOnDeliveryCC, type =&gt; &apos;xs:string&apos;);
	my $notifyOnDeliveryBCCObj = SOAP::Data-&gt;new(name =&gt; &apos;deliveryBlindCopy&apos;, value =&gt; $notifyOnDeliveryBCC, type =&gt; &apos;xs:string&apos;);
	my $notifyOnDownloadCCObj  = SOAP::Data-&gt;new(name =&gt; &apos;downloadCopy&apos;, value =&gt; $notifyOnDownloadCC, type =&gt; &apos;xs:string&apos;);
	my $notifyOnDownloadBCCObj = SOAP::Data-&gt;new(name =&gt; &apos;downloadBlindCopy&apos;, value =&gt; $notifyOnDownloadBCC, type =&gt; &apos;xs:string&apos;);

	#
	# issue SOAP request to updatePackage web service
	#
	eval
	{
		my $RESULT = $SOAPHANDLE -&gt; updatePackage(
					$packageIdObj,
					$titleObj,
					$agentObj,
					$descObj,
					$filesObj,
					$forwardObj,
					$enableOnObj,
					$expireOnObj,
					$archiveOnObj,
					$notifyOnDeliveryCCObj,
					$notifyOnDeliveryBCCObj,
					$notifyOnDownloadCCObj,
					$notifyOnDownloadBCCObj);
					
		if (defined($RESULT))
		{
			if ( $RESULT-&gt;fault )
			{
				main::SigPrintLog("ERROR: updatePackage web service call - soap call fault .",main::LOGERROR);
				ShowSoapFault( $RESULT );
				$PackageRC=1;
			}
			else
			{
				#
				# There is no &apos;//updatePackageResponse/return&apos; return value, as there is for createPackage,
				# so just query the package again...
				#
				%mxPkg =  GetPackage($PackageID);
			}
		}
		else
		{
			main::SigPrintLog("ERROR: updatePackage web service call - contents of soap request returned is undefined.",main::LOGERROR);
			$PackageRC=1;
		}
	};

	if ($@)
	{
		main::SigPrintLog("ERROR: updatePackage web service call",main::LOGERROR);
		main::SigPrintLog("Error: $@ ",main::LOGERROR);
		$PackageRC=1;
	}

	main::SigPrintLog("&lt;&lt;&lt; Leaving subroutine: UpdatePackage",main::LOGDEBUG);

	return(%mxPkg);
}

################################################################################
#
# Routine:		DeliverPackage()
#
# Description:	Issue a SOAP web-service call to deliver a package with a given ID.
#
# Parameters:	jobId
#			pkgId
#			userList
#			catListXML
#			fromUser
#			personalizedMessage
#
# Returns:		PackageRC
#
################################################################################
sub DeliverPackage($$$$$$)
{
	my ($jobId,$pkgId,$userList,$catListXML,$fromUser,$personalizedMessage) = @_;

	main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: DeliverPackage",main::LOGDEBUG);

	my $listType;
	my @Elements;
	my @TgtUserArray;
	my @TgtCategoryArray;

	if ($userList ne "")
	{
		@TgtUserArray = ResolveRecipientInput($userList);

		if (scalar(@TgtUserArray) == 0 )
		{
			main::SigPrintLog("ERROR: Could not resolve recipient list: [" . main::SigEscapeXML($userList) . "]",main::LOGERROR);
			$PackageRC =1;
			return;
		}
		main::SigPrintLog("Target users: [" . join(";",@TgtUserArray) . "]",main::LOGDEBUG);
	}

	if ($catListXML ne "")
	{
		@Elements=();
		#
		# Parse the Category List XML input...
		#
		if (main::SigListXMLParse($catListXML,\$listType,\@Elements) != 0)
		{
			main::SigPrintLog("ERROR: Category list XML specification is not parsable\n",main::LOGERROR);
			$PackageRC = 1;
		    return;
		}

		@TgtCategoryArray = main::SigListGetELementsByAttribute(\@Elements,"FQN");

		main::SigPrintLog("Target categories: [" . main::SigEscapeXML(join(";",@TgtCategoryArray)) . "]\n",main::LOGDEBUG);
	}

	if ($personalizedMessage ne "")
	{
		if (main::IsSigListXmlFormat($personalizedMessage ))
		{
			@Elements=();

			#
			# Parse the multi-line value Personalized Message...
			#
			if (main::SigListXMLParse($personalizedMessage,\$listType,\@Elements) != 0)
			{
				main::SigPrintLog("ERROR: Persoanlized message XML specification is not parsable",main::LOGERROR);
				$PackageRC=1;
				return;
			}

			my @PersonalizedMessageArray = main::SigListGetELementsByAttribute(\@Elements,"V");

			$personalizedMessage = main::SigArrayToMultiLineStr(\@PersonalizedMessageArray );
		}
	}

	#
	# Create the soap handle...
	#
	my $SOAPHANDLE = GetSoapHandle();

	#
	# Define soap data objects for each argument for the deliverPackage web service call
	#
	my $jobIdObj = SOAP::Data-&gt;new(name =&gt; &apos;jobId&apos;, value =&gt; $jobId, type =&gt; &apos;xs:string&apos;);
	my $pkgIdObj = SOAP::Data-&gt;new(name =&gt; &apos;packageId&apos;, value =&gt; $pkgId, type =&gt; &apos;xs:long&apos;);

	my @userObj;

	for (my $i=0; $i &lt; scalar(@TgtUserArray); $i++)
	{
		$TgtUserArray[$i]=main::GetUtf8String(main::SigEscapeXML($TgtUserArray[$i]));
		$userObj[$i] = SOAP::Data-&gt;new(name =&gt; &apos;userAndGroupNames&apos;, value =&gt; $TgtUserArray[$i], type =&gt; &apos;xs:string&apos;);
	}

	my @catObj;

	for (my $i=0; $i &lt; scalar(@TgtCategoryArray); $i++)
	{
		$TgtCategoryArray[$i]=main::GetUtf8String(main::SigEscapeXML($TgtCategoryArray[$i]));
		$catObj[$i] = SOAP::Data-&gt;new(name =&gt; &apos;categoryNames&apos;, value =&gt; $TgtCategoryArray[$i], type =&gt; &apos;xs:string&apos;);
	}

	$fromUser=main::GetUtf8String(main::SigEscapeXML($fromUser));
	$personalizedMessage=main::GetUtf8String(main::SigEscapeXML($personalizedMessage));

	my $fromObj    = SOAP::Data-&gt;new(name =&gt; &apos;fromUser&apos;, value =&gt; $fromUser, type =&gt; &apos;xs:string&apos;);
	my $messageObj = SOAP::Data-&gt;new(name =&gt; &apos;personalizedMessage&apos;, value =&gt; $personalizedMessage, type =&gt; &apos;xs:string&apos;);

	#
	# Issue SOAP request to deliverPackage web service.
	#
	# Note: if the package is not found (does not exist) an exception fault is returned
	#
	eval
	{
		my $RESULT = $SOAPHANDLE -&gt; deliverPackage($jobIdObj,$pkgIdObj,$fromObj,@userObj,@catObj,$messageObj);

		if (defined $RESULT)
		{
			if ($RESULT-&gt;fault)
			{
				main::SigPrintLog("ERROR: deliverPackage web service call - soap call fault.\n",main::LOGERROR);
				ShowSoapFault($RESULT);
				$PackageRC=1;
			}

		}
		else
		{
			main::SigPrintLog("ERROR: deliverPackage web service call - contents of soap request returned is undefined.\n",main::LOGERROR);
			$PackageRC=1;
		}

	};

	if ($@) {
		main::SigPrintLog("ERROR: deliverPackage web service call: $@\n",main::LOGERROR);
		$PackageRC=1;
	}

	main::SigPrintLog("&lt;&lt;&lt; Leaving subroutine: DeliverPackage",main::LOGDEBUG);

	return($PackageRC);
}

################################################################################
#
# Routine:		DeliverPackageExtended()
#
# Description:	Issue a SOAP web-service call to deliver a package with a given ID.
#
# Parameters:	jobId
#			pkgId
#			userList
#			catListXML
#			fromUser
#			personalizedMessage
#
# Returns:		PackageRC
#
################################################################################
sub DeliverPackageExtended($$$$$$$$)
{
	my ($jobId,$pkgId,$userList,$catListXML,$fromUser,$personalizedMessage,$successTargets,$failureTargets) = @_;

	main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: DeliverPackage",main::LOGDEBUG);

	my $listType;
	my @Elements;
	my @TgtUserArray;
	my @TgtCategoryArray;

	if ($userList ne "")
	{
		@TgtUserArray = ResolveRecipientInput($userList);

		if (scalar(@TgtUserArray) == 0 )
		{
			main::SigPrintLog("ERROR: Could not resolve recipient list: [" . main::SigEscapeXML($userList) . "]",main::LOGERROR);
			$PackageRC =1;
			return;
		}
		main::SigPrintLog("Target users: [" . join(";",@TgtUserArray) . "]",main::LOGDEBUG);
	}

	if ($catListXML ne "")
	{
		@Elements=();
		#
		# Parse the Category List XML input...
		#
		if (main::SigListXMLParse($catListXML,\$listType,\@Elements) != 0)
		{
			main::SigPrintLog("ERROR: Category list XML specification is not parsable\n",main::LOGERROR);
			$PackageRC = 1;
		    return;
		}

		@TgtCategoryArray = main::SigListGetELementsByAttribute(\@Elements,"FQN");

		main::SigPrintLog("Target categories: [" . main::SigEscapeXML(join(";",@TgtCategoryArray)) . "]\n",main::LOGDEBUG);
	}

	if ($personalizedMessage ne "")
	{
		if (main::IsSigListXmlFormat($personalizedMessage ))
		{
			@Elements=();

			#
			# Parse the multi-line value Personalized Message...
			#
			if (main::SigListXMLParse($personalizedMessage,\$listType,\@Elements) != 0)
			{
				main::SigPrintLog("ERROR: Persoanlized message XML specification is not parsable",main::LOGERROR);
				$PackageRC=1;
				return;
			}

			my @PersonalizedMessageArray = main::SigListGetELementsByAttribute(\@Elements,"V");

			$personalizedMessage = main::SigArrayToMultiLineStr(\@PersonalizedMessageArray );
		}
	}
	
	#
	# Create the soap handle...
	#
	my $SOAPHANDLE = GetSoapHandle();

	#
	# Define soap data objects for each argument for the deliverPackage web service call
	#
	my $jobIdObj = SOAP::Data-&gt;new(name =&gt; &apos;jobId&apos;, value =&gt; $jobId, type =&gt; &apos;xs:string&apos;);
	my $pkgIdObj = SOAP::Data-&gt;new(name =&gt; &apos;packageId&apos;, value =&gt; $pkgId, type =&gt; &apos;xs:long&apos;);

	my @userObj;

	for (my $i=0; $i &lt; scalar(@TgtUserArray); $i++)
	{
		$TgtUserArray[$i]=main::GetUtf8String(main::SigEscapeXML($TgtUserArray[$i]));
		$userObj[$i] = SOAP::Data-&gt;new(name =&gt; &apos;userAndGroupNames&apos;, value =&gt; $TgtUserArray[$i], type =&gt; &apos;xs:string&apos;);
	}

	my @catObj;

	for (my $i=0; $i &lt; scalar(@TgtCategoryArray); $i++)
	{
		$TgtCategoryArray[$i]=main::GetUtf8String(main::SigEscapeXML($TgtCategoryArray[$i]));
		$catObj[$i] = SOAP::Data-&gt;new(name =&gt; &apos;categoryNames&apos;, value =&gt; $TgtCategoryArray[$i], type =&gt; &apos;xs:string&apos;);
	}

	$fromUser=main::GetUtf8String(main::SigEscapeXML($fromUser));
	$personalizedMessage=main::GetUtf8String(main::SigEscapeXML($personalizedMessage));
	$successTargets=main::GetUtf8String(main::SigEscapeXML($successTargets));
	$failureTargets=main::GetUtf8String(main::SigEscapeXML($failureTargets));

	my $fromObj    = SOAP::Data-&gt;new(name =&gt; &apos;fromUser&apos;, value =&gt; $fromUser, type =&gt; &apos;xs:string&apos;);
	my $messageObj = SOAP::Data-&gt;new(name =&gt; &apos;personalizedMessage&apos;, value =&gt; $personalizedMessage, type =&gt; &apos;xs:string&apos;);
	
	my $successTargetsObj    = SOAP::Data-&gt;new(name =&gt; &apos;successTargets&apos;, value =&gt; $successTargets, type =&gt; &apos;xs:string&apos;);
	my $failureTargetsObj    = SOAP::Data-&gt;new(name =&gt; &apos;failureTargets&apos;, value =&gt; $failureTargets, type =&gt; &apos;xs:string&apos;);

	#
	# Issue SOAP request to deliverPackage web service.
	#
	# Note: if the package is not found (does not exist) an exception fault is returned
	#
	eval
	{
		my $RESULT = $SOAPHANDLE -&gt; deliverPackageExtended($jobIdObj,$pkgIdObj,$fromObj,@userObj,@catObj,$messageObj, $successTargetsObj, $failureTargetsObj);

		if (defined $RESULT)
		{
			if ($RESULT-&gt;fault)
			{
				main::SigPrintLog("ERROR: deliverPackage web service call - soap call fault.\n",main::LOGERROR);
				ShowSoapFault($RESULT);
				$PackageRC=1;
			}

		}
		else
		{
			main::SigPrintLog("ERROR: deliverPackage web service call - contents of soap request returned is undefined.\n",main::LOGERROR);
			$PackageRC=1;
		}

	};

	if ($@) {
		main::SigPrintLog("ERROR: deliverPackage web service call: $@\n",main::LOGERROR);
		$PackageRC=1;
	}

	main::SigPrintLog("&lt;&lt;&lt; Leaving subroutine: DeliverPackage",main::LOGDEBUG);

	return($PackageRC);
}

################################################################################
#
# Routine:		DeletePackage()
#
# Description:	Issue a SOAP web-service call to delete a package with a given ID.
#
# Parameters: 	PackageID
#			DeletorID
#
# Returns:		PackageRC
#
################################################################################
sub DeletePackage($$)
{
	my ($PackageID) = @_[0];
	my ($DeletorID) = @_[1];

	main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: DeletePackage",main::LOGDEBUG);

	main::SigPrintLog("Deleting Package with ID: $PackageID",main::LOGINFO);

	#
	# create a soap handle ...
	#
	my $SOAPHANDLE = GetSoapHandle();

	#
	# define the argument value and type for the package ID parameter
	#
	my $packageIdObj = SOAP::Data-&gt;new(name =&gt; &apos;packageId&apos;, value =&gt; $PackageID, type =&gt; &apos;xs:long&apos;);

	# set the $DeletorID to the logged_in_user_id value passed in to the job from the scheduler
	my $deletorIdObj = SOAP::Data-&gt;new(name =&gt; &apos;performedBy&apos;, value =&gt; $DeletorID, type =&gt; &apos;xs:long&apos;);

	#
	# issue SOAP request to deletePackage web service
	#
	#  note: if the package is note found (does not exist) an exception fault is returned
	#
	eval
	{
		#my $RESULT = $SOAPHANDLE -&gt; deletePackage($obj);
		my $RESULT = $SOAPHANDLE -&gt; adminDeletePackage($packageIdObj,$deletorIdObj);

		if (defined $RESULT)
		{
			if ( $RESULT-&gt;fault )
			{
				main::SigPrintLog("ERROR: adminDeletePackage web service call - soap fault .",main::LOGERROR);
		        ShowSoapFault( $RESULT );
		        $PackageRC=1;
			}
			else
			{
				#
				#  - note: nothing is returned to inform you of the number of packages deleted (0 or 1)
				#

			    main::SigPrintLog("Package deleted successfully. ",main::LOGINFO);
			}
		}
		else
		{
			main::SigPrintLog("ERROR: adminDeletePackage web service call - contents of soap request returned is undefined.",main::LOGERROR);
			$PackageRC=1;
		}

	};

	if ($@)
	{
		main::SigPrintLog("ERROR: adminDeletePackage web service call",main::LOGERROR);
		main::SigPrintLog("Error: $@ ",main::LOGERROR);
		$PackageRC=1;
	}

	main::SigPrintLog("&lt;&lt;&lt; Leaving subroutine: DeletePackage",main::LOGDEBUG);

	return($PackageRC);
}

################################################################################
#
# Routine:		DeletePackageDeliveryFromCategory()
#
# Description:	Issue a SOAP web-service call to delete a package deliery
#               with a given ID.
#
# Parameters: 	PackageID
#           CategoryArray - ignored when deleteFromAll set to &apos;yes&apos;
#			DeletorID
#           deleteFromAll - yes/no delete from all categories
#
# Returns:		PackageRC
#
################################################################################
sub DeletePackageDeliveryFromCategory {
    my $pkgId         = $_[0];
    my $catArrayRef   = $_[1];
    my $usrId         = $_[2];
    my $deleteFromAll = $_[3];  # Overrides the category array

    main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: DeletePackage",main::LOGDEBUG);

    #
    # create a soap handle ...
    #
    my $SOAPHANDLE = SigniantPackage::GetSoapHandle();
    my $RESULT;

    #
    # issue SOAP request to web service
    #
    #  note: if the package is note found (does not exist) an exception fault is returned
    #
    eval {
        my $packageIdObj  = SOAP::Data-&gt;new(name =&gt; &apos;packageId&apos;, value   =&gt; $pkgId, type     =&gt; &apos;xs:long&apos;);
        my $deletorIdObj  = SOAP::Data-&gt;new(name =&gt; &apos;performedBy&apos;, value =&gt; $usrId, type =&gt; &apos;xs:long&apos;);

        if (lc($deleteFromAll) eq "yes") {
            main::SigPrintLog("Deleting Package with ID: $pkgId from ALL Delivery Categories", main::LOGINFO);
            $RESULT = $SOAPHANDLE -&gt; adminDeletePackageCategoryDeliveries($packageIdObj,$deletorIdObj);

            if (defined $RESULT) {
                if ( $RESULT-&gt;fault ) {
                    main::SigPrintLog("ERROR: adminDeletePackageCategoryDeliveries web service call - soap fault .",main::LOGERROR);
                    ShowSoapFault( $RESULT );
                    $PackageRC = 1;
                } else {
                    main::SigPrintLog("Successfully deleted ALL package deliveries ",main::LOGINFO);
                }
            } else {
                main::SigPrintLog("ERROR: adminDeletePackageCategoryDeliveries web service call - contents of soap request returned is undefined.",main::LOGERROR);
                $PackageRC = 1;
            }
        } else {
            # Iterate the categories in the list
            foreach my $Category (@$catArrayRef) {
                my $categoryIdObj = SOAP::Data-&gt;new(name =&gt; &apos;category&apos;, value    =&gt; main::SigEscapeXML($Category), type  =&gt; &apos;xs:string&apos;);

                main::SigPrintLog("Deleting Package with ID: $pkgId from: ".main::SigEscapeXML($Category), main::LOGINFO);
                $RESULT = $SOAPHANDLE -&gt; adminDeletePackageDeliveryFromCategory($packageIdObj,$categoryIdObj,$deletorIdObj);

                if (defined $RESULT) {
                    if ( $RESULT-&gt;fault ) {
                        main::SigPrintLog("ERROR: adminDeletePackageDeliveryFromCategory web service call - soap fault .",main::LOGERROR);
                        ShowSoapFault( $RESULT );
                        $PackageRC = 1;
                    } else {
                        main::SigPrintLog("Successfully deleted package delivery ",main::LOGINFO);
                    }
                } else {
                    main::SigPrintLog("ERROR: adminDeletePackageDeliveryFromCategory web service call - contents of soap request returned is undefined.",main::LOGERROR);
                    $PackageRC = 1;
                }
            }
        }
        1;
    } or do {
        main::SigPrintLog("ERROR: adminDeletePackageFromCategory web service call",main::LOGERROR);
        main::SigPrintLog("Error: $@ ",main::LOGERROR);
        $PackageRC = 1;
    };

    main::SigPrintLog("&lt;&lt;&lt; Leaving subroutine: DeletePackageFromCategory",main::LOGDEBUG);

    return($PackageRC);
}

################################################################################
#
# Routine:		GetTargetAgentsAndDirs()
#
# Description:	Issues a SOAP web service call to retrieve the lists of target
#				agents and target directories associated with the package.
#				The target agents and directories are based on the target
#				users &amp; categories.
#
# Parameters:	$jobId:			The job ID of the current run.
#				$pkgId:			The package ID of the package.
#				$userListXML:	The list of target users for the package, encapsulated in SigListXML format.
#				$catListXML:	The list of target categories for the package, encapsulated in SigListXML format.
#
# Returns:		$tgtHostList:		A space-separated list of the target agents
#				$tgtHostDirsList:	An XML representation of the targetHostDirs array.
#
################################################################################
sub GetTargetAgentsAndDirs($$$$;$$)
{
	my $jobId = $_[0];
	my $pkgId = $_[1];
	my $userList = $_[2];
	my $catListXML = $_[3];
	my $additionalAgents = $_[4];
	my $additionalAgentsFolder = $_[5];

	main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: GetTargetAgentsAndDirs",main::LOGDEBUG);

	my $listType;

	my @targetHosts; 		# An array of the target agents.
	my @targetHostDirs;		# An array of hashes mapping each host to its target directory:
						#  {&apos;agent&apos;} == Agent Host
						#  {&apos;dir&apos;} == Target Directory on Agent Host

	my $tgtHostList;
	my $tgtHostDirsList;

	my @TgtUserArray = ();
	my @TgtCategoryArray = ();
	my @Elements = ();

	my @additionalTargetHosts = split(&apos; &apos;,$additionalAgents);
	
	if ($userList ne "")
	{
		@TgtUserArray = ResolveRecipientInput($userList);
		if (scalar(@TgtUserArray) == 0 ){
			main::SigPrintLog("Error resolving recipient list",main::LOGERROR);
			$PackageRC =1;
			return;
		}
		main::SigPrintLog("Target users: [" . join(";",@TgtUserArray) . "]",main::LOGDEBUG);
	}

	if ($catListXML ne "")
	{
		#
		# Parse the Category List XML input...
		#
		if (main::SigListXMLParse($catListXML,\$listType,\@Elements) != 0)
		{
			main::SigPrintLog("ERROR: Category list XML specification is not parsable",main::LOGERROR);
			$PackageRC = 1;
			return;
		}

		@TgtCategoryArray = main::SigListGetELementsByAttribute(\@Elements,"FQN");

		main::SigPrintLog("Target categories: [" . main::SigEscapeXML(join(";",@TgtCategoryArray)) . "]",main::LOGDEBUG);
	}

	#
	# Create the soap handle...
	#
	my $SOAPHANDLE = GetSoapHandle();

	#
	# Define soap data objects for each argument for the getDestinations web service call
	#
	my $jobIdObj = SOAP::Data-&gt;new(name =&gt; &apos;jobId&apos;, value =&gt; $jobId, type =&gt; &apos;xs:string&apos;);
	my $pkgIdObj = SOAP::Data-&gt;new(name =&gt; &apos;packageId&apos;, value =&gt; $pkgId, type =&gt; &apos;xs:long&apos;);

	my @userObj;

	for (my $i=0; $i &lt; scalar(@TgtUserArray); $i++)
	{
		$TgtUserArray[$i]=main::GetUtf8String(main::SigEscapeXML($TgtUserArray[$i]));
		$userObj[$i] = SOAP::Data-&gt;new(name =&gt; &apos;userAndGroupNames&apos;, value =&gt; $TgtUserArray[$i], type =&gt; &apos;xs:string&apos;);
	}

	my @catObj;

	for (my $i=0; $i &lt; scalar(@TgtCategoryArray); $i++)
	{
		$TgtCategoryArray[$i]=main::GetUtf8String(main::SigEscapeXML($TgtCategoryArray[$i]));
		$catObj[$i] = SOAP::Data-&gt;new(name =&gt; &apos;categoryNames&apos;, value =&gt; $TgtCategoryArray[$i], type =&gt; &apos;xs:string&apos;);
	}

	if ((scalar(@TgtUserArray) &gt; 0) || (scalar(@TgtCategoryArray) &gt; 0))
	{
		#
		# Issue SOAP request to getDestinationsweb service.
		#
		# Note: if the package is not found (does not exist) an exception fault is returned.
		#
		eval
		{
			#
			# Call web service to get the list of target agents and directories...
			#
			my $RESULT = $SOAPHANDLE-&gt;getDestinations($jobIdObj,$pkgIdObj,@userObj,@catObj);

			if (defined($RESULT))
			{
				if ($RESULT-&gt;fault)
				{
					main::SigPrintLog("ERROR: getDestinations web service call: SOAP call fault.",main::LOGERROR);
					ShowSoapFault($RESULT);
					$PackageRC=1;
				}
				else
				{
					my $Data = $RESULT-&gt;valueof(&apos;//getDestinationsResponse&apos;);

					# print "%dds_msg_info%\"getDestinations\" web service response...", Dumper($Data);

					if (defined($Data) &amp;&amp; (ref($Data) eq "HASH")) # If $Data isn&apos;t a hash, we haven&apos;t received any data
					{
						#
						# $Data-&gt;{&apos;return&apos;} will either be a hash (in the case of a single destination - which could have aliases)
						# or an array of hashes (in the case of multiple destinations).
						#
						if (ref($Data-&gt;{&apos;return&apos;}) eq "HASH")
						{
							my $agentName = $Data-&gt;{&apos;return&apos;}-&gt;{&apos;agent&apos;}-&gt;{&apos;agentName&apos;};

							if (lc($Data-&gt;{&apos;return&apos;}-&gt;{&apos;agent&apos;}-&gt;{&apos;nodeType&apos;}) eq "group")
							{
								if (defined($Data-&gt;{&apos;return&apos;}-&gt;{&apos;agent&apos;}-&gt;{&apos;organization&apos;}-&gt;{&apos;id&apos;}))
								{
									my $orgId = $Data-&gt;{&apos;return&apos;}-&gt;{&apos;agent&apos;}-&gt;{&apos;organization&apos;}-&gt;{&apos;id&apos;};
									$agentName = $agentName . "!" . $orgId;
								}

							}

							push(@targetHosts,$agentName);

							my $agentDirectory =  $Data-&gt;{&apos;return&apos;}-&gt;{&apos;serverPath&apos;};
							my $removeIdDirectory = "false";

							if (defined($Data-&gt;{&apos;return&apos;}-&gt;{&apos;createPackageDirectory&apos;}))
							{
								if ($Data-&gt;{&apos;return&apos;}-&gt;{&apos;createPackageDirectory&apos;} eq "false")
								{
									$removeIdDirectory = "true";
								}
							}

							push(@targetHostDirs,{AGENT =&gt; $agentName, DIR =&gt; $agentDirectory, REMOVE_ID_DIR =&gt; $removeIdDirectory});

							if (defined($Data-&gt;{&apos;return&apos;}-&gt;{&apos;aliasMembers&apos;}))
							{
								#
								# Now get all of  the aliases in order to set their agent/directory mappings...
								#
								if (ref($Data-&gt;{&apos;return&apos;}-&gt;{&apos;aliasMembers&apos;}) eq "HASH")
								{
									#
									# Alias resolves to a single host...
									#
									if (defined($Data-&gt;{&apos;return&apos;}-&gt;{&apos;aliasMembers&apos;}-&gt;{&apos;agentName&apos;}) &amp;&amp; ($Data-&gt;{&apos;return&apos;}-&gt;{&apos;aliasMembers&apos;}-&gt;{&apos;agentName&apos;} ne ""))
									{
										push(@targetHostDirs,{AGENT =&gt; $Data-&gt;{&apos;return&apos;}-&gt;{&apos;aliasMembers&apos;}-&gt;{&apos;agentName&apos;}, DIR =&gt; $Data-&gt;{&apos;return&apos;}-&gt;{&apos;serverPath&apos;}, REMOVE_ID_DIR =&gt; $removeIdDirectory});
									}
								}
								else
								{
									#
									# Alias resolves to multiple hosts...
									#
									for (my $j=0; $j &lt; scalar($Data-&gt;{&apos;return&apos;}-&gt;{&apos;aliasMembers&apos;}); $j++)
									{
										if (!defined($Data-&gt;{&apos;return&apos;}-&gt;{&apos;aliasMembers&apos;}[$j]))
										{
											last; # The scalar function isn&apos;t returning the length properly
										}
										else
										{
											if (defined($Data-&gt;{&apos;return&apos;}-&gt;{&apos;aliasMembers&apos;}[$j]-&gt;{&apos;agentName&apos;}) &amp;&amp; ($Data-&gt;{&apos;return&apos;}-&gt;{&apos;aliasMembers&apos;}[$j]-&gt;{&apos;agentName&apos;} ne ""))
											{
												push(@targetHostDirs,{AGENT =&gt; $Data-&gt;{&apos;return&apos;}-&gt;{&apos;aliasMembers&apos;}[$j]-&gt;{&apos;agentName&apos;}, DIR =&gt; $Data-&gt;{&apos;return&apos;}-&gt;{&apos;serverPath&apos;}, REMOVE_ID_DIR =&gt; $removeIdDirectory});
											}
										}
									}
								}
							}
						}
						else # ARRAY
						{
							for (my $i=0; $i &lt; scalar($Data-&gt;{&apos;return&apos;}); $i++)
							{
								#
								# The scalar(...) loop condition above can&apos;t be relied on for arrays
								# returned by the SOAP call, so we will exit the loop as soon as we see
								# the first undefined element. Failure to do this can crash the system.
								#
								if (!defined($Data-&gt;{&apos;return&apos;}[$i]))
								{
									last;
								}

								my $agentName = $Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;agent&apos;}-&gt;{&apos;agentName&apos;};

								if (lc($Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;agent&apos;}-&gt;{&apos;nodeType&apos;}) eq "group")
								{
									if (defined($Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;agent&apos;}-&gt;{&apos;organization&apos;}-&gt;{&apos;id&apos;}))
									{
										my $orgId = $Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;agent&apos;}-&gt;{&apos;organization&apos;}-&gt;{&apos;id&apos;};
										$agentName = $agentName . "!" . $orgId;
									}
								}

								push(@targetHosts,$agentName);

								my $agentDirectory =  $Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;serverPath&apos;};
								my $removeIdDirectory = "false";

								if (defined($Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;createPackageDirectory&apos;}))
								{
									if ($Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;createPackageDirectory&apos;} eq "false")
									{
										$removeIdDirectory = "true";
									}
								}

								push(@targetHostDirs,{AGENT =&gt; $agentName, DIR =&gt; $agentDirectory, REMOVE_ID_DIR =&gt; $removeIdDirectory});

								if (defined($Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;aliasMembers&apos;}))
								{
									#
									# Now get all of  the aliases in order to set their agent/directory mappings...
									#
									if (ref($Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;aliasMembers&apos;}) eq "HASH")
									{
										#
										# Alias resolves to a single host...
										#
										if (defined($Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;aliasMembers&apos;}-&gt;{&apos;agentName&apos;}) &amp;&amp; ($Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;aliasMembers&apos;}-&gt;{&apos;agentName&apos;} ne ""))
										{
											push(@targetHostDirs,{AGENT =&gt; $Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;aliasMembers&apos;}-&gt;{&apos;agentName&apos;}, DIR =&gt; $Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;serverPath&apos;}, REMOVE_ID_DIR =&gt; $removeIdDirectory});
										}
									}
									else
									{
										#
										# Alias resolves to multiple hosts...
										#
										for (my $j=0; $j &lt; scalar($Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;aliasMembers&apos;}); $j++)
										{
											if (!defined($Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;aliasMembers&apos;}[$j]))
											{
												last; # The scalar function isn&apos;t returning the length properly
											}
											else
											{
												if (defined($Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;aliasMembers&apos;}[$j]-&gt;{&apos;agentName&apos;}) &amp;&amp; ($Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;aliasMembers&apos;}[$j]-&gt;{&apos;agentName&apos;} ne ""))
												{
													push (@targetHostDirs,{AGENT =&gt; $Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;aliasMembers&apos;}[$j]-&gt;{&apos;agentName&apos;}, DIR =&gt; $Data-&gt;{&apos;return&apos;}[$i]-&gt;{&apos;serverPath&apos;}, REMOVE_ID_DIR =&gt; $removeIdDirectory});
												}
											}
										}
									}
								}
							}
						}

						for (my $i=0; $i &lt; scalar(@targetHosts); $i++)
						{
							main::SigPrintLog("Target Agent: [" . $targetHosts[$i] . "]",main::LOGDEBUG);
						}

						for (my $i=0; $i &lt; scalar(@targetHostDirs); $i++)
						{
							main::SigPrintLog("Agent : [" . $targetHostDirs[$i]{&apos;AGENT&apos;} . "] - Repository : [" . $targetHostDirs[$i]{&apos;DIR&apos;} . "] - Remove ID Directory : [" . $targetHostDirs[$i]{&apos;REMOVE_ID_DIR&apos;} . "]",main::LOGDEBUG);
						}
					}
					else
					{
						main::SigPrintLog("ERROR: Failed to get any destinations in getDestinations web service call.",main::LOGERROR);
						ShowSoapFault($RESULT);
						$PackageRC=1;
					}
				}
			}
			else
			{
				main::SigPrintLog("ERROR: getDestinations web service call - contents of soap request returned is undefined.",main::LOGERROR);
				$PackageRC=1;
			}

		};
	}
	
	if ($@)
	{
		main::SigPrintLog("ERROR: getDestinations web service call: $@",main::LOGERROR);
		$PackageRC=1;
	}

	foreach my $additionalTargetHost(@additionalTargetHosts)
	{
		if ($additionalTargetHost ne "" )
		{
			push(@targetHosts,$additionalTargetHost);
			push(@targetHostDirs,{AGENT =&gt; $additionalTargetHost, DIR =&gt; $additionalAgentsFolder, REMOVE_ID_DIR =&gt; 0});	
		}
	}

	# 
	# Remove duplicate entries from the lists...
	#
	my @uniqueArray = ();
	
	for (my $i=0; $i &lt; scalar(@targetHosts); $i++)
	{
		my $MatchFound=FALSE;

		for (my $j=$i+1; $j &lt; scalar(@targetHosts); $j++)
		{
			if ($targetHosts[$i] eq $targetHosts[$j])
			{
				$MatchFound=TRUE;
				last;
			}
		}

		if (!$MatchFound)
		{
			push(@uniqueArray, $targetHosts[$i]);
		}
	}	
	
	@targetHosts = @uniqueArray;
	
	@uniqueArray = ();
	
	for (my $i=0; $i &lt; scalar(@targetHostDirs); $i++)
	{
		my $MatchFound=FALSE;

		for (my $j=$i+1; $j &lt; scalar(@targetHostDirs); $j++)
		{
			if (($targetHostDirs[$i]{&apos;AGENT&apos;} eq $targetHostDirs[$j]{&apos;AGENT&apos;}) &amp;&amp; 
			    ($targetHostDirs[$i]{&apos;DIR&apos;}   eq $targetHostDirs[$j]{&apos;DIR&apos;}))
			{
				$MatchFound=TRUE;
				last;
			}
		}

		if (!$MatchFound)
		{
			push(@uniqueArray, $targetHostDirs[$i]);
		}
	}	
	
	@targetHostDirs = @uniqueArray;

	$tgtHostList = join(" ",@targetHosts);
	main::SigListXMLCreate ($tgtHostDirsList, "OTHER", \@targetHostDirs);

	main::SigPrintLog("&lt;&lt;&lt; Leaving subroutine: GetTargetAgentsAndDirs",main::LOGDEBUG);

	return($tgtHostList,$tgtHostDirsList);
}


################################################################################
#
# Routine:		GetMapSpecialChars()
#
# Description:	Retrieves the "Media Exchange map special characters" system setting.
#
# Parameters:	None
#
# Returns:		true (setting is enabled), false (setting is disabled), 1 (a fault or otherwise unexpected condition).
#
################################################################################
sub GetMapSpecialChars(%)
{
	my $RC;
	main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: GetMapSpecialChars",main::LOGDEBUG);

	#
	# create a soap handle ...
	#
	my $SOAPHANDLE = GetSoapHandle();

	#
	# define the argument value and type for the package ID parameter
	#
	my $obj = SOAP::Data-&gt;new();

	#
	# issue SOAP request to getMxMapSpecialChars web service
	#

	eval
	{
		my $RESULT = $SOAPHANDLE -&gt; getMxMapSpecialChars($obj);

		if (defined($RESULT))
		{
			if ($RESULT-&gt;fault)
			{
				main::SigPrintLog("ERROR: getMxMapSpecialChars web service call: SOAP call fault.",main::LOGERROR);
				ShowSoapFault( $RESULT );
				$RC=1;
			}
			else
			{
				my $DATA = $RESULT-&gt;valueof(&apos;//getMxMapSpecialCharsResponse/return&apos;) ;
				if ( $DATA =~ m/true/ ) {
					$RC = &apos;true&apos;;
				} elsif ( $DATA =~ m/false/ ) {
					$RC = &apos;false&apos;;
				} else {
					$RC = 1;
				}
			}
		}
		else
		{
			main::SigPrintLog("ERROR: getMxMapSpecialChars web service call: Contents of SOAP request returned is undefined.",main::LOGERROR);
			$RC=1;
		}
	};

	if ($@)
	{
		main::SigPrintLog("ERROR: getMxMapSpecialChars web service call: $@",main::LOGERROR);
		$RC=1;
	}

	main::SigPrintLog("&lt;&lt;&lt; Leaving subroutine: GetMapSpecialChars",main::LOGDEBUG);

	return($RC);
}



################################################################################
#
# Routine: 		ResolveRecipientInput()
#
# Description:	Resolve user input from recipient prompt between xml or comma
#			separated list of usernames and/or emails
#
# Parameters:	recipientList (XML or comma-separated)
#
# Returns:		UserIdList (array)
#
################################################################################
sub ResolveRecipientInput($)
{
    my $recipientList = $_[0];
    my @UserIdList = ();

	if (main::IsSigListXmlFormat($recipientList))
	{
		my @Elements=();
		my $listType;

		if (main::SigListXMLParse($recipientList,\$listType,\@Elements) == 0)
		{
			@UserIdList = main::SigListGetELementsByAttribute(\@Elements,"USERNAME");
		}
		else
		{
			main::SigPrintLog("ERROR: User list XML specification is not parsable",main::LOGERROR);
		}
	}
	else
	{
		my @IdList = split(/;/,$recipientList);

		foreach my $id (@IdList)
		{
			if ($id ne "" )
			{
				push @UserIdList, $id;
			}
		}
	}

	return @UserIdList;
}

################################################################################
#
# Routine:		ConvertTimeForSoap()
#
# Description:	Converts a time string in the format passed by the Date/Time
#			picker, to the format required by the XML "datetime" type
#			used in SOAP calls.
#
# Parameters:	$dateTime	- The date/time input string.
#
# Returns:		$dateTime	- The reformatted date/time string.
#
################################################################################
sub ConvertTimeForSoap($)
{
	my ($dateTime) = @_;

	$dateTime =~ s/\//-/g;
	$dateTime =~ s/ /T/g;

	return($dateTime);
}

################################################################################
#
# Routine:		GetSoapHandle()
#
# Description:	Creates and returns a SOAP handle to be used for MX web services.
#
# Parameters:	(none)
#
# Returns:		$SH: The SOAP handle object.
#
################################################################################
sub GetSoapHandle()
{
	my $SoapServer = @_[0];
	my $SoapPort   = @_[1];

	$SoapServer = "localhost" if ($SoapServer eq "");
	$SoapPort   = "80"        if ($SoapPort   eq "");

	main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: GetSoapHandle",main::LOGDEBUG);

	my $SH = SOAP::Lite
		-&gt; proxy("http://$SoapServer:$SoapPort/signiant_web_services/MxPackageService", timeout =&gt; 3600)
		-&gt; uri(&apos;http://signiant.com/web/services&apos;)
		-&gt; ns(&apos;http://signiant.com/web/services&apos;)
		-&gt; readable(1);
	#	-&gt; on_action(sub{sprintf &apos;%s/%s&apos;, @_ });

	   $SH-&gt;serializer()-&gt;register_ns( &apos;http://www.w3.org/2001/XMLSchema&apos;, &apos;xs&apos; );

	main::SigPrintLog("&lt;&lt;&lt; Leaving subroutine: GetSoapHandle",main::LOGDEBUG);

	return($SH);
}

################################################################################
#
# Routine:		ShowSoapFault()
#
# Description:	Prints out some detailed information related to a SOAP fault.
#
# Parameters:	soapResult
#
# Returns:		(none)
#
################################################################################
sub ShowSoapFault
{
	my($soapResult) = @_;

	main::SigPrintLog("&gt;&gt;&gt; Entering subroutine: ShowSoapFault",main::LOGDEBUG);

	my $err = "Fault Code: " . $soapResult-&gt;faultcode;
	main::SigPrintLog("$err",main::LOGERROR);
	my $err = "Fault String: " . $soapResult-&gt;faultstring;
	main::SigPrintLog("$err",main::LOGERROR);

	# The fault detail can point to a string or a hash so use the dumper function...
	main::SigPrintLog("Fault Detail: " . Dumper($soapResult-&gt;faultdetail),main::LOGERROR);

	main::SigPrintLog("&lt;&lt;&lt; Leaving subroutine: ShowSoapFault",main::LOGDEBUG);
}

} # End Package</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SigniantSchedulerService">package SigniantSchedulerService; {

#
# Sample setup/usage:
#
# 	my $ddsHome = "/usr/signiant/dds";
#
# 	require "$ddsHome/bin/SchedulerService.pl";
# 	use SOAP::Lite;
#
# 	my $schedSoapCalls = eval{new SchedulerService();} or die ($@);
# 	$schedSoapCalls-&gt;setup("https://myserver/signiant", "admin", "password");
#
# 	$schedSoapCalls-&gt;jobAction("default", "MyJob", "kill");
#
# With all subroutines that return a return code, a zero indicates success, non-zero for failure.
#
# Details of a fault/failure can be retrieved from $object-&gt;lastError().
#

#
# Constructor
#
sub new {
    my ($class) = @_;
    my $self = {
        _baseUrl =&gt; undef,
        _username =&gt; undef,
        _password =&gt; undef,
        _soapCall =&gt; undef,
        _lastError =&gt; undef
    };
    bless $self, $class;
    return $self;
}

#
# General setup
#
sub setup {
    my ( $self, $baseUrl, $username, $password ) = @_;
	if($baseUrl !~ /\/$/){
		$baseUrl .= "/";
	}#if
	$self-&gt;baseUrl($baseUrl);
	$self-&gt;username($username);
	$self-&gt;password($password);
	$self-&gt;soapCall(SOAP::Lite -&gt; proxy($baseUrl . "services/SchedulerService") -&gt; uri("")) -&gt; on_action(sub{sprintf &apos;%s/%s&apos;, @_ });
	$self-&gt;lastError(" ");
    return "ok";
}

#
# commandForJob($jobGroup, $jobName, $action) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : $action - the function/action to perform (delete, force, kill, suspend, resume, setbwlimits_#:#:#)
#
# 	Returns ($rc)
#
# 	"commandForJob" is an interface for a variety of job management functions. All of these functions can be set by
# 	either secondary native SOAP calls and/or other perl subroutines within this library.
#
# 	delete - see removeJob()
# 	force - see startJob()
# 	kill - see stopJob()
# 	resume - resumeJobSchedule()
# 	suspend - suspendJobSchedule()
# 	setbwlimits_#:#:# - see setBandwidthLimit(), setBandwidthCeiling(), setBandwidthFloor(), setBandwidthLimits()
#
sub commandForJob{
	my ($self, $jobGroup, $jobName, $action) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; commandForJob($self-&gt;username, $self-&gt;password, $jobName, $jobGroup, $action);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1);
	}#if

	return($soapResult -&gt; result());
}#sub

#
# setBandwidthLimit($jobGroup, $jobName, $bwLimit) - abstracted call to commandForJob
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : $bwLimit - bandwidth limit in bytes per second
#
# 	returns ($rc)
#
# 	Same as commandForJob("setbwlimits_#::")
#
sub setBandwidthLimit{
	my ($self, $jobGroup, $jobName, $bwLimit) = @_;
	return(commandForJob($self, $jobGroup, $jobName, "setbwlimits_$bwLimit::"));
}#sub

#
# setBandwidthCeiling($jobGroup, $jobName, $bwCeiling) - abstracted call to commandForJob
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : $bwCeiling - bandwidth ceiling in bytes per second
#
# 	returns ($rc)
#
# 	Same as commandForJob("setbwlimits_::#")
#
sub setBandwidthCeiling{
	my ($self, $jobGroup, $jobName, $bwCeiling) = @_;
	return(commandForJob($self, $jobGroup, $jobName, "setbwlimits_::$bwCeiling"));
}#sub

#
# setBandwidthFloor($jobGroup, $jobName, $bwFloor) - abstracted call to commandForJob
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : $bwFloor - bandwidth floor in bytes per second
#
# 	returns ($rc)
#
# 	Same as commandForJob("setbwlimits_:#:")
#
sub setBandwidthFloor
{
    my ($self, $jobGroup, $jobName, $bwFloor) = @_;
    return(commandForJob($self, $jobGroup, $jobName, "setbwlimits_:$bwFloor:"));
}#sub

#
# setBandwidthLimits($jobGroup, $jobName, bwLimit, bwFloor, bwCeiling) - abstracted call to commandForJob
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : $bwLimit - bandwidth limit in bytes per second
# 	Argument : $bwFloor - bandwidth floor in bytes per second
# 	Argument : $bwCeiling - bandwidth ceiling in bytes per second
#
# 	returns ($rc)
#
# 	Same as commandForJob("setbwlimits_#:#:#")
#
sub setBandwidthLimits{
	my ($self, $jobGroup, $jobName, $bwLimit, $bwFloor, $bwCeiling) = @_;
	return(commandForJob($self, $jobGroup, $jobName, "setbwlimits_$bwLimit:$bwFloor:$bwCeiling"));
}#sub

#
# startJob($jobGroup, $jobName) - abstracted call to commandForJob
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
#
# 	returns ($rc)
#
# 	Start a non-running job.
# 	Same as commandForJob("force")
#
sub startJob{
	my ($self, $jobGroup, $jobName) = @_;
	return(commandForJob($self, $jobGroup, $jobName, "force"));
}#sub

#
# stopJob($jobGroup, $jobName) - abstracted call to commandForJob
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
#
# 	returns ($rc)
#
# 	Stop a running job.
# 	Same as commandForJob("kill")
#
sub stopJob{
	my ($self, $jobGroup, $jobName) = @_;
	return(commandForJob($self, $jobGroup, $jobName, "kill"));
}#sub

#
# suspendJobSchedule($jobGroup, $jobName) - abstracted call to commandForJob
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
#
# 	returns ($rc)
#
# 	Suspend a job&apos;s run schedule.
# 	Same as commandForJob("suspend")
sub suspendJobSchedule{
	my ($self, $jobGroup, $jobName) = @_;
	return(commandForJob($self, $jobGroup, $jobName, "suspend"));
}#sub

#
# resumeJobSchedule($jobGroup, $jobName) - abstracted call to commandForJob
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
#
# 	returns ($rc)
#
# 	Resumes a job&apos;s run schedule.
# 	Same as commandForJob("resume")
#
sub resumeJobSchedule{
	my ($self, $jobGroup, $jobName) = @_;
	return(commandForJob($self, $jobGroup, $jobName, "resume"));
}#sub

#
# newJob($jobGroup, $jobName, $jobTemplateLibrary, $jobTemplate) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : $jobTemplateLibrary - name of the job template library that contains the job template being scheduled
# 	Argument : $jobTemplate - the job template being scheduled
#
# 	returns ($rc)
#
# 	The same as shortCreateJob, but without any variables and a fixed timezone (UTC).
#
sub newJob{
	my ($self, $jobGroup, $jobName, $jobTemplateLibrary, $jobTemplate) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; newJob($self-&gt;username, $self-&gt;password, $jobGroup, $jobName, $jobTemplateLibrary, $jobTemplate);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1);
	}#if

	return($soapResult -&gt; result());
}#sub

#
# getActiveStatusMsg($jobGroup, $jobName) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
#
# 	Returns ($rc, $statusMessage)
#
# 	Retrieve the active status message (custom message from a solution) from either the current running instance of
# 	this job or the last message from the most recent run of a job.
#
sub getActiveStatusMsg {
	my ($self, $jobGroup, $jobName) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; getActiveStatusMsg($self-&gt;username, $self-&gt;password, $jobName, $jobGroup);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# getActiveFilename($jobGroup, $jobName) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
#
# 	Returns ($rc, $fileName)
#
# 	Retrieve the file currently being processed from the current running instance of
# 	this job
#
sub getActiveFilename {
	my ($self, $jobGroup, $jobName) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; getActiveFilename($self-&gt;username, $self-&gt;password, $jobName, $jobGroup);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# getLastJobResult($jobGroup, $jobName) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
#
# 	returns ($rc, $exitCode)
#
# 	Retrieve the overall job exit code (generally zero for success and non-zero for failure) from the most recent
# 	run of a job.
#
sub getLastJobResult {
	my ($self, $jobGroup, $jobName) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; getLastJobResult($self-&gt;username, $self-&gt;password, $jobName, $jobGroup);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, 0);
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# getJobStatus($jobGroup, $jobName) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
#
# 	returns ($rc, $state)
#
# 	Get a job&apos;s current active (RUNNING, IDLE) and scheduled (DORMANT, SUSPENDED) state. Separates the two with a plus
# 	(+) sign.
#
sub getJobStatus {
	my ($self, $jobGroup, $jobName) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; getJobStatus($self-&gt;username, $self-&gt;password, $jobName, $jobGroup);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# getJobActiveState($jobGroup, $jobName) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
#
# 	returns ($rc, $state)
#
# 	Get a job&apos;s active state (RUNNING, IDLE).
#
sub getJobActiveState{
	my ($self, $jobGroup, $jobName) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; getJobActiveState($self-&gt;username, $self-&gt;password, $jobName, $jobGroup);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# getJobScheduledState($jobGroup, $jobName) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
#
# 	returns ($rc, $state)
#
# 	Get a job&apos;s scheduled state (DORMANT, SUSPENDED).
#
sub getJobScheduledState {
	my ($self, $jobGroup, $jobName) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; getJobScheduledState($self-&gt;username, $self-&gt;password, $jobName, $jobGroup);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# listJobs($jobGroup) - native SOAP call
# 	Argument : $jobGroup - name of the job group
#
# 	returns ($rc, @jobs)
#
# 	Returns a list of job names from a job group.
#
sub listJobs{
	my ($self, $jobGroup) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; listJobs($self-&gt;username, $self-&gt;password, $jobGroup);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1);
	}else{
		my @jobs = split /,/, $soapResult-&gt;result;

		for(my $i = 0; $i &lt; scalar(@jobs); $i++){
			$jobs[$i] =~ s/^\s*//g; #trim start
			$jobs[$i] =~ s/\s*$//g; #trim end
		}#foreach

		return(0, @jobs);
	}#if
}#sub

#
# listGroups() - native SOAP call
# 	Argument : none
#
# 	returns ($rc, %groupInfo) where groupInfo is a hash of groupName =&gt; ContractID
#
# 	Returns a list of group names and contractIDs.
#
sub listGroups{
	my ($self) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; listGroups($self-&gt;username, $self-&gt;password);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1);
	}else{
		return(0, $soapResult-&gt;result);
	}#if
}#sub

#
# listResourceControlQueue($username, $password, $resourceControlName) - native SOAP call
# 	Argument : $username - username for the user calling this method
# 	Argument : $password - password for the user calling this method
# 	Argument : $resourceControlName - name of the resource control
#
# 	returns ($rc, %allQueuedJobsInfo)
# 
# 	Returns a hash of all queued jobs along with certain properties of those jobs
#
sub listResourceControlQueue {
	my ($self, $username, $password, $resourceControlName) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; listResourceControlQueue($self-&gt;username, $self-&gt;password, $resourceControlName);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# listResourceControls() - native SOAP call
#
# 	returns ($rc, %resourceControls)
# 
# 	Returns a hash of all resource controls ($resourceControlName,$resourceControlID)
#
sub listResourceControls {
	my ($self, $username, $password) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; listResourceControls($self-&gt;username, $self-&gt;password);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# listResourcesForJob($username, $password, $jobName, $jobGroupName) - native SOAP call
# 	Argument : $username - username for the user calling this method
# 	Argument : $password - password for the user calling this method
# 	Argument : $jobName - name of the job
# 	Argument : $jobGroupName - name of the job group
#
# 	returns ($rc, %queuedJobInfo)
# 
# 	Returns hash with certain job parameters and the agent resouce controls that apply for that job
#
sub listResourcesForJob {
	my ($self, $username, $password, $jobName, $jobGroupName) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; listResourcesForJob($self-&gt;username, $self-&gt;password, $jobName, $jobGroupName);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# modifyJobPriority($username, $password, $jobGroupName, $jobName, $priority) - native SOAP call
# 	Argument : $username - username for the user calling this method
# 	Argument : $password - password for the user calling this method
# 	Argument : $jobGroupName - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : $priority - priority for the job: Low, Medium, High, Urgent, Immediate
#
# 	returns ($rc)
# 
# 	Set priority for a given job.
#
sub modifyJobPriority {
	my ($self, $username, $password, $jobGroupName, $jobName, $priority) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; modifyJobPriority($self-&gt;username, $self-&gt;password, $jobGroupName, $jobName, $priority);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# moveJobInResourceQueue($username, $password, $consumerId, $offset) - native SOAP call
# 	Argument : $username - username for the user calling this method
# 	Argument : $password - password for the user calling this method
# 	Argument : $consumerId - id of the consumer
# 	Argument : $offset - Position in the queue on which the job will be moved
#
# 	returns ($rc)
# 
# 	Move jobs that have certain consumer id in the queue by some offset
#
sub moveJobInResourceQueue {
	my ($self, $username, $password, $consumerId, $offset) = @_;
	my $consumerId_value = SOAP::Data-&gt;new(name =&gt; &apos;consumerId&apos;, value =&gt; $consumerId, type =&gt; &apos;xsd:long&apos;);

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; moveJobInResourceQueue($self-&gt;username, $self-&gt;password, $consumerId_value, $offset);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# addJobVariable($username, $password, $jobGroupName, $jobName, $name, $value) - native SOAP call
# 	Argument : $username - username for the user calling this method
# 	Argument : $password - password for the user calling this method
# 	Argument : $jobGroupName - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : $name - name that will be mapped to the value of the variable
# 	Argument : $value - value that will be mapped to the name of the variable
#
# 	returns ($rc)
# 
# 	Add a custom job variable
#
sub addJobVariable {
	my ($self, $username, $password, $jobGroupName, $jobName, $name, $value) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; addJobVariable($self-&gt;username, $self-&gt;password, $jobGroupName, $jobName, $name, $value);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# moveJobInQueue($username, $password, $jobGroupName, $jobName, $offset) - native SOAP call
# 	Argument : $jobName - name of the job
# 	Argument : $jobGroupName - name of the job group
# 	Argument : $offset - Position in the queue on which the job will be moved relative to its current position
# 
# 	returns ($rc)
# 
# 	Push a job on a position in the queue relative to its current position
#
sub moveJobInQueue {
	my ($self, $username, $password, $jobGroupName, $jobName, $offset) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; moveJobInQueue($self-&gt;username, $self-&gt;password, $jobGroupName, $jobName, $offset);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# newJobGroup() - native SOAP call
# 	Argument : jobGroupName
#
# 	returns ($rc, $jobGroupID)
# 
# 	Creates a new job group and returns the ID of the created job group
#	If the job group already exists the ID of the existing group is returned
#
sub newJobGroup{
	my ($self, $jobGroupName) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; newJobGroup($self-&gt;username, $self-&gt;password, $jobGroupName);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1);
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# getJobGroupId($username, $password, $groupName) - native SOAP call
# 	Argument : $username - username for the user calling this method
# 	Argument : $password - password for the user calling this method
# 	Argument : $groupName - name of the group
# 
# 	returns ($rc, $jobGroupID)
# 
# 	Returns the int id for the given job group.
#
sub getJobGroupId {
	my ($self, $username, $password, $groupName) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; getJobGroupId($self-&gt;username, $self-&gt;password, $groupName);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# listQueuedJobs($username, $password, $groupName) - native SOAP call
# 	Argument : $username - username for the user calling this method
# 	Argument : $password - password for the user calling this method
# 	Argument : $groupName - name of the group
# 
# 	returns ($rc, @queuedJobs)
# 
# 	Returns a list of queued jobs
#
sub listQueuedJobs {
	my ($self, $username, $password, $groupName) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; listQueuedJobs($self-&gt;username, $self-&gt;password, $groupName);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# getJobInfo($jobName, $jobGroupName) - native SOAP call
# 	Argument : $jobName - name of the job
# 	Argument : $jobGroupName - name of the job group
#
# 	returns ($rc, $jobName, $jobGroup, $jtlName, $jobTemplateName, $timeZone, %variables) 
#      where %variables contains an array of hashes for other variables
#
sub getJobInfo{
	my ($self,$job,$group) = @_;
        my %variables = ();

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; getJobInfo($self-&gt;username, $self-&gt;password,$job,$group);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1);
	} else {
		my $jobInfo = $soapResult-&gt;result;

		my $jobName             = $jobInfo-&gt;{&apos;jobName&apos;};
		my $jobGroup            = $jobInfo-&gt;{&apos;jobGroup&apos;};
		my $jtlName             = $jobInfo-&gt;{&apos;jobTemplateLibraryName&apos;};
		my $jobTemplateName     = $jobInfo-&gt;{&apos;jobTemplateName&apos;};
		my $timeZone            = $jobInfo-&gt;{&apos;timeZone&apos;};

		delete $jobInfo-&gt;{&apos;jobName&apos;};
		delete $jobInfo-&gt;{&apos;jobGroup&apos;};
		delete $jobInfo-&gt;{&apos;jobTemplateLibraryName&apos;};
		delete $jobInfo-&gt;{&apos;jobTemplateName&apos;};
		delete $jobInfo-&gt;{&apos;timeZone&apos;};

		return(0, $jobName, $jobGroup, $jtlName, $jobTemplateName, $timeZone, $jobInfo);
        }
}#sub

#
# runJob($jobGroup, $jobName, $timeout) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : $timeout - time (in seconds) that the job will be monitored after it&apos;s started.
#
# 	returns ($rc)
#
# 	Starts job (commandForJob("force")) and monitors it (every half second) until the timeout expires.
#
sub runJob {
	my ($self, $jobGroup, $jobName, $timeout) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; runJob($self-&gt;username, $self-&gt;password, $jobName, $jobGroup, $timeout);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1);
	}#if

	return($soapResult -&gt; result());
}#sub

#
# removeJob($jobGroup, $jobName) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
#
# 	returns ($rc)
#
# 	Same as commandForJob("delete")
#
sub removeJob {
	my ($self, $jobGroup, $jobName) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; removeJob($self-&gt;username, $self-&gt;password, $jobName, $jobGroup);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1);
	}#if

	return($soapResult -&gt; result());
}#sub

#
# setJobVariables($jobGroup, $jobName, %varValues) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : %varValues - hash of the variable values
#
# 	returns ($rc)
#
# 	Set the variables that have been passed in via varValues.  Does not remove any other variables that might also have
# 	been set prior to this call.
#
sub setJobVariables {
	my ($self, $jobGroup, $jobName, %varValues) = @_;

	my @varNamesArr = ();
	my @varValuesArr = ();
	foreach my $varName (keys %varValues){
		push @varNamesArr, SOAP::Data-&gt;type(string =&gt; $varName);
		push @varValuesArr, SOAP::Data-&gt;type(string =&gt; $varValues{$varName});
	}#for

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; setJobVariables($self-&gt;username, $self-&gt;password, $jobGroup, $jobName,
			SOAP::Data-&gt;name("variables" =&gt; \SOAP::Data-&gt;value(@varNamesArr)),
			SOAP::Data-&gt;name("variablesValues" =&gt; \SOAP::Data-&gt;value(@varValuesArr)));

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1);
	}#if

	return($soapResult -&gt; result());
}#sub

#
# resetAllJobVariables($jobGroup, $jobName, %varValues) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : %varValues - hash of the variable values
#
# 	returns ($rc)
#
# 	Clears all of the job&apos;s variables and uses varValues as the new set.
#
sub resetAllJobVariables {
	my ($self, $jobGroup, $jobName, %varValues) = @_;

	my @varNamesArr = ();
	my @varValuesArr = ();
	foreach my $varName (keys %varValues){
		push @varNamesArr, SOAP::Data-&gt;type(string =&gt; $varName);
		push @varValuesArr, SOAP::Data-&gt;type(string =&gt; $varValues{$varName});
	}#for

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; resetAllJobVariables($self-&gt;username, $self-&gt;password, $jobGroup, $jobName,
			SOAP::Data-&gt;name("variables" =&gt; \SOAP::Data-&gt;value(@varNamesArr)),
			SOAP::Data-&gt;name("variablesValues" =&gt; \SOAP::Data-&gt;value(@varValuesArr)));

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1);
	}#if

	return($soapResult -&gt; result());
}#sub

#
# setJobVariable($jobGroup, $jobName, $name, $value) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : $name - name of the variable
# 	Argument : $value - value of the variable
#
# 	returns ($rc)
#
# 	Sets a single job variable overwriting the existing setting if already set.
#
sub setJobVariable {
	my ($self, $jobGroup, $jobName, $name, $value) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; setJobVariable($self-&gt;username, $self-&gt;password, $jobGroup, $jobName,
			$name, SOAP::Data-&gt;type(string =&gt; $value));

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1);
	}#if

	return($soapResult -&gt; result());
}#sub

#
# getStats($jobGroup, $jobName, runNumber, fields, fieldSep, recordSep) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : $fields - comma separated list of stats fields
# 	Argument : $fieldSep - field separator for the data returned
# 	Argument : $recordSep - record separator for the data returned
#
# 	returns ($rc, $stats)
#
# 	Will always return:
#          package_name (aka component name), package_type (aka component type), source_host, target_host
#   regardless of whether or not they&apos;re requested.
#
#   Valid columns are : job_id, package_name, source_host, target_host, status, package_type,
#			transport_type, effective_bytes, file_count, directory_count, byte_count, files_transferred,
#			files_skipped, files_deleted, failed_files, agent_start_time, remote_start_time, names_cmd_end_time,
#			transfer_start_time, transfer_end_time, remote_end_time, agent_end_time, bandwidth_throttle, transfer_rate,
#			transfer_rate_max, transfer_rate_min, directories_transferred, directories_skipped, directories_deleted,
#			failed_directories, file_data_bytes, file_attr_bytes, file_data_bytes_comp, file_attr_bytes_comp,
#			file_bytes_skipped, file_bytes_deleted, rsync_bytes_skipped, ovhd_src_rsync, ovhd_tgt_rsync,
#			ovhd_src_mnfst_comp, ovhd_tgt_mnfst_comp, ovhd_src_prtcl, ovhd_tgt_prtcl, ovhd_src_cchnl,
#			ovhd_tgt_cchnl, sf_bytes_recvd, sf_bytes_sent, ntwk_bytes_recvd, ntwk_bytes_sent, udp_aggressiveness,
#			udp_payload_size, udp_header_size, udp_pkts_recvd, udp_pkts_rjctd, udp_pkts_sent, udp_pkts_resent,
#			udp_ceiling, udp_floor, unrecovered_errors, total_errors, proc_data_bytes_sent, proc_data_bytes_unconsumed,
#			tnnl_data_bytes_sent, tnnl_data_bytes_recvd, agent_stat_time
#
sub getStats {
	my ($self, $jobGroup, $jobName, $runNumber, $fields, $fieldSep, $recordSep) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; getStats($self-&gt;username, $self-&gt;password, $jobName, $jobGroup,
			$runNumber, $fields, $fieldSep, $recordSep);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1, "");
	}#if

	return(0, $soapResult -&gt; result());
}#sub

#
# shortCreateJob($jobGroup, $jobName, $jobTemplateLibrary, $jobTemplate, $timezone, %varValues)
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : $jobTemplateLibrary - name of the job template library that contains the job template being scheduled
# 	Argument : $jobTemplate - the job template being scheduled
# 	Argument : $timezone -
# 	Argument : %varValues - hash of the variable values
#
# 	returns ($rc)
#
# 	Create a new job.  If a job with the same name exists in the job group, an exception will be thrown. A new job
# 	group will be created if one doesn&apos;t exist and ENABLE_AUTO_JOB_GROUP_CREATE is set to "yes" in the signiant.ini
# 	file on the manager.
#
sub shortCreateJob {
	my ($self, $jobGroup, $jobName, $jobTemplateLibrary, $jobTemplate, $timezone, %varValues) = @_;

	my @varNamesArr = ();
	my @varValuesArr = ();
	foreach my $varName (keys %varValues){
		push @varNamesArr, SOAP::Data-&gt;type(string =&gt; $varName);
		push @varValuesArr, SOAP::Data-&gt;type(string =&gt; $varValues{$varName});
	}#for

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; shortCreateJob($self-&gt;username, $self-&gt;password, $jobName, $jobGroup,
			$jobTemplateLibrary, $jobTemplate, $timezone,
			SOAP::Data-&gt;name("variables" =&gt; \SOAP::Data-&gt;value(@varNamesArr)),
			SOAP::Data-&gt;name("variablesValues" =&gt; \SOAP::Data-&gt;value(@varValuesArr)));

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1);
	}#if

	return($soapResult -&gt; result());
}#sub

#
# shortUpdateJob($jobGroup, $jobName, $timezone, %varValues) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : $timezone -
# 	Argument : %varValues - hash of the variable values
#
# 	returns ($rc)
#
# 	Update an existing job.
#
sub shortUpdateJob {
	my ($self, $jobGroup, $jobName, $timezone, %varValues) = @_;

	my @varNamesArr = ();
	my @varValuesArr = ();
	foreach my $varName (keys %varValues){
		push @varNamesArr, SOAP::Data-&gt;type(string =&gt; $varName);
		push @varValuesArr, SOAP::Data-&gt;type(string =&gt; $varValues{$varName});
	}#for

	my $soapResult = $self-&gt;soapCall() -&gt; shortUpdateJob($self-&gt;username, $self-&gt;password, $jobName, $jobGroup, $timezone,
			SOAP::Data-&gt;name("variables" =&gt; \SOAP::Data-&gt;value(@varNamesArr)),
			SOAP::Data-&gt;name("variablesValues" =&gt; \SOAP::Data-&gt;value(@varValuesArr)));

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1);
	}#if

	return($soapResult -&gt; result());
}#sub

#
# removeJobVariable($jobGroup, $jobName, $name) - native SOAP call
# 	Argument : $jobGroup - name of the job group
# 	Argument : $jobName - name of the job
# 	Argument : $name - name of the variable
#
# 	returns ($rc)
#
# 	Removes (unsets) a job variable
#
sub removeJobVariable {
	my ($self, $jobGroup, $jobName, $name) = @_;

	# Make the SOAP call
	my $soapResult = $self-&gt;soapCall() -&gt; removeJobVariable($self-&gt;username, $self-&gt;password, $jobGroup, $jobName, $name);

	# .. and handle the result.
	if($soapResult-&gt;fault){
		showFault($self, $soapResult);
		return(1);
	}#if

	return($soapResult -&gt; result());
}#sub

#################################################
############ accessor methods ###################
#################################################

#accessor method for baseUrl
sub baseUrl {
    my ( $self, $baseUrl ) = @_;
    $self-&gt;{_baseUrl} = $baseUrl if defined($baseUrl);
    return $self-&gt;{_baseUrl};
}

#accessor method for username
sub username {
    my ( $self, $username ) = @_;
    $self-&gt;{_username} = SOAP::Data-&gt;type(string =&gt; $username) if defined($username);
    return $self-&gt;{_username};
}

#accessor method for password
sub password {
    my ( $self, $password ) = @_;
    $self-&gt;{_password} = SOAP::Data-&gt;type(string =&gt; $password) if defined($password);
    return $self-&gt;{_password};
}

#accessor method for soapCall
sub soapCall {
    my ( $self, $soapCall ) = @_;
    $self-&gt;{_soapCall} = $soapCall if defined($soapCall);
    return $self-&gt;{_soapCall};
}

#accessor method for lastError
sub lastError {
    my ( $self, $lastError ) = @_;
    $self-&gt;{_lastError} = $lastError if defined($lastError);
    return $self-&gt;{_lastError};
}

#################################################
################## utils ########################
#################################################

sub dumpComplexHashAsString{
	my($self, $depth, %theHash) = @_;
	my $outp = "";
	my $depthStr = "  " x $depth;
	foreach my $key (sort keys %theHash){
		my $val = $theHash{$key};
		if($val =~ /HASH\(0x.*\)/){
			$outp .= $depthStr . "$key = " . $val . "\n";
			$outp .= dumpComplexHashAsString($self, $depth + 1, %{$theHash{$key}});
		}else{
			$outp .= $depthStr . "$key = " . $val . "\n";
		}#if
	}#foreach

	return($outp);
}#sub


sub showFault{
	my($self, $soapResult) = @_;
	my $err = "Fault Code   : " . $soapResult-&gt;faultcode . "\n"
			.  "Fault String : " . $soapResult-&gt;faultstring . "\n"
			.  "Fault Detail      : " . $soapResult-&gt;faultdetail . "\n"
			.  dumpComplexHashAsString($self, 0, %{$soapResult-&gt;faultdetail}) . "\n";
	$self-&gt;lastError($err);
	print STDERR $err;
}#sub

}#end package</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionBuildFullPathSearchVariable">#
# Build the Search Path, format in properly for FindFiles
# Arguements are 1) Debug Value 2) List of comma separated search paths
# This method requires ModifyInputValue and DebugLog to be defined in same script as well
#
sub BuildSearchPathForFindFiles( $$ )
{
	my $DEBUG = @_[0];
	my $SRCDIR = @_[1];

	my $SEARCHPATHS = "";

	if ( $SRCDIR ne "" )
	{
		my @DIRTOSEARCH = split/,/, $SRCDIR;

		foreach my $DIR (@DIRTOSEARCH)
		{
			$DIR = ModifyInputValue( $DIR, 0 );

			if ( $DEBUG ) { DebugLog("Modified Search dir - $DIR\n"); }

			if ( $SEARCHPATHS eq "" )
			{
				$SEARCHPATHS = $SEARCHPATHS . "\"" . $DIR . "\"";
			}
			else
			{
				$SEARCHPATHS =  $SEARCHPATHS . " " . "\"" . $DIR . "\"";
			}

			if ( $DEBUG ) { DebugLog("Search paths - $SEARCHPATHS\n"); }
		}

		if ( $ DEBUG ) { DebugLog("Search separated directories - $SEARCHPATHS\n"); }
	}

	return $SEARCHPATHS;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionCheckFileReadiness">#
# CheckFileReadiness
#
# Checks each of the files in the array FileList to determine whether the file is changing or is static,
# based on the test mode passed (Consecutive Seek, MD5 Hash, or Date/Time/Size).
#
# The list of static files is returned as an array.
#
sub CheckFileReadiness($;$$$)
{
	use Data::Dumper;

	my $FileList = @_[0]; # By reference
	my $FileReadinessCheckType = @_[1];
	my $FileReadinessCheckDelay = @_[2];
	my $AbortImmediatelyOnWorkFiles = @_[3];

	my %Tracks = ();
	my %StaticFilesTrack = ();
	my @StaticFiles;
	my $FileTestMode;

	if (lc($FileReadinessCheckType) eq "none")
	{
		return(@{$FileList});
	}
	elsif (lc($FileReadinessCheckType) eq "md5 hash")
	{
		SigPrintLog("Generating file hashes for source file set (phase 1)...",LOGDEBUG);
		$FileTestMode = "MD5";
	}
	elsif (lc($FileReadinessCheckType) eq "date/time &amp; size")
	{
		SigPrintLog("Gathering date/time stamp info for source file set (phase 1)...",LOGDEBUG);
		$FileTestMode = "SIZETIME";
	}
	else
	{
		SigPrintLog("Generating consecutive seek info for source file set (phase 1)...",LOGDEBUG);
		$FileTestMode = "CSC";
	}

	if ($FileReadinessCheckDelay eq "")
	{
		$FileReadinessCheckDelay = 5;
	}

	if ($AbortImmediatelyOnWorkFiles eq "")
	{
		$AbortImmediatelyOnWorkFiles = FALSE;
	}

	if ($DEBUG)
	{
		SigPrintLog("FileList:\n" . Dumper(@{$FileList}),LOGDEBUG);
	}
	
	#
	# Determine the status of the file at this moment in time...
	#
	foreach my $file (@{$FileList})
	{
		$Tracks{$file} = _CheckSingleFileReadiness($FileTestMode, $file, "",$AbortImmediatelyOnWorkFiles);
	}

	if ($DEBUG)
	{
		SigPrintLog("Phase 1 Tracks:\n" . Dumper(%Tracks),LOGDEBUG);
	}

	sleep(abs($FileReadinessCheckDelay));

	#
	# Now go through each file and check it again...
	#
	if ($FileTestMode eq "MD5")
	{
		SigPrintLog("Generating file hashes for source file set (phase 2)...",LOGDEBUG);
	}
	elsif ($FileTestMode eq "SIZETIME")
	{
		SigPrintLog("Gathering date/time stamp info for source file set (phase 2)...",LOGDEBUG);
	}
	else # CSC
	{
		SigPrintLog("Generating consecutive seek info for source file set (phase 2)...",LOGDEBUG);
	}

	foreach my $file (@{$FileList})
	{
		if ($StaticFilesTrack{$file} ne "y")
		{
			my $track = _CheckSingleFileReadiness($FileTestMode, $file, $Tracks{$file},$AbortImmediatelyOnWorkFiles);

			if ($Tracks{$file} eq $track)
			{
				$StaticFilesTrack{$file} = "y";
				push @StaticFiles, $file;
			}
			else
			{
				SigPrintLog("File is not static and will be skipped: $file",LOGDEBUG);
			}

			$Tracks{$file} = $track;
		}
	}

	if ($DEBUG)
	{
		SigPrintLog("Phase 2 Tracks:\n" . Dumper(%Tracks),LOGDEBUG);
		SigPrintLog("Static Files:\n" . Dumper(@StaticFiles),LOGDEBUG);
	}

	return @StaticFiles;

	#
	# Private subroutine _CheckSingleFileReadiness
	#
	sub _CheckSingleFileReadiness($$$$)
	{
		my ($mode, $file, $lastTrack, $skipWorkFiles) = @_;

		my $track = "";
		$file =~ s/[\n\r]//g; # Remove newlines and/or line-feeds

		#
		# If the last track returned _SKIP_ no need to test again...
		#
		if ($lastTrack =~ m/SKIP/)
		{
			return("_SKIP_2_");
		}

		#
		# If this is a directory, there is no need to test it...
		#
		if (-d $file)
		{
			return("_DIR_OK_");
		}

		if (($skipWorkFiles) &amp;&amp; (($file =~ m/#work_file#/) || ($file =~ m/#chkpt_file#/)))
		{
			return("_SKIP_1_");
		}
		
		if ($mode eq "MD5")
		{
			#
			# There are issues with executing commands containing quote characters (in arguments) within backticks,
			# so we have to handle those cases...
			#
			my $QUOTE;

			if (($file =~ m/\&apos;/) &amp;&amp; ($file =~ m/\"/)) # Filename contains both single and double quotes
			{
				$track = "_NO_TRACK_"; # We won&apos;t even try dds_hash since it will fail.
			}
			elsif (($file =~ m/\"/) &amp;&amp; ($IsWindows)) # Single quote won&apos;t work on Windows so we can&apos;t quote a double with a single
			{
				$track = "_NO_TRACK_"; # We won&apos;t even try dds_hash since it will fail.
			}
			else
			{
				if ($file =~ m/\&apos;/) # contains &apos; but no "...so " is the safe quote
				{
					$QUOTE = "\""
				}
				else # neither " nor &apos;
				{
					if ($IsWindows)
					{
						$QUOTE = "\"" # Default for Windows
					}
					else
					{
						$QUOTE = "&apos;" # Default for non-Windows
					}
				}

				my $hashCmd = "dds_hash -hash $mode $QUOTE$file$QUOTE";

				$track = `$hashCmd`;

				if ($? != 0)
				{ # if hash failed, it&apos;s probably because the file&apos;s in use
					$track = "_SKIP_1_";
				}
			}
		}
		elsif ($mode eq "SIZETIME")
		{
			my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($file);
			$track = $size . ":" . $mtime . ":" . $atime;
		}
		else # CSC
		{
			if ( open FILE,"$file" )
			{
				#seek 0 bytes from the end, get offset, save this value
				seek FILE,0,2;
				my $offset = tell(FILE);
				$track = $offset;
				close FILE;
			}
			else
			{
				# Open failed, file is most likely in use.  Skip it.
				SigPrintLog("Unable to open file $file for reading:  $!",LOGDEBUG);
				$track = "_SKIP_1_";
			}

		}

		$track =~ s/[\n\r]//g; # Remove newlines and/or line-feeds

		return($track);
	}
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionCheckFreeSpace">#
# GetFreeSpace
#
# Gets the free space for the drive on whitch the transfer target directory is located in bytes and saves it in the targetFreeSpace global variable
# Args : 1. TargetDirectory (The target directory for the transfer)
#

sub GetFreeSpace($){
	
	#$DEBUG = 1;

	my $TargetDirectory = $_[0];
	
	my $VerifyForSufficientDiskSpace = ModifyInputValue(q|%Inputs.Options.verifyforsufficientdiskspacebeforeJobtransfersstart% |,0);
	print STDOUT "VerifyForSufficientDiskSpace: [$VerifyForSufficientDiskSpace]\n";
	
	my $freeSpace = 0; 
	
	if($VerifyForSufficientDiskSpace eq "yes"){
		if($IsWindows)
		{	
			eval &apos;use Win32::FileOp&apos;; #Import the module only on Windows machines
			
			if($^E)
			{
				print STDERR "Errors occured while importing required module Win32::FileOp\n";
				print STDERR "The error that was returned by the import command is: $@\n";
				exit 1;
			}
			
			$freeSpace =  Win32::FileOp::GetDiskFreeSpace($TargetDirectory);
			$freeSpace = $freeSpace - 7340032; #Windows stops the transfer when there is 7MB free space left
		
			print "%dds_set%Inputs.Target.targetFreeSpace=$freeSpace\n";
			
			if ($DEBUG)
			{
				print STDERR "Target OS is: Windows\n";
				print STDERR "Traget directory is: [$TargetDirectory]\n";
				print STDERR "Free Space in $TargetDirectory: [$freeSpace] bytes\n";
			}
		}
		elsif($IsUnix &amp;&amp; $^O !~ m/solaris/)
		{
			$TargetDirectory =~ s/\s/\\ /g; #Escape spaces in target directory path
			
			#Get general drive info using standard memory measurements in POSIX format | discard the "Filesystem" line
			# | in the rest of the string find (using the regex) 3 numbers separated by space character(s)
			$freeSpace = `df -P -k $TargetDirectory | grep -v "Filesystem" | grep -E -o "\\s[0-9]+\\s+[0-9]+\\s+[0-9]+\\s"`;
			
			#Remove all unnecesarry data that the above command returns
			$freeSpace =~ s/\n//g;
			my @dfvalues = split(&apos; &apos;, $freeSpace );
			$freeSpace = $dfvalues[2];
			
			$freeSpace = $freeSpace * 1024; #Because the size is returned in KB convert it to B
			
			print "%dds_set%Inputs.Target.targetFreeSpace=$freeSpace\n";
			
			print "Free space in target directory is: [$freeSpace]\n";
			
			if ($DEBUG)
			{
				print "Target OS is: Unix\n";
			}
		}
		elsif($^O =~ m/solaris/)
		{
			eval &apos;use Filesys::DiskFree&apos;; #Import the module only on Solaris machines
			
			if($^E)
			{
				print STDERR "Errors occured while importing required module Filesys::DiskFree\n";
				print STDERR "The error that was returned by the import command is: $@\n";
				exit 1;
			}
			
			my $dfHandle = new Filesys::DiskFree;
			$dfHandle-&gt;df();
			
			$freeSpace = $dfHandle-&gt;avail($TargetDirectory);
			
			print "%dds_set%Inputs.Target.targetFreeSpace=$freeSpace\n";
			
			if ($DEBUG)
			{
				print STDERR "Target OS is: Solaris\n";
				print STDERR "Free space in target directory is: $freeSpace\n";
			}
		}
	}
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionConfigSimpleEmail">#
# Configure Email
# Args : 1. Contacts 2. Subject 3. 0 - success, 1 - fail, 2 - both
#
sub ConfigSimpleEmail($$$)
{
	my $CONTACT = $_[0];
	my $SUBJECT = $_[1];
	my $TYPE    = $_[2];
	my $SUBJECTFAIL = "";

	if ( $SUBJECT ne "" )
	{
		$SUBJECTFAIL = "Failure " . $SUBJECT;
	}

	# Success
	#
	if ( ( $TYPE == 0 ) || ( $TYPE == 2 ) )
	{
		print "%dds_notify_succ_to%$CONTACT\n";

		if ( $SUBJECT ne "" )
		{
			print "%dds_notify_succ_subj%$SUBJECT\n";
		}
	}

	# Fail
	#
	if ( ( $TYPE == 1 ) || ( $TYPE == 2 ) )
	{
		print "%dds_notify_fail_to%$CONTACT\n";

		if ( $SUBJECT ne "" )
		{
			print "%dds_notify_fail_subj%$SUBJECTFAIL\n";
		}
	}
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionConnectWMIOLE">#
# Connect to Windows Management Instrumentation with OLE
# Args: 1 - Server ( empty for local server ) 2 - entry to look into table
#
sub ConnectWMIOLE( $$ )
{
	require Win32::OLE;
	Win32::OLE-&gt;Option(Warn =&gt; 0);

	my $SERVER   = $_[0];
	my $CIMROOT  = $_[1];

	my $LOCATOR;
	my $SERVICES;

	if ( ( $LOCATOR = Win32::OLE-&gt;new(&apos;WbemScripting.SWbemLocator&apos;) ) )
	{
		if ( ( $SERVICES = $LOCATOR-&gt;ConnectServer( $SERVER, $CIMROOT ) ) )
		{
		}
		else
		{
			print "Cannot access WMI on machine $SERVER - Win32::OLE-&gt;LastError\n";
			$SERVICES = "";
		}
	}
	else
	{
		print "Cannot access WMI  with OLE - Win32::OLE-&gt;LastError\n";
		$SERVICES = "";
	}

	return $SERVICES;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionCreateDirectory">#
# Create directory based on full path, or relative to pwd
#
sub CreateDirectory ($)
{
	require File::Path;
	my ($DIRCREATE) = @_;
	my $RET = 0;

	if ( -d $DIRCREATE )
	{
		# print "%dds_msg_noh%Directory already exists\n";
	}
	else
	{
		if (-f $DIRCREATE ){
        	print STDERR "ERROR: File with same name already exists $DIRCREATE \n";
            $RET = 1;
        } else {

			#
			# Handle race condition where multiple scripts executing at once
			# Another script could have created the directory
			#
			my @DIRLIST;
			eval {  @DIRLIST = File::Path::mkpath($DIRCREATE); };
			if ( -d $DIRCREATE )
			{
				# if on a GOS system change the owner and group
				if ( -f &apos;/proc/qinfo/SerialNumber&apos; )
				{
					foreach my $DIR (@DIRLIST )
					{
						$RET = `chown -R admin:admingrp $DIR`;
					}
				}
				else
				{
					$RET = 0;
				}
			}
			else
			{
				print STDERR "ERROR: Invalid permissions to create target directory\n";	
				$RET = 1;
			}
		}
	}

	return $RET;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionCreateShadow">#
# Create a process to execute dds_shadow, then loop until the
# mapping file appears or the timeout expires.
#
# Return the process id or -1 if th eprocess could not be created.
#
sub SolutionCreateShadow($$$$$)
{
	my $DeviceMapping = @_[0]; # By reference
	my $ShadowCreationTimeout = @_[1]; #Seconds
	my $ShadowLifetime = @_[2]; # -1=Forever
	my $ShadowMapFile = @_[3];
	my $ShadowErrFile = @_[4];

	my $ProcessObj;
	my $PID;
	my $DriveList = "";

	print ("Creating volume shadow copies...\n");

	for my $key ( sort keys %$DeviceMapping )
	{
		$DriveList = $DriveList . " " . $key;
	}

	my $DdsShadowExe = "dds_shadow.exe";
	my $DdsBinDir = `dds_cfgutil installdirectory`;
 	chomp($DdsBinDir);
 	#QUOTE $DdsBinDir =~ s/\\/\//g;

	if ($ShadowLifetime eq "")
	{
		printf STDERR ("ERROR: Null -wait parameter specified for dds_shadow call\n");
		$PID=-1;
		return($PID);
	}

	if ($ShadowMapFile eq "")
	{
		printf STDERR ("ERROR: Null -mapping parameter specified for dds_shadow call\n");
		$PID=-1;
		return($PID);
	}

	if ($DriveList eq "")
	{
		printf STDERR ("ERROR: Null volume list specified for dds_shadow call\n");
		$PID=-1;
		return($PID);
	}

	print ("Calling: $DdsBinDir\\$DdsShadowExe -wx=MSDEWriter -wait=$ShadowLifetime -mapping=\"$ShadowMapFile\" -error=\"$ShadowErrFile\" $DriveList\n");

	unlink($ShadowMapFile);
	unlink($ShadowErrFile);

	#
	# We must exclude the writer MSDEWriter in the call to dds_shadow due to the error
	# documented at: http://support.microsoft.com/default.aspx?scid=kb;en-us;828481
	#
	if (Win32::Process::Create($ProcessObj,
				"$DdsBinDir\\$DdsShadowExe",
				"$DdsShadowExe -wx=MSDEWriter -wait=$ShadowLifetime -mapping=\"$ShadowMapFile\" -error=\"$ShadowErrFile\" $DriveList",
				0,
				DETACHED_PROCESS,
				"."))
	{
		$PID=$ProcessObj-&gt;GetProcessID;

		print "Created dds_shadow process: PID=$PID\n";

		#
		# Now sleep until we see the mapping file having been created or until the timeout expires...
		#

		my $StartTime=time();
		my $TimeNow=time();
		my $MapFileFound = 0;

		while (($TimeNow &lt; ($StartTime + $ShadowCreationTimeout)) &amp;&amp; (! -f $ShadowMapFile) &amp;&amp; (! -f $ShadowErrFile))
		{
			sleep(1);

			$TimeNow=time();

			if ($TimeNow &gt;= ($StartTime + $ShadowCreationTimeout))
			{
				print STDERR "WARNING: Shadow map creation timeout has expired ($ShadowCreationTimeout seconds)\n";
			}
			elsif (-f $ShadowMapFile)
			{
				printf ("Shadow map file has appeared (elapsed time %s seconds)\n", $TimeNow - $StartTime);
			}
			elsif (-f $ShadowErrFile)
			{
				if (open(SHADOWERRFILE,$ShadowErrFile))
				{
					my $LogLine;

					printf STDERR ("ERROR: Shadow copy creation failed\n");

					while (!eof(SHADOWERRFILE))
					{
						$LogLine= &lt;SHADOWERRFILE&gt;;
						printf STDERR "$LogLine";
					}

					close(SHADOWERRFILE);
				}
			}
		}
	}
	else
	{
		printf STDERR ("ERROR: Could not create dds_shadow process: %s\n",Win32::FormatMessage(Win32::GetLastError()));
		$PID=-1;
	}

	return($PID);
}
#
# Copyright 2005-2006 Signiant Inc.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionCreateSimpleShortCut">#
# Create a simple Windows shortcut. Will name file to "File".lnk
# Args 1. - File 2. Target Directory 3. Description
#
sub CreateWindowsShortCut($$$)
{
	require Win32::Shortcut;
	import Win32::Shortcut;

	my $FILE = $_[0];
	my $SHARE = $_[1];
	my $DESCRIPTION = $_[2];

	my $RET = 0;

	my $LINK = new Win32::Shortcut("$FILE.lnk");
	$LINK-&gt;{&apos;Path&apos;} = "$SHARE";
	$LINK-&gt;{&apos;Description&apos;} = $DESCRIPTION;

	if ( $LINK-&gt;Save() )
	{
		$RET = 0;
	}
	else
	{
		print "%dds_msg_noh%Can not find link file - $FILE.lnk\n";
		$RET = 1;
	}

	$LINK-&gt;Close();

	#
	# Use this code if we do not have Win32::Perl extemsions
	# my $RET = `shortcut /f:"$FILE.lnk" /A:C /T:"$SHARE" /d:$DESCRIPTION`;
	# Can not rely on return code, make sure file was created
	#if ( -e $FILE. &apos;.lnk&apos; )
	#{
	#    $RET = 0;
	#}
	#else
	#{
	#   print "%dds_msg_noh%Can not find link file - $FILE.lnk\n";
	#   $RET = 1;
	#}

	return $RET;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionDateTimeLabel">#
# Create a label based on current date/time combination
#
sub DateTimeLabel($)
{
	my $TZ = $_[0];

	my @TIMEARRAY;

	if ( $TZ == 1 )
	{
		@TIMEARRAY = gmtime(time);
	}
	else
	{
		@TIMEARRAY = localtime(time);
	}

	my $DIRTIMESTAMP = sprintf ( "%02d%02d%02d%02d%02d%02d", ($TIMEARRAY[5]-100),($TIMEARRAY[4]+1),$TIMEARRAY[3],$TIMEARRAY[2],$TIMEARRAY[1],$TIMEARRAY[0]);

	return $DIRTIMESTAMP;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionDebugLog">#
# Log output to debug
#
sub DebugLog($)
{
	print "$_[0]";
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionDeleteShadow">#
# Deletes all shadow copies within the given ShadowSetID.
#
# This is a best-effort call since we don&apos;t want to wait for it to complete.
#
sub SolutionDeleteShadow($)
{
	my $ShadowSetID = @_[0];

	print "Deleting volume shadow copies...\n";

	my $ShadowArgs;
	my $ProcessObj;
	my $PID;

	if ($ShadowSetID eq "")
	{
		printf STDERR ("ERROR: No Shadow Set ID specified.\n");
		return(-1);
	}

	my $DdsShadowExe="dds_shadow.exe";
	my $DdsBinDir = `dds_cfgutil installdirectory`;
	chomp($DdsBinDir);
	#QUOTE $DdsBinDir =~ s/\\/\//g;

	if (lc($ShadowSetID) eq "all")
	{
		$ShadowArgs = "-da";
	}
	else
	{
		$ShadowArgs = "-dx=\"$ShadowSetID\"";
	}

	print ("Calling: $DdsBinDir\\$DdsShadowExe $ShadowArgs\n");

	if (Win32::Process::Create($ProcessObj,
				"$DdsBinDir\\$DdsShadowExe",
				"$DdsShadowExe $ShadowArgs",
				0,
				NORMAL_PRIORITY_CLASS,
				"."))
	{
		$PID=$ProcessObj-&gt;GetProcessID;

		print "Created dds_shadow process: PID=$PID\n";
	}
	else
	{
		printf STDERR ("ERROR: Could not create dds_shadow process: %s\n",Win32::FormatMessage(Win32::GetLastError()));
		$PID=-1;
	}

	return($PID);
}
#
# Copyright 2005-2006 Signiant Inc.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionExistsLongPathname">#
# Checks the existence of a file via a slow but reliable method. Perl can&apos;t handle
# pathnames &gt; 256 chars, so this script gets the directory name (still subject to
# a 256 char maximum) and uses string comparisons for the filename - eliminating any
# length restriction there.
#
sub SolutionExistsLongPathname($)
{
	use File::Basename;

	my $TRUE=1;
	my $FALSE=0;

	my ($PATHNAME) = @_;
	$PATHNAME =~ s/\\/\//g;

	my $DIRNAME;
	my $DIRENTRY;
	my $FILENAME;
	my $FileFound=$FALSE;

	$DIRNAME=dirname($PATHNAME);
	$FILENAME=basename($PATHNAME);

	if (($DIRNAME eq "") || ($FILENAME eq ""))
	{
		return($FALSE);
	}

	if ( !opendir ( HDIR, "$DIRNAME" ) )
	{
		return($FALSE);
	}

	while (($DIRENTRY = readdir( HDIR ) ) &amp;&amp; (!$FileFound))
	{
		if ($DIRENTRY eq $FILENAME)
		{
			$FileFound = $TRUE;
		}
	}

	closedir HDIR;

	return $FileFound;
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionFindPgDump">#
# Function:	SolutionFindPgDump
#
# Description:	Resolve the location of the postgres db dump command line tool
#
sub SolutionFindPgDump{
	my($ddsHome) = @_;

	my $localOS = "";
	if ($^O =~ /^MSWin/){
		$localOS = "win";
	}else{
		$localOS = "unix";
	}

	my $localDirSep = "/";
	if($localOS eq "win"){
		$localDirSep = "\\";
	}#if

	my @pgDumpLocs = ();

	@pgDumpLocs = (@pgDumpLocs, $ddsHome.$localDirSep."db".$localDirSep."pgsql".$localDirSep."bin".$localDirSep."pg_dump");
	if($localOS eq "win"){
		@pgDumpLocs = (@pgDumpLocs, $ddsHome.$localDirSep."db".$localDirSep."pgsql".$localDirSep."bin".$localDirSep."pg_dump.exe");
	}#if
	@pgDumpLocs = (@pgDumpLocs, $ddsHome.$localDirSep."db".$localDirSep."pgsql_81".$localDirSep."bin".$localDirSep."pg_dump");

	# old path
	@pgDumpLocs = (@pgDumpLocs, "/usr/bin/pg_dump");

	# oem path for smb
	@pgDumpLocs = (@pgDumpLocs, $ddsHome.$localDirSep."db".$localDirSep."bin".$localDirSep."pg_dump");

	my $pg_dump = "";
	foreach $pg_dump (@pgDumpLocs){
		if(-f "$pg_dump"){
			return($pg_dump);
		}#if
	}#if

	die("Cannot find pg_dump - paths tried were:\n" . join("\n", @pgDumpLocs));
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionFindPsql">#
# Function:	SolutionFindPsql
#
# Description:	Resolve the location of the postgres command line query tool
#
sub SolutionFindPsql{
	my($ddsHome) = @_;

	my $localOS = "";
	if ($^O =~ /^MSWin/){
		$localOS = "win";
	}else{
		$localOS = "unix";
	}

	my $localDirSep = "/";
	if($localOS eq "win"){
		$localDirSep = "\\";
	}#if

	my @psqlLocs = ();

	@psqlLocs = (@psqlLocs, $ddsHome.$localDirSep."db".$localDirSep."pgsql".$localDirSep."bin".$localDirSep."psql");
	if($localOS eq "win"){
		@psqlLocs = (@psqlLocs, $ddsHome.$localDirSep."db".$localDirSep."pgsql".$localDirSep."bin".$localDirSep."psql.exe");
	}#if
	@psqlLocs = (@psqlLocs, $ddsHome.$localDirSep."db".$localDirSep."pgsql_81".$localDirSep."bin".$localDirSep."psql");

	# old path
	@psqlLocs = (@psqlLocs, "/usr/bin/psql");

	# oem path for smb
	@psqlLocs = (@psqlLocs, $ddsHome.$localDirSep."db".$localDirSep."bin".$localDirSep."psql");

	my $psql = "";
	foreach $psql (@psqlLocs){
		if(-f "$psql"){
			return($psql);
		}#if
	}#if

	die("Cannot find psql - paths tried were:\n" . join("\n", @psqlLocs));
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetAvailableDrives">#
# Returns a hash representing the local drives found on the system.
# The hash is indexed by the drive itself.
#
sub SolutionGetAvailableDrives()
{
	my @VOLUMEINFO = SolutionGetWindowsVolumeInfoByDriveType(3);
	my $SIZE = @VOLUMEINFO;
	my $WINDOWS=1;

	my %AvailableDrives = ();

	if ($DEBUG)
	{
		print "Available Local Drives...\n";
	}

	for ( my $CNT = 0; $CNT &lt; $SIZE; ++$CNT )
	{
	        my @VOLINFO = @{$VOLUMEINFO[$CNT]};
	        my $DRIVE;

	        if ( $WINDOWS )
	        {
	            $DRIVE = $VOLINFO[0]; # Drive for windows
	        }

		#
		# Add the drive to a hash, indexed by the drive itself.
		#
		if ( $DRIVE ne "" )
		{
			$AvailableDrives{uc($DRIVE)}=uc($DRIVE);
		}

	}

	if ($DEBUG)
	{
		for my $key ( sort keys %AvailableDrives )
		{
		        print "Available Drive: $key =&gt; $AvailableDrives{$key}\n";
		}
	}

	return(%AvailableDrives);
}
#
# Copyright 2005-2006 Signiant Inc.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetBaseDDSInstallDir">#
# Return the base DDS install directory
#

sub GetBaseDDSInstallDirectory ()
{
	my $RETSTRING = `dds_cfgutil installdirectory`;
	chomp( $RETSTRING );
	$RETSTRING =~ s/\\/\//g;
	$RETSTRING =~ s/\/bin$//i;
	return $RETSTRING;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetBaseDirectoryListing">#
# Get the files in the base directory
# 0 - Directory
#
sub GetBaseDirectoryListing( $ )
{
	my $DIR = $_[0];
	my @LIST;

	if ( opendir ( HDIR, $DIR ) )
	{
		my $DIRENTRY;

		while ( $DIRENTRY = readdir( HDIR ) )
		{
			push ( @LIST, $DIRENTRY );
		}

		closedir HDIR;
	}
	else
	{
		SigPrintLog("ERROR: GetBaseDirectoryListing - Failed to open directory: [$DIR]",LOGERROR);
	}

	return @LIST;
}
#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetCommonDrives">#
# Loop through search drives
#	- if element "n" exists in available drives,
#		-- add element "n" to device map hash
#
sub SolutionGetCommonDrives($$)
{
	my $SearchDrives = @_[0]; # By reference
	my $AvailableDrives = @_[1]; # By reference

	my %DeviceMapping = ();

	for my $key ( sort keys %$SearchDrives )
	{
		if ((exists $AvailableDrives-&gt;{lc($key)}) || (exists $AvailableDrives-&gt;{uc($key)}))
		{
			$DeviceMapping{uc($key)}=uc($key);
		}
	}

	if ($DEBUG)
	{
		print "Common Drives...\n";

		for my $key ( sort keys %DeviceMapping )
		{
		        print "Device Map: $key =&gt; $DeviceMapping{$key}\n";
		}
	}

	return(%DeviceMapping);
}
#
# Copyright 2005-2006 Signiant Inc.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetDebugFromLogLevel"># Retrieve whether the debug flag has been set and whether
# the solution should log additional messages

sub GetDebugFromLogLevel ($)
{
	my $DEBUG = @_[0];

	if ($DEBUG == 3)
		{ $DEBUG = 1; }
	else
		{ $DEBUG = 0; }

	return $DEBUG;
}

#
# Copyright Signiant 2004-2005
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetFileName">#
# Get the file name only
#
sub GetFileNameOnly($)
{
	my $FILENAME = @_[0];

	$FILENAME =~ s/\\/\//g;
	my $INDEX = rindex ( $FILENAME, "/" );

	if ( $INDEX &gt; -1 )
	{
		$FILENAME = substr $FILENAME,($INDEX + 1);
	}

	return $FILENAME;
}

#
# Copyright Signiant 2004-2005
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetFixedLocalDrives">#
# Returns a hash representing the local (fixed) drives found on the system.
# The hash is indexed by the drive itself.
#
sub GetFixedLocalDrives()
{
	require Win32::NetAdmin;
	import Win32::NetAdmin;
	require Win32::API;
	import Win32::API;

	my @serverDrives;
	my @VOLUMEINFO;

	# get all the local drives on the server
	Win32::NetAdmin::GetServerDisks(&apos;&apos;,\@serverDrives);

	foreach my $drive (@serverDrives)
	{
   		my $dtype = DriveType($drive);
		if ($dtype == 3) {push (@VOLUMEINFO,$drive)};
	}

	my $SIZE = @VOLUMEINFO;

	my %AvailableDrives = ();

	if ($DEBUG)
	{
		print "Available Local Drives...\n";
	}

	for ( my $CNT = 0; $CNT &lt; $SIZE; ++$CNT )
	{
		my $DRIVE  = $VOLUMEINFO[$CNT];

		#
		# Add the drive to a hash, indexed by the drive itself.
		#
		if ( $DRIVE ne "" )
		{
			$AvailableDrives{uc($DRIVE)}=uc($DRIVE);
		}

	}

	if ($DEBUG)
	{
		for my $key ( sort keys %AvailableDrives )
		{
		        print "Available Drive: $key =&gt; $AvailableDrives{$key}\n";
		}
	}

	return(%AvailableDrives);
}

#==================
# DriveType ( drive )
# Returns integer value:
#
#  0     - the drive type cannot be determined.
#  1     - the root directory does not exist.
#  2     - the drive can be removed from the drive (removable).
#  3     - the disk cannot be removed from the drive (fixed).
#  4     - the drive is a remote (network) drive.
#  5     - the drive is a CD-ROM drive.
#  6     - the drive is a RAM disk.
#
#   drive - drive-letter in either &apos;c&apos; or &apos;c:&apos; or &apos;c:\\&apos; form or UNC path
#   in either "\\\\server\\share" or "\\\\server\\share\\" form.
#
#   In case of UNC path 4 will be returned that means that
#   networked drive is available (1 - if not available).
#==================
sub DriveType ($) {
#==================
   my $drive = shift;
   return undef unless $drive =~ s/^([a-z])(:(\\)?)?$/$1:\\/i ||
                       $drive =~ s/^(\\\\\w+\\\w+\$?)(\\)?$/$1\\/;

   my $GetDriveType ||= new Win32::API("kernel32", "GetDriveType", [&apos;P&apos;], &apos;N&apos;) or return;

   my ($lpDirectoryName) = $drive;

   my $type = $GetDriveType-&gt;Call( $lpDirectoryName );
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetLinuxCPU">#
# Retrieve the CPU information from a Linux machine
#

sub GetLinuxCPU()
{
	my $CPU = "";

	if ( -e "/proc/cpuinfo" )
	{
		my $OUTPUT = `grep -i "model name" /proc/cpuinfo`;
		my $INDEX = index( $OUTPUT, ":" );
		if ( $INDEX &gt; -1 )
		{
			$CPU = substr( $OUTPUT, ($INDEX + 1) );
		}

		$OUTPUT = `grep -i "cpu mhz" /proc/cpuinfo`;
		$INDEX = index( $OUTPUT, ":" );
		if ( $INDEX &gt; -1 )
		{
			my @PROCNUMBER = `grep "processor" /proc/cpuinfo`;
			my $PROCSIZE = @PROCNUMBER;
			if ( $PROCSIZE &gt; 1 )
			{
				$CPU = $CPU . " " . substr( $OUTPUT, ($INDEX + 1) ) . " MHz ($PROCSIZE detected)";
			}
			else
			{
				$CPU = $CPU . " " . substr( $OUTPUT, ($INDEX + 1) ) . " MHz";
			}
		}

		if ( $CPU eq "" )
		{
			$CPU = "unavailable";
		}
	}
	else
	{
		$CPU = "unavailable";
	}

	return $CPU;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetLinuxMemory">#
# Retrieve the Physical memory from a Linux machine
#

sub GetLinuxMemory()
{
	my $MEM = "";

	my $OUTPUT = `free | grep -i mem`;

	if ( index($OUTPUT,"not found") == -1 )
	{
		my @TOKENS = split/\s+/,$OUTPUT;

		my $SIZE = @TOKENS;
		if ( $SIZE &gt; 2 )
		{
			$MEM = $TOKENS[1] . " Kbytes";
		}
		else
		{
			$MEM = "unavailable";
		}
	}
	else
	{
		$MEM = "unavailable";
	}

	return $MEM;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetLinuxVolumeInfo">#
# Retrieve the volume info from a Linux machine
# Return Format
# 0 - name, 1 - kbytes, 2 - used, 3 - available, 4 - %used, 5 - Mounted On
#
# NOTE: Must include SolutionParseUnixVolumeInfo when using this script
#
sub GetLinuxVolumeInfo()
{
	my @VOLUMES = `df -kP`;

	return ParseUnixVolumeInfo(@VOLUMES);
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetPathComponents">#
# Return an array representing the path components in the comma-separated path
#
sub SolutionGetPathComponents($)
{
	my $SearchPath = @_[0];

	my @SearchPaths;
	my $PathCount;

	if ($DEBUG)
	{
		print "Searching path: $SearchPath\n";
	}

	@SearchPaths = split (/\s*,\s*/,$SearchPath);

	$PathCount = scalar @SearchPaths;

	if ($DEBUG)
	{
		print "Path Components...\n";

		for(my $i = 0; $i &lt; $PathCount; $i++)
		{
			print "PATH[$i]: $SearchPaths[$i]\n";
		}
	}


	return(@SearchPaths);
}
#
# Copyright 2005-2006 Signiant Inc.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetPathDrives">#
# Returns a hash representing the drives found in the search paths.
# The hash is indexed by the drive itself.
#
sub SolutionGetPathDrives($$)
{
	my $SearchPaths = @_[0]; # By reference
	my $PathCount = @_[1];

	my %SearchDrives = ();

	if ($DEBUG)
	{
		print "Path Drives...\n";
	}

	for (my $i = 0; $i &lt; $PathCount; $i++)
	{
		$SearchPaths-&gt;[$i] =~ m/^"*&apos;*@*[a-zA-Z]:[\\\/]/;

		my $DRIVE= $&amp;;

		#
		# Strip off any leading or trailing characters that matched besides the drive letter...
		#
		$DRIVE =~ s/^@*//;  # Remove leading @
		$DRIVE =~ s/^"*//;  # Remove leading "
		$DRIVE =~ s/^&apos;*//;  # Remove leading &apos;
		$DRIVE =~ s/\\*$//; # Remove trailing \
		$DRIVE =~ s/\/*$//; # Remove trailing /

		#
		# Add the drive to a hash, indexed by the drive itself.
		#
		if ( $DRIVE ne "" )
		{
			if ($DEBUG)
			{
				print "PATH: $SearchPaths-&gt;[$i] - DRIVE: $DRIVE\n";
			}

			$SearchDrives{uc($DRIVE)}=uc($DRIVE);
		}
	}

	if ($DEBUG)
	{
		print "Search Path Drives (sorted, duplicates removed)...\n";

		for my $key ( sort keys %SearchDrives )
		{
		        print "Search Drive: $key =&gt; $SearchDrives{$key}\n";
		}
	}

	return(%SearchDrives);
}
#
# Copyright 2005-2006 Signiant Inc.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetRDPTransferStatus">#
# Function: GetRDPTransferStatus
#
# Gets the transfer status for the given job status dir and hostname.
# This is used to keep track of the status of multiple hosts
# during the course of a backup/replication/restore job.
#

sub GetRDPTransferStatus($$)
{
	my $StatusDir = @_[0];
	my $HostName = @_[1];

	my $STATUSFILE = $StatusDir . "/" . $HostName;

	my $Status = "";

	if (-f $STATUSFILE)
	{
		if (open(STATUSFILE,"$STATUSFILE"))
		{
			$Status = &lt;STATUSFILE&gt;;
			$Status =~ s/[\n\r]//g; # Remove newlines and/or line-feeds
			close(STATUSFILE);
		}

	}

	return(lc($Status));
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetSolarisCPU">#
# Retrieve the processor information from Solaris machine
#

sub GetSolarisCPU()
{
	my $CPU = "";

	my $OUTPUT = `/usr/sbin/psrinfo -v | grep processor`;

	if ( index ( $OUTPUT, "not found" ) &gt; -1 )
	{
		$CPU = "unavailable";
	}
	else
	{
		$OUTPUT =~ m/the (.+) processor/i;
		$CPU = $1;
		$OUTPUT =~ m/at (.+),/i;
		$CPU = $CPU . " " . $1;

		my $COUNT = 0;
		$OUTPUT = lc ( $OUTPUT );

		while ( $OUTPUT =~ m/status of processor/g )
		{
			$COUNT++;
		}

		if ( $COUNT &gt; 1 )
		{
			$CPU = $CPU . " ($COUNT detected)";
		}
	}

	return $CPU;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetSolarisMemory">#
# Retrieve the physical memory from a Solaris machine
#

sub GetSolarisMemory()
{
	my $MEM = "";

	my $OUTPUT;

	if ( -e "/usr/sbin/prtconf" )
	{
		$OUTPUT = `/usr/sbin/prtconf | grep -i "memory size:"`;
	}
	else
	{
		$OUTPUT = `prtconf | grep -i "memory size:"`;
	}

	if ( index ( $OUTPUT, "not found" ) &gt; -1 )
	{
		$MEM = "unavailable";
	}
	else
	{
		my $INDEX = index( $OUTPUT, ":" );
		if ( $INDEX &gt; -1 )
		{
			$MEM = substr( $OUTPUT, ($INDEX + 1) );
		}
	}

	return $MEM;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetSolarisVolumeInfo">#
# Retrieve the volume information from a Solaris machine
# Return Format
# 0 - name, 1 - kbytes, 2 - used, 3 - available, 4 - %used, 5 - Mounted On
#
# NOTE: Must include SolutionParseUnixVolumeInfo when using this script
#

sub GetSolarisVolumeInfo()
{
my @VOLUMES = `df -k`;

return ParseUnixVolumeInfo(@VOLUMES);
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetTargetBackupStructure">#
# Build the List of directories to search under the specified version in backup repository
# Args - 1) Parent Directory
#
sub BuildDirsToSearchFromRoot($)
{
	my ($PARENTDIR) = @_;
	my @DIRLIST;
	my $DIRENTRY;

	if ( opendir ( HDIR, "$PARENTDIR" ) )
	{
		while ( $DIRENTRY = readdir( HDIR ) )
		{
			# Skip files
			if ( -d "$PARENTDIR/$DIRENTRY" )
			{
				# Only get the ones we want
				if ( $DIRENTRY eq &apos;%PrefixDrive%&apos; )
				{
					push ( @DIRLIST, "$DIRENTRY" );
				}
				elsif ( $DIRENTRY eq &apos;%PrefixUNC%&apos; )
				{
					push ( @DIRLIST, "$DIRENTRY" );
				}
				elsif ( $DIRENTRY eq &apos;%PrefixRoot%&apos; )
				{
					push ( @DIRLIST, "$DIRENTRY" );
				}
			}
		}

		closedir HDIR;
	}
	else
	{
		NotifyMessage("Failure Get directories to search from root - $PARENTDIR\n",28);
	}

	return @DIRLIST;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetTransferStatus">#
# Function: GetTransferStatus
#
# Gets the transfer status for the given job status dir and hostname.
# This is used to keep track of the status of multiple hosts
# during the course of a backup/replication/restore job.
#

sub GetTransferStatus($$)
{
	my $StatusDir = @_[0];
	my $HostName = @_[1];

	my $STATUSFILE = $StatusDir . "/" . $HostName;

	my $Status = "";

	if (-f $STATUSFILE)
	{
		if (open(STATUSFILE,"$STATUSFILE"))
		{
			$Status = &lt;STATUSFILE&gt;;
			$Status =~ s/[\n\r]//g; # Remove newlines and/or line-feeds
			close(STATUSFILE);
		}

	}

	return(lc($Status));
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetUnixOS">#
# Return the operating system details for unix machines
#

sub GetUnixOS()
{
	my $OS = `uname -r -s -v`;
	return $OS;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetUtf8String">#
# Ensures that a string passed in is encoded as UTF8.
#
sub GetUtf8String($)
{
	use Encode;

	my ($srcString) = @_;
	my $returnString = $srcString;

	eval {
		Encode::decode(&apos;UTF-8&apos;, $returnString, Encode::FB_QUIET);
	};

	if ($returnString) {
		$returnString = Encode::encode("UTF-8", $srcString);
	} else {
		$returnString = $srcString;
	}

	return $returnString;
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetWindowsCPU">#
# Retrieve Windows processor information
# NOTE: Include the script SolutionConnectWMIOLE before
# including this script
#

sub GetWindowsCPU()
{
	my $CPU = "unavailable";

	my $SERVICES = ConnectWMIOLE( &apos;&apos;, &apos;root/cimv2&apos; );

	if ( $SERVICES ne "" )
	{
		my $ENUM;

		if ( ( $ENUM = $SERVICES-&gt;InstancesOf("Win32_Processor") ) )
		{
			my $COUNT = $ENUM-&gt;{Count};
			if ( $COUNT )
			{
				for my $ITEM ( in $ENUM )
				{
					my $DESC = $ITEM-&gt;{&apos;Description&apos;};
					my $MAN  = $ITEM-&gt;{&apos;Manufacturer&apos;};
					my $MAXCLOCK = $ITEM-&gt;{&apos;MaxClockSpeed&apos;};

					if ( $COUNT &gt; 1 )
					{
						$CPU = sprintf("%s %s %sMhz (%s detected)",$DESC,$MAN,$MAXCLOCK,$COUNT);
					}
					else
					{
						$CPU = sprintf("%s %s %sMhz",$DESC,$MAN,$MAXCLOCK);
					}

					# Only get first one, all processors will be the same
					last;
				}
			}
		}
	}

	return $CPU;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetWindowsMemory">#
# Retrieve Windows memory information
# NOTE: Include the script SolutionConnectWMIOLE before
# including this script
#

sub GetWindowsMemory()
{
	my $MEM = "unavailable";

	my $SERVICES = ConnectWMIOLE( &apos;&apos;, &apos;root/cimv2&apos; );

	if ( $SERVICES ne "" )
	{
		my $ENUM;

		if ( ( $ENUM = $SERVICES-&gt;InstancesOf("Win32_OperatingSystem") ) )
		{
			if ( $ENUM-&gt;{Count} )
			{
				for my $ITEM ( in $ENUM )
				{
					my $TOTMEM = $ITEM-&gt;{&apos;TotalVisibleMemorySize&apos;};

					if ( $TOTMEM ne "" )
					{
						#$TOTMEM = sprintf("%lu",$TOTMEM/1024);
						$MEM = $TOTMEM . " Kbytes";
					}

					# there is only one
					last;
				}
			}
		}
	}

	return $MEM;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetWindowsOS">#
# Return the Operating System details for Windows
#
sub GetWindowsOS()
{
	my $SERVICES = ConnectWMIOLE( &apos;&apos;, &apos;root/cimv2&apos; );
	my $OS = "";
	my $OSCOUNT = 0;
	my $ENUM;

	if ( $SERVICES ne "" )
	{
		if ( ( $ENUM = $SERVICES-&gt;InstancesOf("Win32_OperatingSystem") ) )
		{
			$OSCOUNT = $ENUM-&gt;{Count};
		}
	}

	# Build Operating System information
	#
	if ( $OSCOUNT &gt; 0 )
	{
		for my $ITEM ( in $ENUM )
		{
			$OS = $ITEM-&gt;{&apos;Caption&apos;} . " [ Version " . $ITEM-&gt;{&apos;Version&apos;} . "  Service Pack " . $ITEM-&gt;{&apos;ServicePackMajorVersion&apos;} . " ]";
			last;
		}
	}

	return $OS;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetWindowsVolumeInfo">#
# Retrieve volume information from a Windows machine
#
# NOTE: Include the script SolutionConnectWMIOLE before
# including this script# Return in the following format.
# 0 - name, 1 - kbytes, 2 - used, 3 - available, 4 - %used, 5 - Mounted On
#
sub GetWindowsVolumeInfo()
{
	my $SERVICES = ConnectWMIOLE( &apos;&apos;, &apos;root/cimv2&apos; );
	my @VOLINFO;
	my $VOLCOUNT = 0;
	my $ENUM;

	if ( $SERVICES ne "" )
	{
		if ( ( $ENUM = $SERVICES-&gt;InstancesOf("Win32_LogicalDisk") ) )
		{
			$VOLCOUNT = $ENUM-&gt;{Count};
		}
	}

	# Build List of Volume information
	#
	if ( $VOLCOUNT &gt; 0 )
	{
		my $VCNTR = 0;

		for my $ITEM ( in $ENUM )
		{
			my $DRIVETYPE = $ITEM-&gt;{&apos;DriveType&apos;};
			my $DEVID     = $ITEM-&gt;{&apos;DeviceID&apos;};
			my $PROVNAME  = $ITEM-&gt;{&apos;ProviderName&apos;};
			my $VOLNAME   = $ITEM-&gt;{&apos;VolumeName&apos;};
			my $SIZE      = $ITEM-&gt;{&apos;Size&apos;};
			my $FREE      = $ITEM-&gt;{&apos;FreeSpace&apos;};

			# Skip the removable drives CD,Floppy,DVD, RAM disk
			#
			if ( ( $DRIVETYPE == 2 ) || ( $DRIVETYPE == 5 ) || ( $DRIVETYPE == 6 ) )
			{
				next;
			}
			else
			{
				my @VINFO;
				my $PERCENT;
				my $USED;
				my $NAME;
				my $MOUNTNAME;

				# Make sure we get values, drives could be offline
				#
				if ( ( $SIZE eq "" ) || ( $SIZE == 0 ) )
				{
					$SIZE = "unavailable";
				}

				# We could get back a ligitimate 0, but also indicates drive off line
				#
				if ( ( $FREE eq "" ) || ( $FREE == 0 ) )
				{
					$FREE = "unavailable";
				}

				if ( ( $SIZE eq "unavailable" ) || ( $FREE eq "unavailable" ) )
				{
					$PERCENT = "unavailable";
					$USED = "unavailable";
				}
				else
				{
					# Return Values in Kbytes
					#
					$SIZE = sprintf( "%lu", $SIZE/1024 );
					$FREE = sprintf( "%lu", $FREE/1024 );
					$USED  = $SIZE - $FREE;
					$PERCENT = sprintf( "%d", (($USED/$SIZE) * 100));
				}

				# Use Device ID, recognized by user
				$NAME = $DEVID;

				# Now sort out the name
				#
				#if ( $DRIVETYPE == 3 )
				#{
				# Local check volume Name or use DeviceID
				#    if ( $VOLNAME eq "" )
				#    {
				#    	$NAME = $DEVID;
				#    }
				#    else
				#    {
				#        $NAME = $VOLNAME;
				#    }
				#}
				#else
				#{
				#	$NAME = $VOLNAME;
				#}

				$MOUNTNAME = $PROVNAME;

				$VINFO[0] = $NAME;
				$VINFO[1] = $SIZE;
				$VINFO[2] = $USED;
				$VINFO[3] = $FREE;
				$VINFO[4] = $PERCENT;
				$VINFO[5] = $MOUNTNAME;

				$VOLINFO[ $VCNTR ] = [ @VINFO ];
				++$VCNTR;
			}
		}
	}

	return @VOLINFO;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionGetWindowsVolumeInfoByDriveType">#
# Retrieve volume information from a Windows machine for a specific drive type.
#
# Drive types:
#
# 0 = Unknown
# 1 = No Root Directory
# 2 = Removable Disk
# 3 = Local Disk
# 4 = Network Drive
# 5 = Compact Disk
# 6 = RAM Disk
#
# Return in the following format:
#
# 0 - name, 1 - kbytes, 2 - used, 3 - available, 4 - %used, 5 - Mounted On
#
# NOTE: Include the script SolutionConnectWMIOLE before including this script.
#
sub SolutionGetWindowsVolumeInfoByDriveType($)
{
	my $TARGET_TYPE = @_[0];

	my $SERVICES = ConnectWMIOLE( &apos;&apos;, &apos;root/cimv2&apos; );
	my @VOLINFO;
	my $VOLCOUNT = 0;
	my $ENUM;

	if ( $SERVICES ne "" )
	{
		if ( ( $ENUM = $SERVICES-&gt;InstancesOf("Win32_LogicalDisk") ) )
		{
			$VOLCOUNT = $ENUM-&gt;{Count};
		}
	}

	#
	# Build List of Volume information
	#
	if ( $VOLCOUNT &gt; 0 )
	{
		my $VCNTR = 0;

		for my $ITEM ( in $ENUM )
		{
			my $DRIVETYPE = $ITEM-&gt;{&apos;DriveType&apos;};
			my $DEVID     = $ITEM-&gt;{&apos;DeviceID&apos;};
			my $PROVNAME  = $ITEM-&gt;{&apos;ProviderName&apos;};
			my $VOLNAME   = $ITEM-&gt;{&apos;VolumeName&apos;};
			my $SIZE      = $ITEM-&gt;{&apos;Size&apos;};
			my $FREE      = $ITEM-&gt;{&apos;FreeSpace&apos;};

			if ($DEBUG)
			{
				print "Found drive: DRIVETYPE - $DRIVETYPE, DEVID - $DEVID, PROVNAME - $PROVNAME, VOLNAME - $VOLNAME, SIZE - $SIZE, FREE - $FREE\n";
			}

			#
			# Only return the list drive types we are looking for...
			#
			if ($DRIVETYPE != $TARGET_TYPE )
			{
				if ($DEBUG)
				{
					print "Drive type $DRIVETYPE does not match target type $TARGET_TYPE - skipping\n";
				}

				next;
			}
			else
			{
				my @VINFO;
				my $PERCENT;
				my $USED;
				my $NAME;
				my $MOUNTNAME;

				#
				# Make sure we get values, drives could be offline
				#
				if ( ( $SIZE eq "" ) || ( $SIZE == 0 ) )
				{
					$SIZE = "unavailable";
				}

				#
				# We could get back a ligitimate 0, but also indicates drive off line
				#
				if ( ( $FREE eq "" ) || ( $FREE == 0 ) )
				{
					$FREE = "unavailable";
				}

				if ( ( $SIZE eq "unavailable" ) || ( $FREE eq "unavailable" ) )
				{
					$PERCENT = "unavailable";
					$USED = "unavailable";
				}
				else
				{
					#
					# Return Values in Kbytes
					#
					$SIZE = sprintf( "%lu", $SIZE/1024 );
					$FREE = sprintf( "%lu", $FREE/1024 );
					$USED  = $SIZE - $FREE;
					$PERCENT = sprintf( "%d", (($USED/$SIZE) * 100));
				}

				#
				# Use Device ID, recognized by user
				#
				$NAME = $DEVID;
				$MOUNTNAME = $PROVNAME;

				$VINFO[0] = $NAME;
				$VINFO[1] = $SIZE;
				$VINFO[2] = $USED;
				$VINFO[3] = $FREE;
				$VINFO[4] = $PERCENT;
				$VINFO[5] = $MOUNTNAME;

				$VOLINFO[ $VCNTR ] = [ @VINFO ];

				print "Including drive: NAME - $NAME, SIZE - $SIZE, USED - $USED, FREE - $FREE, PERCENT - $PERCENT, MOUNTNAME - $MOUNTNAME\n";

				++$VCNTR;
			}
		}
	}

	return @VOLINFO;
}
#
# Copyright 2005-2006 Signiant Inc.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionHashMerge">#
# This script is a copy of the perl Hash::Merge module, which is not included in the version of perl
# bundled with Signiant. It is being included here until it can be incorporated into the main perl
# distribution.
#
package Hash::Merge; {

	use Carp;
	use base &apos;Exporter&apos;;
	use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $context);

	my ( $GLOBAL, $clone );

	$VERSION     = &apos;0.12&apos;;
	@EXPORT_OK   = qw( merge _hashify _merge_hashes );
	%EXPORT_TAGS = ( &apos;custom&apos; =&gt; [qw( _hashify _merge_hashes )] );

	$GLOBAL = {};
	bless $GLOBAL, __PACKAGE__;
	$context = $GLOBAL;    # $context is a variable for merge and _merge_hashes. used by functions to respect calling context

	$GLOBAL-&gt;{&apos;behaviors&apos;} = {
		&apos;LEFT_PRECEDENT&apos; =&gt; {
			&apos;SCALAR&apos; =&gt; {
				&apos;SCALAR&apos; =&gt; sub { $_[0] },
				&apos;ARRAY&apos;  =&gt; sub { $_[0] },
				&apos;HASH&apos;   =&gt; sub { $_[0] },
			},
				&apos;ARRAY&apos; =&gt; {
				&apos;SCALAR&apos; =&gt; sub { [ @{ $_[0] }, $_[1] ] },
				&apos;ARRAY&apos;  =&gt; sub { [ @{ $_[0] }, @{ $_[1] } ] },
				&apos;HASH&apos;   =&gt; sub { [ @{ $_[0] }, values %{ $_[1] } ] },
			},
				&apos;HASH&apos; =&gt; {
				&apos;SCALAR&apos; =&gt; sub { $_[0] },
				&apos;ARRAY&apos;  =&gt; sub { $_[0] },
				&apos;HASH&apos;   =&gt; sub { _merge_hashes( $_[0], $_[1] ) },
			},
		},

		&apos;RIGHT_PRECEDENT&apos; =&gt; {
			&apos;SCALAR&apos; =&gt; {
				&apos;SCALAR&apos; =&gt; sub { $_[1] },
				&apos;ARRAY&apos;  =&gt; sub { [ $_[0], @{ $_[1] } ] },
				&apos;HASH&apos;   =&gt; sub { $_[1] },
			},
				&apos;ARRAY&apos; =&gt; {
				&apos;SCALAR&apos; =&gt; sub { $_[1] },
				&apos;ARRAY&apos;  =&gt; sub { [ @{ $_[0] }, @{ $_[1] } ] },
				&apos;HASH&apos;   =&gt; sub { $_[1] },
			},
			&apos;HASH&apos; =&gt; {
				&apos;SCALAR&apos; =&gt; sub { $_[1] },
				&apos;ARRAY&apos;  =&gt; sub { [ values %{ $_[0] }, @{ $_[1] } ] },
				&apos;HASH&apos;   =&gt; sub { _merge_hashes( $_[0], $_[1] ) },
			},
		},

		&apos;STORAGE_PRECEDENT&apos; =&gt; {
			&apos;SCALAR&apos; =&gt; {
				&apos;SCALAR&apos; =&gt; sub { $_[0] },
				&apos;ARRAY&apos;  =&gt; sub { [ $_[0], @{ $_[1] } ] },
				&apos;HASH&apos;   =&gt; sub { $_[1] },
			},
			&apos;ARRAY&apos; =&gt; {
				&apos;SCALAR&apos; =&gt; sub { [ @{ $_[0] }, $_[1] ] },
				&apos;ARRAY&apos;  =&gt; sub { [ @{ $_[0] }, @{ $_[1] } ] },
				&apos;HASH&apos;   =&gt; sub { $_[1] },
			},
			&apos;HASH&apos; =&gt; {
				&apos;SCALAR&apos; =&gt; sub { $_[0] },
				&apos;ARRAY&apos;  =&gt; sub { $_[0] },
				&apos;HASH&apos;   =&gt; sub { _merge_hashes( $_[0], $_[1] ) },
			},
		},

		&apos;RETAINMENT_PRECEDENT&apos; =&gt; {
			&apos;SCALAR&apos; =&gt; {
				&apos;SCALAR&apos; =&gt; sub { [ $_[0],                          $_[1] ] },
				&apos;ARRAY&apos;  =&gt; sub { [ $_[0],                          @{ $_[1] } ] },
				&apos;HASH&apos;   =&gt; sub { _merge_hashes( _hashify( $_[0] ), $_[1] ) },
			},
			&apos;ARRAY&apos; =&gt; {
				&apos;SCALAR&apos; =&gt; sub { [ @{ $_[0] },                     $_[1] ] },
				&apos;ARRAY&apos;  =&gt; sub { [ @{ $_[0] },                     @{ $_[1] } ] },
				&apos;HASH&apos;   =&gt; sub { _merge_hashes( _hashify( $_[0] ), $_[1] ) },
			},
			&apos;HASH&apos; =&gt; {
				&apos;SCALAR&apos; =&gt; sub { _merge_hashes( $_[0], _hashify( $_[1] ) ) },
				&apos;ARRAY&apos;  =&gt; sub { _merge_hashes( $_[0], _hashify( $_[1] ) ) },
				&apos;HASH&apos;   =&gt; sub { _merge_hashes( $_[0], $_[1] ) },
			},
		},
	};

	$GLOBAL-&gt;{&apos;behavior&apos;} = &apos;LEFT_PRECEDENT&apos;;
	$GLOBAL-&gt;{&apos;matrix&apos;}   = $GLOBAL-&gt;{behaviors}{ $GLOBAL-&gt;{&apos;behavior&apos;} };
	$GLOBAL-&gt;{&apos;clone&apos;}    = 1;

	sub _get_obj {
		if ( my $type = ref $_[0] ) {
			return shift() if $type eq __PACKAGE__ || eval { $_[0]-&gt;isa(__PACKAGE__) };
	}

	return $context;
	}

	sub new {
		my $pkg = shift;
		$pkg = ref $pkg || $pkg;
		my $beh = shift || $context-&gt;{&apos;behavior&apos;};

		croak "Behavior &apos;$beh&apos; does not exist" if !exists $context-&gt;{&apos;behaviors&apos;}{$beh};

		return bless {
			&apos;behavior&apos; =&gt; $beh,
			&apos;matrix&apos;   =&gt; $context-&gt;{&apos;behaviors&apos;}{$beh},
		}, $pkg;
	}

	sub set_behavior {
		my $self  = &amp;_get_obj;    # &apos;&amp;&apos; + no args modifies current @_
		my $value = uc(shift);
		if ( !exists $self-&gt;{&apos;behaviors&apos;}{$value} and !exists $GLOBAL-&gt;{&apos;behaviors&apos;}{$value} ) {
			carp &apos;Behavior must be one of : &apos; . join( &apos;, &apos;, keys %{ $self-&gt;{&apos;behaviors&apos;} }, keys %{ $GLOBAL-&gt;{&apos;behaviors&apos;}{$value} } );
			return;
		}
		my $oldvalue = $self-&gt;{&apos;behavior&apos;};
		$self-&gt;{&apos;behavior&apos;} = $value;
		$self-&gt;{&apos;matrix&apos;} = $self-&gt;{&apos;behaviors&apos;}{$value} || $GLOBAL-&gt;{&apos;behaviors&apos;}{$value};
		return $oldvalue;         # Use classic POSIX pattern for get/set: set returns previous value
	}

	sub get_behavior {
		my $self = &amp;_get_obj;     # &apos;&amp;&apos; + no args modifies current @_
		return $self-&gt;{&apos;behavior&apos;};
	}

	sub specify_behavior {
		my $self = &amp;_get_obj;     # &apos;&amp;&apos; + no args modifies current @_
		my ( $matrix, $name ) = @_;
		$name ||= &apos;user defined&apos;;
		if ( exists $self-&gt;{&apos;behaviors&apos;}{$name} ) {
			carp "Behavior &apos;$name&apos; was already defined. Please take another name";
			return;
		}

		my @required = qw( SCALAR ARRAY HASH );

		foreach my $left (@required) {
			foreach my $right (@required) {
				if ( !exists $matrix-&gt;{$left}-&gt;{$right} ) {
					carp "Behavior does not specify action for &apos;$left&apos; merging with &apos;$right&apos;";
					return;
				}
			}
		}

		$self-&gt;{&apos;behavior&apos;} = $name;
		$self-&gt;{&apos;behaviors&apos;}{$name} = $self-&gt;{&apos;matrix&apos;} = $matrix;
	}

	sub set_clone_behavior {
		my $self     = &amp;_get_obj;          # &apos;&amp;&apos; + no args modifies current @_
		my $oldvalue = $self-&gt;{&apos;clone&apos;};
		$self-&gt;{&apos;clone&apos;} = shift() ? 1 : 0;
		return $oldvalue;
	}

	sub get_clone_behavior {
		my $self = &amp;_get_obj;              # &apos;&amp;&apos; + no args modifies current @_
		return $self-&gt;{&apos;clone&apos;};
	}

	sub merge {
		my $self = &amp;_get_obj;              # &apos;&amp;&apos; + no args modifies current @_

		my ( $left, $right ) = @_;

		# For the general use of this module, we want to create duplicates
		# of all data that is merged.  This behavior can be shut off, but
		# can create havoc if references are used heavily.

		my $lefttype  = ref $left  eq &apos;HASH&apos;  ? &apos;HASH&apos; : ref $left  eq &apos;ARRAY&apos; ? &apos;ARRAY&apos; : &apos;SCALAR&apos;;
		my $righttype = ref $right eq &apos;HASH&apos;  ? &apos;HASH&apos; : ref $right eq &apos;ARRAY&apos; ? &apos;ARRAY&apos; : &apos;SCALAR&apos;;

		if ( $self-&gt;{&apos;clone&apos;} ) {
			$left  = _my_clone( $left,  1 );
			$right = _my_clone( $right, 1 );
		}

		local $context = $self;
		return $self-&gt;{&apos;matrix&apos;}-&gt;{$lefttype}{$righttype}-&gt;( $left, $right );
	}

	# This does a straight merge of hashes, delegating the merge-specific
	# work to &apos;merge&apos;

	sub _merge_hashes {
		my $self = &amp;_get_obj;    # &apos;&amp;&apos; + no args modifies current @_

		my ( $left, $right ) = ( shift, shift );
		if ( ref $left ne &apos;HASH&apos; || ref $right ne &apos;HASH&apos; ) {
			carp &apos;Arguments for _merge_hashes must be hash references&apos;;
			return;
		}

		my %newhash;
		foreach my $leftkey ( keys %$left ) {
			if ( exists $right-&gt;{$leftkey} ) {
				$newhash{$leftkey} = $self-&gt;merge( $left-&gt;{$leftkey}, $right-&gt;{$leftkey} );
			}
			else {
				$newhash{$leftkey} = $self-&gt;{clone} ? $self-&gt;_my_clone( $left-&gt;{$leftkey} ) : $left-&gt;{$leftkey};
			}
		}

		foreach my $rightkey ( keys %$right ) {
			if ( !exists $left-&gt;{$rightkey} ) {
				$newhash{$rightkey} = $self-&gt;{clone} ? $self-&gt;_my_clone( $right-&gt;{$rightkey} ) : $right-&gt;{$rightkey};
			}
		}

		return \%newhash;
	}

	# Given a scalar or an array, creates a new hash where for each item in
	# the passed scalar or array, the key is equal to the value.  Returns
	# this new hash

	sub _hashify {
		my $self = &amp;_get_obj;    # &apos;&amp;&apos; + no args modifies current @_
		my $arg  = shift;
		if ( ref $arg eq &apos;HASH&apos; ) {
			carp &apos;Arguement for _hashify must not be a HASH ref&apos;;
			return;
		}

		my %newhash;
		if ( ref $arg eq &apos;ARRAY&apos; ) {
			foreach my $item (@$arg) {
				my $suffix = 2;
				my $name   = $item;
				while ( exists $newhash{$name} ) {
					$name = $item . $suffix++;
				}
				$newhash{$name} = $item;
			}
		}
		else {
			$newhash{$arg} = $arg;
		}
		return \%newhash;
	}

	# This adds some checks to the clone process, to deal with problems that
	# the current distro of ActiveState perl has (specifically, it uses 0.09
	# of Clone, which does not support the cloning of scalars).  This simply
	# wraps around clone as to prevent a scalar from being cloned via a
	# Clone 0.09 process.  This might mean that CODEREFs and anything else
	# not a HASH or ARRAY won&apos;t be cloned.

	# $clone is global, which should point to coderef

	sub _my_clone {
		my $self = &amp;_get_obj;    # &apos;&amp;&apos; + no args modifies current @_
		my ( $arg, $depth ) = @_;

		if ( $self-&gt;{clone} &amp;&amp; !$clone ) {
			if ( eval { require Clone; 1 } ) {
				$clone = sub {
					if (   !( $Clone::VERSION || 0 ) &gt; 0.09
					&amp;&amp; ref $_[0] ne &apos;HASH&apos;
					&amp;&amp; ref $_[0] ne &apos;ARRAY&apos; ) {
						my $var = shift;    # Forced clone
						return $var;
					}
					Clone::clone( shift, $depth );
				};
			}
			elsif ( eval { require Storable; 1 } ) {
				$clone = sub {
					my $var = shift;        # Forced clone
					return $var if !ref($var);
					Storable::dclone($var);
				};
			}
			elsif ( eval { require Clone::PP; 1 } ) {
				$clone = sub {
					my $var = shift;        # Forced clone
					return $var if !ref($var);
					Clone::PP::clone( $var, $depth );
				};
			}
			else {
				croak "Can&apos;t load Clone, Storable, or Clone::PP for cloning purpose";
			}
		}

		if ( $self-&gt;{&apos;clone&apos;} ) {
			return $clone-&gt;($arg);
		}
		else {
			return $arg;
		}
	}
}#end package</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionKillProcess">#
# Kill the process identified by the given PID.
#
sub SolutionKillProcess($$)
{
	my $PID = @_[0];
	my $ProcName = @_[1];
	my $ExitCode;

	print "Terminating process $ProcName (PID $PID)\n";

	Win32::Process::KillProcess($PID, $ExitCode);
}
#
# Copyright 2005-2006 Signiant Inc.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionKillWinProcessByName">#
# SolutionKillProcessByName
#
# This code is provided so that a script can kill any process simply by knowing its name and
# not having to know its PID. This is initially used by RDP to kill any existing dds_shadow.exe
# processes before job start.
#
my $DWORD_SIZE;
my $PROC_ARRAY_SIZE;
my $MODULE_LIST_SIZE;

my $PROCESS_QUERY_INFORMATION;
my $PROCESS_VM_READ;

my $TOKEN_QUERY;
my $TOKEN_ADJUST_PRIVILEGES;
my $SE_PRIVILEGE_ENABLED;
my $PROCESS_TERMINATE;
my $SE_DEBUG_NAME;

my $GetCurrentProcess;
my $OpenProcessToken;
my $LookupPrivilegeValue;
my $AdjustTokenPrivileges;
my $TerminateProcess;
my $OpenProcess;
my $CloseHandle;
my $EnumProcesses;
my $EnumProcessModules;
my $GetModuleBaseName;
my $GetModuleFileNameEx;
my $GetProcessMemoryInfo;

my @ModuleList;
my @PidList;
my $ProcArray;
my $ProcNum;
my $Pid;
my $Module;
my @KillList;
my $iIndex;
my $iResult;
my $BufSize;

my $ProcessKilled=1;

if ($^O =~ m/MSWin/)
{
	require Win32::API;
	require Getopt::Long;
}

sub KillWinProcessByName($)
{
	my $ProcessName = $_[0];

	push( @ModuleList, $ProcessName );

	$DWORD_SIZE = 4;
	$PROC_ARRAY_SIZE = 100;
	$MODULE_LIST_SIZE = 200;

	$PROCESS_QUERY_INFORMATION = 0x0400;
	$PROCESS_VM_READ = 0x0010;

	$TOKEN_QUERY                = 0x0008;
	$TOKEN_ADJUST_PRIVILEGES    = 0x0020;
	$SE_PRIVILEGE_ENABLED       = 0x02;
	$PROCESS_TERMINATE          = 0x0001;
	$SE_DEBUG_NAME              = "SeDebugPrivilege";

	$GetCurrentProcess = new Win32::API( &apos;Kernel32.dll&apos;, &apos;GetCurrentProcess&apos;, &apos;&apos;, &apos;N&apos; );
	$OpenProcessToken = new Win32::API( &apos;AdvApi32.dll&apos;, &apos;OpenProcessToken&apos;, &apos;NNP&apos;, &apos;I&apos; );
	$LookupPrivilegeValue = new Win32::API( &apos;AdvApi32.dll&apos;, &apos;LookupPrivilegeValue&apos;, &apos;PPP&apos;, &apos;I&apos; );
	$AdjustTokenPrivileges = new Win32::API( &apos;AdvApi32.dll&apos;, &apos;AdjustTokenPrivileges&apos;, &apos;NIPNPP&apos;, &apos;I&apos; );
	$TerminateProcess = new Win32::API( &apos;Kernel32.dll&apos;, &apos;TerminateProcess&apos;, &apos;NI&apos;, &apos;I&apos; );

	$OpenProcess = new Win32::API( &apos;kernel32.dll&apos;, &apos;OpenProcess&apos;, &apos;NIN&apos;, &apos;N&apos; );
	$CloseHandle = new Win32::API( &apos;kernel32.dll&apos;, &apos;CloseHandle&apos;, &apos;N&apos;, &apos;I&apos; );
	$EnumProcesses = new Win32::API( &apos;psapi.dll&apos;, &apos;EnumProcesses&apos;, &apos;PNP&apos;, &apos;I&apos; );
	$EnumProcessModules = new Win32::API( &apos;psapi.dll&apos;, &apos;EnumProcessModules&apos;, &apos;NPNP&apos;, &apos;I&apos; );
	$GetModuleBaseName = new Win32::API( &apos;psapi.dll&apos;, &apos;GetModuleBaseName&apos;, &apos;NNPN&apos;, &apos;N&apos; );
	$GetModuleFileNameEx = new Win32::API( &apos;psapi.dll&apos;, &apos;GetModuleFileNameEx&apos;, &apos;NNPN&apos;, &apos;N&apos; );
	$GetProcessMemoryInfo = new Win32::API( &apos;psapi.dll&apos;, &apos;GetProcessMemoryInfo&apos;, &apos;NPN&apos;, &apos;I&apos; );

	if( scalar @PidList == 0 )
	{
		@PidList = GetPidList();
	}

	my $iTotal = 0;

	$ProcArray = MakeBuffer( $DWORD_SIZE * $PROC_ARRAY_SIZE );
	$ProcNum = MakeBuffer( $DWORD_SIZE );

	foreach $Pid ( @PidList )
	{
		my $iModuleCount = 0;
		my $ProcInfo = GetProcessInfo( $Pid, \@ModuleList );

		next unless( $ProcInfo-&gt;{fModuleFound} );

		if( scalar @{$ProcInfo-&gt;{modules}} )
		{
			push( @KillList, { pid =&gt; $ProcInfo-&gt;{pid}, name =&gt; $ProcInfo-&gt;{name} } );
		}
	}

	KillListOfProcesses( @KillList );

	return($ProcessKilled);
}

sub GetPidList()
{
	my( @PidList );
	my $ProcArrayLength = $PROC_ARRAY_SIZE;
	my $iIterationCount = 0;
	my $ProcNum;
	my $pProcArray;

	do
	{
		my $ProcArrayByteSize;
		my $pProcNum = MakeBuffer( $DWORD_SIZE );
		$ProcNum = 0;
		$ProcArrayLength = $PROC_ARRAY_SIZE * ++$iIterationCount;
		$ProcArrayByteSize = $ProcArrayLength * $DWORD_SIZE;
		$pProcArray = MakeBuffer( $ProcArrayByteSize );

		if( 0 != $EnumProcesses-&gt;Call( $pProcArray, $ProcArrayByteSize, $pProcNum ) )
		{
			$ProcNum = unpack( "L", $pProcNum ) / $DWORD_SIZE;
		}
	}
	while ($ProcNum &gt;= $ProcArrayLength);

	if (0 != $ProcNum)
	{
		@PidList = unpack( "L$ProcNum", $pProcArray );
	}

	return( @PidList );
}


sub GetProcessInfo()
{
	my( $Pid, $ModuleList ) = @_;
	my( %ProcInfo );

	$ProcInfo{name} = "unknown";
	$ProcInfo{pid}  = $Pid;
	@{$ProcInfo{modules}} = ();

	$ProcInfo{name} = "Idle" if( 0 == $Pid );

	my( $hProcess ) = $OpenProcess-&gt;Call( $PROCESS_QUERY_INFORMATION | $PROCESS_VM_READ, 0, $Pid );

	if( $hProcess )
	{
		my( $BufferSize ) = $MODULE_LIST_SIZE * $DWORD_SIZE;
		my( $MemStruct ) = MakeBuffer( $BufferSize );
		my( $iReturned ) = MakeBuffer( $BufferSize );

		$ProcInfo{fModuleFound} = ( scalar @{$ModuleList} )? 0:1;

		if( $EnumProcessModules-&gt;Call( $hProcess, $MemStruct, $BufferSize, $iReturned ) )
		{
			my( $StringSize ) = 255 * ( ( Win32::API::IsUnicode() )? 2 : 1 );
			my( $ModuleName ) = MakeBuffer( $StringSize );
			my( @ModuleList ) = unpack( "L*", $MemStruct );
			my $hModule = $ModuleList[0];
			my $TotalChars;

			$iReturned = unpack( "L", $iReturned ) / $DWORD_SIZE;

			if( $TotalChars = $GetModuleBaseName-&gt;Call( $hProcess, $hModule, $ModuleName, $StringSize ) )
			{
				$ProcInfo{name} = FixString( $ModuleName );
			}
			else
			{
				$ProcInfo{name} = "unknown";
			}

			for( $iIndex = 0; $iIndex &lt; $iReturned; $iIndex++ )
			{
				$hModule = $ModuleList[$iIndex];
				$ModuleName = MakeBuffer( $StringSize );

				if( $GetModuleFileNameEx-&gt;Call( $hProcess,
								$hModule,
								$ModuleName,
								$StringSize ) )
				{
					my $ModuleNameFixed = FixString( $ModuleName );

					if( 0 == $iIndex )
					{
						$ProcInfo{fullname} = $ModuleNameFixed;
					}

					push( @{$ProcInfo{modules}}, $ModuleNameFixed );

					if( 0 == $ProcInfo{fModuleFound} )
					{
						foreach my $TargetModule ( @{$ModuleList} )
						{
							$ProcInfo{fModuleFound} = ( $ModuleNameFixed =~ /$TargetModule/i );
						}
					}
				}
			}
		}

		$BufSize = 10 * $DWORD_SIZE;
		$MemStruct = pack( "L10", ( $BufSize, split( "", 0 x 9 ) ) );

		if( $GetProcessMemoryInfo-&gt;Call( $hProcess, $MemStruct, $BufSize ) )
		{
			my( @MemStats ) = unpack( "L10", $MemStruct );
			$ProcInfo{workingsetpeak} = $MemStats[2];
			$ProcInfo{workingset} = $MemStats[3];
			$ProcInfo{pagefileuse} = $MemStats[8];
			$ProcInfo{pagefileusepeak} = $MemStats[9];
		}

		$CloseHandle-&gt;Call( $hProcess );
	}

	return( \%ProcInfo );
}

sub MakeBuffer
{
	my( $BufferSize ) = @_;
	return( "\x00"  x $BufferSize );
}

sub FixString
{
	my( $String ) = @_;
	$String =~ s/(.)\x00/$1/g if( Win32::API::IsUnicode() );
	return( unpack( "A*", $String ) );
}

sub FormatNumber
{
	my( $Number ) = @_;
	while ($Number =~ s/^(-?\d+)(\d{3})/$1,$2/){};
	return( $Number );
}

sub KillListOfProcesses
{
	my( @KillList ) = @_;

	my $iCount = 0;

	foreach my $Process ( sort { $a-&gt;{name} cmp $b-&gt;{name} } @KillList )
	{
		if( !Kill( $Process-&gt;{pid} ) )
		{
			$ProcessKilled=0;
		}
	}
}

sub Kill
{
	my( $Pid ) = @_;
	my $fResult = 0;

	if( !( $fResult = kill( $Pid, 0 ) ) )
	{
		$fResult = ForceKill( $Pid );
	}

	return( $fResult );
}

sub ForceKill
{
	my( $Pid ) = @_;
	my $iResult = 0;
	my $phToken = pack( "L", 0 );

	if( $OpenProcessToken-&gt;Call( $GetCurrentProcess-&gt;Call(), $TOKEN_ADJUST_PRIVILEGES | $TOKEN_QUERY, $phToken ) )
	{
		my $hToken = unpack( "L", $phToken );

		if( SetPrivilege( $hToken, $SE_DEBUG_NAME, 1 ) )
		{
			my $hProcess = $OpenProcess-&gt;Call( $PROCESS_TERMINATE, 0, $Pid );

			if( $hProcess )
			{
				SetPrivilege( $hToken, $SE_DEBUG_NAME, 0 );
				$iResult = $TerminateProcess-&gt;Call( $hProcess, 0 );
				$CloseHandle-&gt;Call( $hProcess );
			}
		}

		$CloseHandle-&gt;Call( $hToken );
	}

	return( $iResult );
}

sub SetPrivilege
{
	my( $hToken, $pszPriv, $bSetFlag ) = @_;
	my $pLuid = pack( "Ll", 0, 0 );

	if( $LookupPrivilegeValue-&gt;Call( "\x00\x00", $pszPriv, $pLuid ) )
	{
		my $pPrivStruct = pack( "LLlL", 1, unpack( "Ll", $pLuid ), ( ( $bSetFlag )? $SE_PRIVILEGE_ENABLED : 0 ) );
		$iResult = ( 0 != $AdjustTokenPrivileges-&gt;Call( $hToken, 0,$pPrivStruct, length( $pPrivStruct ), 0, 0 ) );
	}

	return( $iResult );
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionMakeNativePath">#
# Convert back slashes to forward slashes or vice-versa
# depending on the running platform.
#
sub MakeNativePath($)
{
	my ($PATH) = @_;

	if ($^O eq "MSWin32")
	{
		#
		# Windows - Convert all forward slashes to backslashes
		#
		$PATH =~ s/\//\\/g;
	}
	else
	{
		#
		# Windows - Convert all back slashes to forward slashes
		#
		$PATH =~ s/\\/\//g;
	}

	return($PATH);
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionMapFullPathSource">#
# 1. Get the file name only, removing the host portion
# 2. Determine the type of file
#
# File types are as follows:
# -1 = UNKNOWN, 0 - drives, 1 - root, 2 - unc, 3 - application data
#
# Define the following for flexability PrefixDrive, PrefixRoot, PrefixUNC, PrefixAppData
#
sub MapFullPathFromTargetStorage ($$$)
{
	my $PATHNAME = @_[0];
	my $HOSTNAME = @_[1];

	my $TARGETFILE = "";
	my $FILETYPE = -1;

	my $TARGETPATH = "";
	my $FOUNDPATH = 0;

	my $PREPATH = "";
	my $MATCHPATH = "";

	my $PrefixDrive=&apos;%PrefixDrive%&apos;;
	my $PrefixRoot=&apos;%PrefixRoot%&apos;;
	my $PrefixUNC=&apos;%PrefixUNC%&apos;;
	my $PrefixAppData=&apos;%PrefixAppData%&apos;;

	#
	# We are only interested in pathnames matching the following patterns:
	#
	# $HOSTNAME/latest/
	# $HOSTNAME/versions/&lt;new_version_format&gt;/
	# $HOSTNAME/versions/&lt;old_version_format&gt;/
	# $HOSTNAME/&lt;old_version_format&gt;/
	#

	if ($PATHNAME =~ m/$HOSTNAME\/latest\//i)
	{
		$PREPATH=$`;
		$MATCHPATH=$&amp;;
		$TARGETPATH=$&apos;;
		$FOUNDPATH = 1;
	}
	elsif ($PATHNAME =~ m/$HOSTNAME\/versions\/\d\d-\d\d-\d\d_\d\d-\d\d-\d\d\//i)
	{
		$PREPATH=$`;
		$MATCHPATH=$&amp;;
		$TARGETPATH=$&apos;;
		$FOUNDPATH = 1;
	}
	elsif ($PATHNAME =~ m/$HOSTNAME\/versions\/\d{12}\//i)
	{
		$PREPATH=$`;
		$MATCHPATH=$&amp;;
		$TARGETPATH=$&apos;;
		$FOUNDPATH = 1;
	}
	elsif ($PATHNAME =~ m/$HOSTNAME\/\d{12}\//i)
	{
		$PREPATH=$`;
		$MATCHPATH=$&amp;;
		$TARGETPATH=$&apos;;
		$FOUNDPATH = 1;
	}

	if ($FOUNDPATH)
	{
		#
		# Now look for our well-known-prefixes...
		#
		if ($TARGETPATH =~ m/^$PrefixDrive/i)
		{
			$TARGETFILE=$&apos;;
			$FILETYPE = 0;
		}
		elsif ($TARGETPATH =~ m/^$PrefixRoot/i)
		{
			$TARGETFILE=$&apos;;
			$FILETYPE = 1;
		}
		elsif ($TARGETPATH =~ m/^$PrefixUNC/i)
		{
			$TARGETFILE=$&apos;;
			$FILETYPE = 2;
		}
		elsif ($TARGETPATH =~ m/^$PrefixAppData/i)
		{
			$TARGETFILE=$&apos;;
			$FILETYPE = 3;
		}
		else
		{
			$TARGETFILE = "";
			$FILETYPE = -1;
		}
	}
	else
	{
		$TARGETFILE = "";
		$FILETYPE = -1;
	}

	@_[2] = $FILETYPE;

	return $TARGETFILE;
}

#
# Copyright 2004-2006 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionMapFullPathTarget">#
# Function to map full path file names to target storage
# Args 1) Add prefix identifier 2) FileName 3) Prefix
#
#
# Define the following for flexability PrefixDrive, PrefixRoot, PrefixUNC
#

sub MapFullPathToTargetStorage ( $$$ )
{
	my $PREPENDPREFIX = $_[0];
	my $FILENAME = $_[1];

	my $UNIXROOT = 0;
	my $UNC = 0;

	my $PREMATCH="";
	my $MATCH="";
	my $POSTMATCH="";

	if ($FILENAME =~ m/^\w:(\\|\/)/)
	{
		#
		# Drive specifier...C:\
		#
		$PREMATCH=$`;
		$MATCH=$&amp;;
		$POSTMATCH=$&apos;;

		$FILENAME = uc($MATCH) . $POSTMATCH; # Lower-case the drive specifier

		$FILENAME =~ s/://; # Remove the colon

		@_[2] = q|%PrefixDrive%|;
	}
	elsif ($FILENAME =~ m/^(\\\\|\/\/)[^\\\/]+?(\\|\/)[^\\\/]+?$/)
	{
		#
		# UNC Share Only: \\SERVER\SHARE
		#
		$PREMATCH=$`;
		$MATCH=$&amp;;
		$POSTMATCH=$&apos;;

		$FILENAME = uc($MATCH) . $POSTMATCH;

		@_[2] = q|%PrefixUNC%|;

		$UNC = 1;
	}
	elsif ($FILENAME =~ m/^(\\\\|\/\/)[^\\\/]+?(\\|\/)[^\\\/]+?(\\|\/)/)
	{
		#
		# UNC Share and PATH: \\SERVER\SHARE\Path
		#
		$PREMATCH=$`;
		$MATCH=$&amp;;
		$POSTMATCH=$&apos;;

		$FILENAME = uc($MATCH) . $POSTMATCH;

		@_[2] = q|%PrefixUNC%|;

		$UNC = 1;
	}
	elsif ($FILENAME =~ m/^(\\|\/)/)
	{
		@_[2] = q|%PrefixRoot%|;

		$UNIXROOT = 1;
	}
	else
	{
		@_[2] = q|%PrefixDrive%|;
	}

	if ($PREPENDPREFIX)
	{
		if ($UNIXROOT)
		{
			return @_[2] . $FILENAME;
		}
		else
		{
			if ($UNC)
			{
				$FILENAME =~ s/^(\\\\|\/\/)/\//;
			}

			return @_[2] . "/" . $FILENAME;
		}
	}
	else
	{
		return $FILENAME;
	}
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionModifyInputValue">#
# Modify the input values to remove quotes and trailing "/" "\"
# This strips off a lot of junk that gets inserted into variables
# from substitution from prompts
#
sub ModifyInputValue( $$;$ )
{
	my $MODIFY = $_[0];
	my $REPLACEBS = $_[1];
	my $PRESERVE_SPACES = $_[2];

	if ( $MODIFY ne "" )
	{
		if ( ( $MODIFY =~ m/^\".+$\"/ ) )
		{
			$MODIFY =~ s/^\"//;
			$MODIFY =~ s/$\"//;
		}

		if ( ! $PRESERVE_SPACES ) {
				# Remove trailing leading whitespace
				$MODIFY =~ s/^\s*(.*?)\s*$/$1/;
		}

		# Remove trailing / or \, findfiles does not like them
		if ( $MODIFY ne "/" )
		{
			if ( $MODIFY =~ m/(\\|\/)$/ )
			{
				if ( ! ( $MODIFY =~ m/(:\\|:\/)$/ ) )
				{
					$MODIFY =~ s/(\\|\/)$//;
				}
			}
		}

		# UNC names get first \ removed unless user enters \\\\
		if ( ( $MODIFY =~ m/^\\/ ) )
		{
			if (  ! ( $MODIFY =~ m/^\\\\/ ) )
			{
				$MODIFY = "\\" . $MODIFY;
			}
		}

		if ( $REPLACEBS == 1 )
		{
			$MODIFY =~ s/\\/\\\\/g;
		}
		elsif ( $MODIFY =~ m/\w:\\$/ ) # need this because of escape char "\"
		{
			$MODIFY = $MODIFY . "\\";
		}
	}

	return $MODIFY;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionModifyInputValueMulti">#
# Calls the ModifyInputValue value for each component of the comma-delimited string
#
sub ModifyInputValueMulti ($$)
{
	my $DIRS = $_[0];
	my $REPLACEBS = $_[1];
	my $FORMATDIR = "";

	if ($DIRS ne "")
	{
		my @DIRTOSEARCH = split/,/, $DIRS;

		foreach my $DIR (@DIRTOSEARCH)
		{
			$DIR = ModifyInputValue($DIR,$REPLACEBS);

			if ($FORMATDIR eq "")
			{
				$FORMATDIR = $DIR;
			}
			else
			{
				$FORMATDIR = $FORMATDIR . "," . $DIR;
			}
		}
	}

	return($FORMATDIR);
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionMoveFiles">#
# Moves all the files from the source to the target directory.  Will over write files in the target
# on name collision
#
# Note: requires inclusion of SolutionGetBaseDirectoryListing
#
sub MoveFiles($$)
{
	my $SourceFolder = $_[0];
	my $TargetFolder = $_[1];

	require File::Copy;
	require File::Path;

	my @FilesToMove = GetBaseDirectoryListing($SourceFolder);
	my $Filename;
	foreach $Filename (@FilesToMove)
	{
		if ($Filename eq "." or $Filename eq "..")
		{
			next;
		}

		my $SourceFile = $SourceFolder."/".$Filename;

		if ( -d $SourceFile )
		{
			my $TargetSubFolder = $TargetFolder."/".$Filename;
			main::SigPrintLog("Moving $SourceFile to $TargetSubFolder",main::LOGDEBUG);
			mkdir($TargetSubFolder);
			MoveFiles($SourceFile, $TargetSubFolder);
			File::Path::rmtree($SourceFile);
		}
		else
		{
			main::SigPrintLog("Moving $Filename to $TargetFolder",main::LOGDEBUG);
			File::Copy::move($SourceFile, $TargetFolder);
		}
	}
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionNormalizePath">#
# NormalizePath - Converts all slashes to forward slashes AND reduces repeated slashes to a single slash, while still preserving UNC path (double leading slash)
#
sub NormalizePath($)
{
	my $Path = $_[0];
	
	$Path =~ s/[\\\/]/\//g;
	
	if ($Path =~ m/^[\/]{2,}/)
	{
		my $Prefix=substr($Path,0,2);
		my $Suffix=substr($Path,2);
		$Suffix =~ s/[\/]{2,}/\//g;
		$Path = $Prefix . $Suffix;
	}
	else
	{
		$Path =~ s/[\/]{2,}/\//g;
	}
	
	return($Path);
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionNotify">#
# Send the supplied Message to requested notification
# interface
# Supported are All:0, noh:1, status:2, succ_body:4, fail_body:8, stderr:12
# Args: 1 - Message, 2 - Level
#
sub NotifyMessage( $$ )
{
	my $MESSAGE = $_[0];
	my $LEVEL = $_[1];

	if ( $LEVEL == 0 )
	{
		print STDERR "$MESSAGE";
		print "%dds_active_status%$MESSAGE";
		print "%dds_notify_fail_body%$MESSAGE";
		print "%dds_notify_succ_body%$MESSAGE";
	}
	else
	{
		if ( $LEVEL &amp; 1 ) { print "$MESSAGE"; };
		if ( $LEVEL &amp; 2 ) { print "%dds_active_status%$MESSAGE"; };
		if ( $LEVEL &amp; 4 ) { print "%dds_notify_succ_body%$MESSAGE"; };
		if ( $LEVEL &amp; 8 ) { print "%dds_notify_fail_body%$MESSAGE"; };
		if ( $LEVEL &amp; 16 ) { print STDERR "$MESSAGE"; };
	}
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionOSSupportsVolumeShadowCopy">#
# Returns true if the OS suppoer volume shadow copy service.
# Requires GetWindowsOS() to already have been included.
#
sub SolutionOSSupportsVolumeShadowCopy($$)
{
	my $AGENT = $_[0];
	my $STDOUT_SAFE = $_[1];

	my $PLATFORM = &apos;&apos;;
	my $WinOS;
	my $WinOSVersion;
	my $VersionMajor;
	my $VersionMinor;
  	my $VSC_SUPPORTED=0;

	if (lc($AGENT) eq "target")
	{
		$PLATFORM = &apos;%tgt_platform%&apos;;
	}
	else
	{
		$PLATFORM = &apos;%src_platform%&apos;;
	}

	if ($^O =~ m/MSWin/)
	{
		#
		# NOTE: This eval was added explicitly for Snap - so the require &amp; input of Win32 would not break 5.2 agents.
		#
		eval
		{
			require Win32;
			import Win32::GetOSName();
			$WinOS = Win32::GetOSName();
			$WinOSVersion = join(",",Win32::GetOSVersion());
		};

		my @s = split (/,/,$WinOSVersion);
		$VersionMajor=$s[1];
		$VersionMinor=$s[2];

		if (($VersionMajor == 5 &amp;&amp; $VersionMinor &gt; 0) || ($VersionMajor == 6))
		#if (($WinOS =~ m/2003/) || ($WinOS =~ m/XP/) || ())
		{
			$VSC_SUPPORTED = 1;
		}
	}

	if ($DEBUG)
	{
		if ($STDOUT_SAFE)
		{
			if ($VSC_SUPPORTED)
			{
				print "O/S supports Volume Shadow Copy: $PLATFORM - $VersionMajor.$VersionMinor\n";
			}
			else
			{
				print "O/S does not support Volume Shadow Copy: $PLATFORM - $VersionMajor.$VersionMinor\n";
			}
		}
	}

	return($VSC_SUPPORTED);
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionParseJobStats">#
# Parse the Summary record from the stats records
#
sub ParseStatsSummaryForJob( $ )
{
	return ParseStatsForJob( $_[0], 1 );
}
#
# Parse the Constant message from the stats records
#
sub ParseStatsConstantsForJob( $ )
{
	return ParseStatsForJob( $_[0], 2 );
}
#
# Parse the Report message from the stats records
#
sub ParseStatsReportForJob( $ )
{
	return ParseStatsForJob( $_[0], 3 );
}
#
# Parse the Aggregate message from the stats records
#
sub ParseStatsAggregateForJob( $ )
{
	return ParseStatsForJob( $_[0], 4 );
}

#
# Parse the stats message, return hash with the job template as key and Name/Value pairs hash per key
# Type - ( 1 - Summary, 2 - Constants, Reports - 3, Aggregate - 4
#
sub ParseStatsForJob( $$ )
{
	my $REPORT = $_[0];
	my $TYPE = $_[1];

	my $PARSETOKEN;

	if    ( $TYPE == 1 ) {$PARSETOKEN = "stats_summary";}
	elsif ( $TYPE == 2 ) {$PARSETOKEN = "stats_const";}
	elsif ( $TYPE == 3 ) {$PARSETOKEN = "stats_report";}
	else  { $PARSETOKEN = "stats_const"; }

	my %HASHTEMPLATE=();

	my $MSG;
	my $TEMPLATE;

	my $MSGHDR = index( $REPORT, $PARSETOKEN );
	my $SEP    = index( $REPORT, ";", $MSGHDR );
	my $OFFSET = 0;

	while ( ( $MSGHDR &gt; -1 ) &amp;&amp; ( $SEP &gt; -1 ) )
	{
		$MSG = substr ( $REPORT, ($OFFSET + length( $PARSETOKEN )), ( $SEP - ($OFFSET + length( $PARSETOKEN )) ) );
		my %HASHPARMS = ();
		%HASHPARMS = ParseNameValuePairs( $MSG );

		$TEMPLATE = $HASHPARMS{pkgname};

		if ( $TEMPLATE ne "" )
		{
			if ( ! exists( $HASHTEMPLATE{$TEMPLATE} ) )
			{
				my %HASHSTATS=();
				$HASHTEMPLATE{$TEMPLATE} = \%HASHSTATS;
			}

			if    ( $PARSETOKEN eq "stats_summary" ) { $HASHTEMPLATE{$TEMPLATE}{summary}   = \%HASHPARMS; }
			elsif ( $PARSETOKEN eq "stats_const" )   { $HASHTEMPLATE{$TEMPLATE}{constants} = \%HASHPARMS; }
			else
			{
				if ( ! exists( $HASHTEMPLATE{$TEMPLATE}{reports} ) )
				{
					my %HASHREPORTS=();
					$HASHTEMPLATE{$TEMPLATE}{reports} = \%HASHREPORTS;
				}

				my $KEY = $HASHPARMS{src} . "-" . $HASHPARMS{tgt};
				$HASHTEMPLATE{$TEMPLATE}{reports}{$KEY} = \%HASHPARMS;
			}
		}
		else
		{
			last; # Break out on bad record
		}

		if ( $TYPE == 4 ) # Look for all in parse all mode, use first token found
		{
			my $SUMHDR = index ( $REPORT, "stats_summary", ($SEP+1) );
			my $CSTHDR = index ( $REPORT, "stats_const",   ($SEP+1) );
			my $RPTHDR = index ( $REPORT, "stats_report",  ($SEP+1) );

			my @INDEXES = ($SUMHDR, $CSTHDR, $RPTHDR);
			my @SORTED = sort{$a &lt;=&gt; $b} @INDEXES;

			foreach my $IND ( @SORTED )
			{
				if ( $IND &gt; -1 )
				{
					if    ( $IND == $SUMHDR ) { $PARSETOKEN = "stats_summary"; }
					elsif ( $IND == $CSTHDR ) { $PARSETOKEN = "stats_const"; }
					elsif ( $IND == $RPTHDR ) { $PARSETOKEN = "stats_report"; }
					last; # Default last one used, should not hit this case
				}
			}
		}

		# Nothing found from type all check this will fail and loop terminates
		if ( ($MSGHDR = index ( $REPORT, $PARSETOKEN, ($SEP+1) )) &gt; -1 )
		{
			$SEP = index ( $REPORT, ";", ($MSGHDR + 1) );
			$OFFSET = $MSGHDR;
		}
	}

	return %HASHTEMPLATE;
}

#
# Parse line for name=value pairs where value can be enclosed in quotes.
# Must index through as pattern too sporadic for regex (optional quotes, spaces, etc).
#
sub ParseNameValuePairs( $ )
{
	my $NVPAIRS = $_[0];

	my %HASHNVP=();

	my $NAME;
	my $VALUE;
	my $START = 0;
	my $END = length ( $NVPAIRS );
	my $SEP = index ( $NVPAIRS, "=", $START );

	while ( $SEP &gt; -1 )
	{
		# Get name portion
		$NAME = substr( $NVPAIRS, $START, ($SEP-$START) );

		# Remove trailing leading whitespace, leading trailing quotes
		$NAME =~ s/^\s*(.*?)\s*$/$1/;
		$NAME =~ s/^\"//;
		$NAME =~ s/$\"//;

		#
		# If VALUE starts with QUOTE, look for end quote
		# Else look for end SPACE
		#
		if (substr($NVPAIRS,$SEP+1,1) eq "\"")
		{
			$START = index( $NVPAIRS, "\"", ($SEP + 2) );
		}
		else
		{
			$START = index( $NVPAIRS, " ", ($SEP + 1) );
		}

		if ( $START &lt; 0 )
		{
			$START = $END;
		}

		$VALUE = substr( $NVPAIRS, ($SEP + 1), ($START - $SEP) );

		# Remove trailing leading whitespace, leading trailing quotes
		$VALUE =~ s/^\s*(.*?)\s*$/$1/;
		$VALUE =~ s/^\"//;
		$VALUE =~ s/$\"//;

		$HASHNVP{$NAME} = $VALUE;

		if ( $START &lt; $END )
		{
			$START = $START + 1;
			$SEP = index ( $NVPAIRS, "=", ($START) );
		}
		else
		{
			$SEP = -1;
		}
	}

	return %HASHNVP;
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionParseShadowMapFile">#
# Read shadow device map file
#	- if drive "n" exists in map file,
#		-- set value from map file in device map hash
#
sub SolutionParseShadowMapFile($$$$)
{
	my $DeviceMapping = @_[0]; # By reference
	my $ShadowSetID = @_[1];
	my $ShadowMapFile = @_[2];
	my $STDOUT_SAFE = $_[3];

	$ShadowSetID="";

	if (-f $ShadowMapFile)
	{
		if (open(MAPFILE ,$ShadowMapFile))
		{
			while (!eof(MAPFILE))
			{
				my $MapLine = &lt;MAPFILE&gt;;

				$MapLine =~ s/[\n\r]//g;	# Remove newlines and/or line-feeds

				my @fields = split (/\s*\t\s*/,$MapLine); # Split based on TAB

				my $FieldCount = scalar @fields;

				if ( $FieldCount eq 3 )
				{
					my $DRIVE=$fields[0];

					$DRIVE =~ m/^[a-zA-Z]:/;
					$DRIVE = $&amp;;

					my $SHADOWDEVICE=$fields[1];

					$ShadowSetID=$fields[2];

					if ($DRIVE ne "")
					{
						$DeviceMapping-&gt;{uc($DRIVE)}=$SHADOWDEVICE;
					}
				}
				else
				{
					print STDERR "ERROR: Shadow map file contains inconsistent records.\n";
				}
			}

			close(MAPFILE);

			if ($ShadowSetID eq "")
			{
				print STDERR "ERROR: Shadow set ID could not be determined from shadow map file.\n";
			}
		}
		else
		{
			print STDERR "WARNING: Shadow map file could not be opened.\n";
		}
	}
	else
	{
		print STDERR "WARNING: Shadow map file could not be found.\n";
	}

	if ($STDOUT_SAFE)
	{
		print "Shadow Set ID: $ShadowSetID\n";
	}

	if ($STDOUT_SAFE)
	{
		print "Effective Path Drives (shadow device substituted, where successful)...\n";

		for my $key ( sort keys %$DeviceMapping )
		{
			print "$key =&gt; $DeviceMapping-&gt;{$key}\n";
		}
	}

	$_[1] = $ShadowSetID;

	return(%$DeviceMapping);
}
#
# Copyright 2005-2006 Signiant Inc.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionParseUnixVolumeInfo">#
# Parse Unix volume information. Common Parse to Solaris, HP, and Linux
# Args 1 - Volume information in raw format
#
# Return Volume information in the following format
# 0 - name, 1 - kbytes, 2 - used, 3 - available, 4 - %used, 5 - Mounted On
#

sub ParseUnixVolumeInfo(@)
{
	my @VOLUMES = @_;
	my @VOLINFO;

	my $SIZE = @VOLUMES;

	my $STORENAME = "";

	my $RETCOUNT = 0;

	my @TOKENS;

	# skip header info, start at 1
	for ( my $CNT = 1; $CNT &lt; $SIZE; ++$CNT )
	{
		my $LINE = $VOLUMES[$CNT];
		chomp($LINE);
		#print "Line is $LINE\n";
		@TOKENS = split/\s+/,$LINE;

		# Should get 6 args, if one missing must be name
		my $TOKSIZE = @TOKENS;

		my @VINFO;
		my $CNTV = 0;

		# on HP and Solaris the line may wrap after the first entry, ignore and
		# append to the second line
		if ( $TOKSIZE == 1 )
		{
			$STORENAME = $TOKENS[0];
		}
		else
		{
			if ( $TOKSIZE == 5 )
			{
				if ( $STORENAME eq "" )
				{
					$VINFO[0] = "none";
				}
				else
				{
					$VINFO[0] = $STORENAME;
				}

				$CNTV = 1;

				# Also remove the % on arg 5
				$TOKENS[3] =~ s/%//;

				for ( my $CNTR = 0; $CNTR &lt; $TOKSIZE; ++$CNTR )
				{
					$VINFO[$CNTV] = $TOKENS[$CNTR];
					++$CNTV;
				}
			}
			else
			{
				# Also remove the % on arg 5
				$TOKENS[4] =~ s/%//;

				if ( $TOKENS[0] eq "" )
				{
					if ( $STORENAME eq "" )
					{
						$TOKENS[0] = "none";
					}
					else
					{
						$TOKENS[0] = $STORENAME;
					}
				}

				for ( my $CNTR = 0; $CNTR &lt; $TOKSIZE; ++$CNTR )
				{
					$VINFO[$CNTR] = $TOKENS[$CNTR];
				}
			}

			my $VSIZE = @VINFO;
			$VOLINFO[ $RETCOUNT ] = [ @VINFO ];
			++$RETCOUNT;
		}
	}

	return @VOLINFO;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionPopulateFileListElement">#
# Function:	SolutionPopulateFileListElement($path,$ignoreNonExistentFile)
#
# Parameters:	$path - path to populate information for
#       	$ignoreNonExistentFile - TRUE  - simple information about the file is output
#                                        FALSE - nothing is returned
#
# Description:	Build a hash of the information about a file so that a SigXML file list can be built
#
# Returns: 	A hash with the Appropriate Sig XML elements populated
#

sub SolutionPopulateFileListElement($$)
{
	use File::stat;   
	my $Path = $_[0];
	my $ignoreNonExistentFile = $_[1];

	# Check if file exists before adding it to the list
	if ( !-e $Path )
	{
		if ($ignoreNonExistentFile)
		{
			# Return only the basic information since we can&apos;t get the rest
			return { V =&gt; $Path, T =&gt; "U" };
		}
		else
		{
			# Return nothing
			return;
		}
	}

	# Get the characteristics of the file and build the array of hashes
	my $ElType = "U";
	my $ElSize = 0;

	if ( -f $Path )
	{
		$ElType = "F";
		$ElSize = ( -s $Path );
	}
	elsif ( -d $Path )
	{
		$ElType = "D";
	}
	elsif ( -l $Path )
	{
		$ElType = "L";
	}

	$ElSize = -s "$Path";

	my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = gmtime( stat($Path)-&gt;mtime );
	my $W3C_time = sprintf( "%04d-%02d-%02dT%02d:%02d:%02dZ", ( 1900 + $year ), ( $mon + 1 ), $mday, $hour, $min, $sec );

	# Add element to the array of hashes
	return { V =&gt; $Path, T =&gt; $ElType, S =&gt; $ElSize, MT =&gt; $W3C_time };
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionResolveRecipientInput">#
# Resolve user input from recipient prompt between xml or comma
# separated list of usernames and/or emails
#
sub resolveRecipientInput ($) {

    my $recipientList = $_[0];
    my @UserIdList = (); 

    if ( IsSigListXmlFormat($recipientList) ){
	SigPrintLog("User List is SigXML",LOGDEBUG);
	#
	# Parse the User List XML input...
	#
	my @Elements=();
        my $listType;
	if (SigListXMLParse($recipientList,\$listType,\@Elements) == 0) {
	    @UserIdList = SigListGetELementsByAttribute(\@Elements,"USERNAME");
        }
        else {	
		SigPrintLog("ERROR: User list XML specification is not parsable",LOGERROR);
        }
    }else{
	SigPrintLog("User List is String based",LOGDEBUG);
	my @IdList = split(/,/,$recipientList);
	foreach my $id (@IdList) {
            if ($id ne "" ) {
	        push @UserIdList, $id;
	    }				
	}
    }
    
    return @UserIdList;	
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionSetRDPTransferStatus">#
# Function: SetRDPTransferStatus
#
# Sets the status passed by "Status" for the given job status dir and hostname.
# This is used to keep track of the status of multiple hosts during the course
# of a backup/replication/restore job.
#

sub SetRDPTransferStatus($$$)
{
	use File::Path;

	my $StatusDir = @_[0];
	my $HostName = @_[1];
	my $Status = lc(@_[2]);

	my $STATUSFILE = $StatusDir . "/" . $HostName;

	my $RC=0;

	if (! -d $StatusDir)
	{
		mkpath($StatusDir);
	}

	if (! -f $STATUSFILE)
	{
		if (open(STATUSFILE,"&gt; $STATUSFILE"))
		{
			printf STATUSFILE ("%s\n",$Status);
			close(STATUSFILE);
		}
	}
	else
	{
		my $CurrentStatus = GetRDPTransferStatus($StatusDir,$HostName);

		if (lc($CurrentStatus) ne "error")
		{
			if (open(STATUSFILE,"&gt; $STATUSFILE"))
			{
				printf STATUSFILE ("%s\n",$Status);
				close(STATUSFILE);
				$RC=1;
			}
		}
	}

	return($RC);
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionSetTransferStatus">#
# Function: SetTransferStatus
#
# Sets the status passed by "Status" for the given job status dir and hostname.
# This is used to keep track of the status of multiple hosts during the course
# of a backup/replication/restore job.
#

sub SetTransferStatus($$$)
{
	use File::Path;

	my $StatusDir = @_[0];
	my $HostName = @_[1];
	my $Status = lc(@_[2]);

	my $STATUSFILE = $StatusDir . "/" . $HostName;

	my $RC=0;

	if (! -d $StatusDir)
	{
		mkpath($StatusDir);
	}

	if (! -f $STATUSFILE)
	{
		if (open(STATUSFILE,"&gt; $STATUSFILE"))
		{
			printf STATUSFILE ("%s\n",$Status);
			close(STATUSFILE);
		}
	}
	else
	{
		my $CurrentStatus = GetTransferStatus($StatusDir,$HostName);

		if (lc($CurrentStatus) ne "error")
		{
			if (open(STATUSFILE,"&gt; $STATUSFILE"))
			{
				printf STATUSFILE ("%s\n",$Status);
				close(STATUSFILE);
				$RC=1;
			}
		}
	}

	return($RC);
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionShareAccessible">#
# Make sure share specified is accessible
#
sub ShareAccessible($)
{
	my $SHAREDIR = $_[0];
	my $RET = 1;

	if ( -d $SHAREDIR )
	{
		$RET = 1;
	}
	else
	{
		$RET = 0;
	}

	return $RET;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionSigListXML">sub SigListXMLCreate($$$;$)
{
	#
	# Purpose:
	#	Creates an XML string based on the type and element array passed.
	#	The array can either be a simple array of strings, or an array of
	#	hashes where each hash element represents an element attribute
	#	(i.e. ElArray[n]{&apos;V&apos;}="C:/temp" indicates that this element has an
	#	attribute called "V" with the value "C:/temp").
	#
	# Inputs:
	#	$SigListType: 	The string indicating the list type ("FILEDIR","PATHLIST","MULTILINEVAL")
	#	@ElArray : 		Simple array of strings OR an array of hashes (element attribute name/value pairs)
	#
	# Outputs:
	#	$XMLString: The XML output string
	#
	# Return values:
	#	0: Success
	#	1: Error
	#

	my $XMLString 	= $_[0];
	my $SigListType	= $_[1];
	my $ElArray 	= $_[2]; # By reference - An array of hashes (key,value) or just a simple array of strings
	my $SigListXattrs = $_[3]; # Optionall

	if (ref($ElArray-&gt;[0]) eq "HASH")
	{
		$XMLString = "&lt;SIGLIST TYPE=\&apos;" . SigEscapeXML(uc($SigListType)) . "\&apos;";

		if ($SigListXattrs ne "")
		{
				$XMLString = $XMLString . " XATTRS=\&apos;" . SigEscapeXML($SigListXattrs) . "\&apos;";
		}

		$XMLString = $XMLString . " &gt;";

		for (my $i=0; $i &lt; scalar @{$ElArray}; $i++)
		{
			$XMLString = $XMLString . "&lt;EL";

			foreach my $key (keys %{$ElArray-&gt;[$i]})
			{
				$XMLString = $XMLString . " " . SigEscapeXML($key) . "=\&apos;" . SigEscapeXML($ElArray-&gt;[$i]{$key}) . "\&apos;";
			}

			$XMLString = $XMLString . " /&gt;";
		}

		$XMLString = $XMLString . " &lt;/SIGLIST&gt;";
		$_[0] = $XMLString;
		return(0);
	}
	elsif (ref($ElArray) eq "ARRAY")
	{
		$XMLString = "&lt;SIGLIST TYPE=\&apos;" . SigEscapeXML(uc($SigListType)) . "\&apos; &gt;";

		for (my $i=0; $i &lt; scalar @{$ElArray}; $i++)
		{
			$XMLString = $XMLString . "&lt;EL V=\&apos;" . SigEscapeXML($ElArray-&gt;[$i]) . "\&apos; T=\&apos;U\&apos; /&gt;";
		}

		$XMLString = $XMLString . " &lt;/SIGLIST&gt;";
		$_[0] = $XMLString;
		return(0);
	}
	else
	{
		print STDERR "ERROR: Non-reference passed to SigListXMLCreate as parameter 3\n";
		$_[0] = "";
		return(1);
	}
}

sub SigListXMLParse ($$$;$)
{
	#
	# Purpose:
	#	Parses the XML string and returns an array of hashes.
	#	One array element (hash) is returned per element.
	#	Each hash element represents an element attribute name/value pair.
	#
	# Inputs:
	#		$XMLString: The XML input string
	#
	# Outputs:
	#		$SigListType: The string indicating the list type (e.g. "FILEDIR","PATHLIST","MULTILINEVAL")
	#		@ElArray : Array of hashes; one array element per XML "EL" tag, each with one hash key/value per "EL" attribute.
	#
	# Return values:
	#		0: Success
	#		1: String is not SigList type
	#		2: String is not parsable
	#

	use XML::Parser::Lite;
	#use XML::Parser;

	my $XMLString 	= $_[0]; # By value
	our $SigListType = $_[1]; # By reference
	our $ElArray	= $_[2]; # By reference - An array of hashes
	our $SigListXattrs = $_[3]; # By reference, optional

	#
	# Clear existing data...
	#
	${$SigListType} = "";
	delete @{$ElArray}[0..@{$ElArray}];

	our $ElCount;

	$ElCount = 0;

	if (!IsSigListXmlFormat($XMLString))
	{
		return(1);
	}

	#
	# Initialize the parser...
	#
	my $parser = XML::Parser::Lite-&gt;new( Handlers =&gt;
	#my $parser = XML::Parser-&gt;new( Handlers =&gt;
				{
					Start=&gt;\&amp;_SigListXMLParse_handle_start,
					End=&gt;\&amp;_SigListXMLParse_handle_end,
				});

	#
	# Parse the string in an eval in case it breaks...
	#
	eval { $parser-&gt;parse( $XMLString ); };

	#
	# Error code only if string not parsable...
	#
	if($@ != 0)
	{
  		return(2);
	}

	#
	#print STDERR "SigListType: ${$SigListType}\n";
	#print STDERR "SigListXattrs: ${$SigListXattrs}\n";
	#
	for (my $i=0; $i &lt; scalar @{$ElArray}; $i++)
	{
		#print STDERR "EL[$i]: ";

		foreach my $key (keys %{$ElArray-&gt;[$i]})
		{
			#print STDERR $key . " =&gt; " . $ElArray-&gt;[$i]{$key} . " ";

			#
			# Note: The unescaping must be done here post-parsing since attempting
			# to do it within the event handler causes a perl crash every time.
			#
			$ElArray-&gt;[$i]{$key} = SigUnescapeXML($ElArray-&gt;[$i]{$key});
		}

		#print STDERR "\n";
	}

	return(0);

	sub _SigListXMLParse_handle_start
	{
		my ($expat,$element,%attrs) = @_;
		my $ElType;

		#print STDER "Element: $element\n";

		if (uc($element) eq "SIGLIST")
		{
			if (%attrs)
			{
				while (my($key,$value) = each(%attrs))
				{
					#print STDERR "KEY: $key =&gt; VALUE: $value\n";

					if (uc($key) eq "TYPE")
					{
						${$SigListType}=uc($value);
					}
					elsif (uc($key) eq "XATTRS")
					{
						${$SigListXattrs}=$value;
					}
				}
			}
		}
		elsif (uc($element) eq "EL")
		{
			my $ElType="U";

			if (%attrs)
			{
				while (my($key,$value) = each(%attrs))
				{
					#print STDERR "KEY $ElCount: $key =&gt; VALUE: $value\n";

					$ElArray-&gt;[$ElCount]{uc($key)}=$value;
				}
			}
		}
	}

	sub _SigListXMLParse_handle_end
	{
		my ($expat,$element) = @_;

		if (lc($element) eq "el")
		{
			$ElCount++;
		}
	}
}

sub IsSigListXmlFormat($)
{
	#
	# Purpose:
	#	Returns TRUE or FALSE indicating whether the string appears to be in SigListXML format.
	#
	# Inputs:
	#	$XMLString: The XML input string
	#
	# Outputs:
	#	None
	#
	# Return values:
	#	TRUE: String is in SigList XML format
	#	FALSE: String is in SigList XML format
	#

	return($_[0] =~ m/^&lt;SigList/i);
}

sub SigEscapeXML($)
{
	#
	# Purpose:
	#	Escapes the unsafe XML charasters (&amp;, &lt;, &gt;, &apos; and ").
	#
	# Inputs:
	#	$text: The XML input string
	#
	# Outputs:
	#	None
	#
	# Return values:
	#	The escaped string
	#

	my $text = $_[0];

	$text =~ s/&amp;/&amp;amp;/go;
	$text =~ s/&lt;/&amp;lt;/go;
	$text =~ s/&gt;/&amp;gt;/go;
	$text =~ s/\"/&amp;quot;/go;
	$text =~ s/\&apos;/&amp;apos;/go;

	return($text);
}

sub SigUnescapeXML($)
{
	#
	# Purpose:
	#	Unescapes the unsafe XML charasters (&amp;, &lt;, &gt;, &apos; and ").
	#
	# Inputs:
	#	$text: The XML input string
	#
	# Outputs:
	#	None
	#
	# Return values:
	#	The unescaped string
	#

	my $text = $_[0];

	$text =~ s/&amp;amp;/&amp;/go;
	$text =~ s/&amp;lt;/&lt;/go;
	$text =~ s/&amp;gt;/&gt;/go;
	$text =~ s/&amp;quot;/\"/go;
	$text =~ s/&amp;apos;/\&apos;/go;

	return($text);
}

sub SigListGetELementsByAttribute($$)
{
	#
	# Purpose:
	#	Returns an array of attribute values from the passed element hash of the requested type.
	#
	# Inputs:
	#	@ElArray : Array of elements (simple array of strings OR an array of hashes)
	#
	# Outputs:
	#	None
	#
	# Return values:
	#	The requested array.
	#

	my $ElArray = $_[0]; # By reference - An array of hashes (key,value) or just a simple array of strings
	my $ElAttr 	= $_[1]; # Element attribute type requested
	my @ValArray = ();

	if (ref($ElArray-&gt;[0]) eq "HASH")
	{
		for (my $i=0; $i &lt; scalar @{$ElArray}; $i++)
		{
			if (defined($ElArray-&gt;[$i]{$ElAttr}))
			{
				$ValArray[$i] = $ElArray-&gt;[$i]{$ElAttr};
			}
			else
			{
				$ValArray[$i] = "";
			}
		}

		return(@ValArray);
	}
	elsif (ref($ElArray) eq "ARRAY")
	{
		return(@{$ElArray});
	}
	else
	{
		print STDERR "ERROR: Non-reference passed to SigListGetElType as parameter 1\n";
		return(@{$ElArray});
	}
}

sub SigArrayToMultiLineStr($)
{
	#
	# Purpose:
	#	Takes an element array and creates a multi-line string out of the element values.
	#	The input array can either be a simple array of strings or an array of hashes.
	#	If the input array is an array of hashes, only those hash elements with a
	#	key of &apos;V&apos; (meaning "value") are used to create the output string.
	#
	# Inputs:
	#	@ElArray : Array of elements (simple array of strings OR an array of hashes)
	#
	# Outputs:
	#	$MLString: A string made up of all array elements with newlines inserted.
	#
	# Return values:
	#	0: Success
	#	1: Error
	#

	my $ElArray 	= $_[0]; # By reference - An array of hashes (key,value) or just a simple array of strings
	my $ElString = "";

	if (ref($ElArray-&gt;[0]) eq "HASH")
	{
		for (my $i=0; $i &lt; scalar @{$ElArray}; $i++)
		{
			if (defined($ElArray-&gt;[$i]{&apos;V&apos;}))
			{
				$ElString = $ElString . $ElArray-&gt;[$i]{&apos;V&apos;} . "\n";
			}
		}
	}
	elsif (ref($ElArray) eq "ARRAY")
	{
		for (my $i=0; $i &lt; scalar @{$ElArray}; $i++)
		{
			$ElString = $ElString . $ElArray-&gt;[$i] . "\n";
		}
	}
	else
	{
		print STDERR "ERROR: Non-reference passed to ArrayToMultiLineStr as parameter 1\n";
		$_[0] = "";
		return(1);
	}

	return($ElString);
}

sub SigListXMLCollapseFileList($$)
{
	my $XmlOutputFileList = @_[0];
	my $XmlInputFileList = @_[1];

	my $XMLPathListType="";
	my $SigListXattrs="";
	
	my @ElArray;
	my @SOURCEPATHS;
	my @BASEPATHS;
	
	if (SigListXMLParse($XmlInputFileList,\$XMLPathListType,\@ElArray,\$SigListXattrs ) != 0)
	{
		SigPrintLog("ERROR: File List XML specification is not parsable",LOGERROR);
		return;
	}
	else
	{
		@SOURCEPATHS = sort { length($$a{&apos;V&apos;}) &lt;=&gt; length($$b{&apos;V&apos;}) } @ElArray;

		#SigPrintLog("Input Paths...\n",LOGDEBUG);

		for (my $i=0; $i &lt; scalar(@SOURCEPATHS); $i++)
		{
			$SOURCEPATHS[$i]{V} =~ s|\\|\/|g; # Normalize slashes to simplify pattern matching below
			#SigPrintLog("Path: " . $SOURCEPATHS[$i]{V} . "\n",LOGDEBUG);
			#SigPrintLog("Size: " . $SOURCEPATHS[$i]{S} . "\n",LOGDEBUG);
		}

		$BASEPATHS[0]{V}  = $SOURCEPATHS[0]{V}; # Seed with first element. Since it is the shortest, there can be no parent.
		$BASEPATHS[0]{S}  = $SOURCEPATHS[0]{S};
		$BASEPATHS[0]{T}  = $SOURCEPATHS[0]{T};
		$BASEPATHS[0]{MD} = $SOURCEPATHS[0]{MD};

		my $BasePaths=0;

		for (my $i=1; $i &lt; scalar(@SOURCEPATHS); $i++)
		{
			my $MatchFound = FALSE;
			my $j;

			for ($j=0; $j &lt; scalar(@BASEPATHS); $j++)
			{
				if (substr($SOURCEPATHS[$i]{V},0,length($BASEPATHS[$j]{V})) eq $BASEPATHS[$j]{V}) # Test prefix match
				{
					if (substr($SOURCEPATHS[$i]{V},length($BASEPATHS[$j]{V}),1) =~ m/[\/]/ ) # Test that prefix is a directory
					{
						$MatchFound=TRUE;
						last;
					}
				}
			}

			if ($MatchFound)
			{
				$BASEPATHS[$j]{S} += $SOURCEPATHS[$i]{S}; # Increment size of base path
			}
			else
			{
				$BasePaths++;

				$BASEPATHS[$BasePaths]{V}  = $SOURCEPATHS[$i]{V}; # New base path.
				$BASEPATHS[$BasePaths]{S}  = $SOURCEPATHS[$i]{S};
				$BASEPATHS[$BasePaths]{T}  = $SOURCEPATHS[$i]{T};
				$BASEPATHS[$BasePaths]{MD} = $SOURCEPATHS[$i]{MD};
			}
		}
	}

	#SigPrintLog("Optimized Paths...\n",LOGDEBUG);
	
	#for (my $i=0; $i &lt; scalar(@BASEPATHS); $i++)			
	#{
	#	SigPrintLog("Path: " . $BASEPATHS[$i]{V} . "\n",LOGDEBUG);
	#	SigPrintLog("Size: " . $BASEPATHS[$i]{S} . "\n",LOGDEBUG);
	#}
	
	SigListXMLCreate($XmlOutputFileList,"FILEDIR",\@BASEPATHS);
	$_[0] = $XmlOutputFileList;
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionSNMPGetTrap">#
# SolutionSNMPGetTrap
#
# Retrieve the trap OID and optional text for a given trap name
# from the snmp.map file.
#
#
sub SolutionSNMPGetTrap($$$)
{
	my $TrapName = @_[0];
	my $TrapOID = @_[1];	# By reference
	my $TrapText = @_[2];	# By reference

	my $DdsBinDir = `dds_cfgutil installdirectory`;
	chomp($DdsBinDir);

	my $SnmpMapFile = $DdsBinDir . "/../etc/snmp.map";

	if ($DEBUG)
	{
		print "Looking up SNMP OID for trap name \"$TrapName\"...\n";
	}

	if (-f $SnmpMapFile)
	{
		if (open(MAPFILE ,$SnmpMapFile))
		{
			while (!eof(MAPFILE))
			{
				my $MapLine = &lt;MAPFILE&gt;;

				$MapLine =~ s/[\n\r]//g;	# Remove newlines and/or line-feeds

				my @fields = split (/\s*=\s*/,$MapLine); # Split based on &apos;=&apos;

				my $FieldCount = scalar @fields;

				if ( $FieldCount eq 2 )
				{
					my $TAG = $fields[0];
					my $VALUE = $fields[1];

					if ($TAG eq ("$TrapName" . "_OID"))
					{
						$$TrapOID = $VALUE;
					}
					elsif ($TAG eq ("$TrapName" . "_Text"))
					{
						$$TrapText = $VALUE;
					}
				}
			}

			close(MAPFILE);

			if ($$TrapOID ne "")
			{
				print "Trap OID: $$TrapOID\n";
				print "Trap Text: $$TrapText\n";
			}
			else
			{
				SigPrintLog("ERROR: SNMP OID could not be determined from SNMP map file.",LOGERROR);
			}
		}
		else
		{
			SigPrintLog("WARNING: SNMP map file could not be opened.",LOGERROR);
		}
	}
	else
	{
		SigPrintLog("WARNING: SNMP map file could not be found.",LOGERROR);
	}
}
#
# Copyright 2005-2011 Signiant Inc.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionSNMPSendTrap">#
# Sends an SNMP trap using the dds_snmptrap utility.
#
# Required parameters:
#	TrapID - The enterprise trap number in the signiant MIB
#	TrapText - The optional trap text to send along with the trap
#	TrapHostList - A comma-separated list of trap hosts
#	Community - SNMP community string
#	EnterpriseID - The enterprise ID related to the trap.
#	VarBinds - Optional sequence of variable bindings to send along with the trap.
#
sub SolutionSNMPSendTrap($$$$;$$)
{
	my $TrapOid = @_[0];
	my $TrapText = @_[1];
	my $TrapHostList = @_[2];
	my $Community = @_[3];
	my $EnterpriseID  = @_[4];
	my $VarBinds = @_[5];

	my $SigniantEnterpriseOID = "1.3.6.1.4.1.10232";

	if ($EnterpriseID eq "")
	{
		$EnterpriseID = "10232"; # The Signiant Enterprise ID
	}

	if ($VarBinds eq "")
	{
		$VarBinds = "$SigniantEnterpriseOID.1000.1.1 s \"$TrapText\"";
	}

	my $HOSTINFO = `dds_hostnm`;

	my @HOSTFIELDS = split/ /, $HOSTINFO;
	my $FQDN = $HOSTFIELDS[0];

	my $rc = 0;

	SigPrintLog("Preparing to send SNMP trap...",LOGDEBUG);

	if ($TrapOid eq "")
	{
		SigPrintLog("ERROR: No object identifier specified",LOGERROR);
		$rc=1;
		return($rc);
	}

	if ($TrapHostList eq "")
	{
		SigPrintLog("ERROR: No trap hosts specified",LOGERROR);
		$rc=1;
		return($rc);
	}

	if ($Community eq "")
	{
		SigPrintLog("ERROR: No community string specified",LOGERROR);
		$rc=1;
		return($rc);
	}

	my $DdsBinDir = `dds_cfgutil installdirectory`;

	chomp($DdsBinDir);

	my $DdsSnmpTrap = "dds_snmptrap";

	my @TRAPHOSTS = split/\s*,\s*/, $TrapHostList;

	foreach my $TRAPHOST (@TRAPHOSTS)
	{
		my $CmdStr          = "\"$DdsBinDir/$DdsSnmpTrap\" -v 1 -c $Community $TRAPHOST 1.3.6.1.4.1.$EnterpriseID $FQDN 6 $TrapOid \"\" $VarBinds";
		my $CmdStrDisplay = "\"$DdsBinDir/$DdsSnmpTrap\" -v 1 -c ********** $TRAPHOST 1.3.6.1.4.1.$EnterpriseID $FQDN 6 $TrapOid \"\" $VarBinds";

		SigPrintLog("Calling: $CmdStrDisplay",LOGDEBUG);

		$rc = system($CmdStr);

		if ($rc != 0)
		{
			SigPrintLog("ERROR: dds_snmptrap call returned non-zero status: $CmdStrDisplay",LOGERROR);
			$rc=1;
		}
	}

	return($rc);
}

#
# Copyright 2005-2011 Signiant Inc.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionSplitPaths">sub SolutionSplitPaths
{
	my ($paths, $separ) = @_;

	if ($paths =~ m/^&lt;SIGLIST/i)
	{
		#
		# Parse SIGLIST XML format...
		#
		use XML::Parser::Lite;

		my $XMLString = $paths;
		my $SigListType;
		our @ElArray;

		our $ElCount = 0;

		my @PathArray;
		my $PathCount=0;

		my $parser = XML::Parser::Lite-&gt;new( Handlers =&gt;
					{
						Start=&gt;\&amp;_SolutionSplitPaths_handle_start,
						End=&gt;\&amp;_SolutionSplitPaths_handle_end,
					});

		eval { $parser-&gt;parse( $XMLString ); };

		if($@ != 0)
		{
			print STDERR "ERROR: XML data passed to SolutionSplitPaths was not parsable\n";
	  		return(@PathArray); # For backwards-compatilibility...routines are expecting an array to be passed back
		}

		for (my $i=0; $i &lt; scalar @ElArray; $i++)
		{
			if (defined($ElArray[$i]{&apos;V&apos;}))
			{
				my $path = $ElArray[$i]{&apos;V&apos;};

				$path =~ s/&amp;amp;/&amp;/go;
				$path =~ s/&amp;lt;/&lt;/go;
				$path =~ s/&amp;gt;/&gt;/go;
				$path =~ s/&amp;quot;/\"/go;
				$path =~ s/&amp;apos;/\&apos;/go;

				$PathArray[$PathCount]=$path;
				$PathCount++;
			}
			elsif (defined($ElArray[$i]{&apos;v&apos;}))
			{
				my $path = $ElArray[$i]{&apos;v&apos;};

				$path =~ s/&amp;amp;/&amp;/go;
				$path =~ s/&amp;lt;/&lt;/go;
				$path =~ s/&amp;gt;/&gt;/go;
				$path =~ s/&amp;quot;/\"/go;
				$path =~ s/&amp;apos;/\&apos;/go;

				$PathArray[$PathCount]=$path;
				$PathCount++;
			}
		}

		return(@PathArray);

		sub _SolutionSplitPaths_handle_start
		{
			my ($expat,$element,%attrs) = @_;
			my $ElType;

			if (uc($element) eq "SIGLIST")
			{
				if (%attrs)
				{
					while (my($key,$value) = each(%attrs))
					{
						if (uc($key) eq "TYPE")
						{
							${$SigListType}=uc($value);
						}
					}
				}
			}
			elsif (uc($element) eq "EL")
			{
				my $ElType="U";

				if (%attrs)
				{
					while (my($key,$value) = each(%attrs))
					{
						$ElArray[$ElCount]{uc($key)}=$value;
					}
				}
			}
		}

		sub _SolutionSplitPaths_handle_end
		{
			my ($expat,$element) = @_;

			if (lc($element) eq "el")
			{
				$ElCount++;
			}
		}
	}
	elsif($paths =~ /\&lt;multi\ssep\=\"(.*)\"\&gt;(.*)\&lt;\/multi\&gt;/)
	{
		#
		# Process legacy multi-line format...
		#
		$separ = $1;
		$paths = $2;
		return(split /$separ/, $paths);
	}
	else
	{
		#
		# Split the simple list based on the separator passed-in...
		#
		return(split /$separ/, $paths);
	}
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionStandardHeaderPerl">use strict;

${^WIDE_SYSTEM_CALLS}=1;

select STDERR; $| = 1; # Enable immediate flush on STDERR
select STDOUT; $| = 1; # Enable immediate flush on STDOUT

use constant
{
	false	=&gt;	0,
	FALSE	=&gt;	0,
	true	=&gt;	1,
	TRUE	=&gt;	1,
};

our $FALSE=FALSE; # For backwards-compatibility
our $TRUE=TRUE;   # For backwards-compatibility

use constant
{
	LOGERROR =&gt;	0,
	LOGWARN	 =&gt;	1,
	LOGINFO	 =&gt;	2,
	LOGDEBUG =&gt;	3,

	LOGSTDOUT =&gt; 0,
	LOGSTDERR =&gt; 	1,

};

use constant
{
	MAXVARIABLESIZE =&gt; 524288
};

our $LOGLEVELVALUE = q|%sp_log_severity%|; # Standard log level variable

if ($LOGLEVELVALUE =~ m/^\%/) # If value undefined
{
	$LOGLEVELVALUE = q|%JobLogDetailLevelVar%|; # Legacy variable
}

if ($LOGLEVELVALUE =~ m/^\%/) # If still undefined
{
	$LOGLEVELVALUE = LOGINFO;
}

our $LOGLEVELNAME  = "";
our $DEBUG         = FALSE;

if ( $LOGLEVELVALUE == LOGERROR )
{
	$LOGLEVELNAME = "ERROR";
}
elsif ( $LOGLEVELVALUE == LOGWARN )
{
	$LOGLEVELNAME = "WARN";
}
elsif ( $LOGLEVELVALUE == LOGINFO )
{
	$LOGLEVELNAME = "INFO";
}
elsif ( $LOGLEVELVALUE == LOGDEBUG )
{
	$LOGLEVELNAME = "DEBUG";
	$DEBUG = TRUE;
}

our $IsWindows="";
our $IsUnix="";
our $SLASH="";

if ($^O =~ m/MSWin/)
{
	$IsWindows=TRUE;
	$IsUnix=FALSE;
	#
	# Use forward slashes on Windows instead of backslashes.
	# Perl handles them equally, so if solutions do as well then
	# many translations and mapping problems are avoided.
	#
	$SLASH="/";
}
else
{
	$IsWindows=FALSE;
	$IsUnix=TRUE;
	$SLASH="/";
}

#
# SigPrintLog: A utility routine to print to the job log, using
#              the %dds_msg% keywords for INFO, WARN, ERROR, DEBUG.
#              Log messages are only printed if the current job log
#              level is appropriate for the given message log level.
#              The output stream can be forced to either STDOUT
#              or STDERR to handle commands that should not write
#              to one or the other. STDOUT is the default output
#              stream.
#
sub SigPrintLog($;$$)
{
	my $LogString	= $_[0];
	my $MsgLevel	= $_[1]; # Optional
	my $MsgStream	= $_[2]; # Optional

	my @LogArray = split(/\n/, $LogString);

	foreach my $LogMessage (@LogArray)
	{
		chomp($LogMessage);

		if (length($LogMessage) &gt; 2048)
		{
			$LogMessage = substr($LogMessage,0,2048) . "...";
		}

		if (($MsgLevel eq "") &amp;&amp; ($LOGLEVELVALUE &gt;= LOGINFO)) # Default is info if MsgLevel not specified
		{
			if ($MsgStream == LOGSTDERR) {
				print STDERR (_GetUtf8String("%dds_msg_info%$LogMessage\n"));
			} else {
				print STDOUT (_GetUtf8String("%dds_msg_info%$LogMessage\n"));
			}
		}
		elsif (($MsgLevel == LOGINFO) &amp;&amp; ($LOGLEVELVALUE &gt;= LOGINFO))
		{
			if ($MsgStream == LOGSTDERR) {
				print STDERR (_GetUtf8String("%dds_msg_info%$LogMessage\n"));
			} else {
				print STDOUT (_GetUtf8String("%dds_msg_info%$LogMessage\n"));
			}
		}
		elsif (($MsgLevel == LOGWARN) &amp;&amp; ($LOGLEVELVALUE &gt;= LOGWARN))
		{
			if ($MsgStream == LOGSTDERR) {
				print STDERR (_GetUtf8String("%dds_msg_warning%$LogMessage\n"));
			} else {
				print STDOUT (_GetUtf8String("%dds_msg_warning%$LogMessage\n"));
			}
		}
		elsif (($MsgLevel == LOGERROR) &amp;&amp; ($LOGLEVELVALUE &gt;= LOGERROR))
		{
			if ($MsgStream == LOGSTDERR) {
				print STDERR (_GetUtf8String("%dds_msg_error%$LogMessage\n"));
			} else {
				print STDOUT (_GetUtf8String("%dds_msg_error%$LogMessage\n"));
			}
		}
		elsif (($MsgLevel == LOGDEBUG) &amp;&amp; ($LOGLEVELVALUE &gt;= LOGDEBUG))
		{
			if ($MsgStream == LOGSTDERR) {
				print STDERR (_GetUtf8String("%dds_msg_debug%$LogMessage\n"));
			} else {
				print STDOUT (_GetUtf8String("%dds_msg_debug%$LogMessage\n"));
			}
		}
	}

	#
	# Ensures that a string passed in is encoded as UTF8.
	#
	sub _GetUtf8String($)
	{
		use Encode;

		my ($srcString) = @_;
		my $returnString = $srcString;

		eval {
			Encode::decode(&apos;UTF-8&apos;, $returnString, Encode::FB_QUIET);
		};

		if ($returnString) {
			$returnString = Encode::encode("UTF-8", $srcString);
		} else {
			$returnString = $srcString;
		}

		return $returnString;
	}
}

#
# SigSetVariable: A utility routine to set an internal dds variable so that the user doesn&apos;t need to know the dds_set syntax.
#
sub SigSetVariable($$)
{
	my $VariableName = $_[0];
	my $VariableValue = $_[1];

	if ($VariableName ne "")
	{
		if (length($VariableValue) &lt;= MAXVARIABLESIZE)
		{
			print STDOUT "%dds_set%$VariableName=$VariableValue\n";
			return(TRUE);
		}
		else
		{
			SigPrintLog("WARNING: SigSetVariable - Maximum variable size exceeded for variable &apos;$VariableName&apos; - value will be nullified.",LOGWARN);
			print STDOUT "%dds_set%$VariableName=\n";
			return(FALSE);
		}
	}
	else
	{
		SigPrintLog("ERROR: SigSetVariable - Null value passed as variable name",LOGERROR);
		return(FALSE);
	}
}

#
# SigSetOutput: A utility routine to set an output property so that the user doesn&apos;t need to know the dds_property_set syntax.
#
sub SigSetOutput($$)
{
	my $OutputPropertyName = $_[0];
	my $OutputPropertyValue = $_[1];

	if ($OutputPropertyName ne "")
	{
		if (length($OutputPropertyValue) &lt;= MAXVARIABLESIZE)
		{
			print STDOUT "%dds_property_set%$OutputPropertyName=$OutputPropertyValue\n";
			return(TRUE);
		}
		else
		{
			SigPrintLog("WARNING: SigSetOutput - Maximum variable size exceeded for output property &apos;$OutputPropertyName&apos; - value will be nullified.",LOGWARN);
			print STDOUT "%dds_property_set%$OutputPropertyName=\n";
			return(FALSE);
		}
	}
	else
	{
		SigPrintLog("ERROR: SigSetOutput - Null value passed as output property name name",LOGERROR);
		return(FALSE);
	}
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionSubstituteShadowDevices">#
# Replace all occurrences in the string MultiPathString that match keys in the device map hash
# with the values stored in the given hash bucket.
#
sub SolutionSubstituteShadowDevices($$)
{
	my $MultiPathString = @_[0];
	my $DeviceMapping = @_[1]; # By reference

	if ($DEBUG)
	{
		print "SubstituteShadowDevices: Input String: $MultiPathString\n";
	}

	for my $key ( sort keys %$DeviceMapping )
	{
		$MultiPathString =~ s/$key/$DeviceMapping-&gt;{$key}/ig;
	}

	if ($DEBUG)
	{
		print "SubstituteShadowDevices: Output String: $MultiPathString\n";
	}

	return($MultiPathString);
}
#
# Copyright 2005-2006 Signiant Inc.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionValidateFQDN">#
# Determines if the string passed in matches the rules for a valid FQDN/hostname.
#
sub IsValidFQDN($)
{
	#	
	# The labels must follow the rules for ARPANET host names.  They must
	# start with a letter, end with a letter or digit, and have as interior
	# characters only letters, digits, hyphen or underscore. There are also some
	# restrictions on the length.  
	#
	# labels:   63 octets or less
	# names: 255 octets or less
	#
	my $FQDN=@_[0];

	$FQDN =~ s/^\s*(.*?)\s*$/$1/;	# Remove leading &amp; trailing whitespace

	if ((length($FQDN) &lt; 1) || (length($FQDN) &gt; 255))
	{
		return 0; # FQDN blank or too long.
	}
	
	my @LabelsArray = split(/\./,$FQDN);

	foreach my $label (@LabelsArray)
	{
		if ((length($label) &lt; 1) || (length($label) &gt; 63))
		{
			return 0; # Label portion blank or too long.
		}

		my $Start = "";
		my $Middle = "";
		my $End = "";

		$Start  = substr($label,0,1);
		
		if (length($label) &gt; 1)
		{
			$Middle  = substr($label,1,length($label)-1);
		}
		
		$End = substr($label,length($label)-1,1);

		if (($Start =~ m/[^a-zA-Z]/) || ($Middle =~ m/[^a-zA-Z0-9\-\_]/) || ($End =~ m/[^a-zA-Z0-9]/))
		{
			return(0); # Invalid characters detected.
		}
	}

	return(1); # All is good.
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionValidateIPAddress">#
# Uses a regex to determine if the string passed in matches the rules for a valid IPv4 IP Address.
#
sub IsValidIPAddress($)
{
	my $IPAddr=@_[0];

	$IPAddr =~ s/^\s*(.*?)\s*$/$1/;	# Remove leading &amp; trailing whitespace
	
	if ($IPAddr =~ m/^(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?){1}$/)
	{
		return(1)
	}
	else
	{
		return(0);
	}
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionValidateRootDirectory">#
# Validate the Root directory was specified
# This will check windows drives, unix root, and unc names
#
sub ValidateRootDirectory ($)
{
	my $RET = 1;
	my ($ROOTDIR) = @_;

	#
	# NOTE: We now treat forward slashes and back slashes equally...
	#

	#
	# UNC Drive
	#
	if ( ! ($ROOTDIR =~ m/^(\\\\|\/\/)/ ))
	{
		#
		# Check unix root
		#
		if ( ! ($ROOTDIR =~ m/^(\\|\/)/ ))
		{
			#
			# Check drive:\ of drive:/
			#
			if ( ! ($ROOTDIR =~ m/^\w:(\\|\/)/) )
			{
				$RET = 0;
			}
		}
	}

	return $RET;
}

#
# Copyright 2004-2005 Signiant Corp.
#</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionValidateUnixAbsolutePath">sub SolutionValidateUnixAbsolutePath ($$)
{
	my $PATH = @_[0];
	my $CheckPathExists = @_[1];

	#
	# Return codes:
	#
	# 0: Invalid path
	# 1: Valid path and path exists
	# 2: Valid path but path does not exist
	#
	my $RET = 0;

	if ($DEBUG) { DebugLog("Validating UNIX path: $PATH\n"); };

	#
	# Treat forward slashes and back slashes equally...
	#
	if ($PATH =~ m/^(\\|\/)/)
	{
		if ($CheckPathExists)
		{
			if (-d $PATH)
			{
				if ($DEBUG) { DebugLog("UNIX path is absolute and exists: $PATH\n"); };
				$RET = 1;
			}
			else
			{
				if ($DEBUG) { DebugLog("UNIX path is absolute but does not exist: $PATH\n"); };
				$RET = 2;
			}
		}
		else
		{
			if ($DEBUG) { DebugLog("UNIX path is absolute: $PATH\n"); };
			$RET = 1;
		}
	}
	else
	{
		if ($DEBUG) { DebugLog("Invalid UNIX absolute path: $PATH\n"); };
	}

	return $RET;
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionValidateW3CDateTime">sub SolutionValidateW3CDateTime($)
{
	my $datestr=$_[0];

	if ($datestr =~ m/Z$/i) {
		$datestr =~ s/Z$/-Z/i;
	}

	my @datebits = split(/[-:T+ \/]/,$datestr);
	my $dtspecs = scalar(@datebits);

	my $year=$datebits[0];
	my $month=$datebits[1];
	my $day=$datebits[2];
	my $hour=$datebits[3];
	my $min=$datebits[4];
	my $sec=$datebits[5];
	my $zone_hour=$datebits[6];
	my $zone_min=$datebits[7];

	if ($dtspecs &gt;= 1 &amp;&amp; (($year =~m /\D/) || ($year &lt; 1900)))	{
		return (FALSE,"Invalid year: $year");
	}

	if ($dtspecs &gt;= 2 &amp;&amp; (($month =~m /\D/) || ($month &lt; 1) || ($month &gt; 12))) {
		return (FALSE,"Invalid month: $month");
	}

	if ($dtspecs &gt;= 3 &amp;&amp; (($day =~m /\D/) || ($day &lt; 1) || ($day &gt; 31))) {
		return (FALSE,"Invalid day: $day");
	}

	if ($dtspecs &gt;= 4 &amp;&amp; (($hour =~m /\D/) || ($hour &lt; 0) || ($hour &gt; 23)))	{
		return (FALSE,"Invalid hour: $hour");
	}

	if ($dtspecs &gt;= 5 &amp;&amp; (($min =~m /\D/) || ($min &lt; 0) || ($min &gt; 59))) {
		return (FALSE,"Invalid minute: $min");
	}

	if ($dtspecs &gt;= 6) {
		my $microsec=0;

		if ($sec =~ m/\./)
		{
			my @secbits = split(/[.]/,$sec);

			$sec=$secbits[0];
			$microsec=$secbits[1];
		}

		if (($sec =~m /\D/) || ($sec &lt; 0) || ($sec &gt; 59)) {
			return (FALSE,"Invalid second: $sec");
		}

		if (($microsec =~m /\D/) || ($microsec &lt; 0) || ($microsec &gt; 999))
		{
			return (FALSE,"Invalid microsec: $microsec");
		}
	}

	if ($dtspecs &gt;= 7 &amp;&amp; (uc($zone_hour) ne "Z"))
	{
		if (($zone_hour =~m /\D/) || ($zone_hour &lt; 0) || ($zone_hour &gt; 23))
		{
			return (FALSE,"Invalid timezone hour: $zone_hour");
		}

		if (($zone_min =~m /\D/) || ($zone_min &lt; 0) || ($zone_min &gt; 59))
		{
			return (FALSE,"Invalid timezone minute: $zone_min");
		}
	}

	return(TRUE,"");
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionValidateWindowsAbsolutePath">sub SolutionValidateWindowsAbsolutePath ($$)
{
	my $PATH = @_[0];
	my $CheckPathExists = @_[1];

	#
	# Return codes:
	#
	# 0: Invalid path
	# 1: Valid path and path exists
	# 2: Valid path but path does not exist
	#
	my $RET = 0;

	if ($DEBUG) { DebugLog("Validating Windows path: $PATH\n"); };

	#
	# Check for non-UNC path with optional drive letter specification
	#
	if ($PATH =~ /^([a-zA-Z]:)?[\\\/]([^\\\/]|$)/)
	{
		if ($CheckPathExists)
		{
			#
			# Validate for driver letter then check for existing path on the local system.
			#
			my $drive = $1;
			if (! -e $drive)
			{
				if ($DEBUG) { DebugLog("Invalid Windows drive letter specified: $drive\n"); };
				$RET = 0;
			}
			elsif (! -d $PATH)
			{
				if ($DEBUG) { DebugLog("Windows path is absolute but does not exist: $PATH\n"); };
				$RET = 2;
			}
			else
			{
				if ($DEBUG) { DebugLog("Windows path is absolute and exists: $PATH\n"); };
				$RET = 1;
			}
		}
		else
		{
			if ($DEBUG) { DebugLog("Windows path is absolute: $PATH\n"); };
			$RET = 1;
		}
	}
	#
	# Check UNC path
	#
	elsif ($PATH =~ m/^(\\\\|\/\/)/)
	{
		#
		# Split on either forward or backslash...
		#
		my $MODPATH = $&apos;;
		my @uncpath = split /\/|\\/, $MODPATH;

		my $MachineName = $uncpath[0];
		my $ShareName = $uncpath[1];

		if ($DEBUG)
		{
			DebugLog("UNC path machine name: $MachineName\n");
			DebugLog("UNC path share name: $ShareName\n");
		}

		if ($CheckPathExists)
		{
			#
			# Validate for share access then check for existing share path.
			#
			my $UNCpath = "\\\\" . $MachineName . "\\" . $ShareName;

			if (! -e $UNCpath)
			{
				if ($DEBUG) { DebugLog("Non-existent UNC share specified: $UNCpath\n"); };
				$RET = 0;
			}
			elsif (! -d $PATH)
			{
				if ($DEBUG) { DebugLog("Windows UNC path is absolute but does not exist: $PATH\n"); };
				$RET = 2;
			}
			else
			{
				if ($DEBUG) { DebugLog("Windows UNC path is absolute and exists: $PATH\n"); };
				$RET = 1;
			}
		}
		else
		{
			if ($MachineName ne "" &amp;&amp; $ShareName ne "")
			{
				if ($DEBUG) { DebugLog("Windows UNC path is absolute: $PATH\n"); };
				$RET = 1;
			}
			else
			{
				if ($DEBUG) { DebugLog("Invalid format for Windows UNC path: $PATH\n"); };
				$RET = 0;
			}
		}
	}
	else
	{
		if ($DEBUG) { DebugLog("Invalid Windows absolute path: $PATH\n"); };
		$RET = 0;
	}

	return $RET;
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionWin32GetShortName">#
# Returns the DOS 8.3 name for a given file
#
sub GetShortName( $ )
{
	# run time equivalent of "use ..."
	require Win32::API;
	import  Win32::API;

	my $GetShortPathNameW = new Win32::API(&apos;kernel32&apos;, &apos;GetShortPathNameW&apos;, &apos;PPN&apos;, &apos;N&apos;)
		or die "70025: GetShortName: Cannot load GetShortPathNameW from kernel.dll: "
		. Win32::FormatMessage(Win32::GetLastError());

	my $filename = $_[0];
	$filename =~ s|/|\\|g; # Windows fixup - must always use backslashes!
	if (-d $filename)
	{
		$filename .= "\\";
	}

	my $CP_UTF8 = 65001; # We want to convert from the UTF-8 codepage, not the default active

	my $short_path_name;
	my $wide_char_filename = Win32MultiByteToWideChar($filename, $CP_UTF8);
	# null terminate the perl string so that C will be happy with it
	$wide_char_filename .= "\0";

	# preallocate a buffer to receive the short path;
	my $short_path_buffer = "\0" x 32768;

	my $return = $GetShortPathNameW-&gt;Call($wide_char_filename, $short_path_buffer, length $short_path_buffer);
	if ($return)
	{
		# Convert it back into UTF-8 from wide char.
		$short_path_name = Win32WideCharToMultiByte( $short_path_buffer, $CP_UTF8 );
		# trim it back to the actual length returned from the call
		$short_path_name = substr($short_path_name, 0, $return);
	}
	else
	{
		die "70026: GetShortName: Cannot get short name for $filename: " . Win32::FormatMessage (Win32::GetLastError ());
	}
	return $short_path_name;
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="SolutionWin32MultiByte">#
# Two routines to convert UTF-8 to Windows Wide Chars and back
#

sub Win32MultiByteToWideChar
{
	my $MultiByteToWideChar = new Win32::API(&apos;kernel32&apos;, &apos;MultiByteToWideChar&apos;, &apos;NNPNPN&apos;, &apos;N&apos;)
		or die "70025: MultiByteToWideChar: Cannot load MultiByteToWideChar from kernel32.dll: "
		. Win32::FormatMessage(Win32::GetLastError());

	my($string, $codepage) = @_;
	$codepage = 0 unless defined($codepage);
	# query the size...
	my $result = $MultiByteToWideChar-&gt;Call($codepage,
							0,
							$string, length($string),
							0, 0);
	return undef unless $result;

	my $ustring = " " x ($result*2);
	$result = $MultiByteToWideChar-&gt;Call($codepage,
							0,
							$string, length($string),
							$ustring, $result);
							return undef unless $result;
	return $ustring;
};

sub Win32WideCharToMultiByte
{
	my $WideCharToMultiByte = new Win32::API(&apos;kernel32&apos;, &apos;WideCharToMultiByte&apos;, &apos;NNPNPNPP&apos;, &apos;N&apos;)
		or die "70025: MultiByteToWideChar: Cannot load WideCharToMultiByte from kernel32.dll: "
		. Win32::FormatMessage(Win32::GetLastError());

	my($ustring, $codepage) = @_;
	$codepage = 0 unless defined($codepage);
	# query the size...
	my $result = $WideCharToMultiByte-&gt;Call($codepage,
							0,
							$ustring, -1,
							0, 0,
							0, 0);
	return undef unless $result;
	my $string = " " x $result;
	$result = $WideCharToMultiByte-&gt;Call($codepage,
							0,
							$ustring, -1,
							$string, $result,
							0, 0);
	# $string =~ s/\0.*$//;
	return undef unless $result;
	return $string;
}</CODE_SNIPPET>
	<CODE_SNIPPET NAME="StripString_NormalizePathname">#
# Strip leading/trailing whitespace from the input string (including newlines, etc.), first
# removing any pair of enclosing quotes.
#
sub StripString($)
{
	my $stringToStrip = $_[0];

	# Remove any enclosing quotes
	if ($stringToStrip =~ /^\"(.+)\"$/)
	{
		$stringToStrip = $1;
	}

	# Remove leading/trailing whitespace
	$stringToStrip =~ s/^\s*(.*?)\s*$/$1/;

	return $stringToStrip;
}

#
# Normalize the input pathname by [1] stripping it (see &apos;StripString&apos;), [2] putting it in
# canonical form (removing extraneous separators, etc) and [3] translating all separator
# characters to the &apos;/&apos; character.
#
sub NormalizePathname($)
{
	use File::Spec::Functions &apos;canonpath&apos;;

	# Strip input pathname
	my $pathToNormalize = $_[0];
	$pathToNormalize = StripString($pathToNormalize);

        $pathToNormalize =~ tr|\\|/|;
        my $isUncPath = ($pathToNormalize =~ m|^/{2,}|);

	# Put pathname into canonical form and translate separators
	$pathToNormalize = canonpath($pathToNormalize);
	$pathToNormalize =~ tr|\\|/|;

	# As necessary, restore UNC syntax or append drive specification with path separator
	if ($pathToNormalize =~ m|^[a-z]:[^/]|i)
	{
		$pathToNormalize =~ s|:|:/|;
	}
	elsif ($isUncPath)
	{
		if ($^O eq "MSWin32")
		{
			$pathToNormalize =~ s|^/{2,}|//|;
		}
		else
		{
			$pathToNormalize = "/" . $pathToNormalize;
		}
	}

	return $pathToNormalize;
}

#
# Copyright 2004-2010 Signiant Corp.
#</CODE_SNIPPET>
</SCRIPT_LIBRARY>