#! /usr/local/bin/perl
############################################################################
#                                                                          #
# The contents of this file are subject to the WebStone Public License     #
# Version 1.0 (the "License"); you may not use this file except in         #
# compliance with the License. You may obtain a copy of the License        #
# at http://www.mindcraft.com/webstone/license10.html                      #
#                                                                          #
# Software distributed under the License is distributed on an "AS IS"      #
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See      #
# the License for the specific language governing rights and limitations   #
# under the License.                                                       #
#                                                                          #
# The Original Code is WebStone 2.5.                                       #
#                                                                          #
# The Initial Developer of the Original Code is Silicon Graphics, Inc.     #
# and Mindcraft, Inc.. Portions created by Silicon Graphics. and           #
# Mindcraft. are Copyright (C) 1995#1998 Silicon Graphics, Inc. and        #
# Mindcraft, Inc. All Rights Reserved.                                     #
#                                                                          #
# Contributor(s): ______________________________________.                  #
#                                                                          #
############################################################################

# ws-utils.pl 1.4

use Cwd;
use Env;

Env::import();

sub set_webstone_conf
{
	# If WEBSTONEROOT is not defined in the environment then the current 
	# directory will be used as WEBSTONEROOT.
	#
	$WEBSTONEROOT or $WEBSTONEROOT = Cwd::getcwd();
	-d $WEBSTONEROOT or 
		die "WebStone root '$WEBSTONEROOT' is not a directory.\n";
	&debug("WEBSTONEROOT directory is '$WEBSTONEROOT'\n");

	$webstone_configfile = "$WEBSTONEROOT/conf/testbed";

	#
	# Configuration variables and defaults.
	#
	%cfg_defaults = (
		"CLIENTOS",			"WIN32",
		"CLIENTS",			"localhost",
		"CLIENTACCOUNT",		"tester",
		"CLIENTFILELIST",		"",
		"CLIENTINCR",			1,
		"CLIENTPASSWORD",		"tester",
		"CLIENTPROGFILE",		"c:/webstone2.5/webclient.exe",
		"DEBUG",			0,
		"DEBUGFILE",			"c:/webstone2.5/debug",
		"DELETE_FILE_CMD",		"del",
		"FILELIST",			"conf/filelist",
		"FIXED_RANDOM_SEED",		"true",
		"GENFILES_DIR",			"DataFiles",
		"GENRAND",			"bin\\genrand.exe",
		"ITERATIONS",			1,
		"LOCAL_CLIENTPROGFILE",		"bin\\webclient.exe",
		"MAXCLIENTS",			1,
		"MINCLIENTS",			1,
		"PORTNO",			80,
		"RCP",				"copy",
		"RESULTSDIR",			"bin/runs",
		"SERVER",			"www",
		"TIMEPERRUN",			1,
		"TMPDIR",			"c:/webstone2.5",
		"WEBDOCDIR",			"c:/inetserv/www"
	);

	#
	# Parse config file and set variables.  Possible line formats are:
	#	[white-space]# comment 
	#	var=value	[#comment]
	#	var="value"	[#comment]
	#	var='value'	[#comment]
	# blank lines are ignored also.
	#
	open(CFG, "< $webstone_configfile") or 
		die "Opening config file '$webstone_configfile': $!";
	while(<CFG>)
	{
		next if /^\s*$/ or /^\s*#/;	# omit blank and comment lines
		chop;
		s/\s*#.*$//;		# remove comments
		if (/(\S+)='([^']*)'\s*$/ or /(\S+)="?([^"]*)"?\s*$/)
		{
			# environment takes precedence over testbed
			${$1} = $2 unless defined(${$1});
		}
		else
		{
			die "Error parsing line $. of config file '$webstone_configfile'";
		}
	}
	close CFG;

	#
	# Check configuration variable defaults.
	#
	foreach (keys %cfg_defaults)
		{ eval qq(\$$_ = '$cfg_defaults{$_}' unless defined(\$$_)); }
	$MASTEROS = "WIN32" if ($MASTEROS =~ /^win/i);

	#
	# Check if debugging is set.  It can be set via the "DEBUG" variable
	# either in the environment or in the configuration file.  
	#
	$debug = ($debug or $ENV{DEBUG} or $DEBUG);
	if ($debug)
	{
		foreach (keys %cfg_defaults)
			{ eval qq(print "$_='\$$_'\n";); }
	}
}

sub debug
{
	print @_ if $debug;
}

sub makepath
{
	my $ostype = shift;
	join(($ostype =~ /unix/i ? '/' : '\\'), @_);
}

1;