view release on metacpan or  search on metacpan

PBS/PBSConfig.pm  view on Meta::CPAN

if(defined $pbs_configuration{$package})
	{
	return($pbs_configuration{$package}) ;
	}
else
	{
	PrintError("GetPbsConfig: no configuration for package '$package'! Returning empty set.\n") ;
	Carp::confess ;
	return({}) ;
	}
}

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

sub GetBuildDirectory
{
my $package  = shift || caller() ;

if(defined $pbs_configuration{$package})
	{
	return($pbs_configuration{$package}{BUILD_DIRECTORY}) ;
	}
else
	{
	PrintError("GetBuildDirectory: no configuration for package '$package'! Returning empty string.\n") ;
	Carp::confess ;
	return('') ;
	}
}

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

sub GetSourceDirectories
{
my $package  = shift || caller() ;

if(defined $pbs_configuration{$package})
	{
	return([@{$pbs_configuration{$package}{SOURCE_DIRECTORIES}}]) ;
	}
else
	{
	PrintError("GetSourceDirectories: no configuration for package '$package'! Returning empty list.\n") ;
	Carp::confess ;
	return([]) ;
	}
}

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

use constant PARSE_SWITCHES_IGNORE_ERROR => 1 ;

sub ParseSwitches
{
my ($pbs_config, $switches_to_parse, $ignore_error) = @_ ;
$pbs_config ||= {} ;

my $success_message = '' ;

local @ARGV = ( # default colors
		  '-ci'  => 'green'
		, '-ci2' => 'bold blue'
		, '-cw'  => 'yellow'
		, '-cw2' => 'bold yellow'
		, '-ce'  => 'red'
		, '-cd'  => 'magenta'
		, '-cs'  => 'bold green'
		, '-cu'  => 'cyan'
		) ;
		
Getopt::Long::Configure('no_auto_abbrev', 'no_ignore_case', 'require_order') ;

my @flags = PBS::PBSConfigSwitches::Get_GetoptLong_Data($pbs_config) ;
unless(GetOptions(@flags))
	{
	return([0, "Error in default colors configuration." . __FILE__ . ':' . __LINE__ . "\n"], $pbs_config, @ARGV) ;
	}

@ARGV = @$switches_to_parse ;

# tweek option parsing so we can mix switches with targets
my $contains_switch ;
my @targets ;

do
	{
	while(@ARGV && $ARGV[0] !~ /^-/)
		{
		#~ print "target => $ARGV[0] \n" ;
		push @targets, shift @ARGV ;
		}
		
	$contains_switch = @ARGV ;
	
	local $SIG{__WARN__} 
		= sub 
			{
			PrintWarning $_[0] unless $ignore_error ;
			} ;
			
	unless(GetOptions(@flags))
		{
		return(0, "Try perl pbs.pl -h.\n", $pbs_config, @ARGV) unless $ignore_error;
		}
	}
while($contains_switch) ;

$pbs_config->{TARGETS} = \@targets ;
 
return(1, $success_message, $pbs_config) ;
}

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

sub GetUserName
{
my $user = 'no_user_set' ;

if(defined $ENV{USER} && $ENV{USER} ne '')
	{