# Name:
#	projectLib.pl.
#
# Purpose:
#	Collection of routines used by several perl scripts.
#
# Author:
#	Ron Savage <ron@savage.net.au>
#
# Version:
#	1.01	19-Aug-97	Original.
#	1.10	30-Nov-98	Change prepareDir() to return the current directory as the 3rd item.
#							This patch is required by Class::Tree V 1.10.
#	1.20	 2-Jun-99	Add a binmode option to writeFile.

use Carp;
use Config;
use Cwd;
use File::Path;

#--------------------------------------------------------------------
# Warning. Assumes existence of command line switch $$switch,
#			from Getopt::Simple.

sub getHome
{
	my($home) = $ENV{'HOME'} || $ENV{'LOGDIR'};

	# If no luck so far, default to C: for DOS, and to getpwuid for Unix.
	my($drive)	= defined($$switch{'drive'}) ? $$switch{'drive'} : 'C:';
	$home		= $home || ( ($Config{'osname'} eq 'MSWin32') ? $drive : (getpwuid($<) )[7]);
	my($cwd)	= cwd();

	# This is for Windows, since 'cd C:' and 'cd C:/' can be different.
	$home .= '/' if ($home !~ /\/$/);

	# Validate the result.
	chdir($home) || croak("Can't chdir($home): \nFailure: $!");

	# This eliminates things such as ../../.
	$home = cwd();

	chdir($cwd) || croak("Can't chdir($cwd): \nFailure: $!");

	# By convention, add a trailing '/' if necessary.
	# This is for Unix and Windows.
	$home .= '/' if ($home !~ /\/$/);

	$home;

}	# End of getHome.

#--------------------------------------------------------------------
# Warning. Assumes existence of command line switch $$switch,
#			from Getopt::Simple.

sub makeDir
{
	my($dir) = @_;

	my($verbose)	= (defined($$switch{'verbose'}) ? $$switch{'verbose'} : 0);
	my($result)		= mkpath($dir, $verbose, 0775);

	croak("Can't mkpath($dir, $verbose, 0775): \nFailure: $!")
		if ( (! $result) && ($! !~ /No such file/) );

}	# End of makeDir.

#--------------------------------------------------------------------
# Warning. Assumes existence of command line switch $$switch,
#			from Getopt::Simple.
#
# Warning: List context 'v' scalar context.
# Context	Result		Eg
# List		$dir		my($dir)	= &prepareDir(...);
# Scalar	$cwd		$cwd		= &prepareDir(...);
#
# Returns (in list context):
#	1	The input directory as an absolute path, ending with /
#	2	A flag. 0 -> Input dir does not exist. 1 -> It does exist
#	3	The current directory, ending with /

sub prepareDir
{
	my($dir) = $_[0] || '.';

	$dir						=~ tr|\\|/|;
	my($currentDir, $exists)	= (cwd(), 1);

	# Does this directory exist?
	if (chdir($dir) )
	{
		# Yes. This eliminates things such as ../../.
		$dir = cwd();
		chdir($currentDir) || croak("Can't chdir back to $currentDir: \nFailure: $!");
	}
	else
	{
		# No. Assume it's a relative path.
		$dir = (defined($$switch{'myHome'}) ) ?
				"$$switch{'myHome'}$dir" : (&getHome() . $dir);

		# Emulate recursion.
		if (chdir($dir) )
		{
			# Yes. This eliminates things such as ../../.
			$dir = cwd();
			chdir($currentDir) || croak("Can't chdir back to $currentDir: \nFailure: $!");
		}
		else
		{
			$exists = 0;
		}
	}

	# By convention, add a trailing '/' if necessary.
	$dir		.= '/' if ($dir !~ /\/$/);
	$currentDir	.= '/' if ($currentDir !~ /\/$/);

	($dir, $exists, $currentDir);

}	# End of prepareDir.

#--------------------------------------------------------------------
# Read a file. Pass in $chomp == 0 to stop chomping.

sub readFile
{
	my($fileName, $chomp) = @_;
	$chomp = 1 if ($#_ == 0);

	open(INX, $fileName) || croak("Can't open($fileName): $!");
	my(@line) = <INX>;
	close(INX);
	chomp(@line) if ($chomp != 0);

	\@line;

}	# End of readFile.

#--------------------------------------------------------------------
# Perform a system command.
# Return:
# 0 -> Not ok.
# 1 -> ok.

sub run
{
	my(@command) = @_;

	my($returnCode) = 0xffff & system(@command);

	printf("system(%s) returned %#04x. ", "@command", $returnCode);

	if ($returnCode == 0)
	{
		print "Success. \n";
	}
	elsif ($returnCode == 0xff00)
	{
		print "Failure: $!. \n";
	}
	elsif ($returnCode > 0x80)
	{
		$returnCode >>= 8;
		print "Exit status: $returnCode. \n";
	}
	else
	{
		if ($returnCode & 0x80)
		{
			$returnCode &= ~0x80;
			print "Coredump from ";
		}

		print "Signal $returnCode. \n";
	}

	$returnCode == 0;

}	# End of run.

#--------------------------------------------------------------------
# Perform a system command.
# Return: real result code.

sub runIt
{
	my(@command) = @_;

	my($returnCode) = 0xffff & system(@command);

	if ($returnCode == 0)
	{
	}
	elsif ($returnCode == 0xff00)
	{
	}
	elsif ($returnCode > 0x80)
	{
		$returnCode >>= 8;
	}
	else
	{
		if ($returnCode & 0x80)
		{
			$returnCode &= ~0x80;
		}
	}

	$returnCode;

}	# End of runIt.

#--------------------------------------------------------------------

sub runOrDie
{
	my(@args) = @_;

	if (! &run(@args) )
	{
		croak("Failure: Can't run '@args'\n");
	}

}	# End of runOrDie.

#--------------------------------------------------------------------
# Add enough tabs to $s to right fill it up to $width chars.

sub tabFill
{
	my($s, $width) = @_;

	my($tabsSoFar)	= int(length($s) / 4);
	my($tabsWanted)	= int($width / 4);

	while ($tabsSoFar < $tabsWanted)
	{
		$tabsSoFar++;
		$s .= "\t";
	}

	$s;

}	# End of tabFill.

#--------------------------------------------------------------------
# Input:	An array to be sorted alphabetically (cmp).
# Output:	An array giving the ordering of the input array.

sub tagSort
{
	my(@order, @rank)	= ( (0 .. $#_), () );
	@order				= sort {$_[$a] cmp $_[$b]} @order;
	@rank[@order]		= 0 .. $#_;

	my($i);

	for ($i = 0; $i < $#_; $i++)
	{
		$order[$rank[$i] ] = $i;
	}

	@order;

}	# End of tagSort.

#--------------------------------------------------------------------
# Warning. Assumes existence of command line switch $$switch,
#			from Getopt::Simple.

sub validateDir
{
	my($switchName, $dirName) = @_;

	croak("Failure: Switch -$switchName is not defined") if (! $$switch{$switchName});

	croak("Failure: Move directory $dirName out of the way") if (-d $dirName);

}	# End of validateDir.

#--------------------------------------------------------------------
# Warning. Assumes existence of command line switch $$switch.

sub validatePlatform
{
	if (defined($$switch{'platform'}) )
	{
		croak("Failure: Invalid platform: -platform $$switch{'platform'}")
			if ($$switch{'platform'} !~ /^(avs|compileUnderWindows|export|pc|sgi)$/);
	}
	else
	{
		croak("Failure: Switch -platform is not defined");
	}

}	# End of validatePlatform.

#--------------------------------------------------------------------
# Process CVS tags in my format.
# Assume the input parameter is like [test_]1.23 or [release_]1.23.
# Strip off the prefix & return 1.23.

sub validateTag
{
	my($tag) = @_;

	croak("Failure: Invalid revision tag: $tag") if ($tag !~ /^[a-z_A-Z]*(\d\d?\.\d\d)$/);

	$1;

}	# End of validateTag.

#--------------------------------------------------------------------

# Wrap a line.  We can't use Text::Wrap because it plays games with tabs.
# We can't use formline, even though we'd really like to, because it
# screws up non-printing characters.  So we have to do the wrapping
# ourselves.  Takes the number of spaces to insert on the left margin and
# the maximum width of each line.  Does not hyphenate.

sub wrap
{
	local($_)			= shift;
	my($margin, $width)	= @_;
	my($output)			= '';
	my($spaces)			= ' ' x $margin;
	$width				-= $margin;

	while (length > $width)
	{
		if (s/^([^\n]{0,$width})\s+// || s/^([^\n]{$width})//)
		{
			$output .= $spaces . $1 . "\n";
		}
		else
		{
			last;
		}
	}
    
	$output .= $spaces . $_;
	$output =~ s/\s+$/\n\n/;

	$output;

}	# End of wrap.


#--------------------------------------------------------------------

sub writeFile
{
	my($fileName, $data, $binmode) = @_;

	open(OUT, "> $fileName") || croak("Can't open(> $fileName): $!");
	binmode(OUT) if ($binmode);
	print OUT join("\n", @{$data}), "\n";
	close(OUT);

}	# End of writeFile.

#--------------------------------------------------------------------

1;