PBS::PBS - Perl Build System.

	# from pbs.pl

	use PBS::PBS ;
	PBS::PBS::Pbs
		(
		$pbs_config->{PBSFILE}
		, ''    # parent package
		, $pbs_config
		, {}    # parent config
		, $targets
		, undef # inserted files
		, "root_pbs_$pbs_config->{PBSFILE}" # tree name
		, DEPEND_CHECK_AND_BUILD
		) ;

package PBS::PBS ;
use PBS::Debug ;

use 5.006 ;

use strict ;
use warnings ;
use Data::Dumper ;
use Data::TreeDumper ;
use Carp ;
use Tie::Hash::Indexed ;
use Time::HiRes qw(gettimeofday tv_interval) ;
use File::Spec::Functions qw(:ALL) ;

require Exporter ;
use AutoLoader qw(AUTOLOAD) ;

our @ISA = qw(Exporter) ;
our %EXPORT_TAGS = ('all' => [ qw() ]) ;
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ) ;
our @EXPORT = qw(PbsUse) ;
our $VERSION = '0.03' ;

use PBS::PBSConfig ;
use PBS::Output ;
use PBS::DefaultBuild ;
use PBS::Config ;
use PBS::Rules ;
use PBS::Depend ;
use PBS::Build ;
use PBS::Shell ;
use PBS::Output ;
use PBS::Constants ;
use PBS::Digest;

use Digest::MD5 qw(md5_hex) ;

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

# a global place to keep timing and other pbs run information
# the idea is to make them available to a post pbs script for processing
# this should of course be passed around not be global, maybe we 
# should package this and the dependency tree, nodes, etc in some structure

our $pbs_run_information = 
	{
	# TIMING => {}
	# CAHE => {MD5_HITS => xxx, C_DEPENDER_HITS => YYY ...
	# BUILDER
	} ;


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

our $Pbs_call_depth = -1 ;
our $pbs_runs ;
my %Pbs_runs ;

sub GetPbsRuns
{
return($pbs_runs) ;
}

sub Pbs
{
my $t0 = [gettimeofday];
$Pbs_call_depth++ ;
$pbs_runs++ ;

my $Pbsfile              = shift ;
my $parent_package       = shift ;
my $pbs_config           = shift ;
my $parent_config        = shift ;
my $package              = CanonizePackageName($pbs_config->{PACKAGE}) ;
my $build_directory      = $pbs_config->{BUILD_DIRECTORY} ;
my $source_directories   = $pbs_config->{SOURCE_DIRECTORIES} ;
my $targets              = shift ;
my $target_names         = join ', ', @$targets ;
my $inserted_nodes       = shift ;
my $dependency_tree_name = shift || die ;
my $depend_and_build     = shift ;

unless('' eq ref $package && '' ne $package)
	{
	PrintError("Invalid 'PACKAGE' at $Pbsfile\n") ;
	die ;
	}

if(defined $pbs_config->{SAVE_CONFIG})
	{
	SaveConfig($targets, $Pbsfile, $pbs_config, $parent_config) ;
	}

undef $pbs_config->{TARGETS} ;
for my $target (@$targets)
	{
	if(file_name_is_absolute($target) || $target =~ /^\.\//)
		{
		push @{$pbs_config->{TARGETS}}, $target ;
		}
	else
		{
		push @{$pbs_config->{TARGETS}}, "./$target" ;
		}
	}

my (undef, $target_path) = File::Basename::fileparse($targets->[0], ('\..*')) ;

$target_path =~ s/^\.\/// ;

$pbs_config->{TARGET_PATH} = $pbs_config->{SET_PATH_REGEX} || $target_path ;

undef $pbs_config->{SET_PATH_REGEX};

$Pbs_runs{$package} = 1 unless (exists $Pbs_runs{$package}) ;

my $load_package = 'PBS::Runs::' . $package . '_' . $Pbs_runs{$package}++ ;
$pbs_config->{LOAD_PACKAGE} = $load_package ;

unless(defined $inserted_nodes)
	{
	tie my %tied_inserted_nodes, "Tie::Hash::Indexed" ;
	$inserted_nodes = \%tied_inserted_nodes ;
	}

my $display_all_pbs_config = 0 ;

for (@{$pbs_config->{DISPLAY_PBS_CONFIGURATION}})
	{
	if('*' eq $_)
		{
		$display_all_pbs_config++ ;
		last ;
		}
	}

if($display_all_pbs_config)
	{
	PrintInfo DumpTree($pbs_config, "Package '$package:$Pbsfile' config:") ;
	}
else
	{
	for (@{$pbs_config->{DISPLAY_PBS_CONFIGURATION}})
		{
		my $key = uc($_) ;
		
		if(exists $pbs_config->{$key})
			{
			if('' eq ref $pbs_config->{$key})
				{
				my $value ;
				
				if(defined $pbs_config->{$key})
					{
					PrintInfo("$key: " . $pbs_config->{$key} . "\n") ;
					}
				else
					{
					PrintInfo("$key: undef\n") ;
					}
				}
			else
				{
				PrintInfo(DumpTree($pbs_config->{$key}, $key, INDENTATION => '    ')) ;
				}
			}
		}
	}
	
$dependency_tree_name =~ s/\//_/g ;
$dependency_tree_name = "__PBS_" . $dependency_tree_name ;

tie my %tree_hash, "Tie::Hash::Indexed" ;
%tree_hash = 
	(
	  __NAME          => $dependency_tree_name
	, __DEPENDENCY_TO => {PBS => "Perl Build System [$Pbs_call_depth]"}
	, __INSERTED_AT   => {
				  INSERTION_FILE         => $Pbsfile
				, INSERTION_PACKAGE      => 'PBS::PBS::Pbs'
				, INSERTION_LOAD_PACKAGE => 'Root load'
				, INSERTION_RULE         => 'Root load'
				, INSERTION_TIME         => 0
				, INSERTING_NODE         => 'Root load'
				}
	, __PBS_CONFIG    => $pbs_config
	) ;

my $dependency_tree = \%tree_hash ;
my $build_point = '' ;
my ($build_result, $build_message) ;

if(-e $Pbsfile || defined $pbs_config->{PBSFILE_CONTENT})
	{
	# check target names
	for(@$targets)
		{
		#~ s/^\.\/// ; !!! what was the use of this? I think it can be removed as well as the './' adding in the root rule
		
		if(/@/ > 1)
			{
			PrintError("Invalid composite target definition\n") ;
			die ;
			}
			
		if(/^(.*)@(.*)$/)
			{
			if(@$targets == 1)
				{
				$build_point = $1 ;
				$_ = $2 ;
				}
			else
				{
				PrintError("Only a composite target is allowed\n") ;
				die ;
				}
			}
		} 
		
	unless(@{$pbs_config->{RULE_NAMESPACES}})
		{
		push @{$pbs_config->{RULE_NAMESPACES}}, ('BuiltIn', 'User')
		}
	push my @rule_namespaces, @{$pbs_config->{RULE_NAMESPACES}} ;
		
	unless(@{$pbs_config->{CONFIG_NAMESPACES}})
		{
		push @{$pbs_config->{CONFIG_NAMESPACES}}, ('BuiltIn', 'User') ;
		}
	push my @config_namespaces, @{$pbs_config->{CONFIG_NAMESPACES}} ;
	
	my $user_build ;
	my $sub_config ;	
	PBS::PBSConfig::RegisterPbsConfig($load_package, $pbs_config) ;
	
	#Command defines
	PBS::Config::AddConfigEntry($load_package, 'COMMAND_LINE', '__PBS', 'Command line', %{$pbs_config->{COMMAND_LINE_DEFINITIONS}}) ;
	PBS::Config::AddConfigEntry($load_package, 'PBS_FORCED', '__PBS_FORCED', 'PBS', 'TARGET_PATH' => $pbs_config->{TARGET_PATH}) ;
	
	# merge parent config
	PBS::Config::AddConfigEntry($load_package, 'PARENT', '__PBS', "parent: '$parent_package' [$target_names]", %{$parent_config}) ;
	
	my $add_pbsfile_digest = '' ;
	
	if(defined $pbs_config->{PBSFILE_CONTENT})
		{
		use Digest::MD5 qw(md5_hex) ;
		my $pbsfile_digest = md5_hex($pbs_config->{PBSFILE_CONTENT}) ;
		$add_pbsfile_digest = "PBS::Digest::AddVariableDependencies(PBSFILE => '$pbsfile_digest') ;\n"
		}
	else
		{
		$add_pbsfile_digest = "PBS::Digest::AddFileDependencies('PBSFILE:$Pbsfile') ;\n"
		}
		
	LoadFileInPackage
		(
		  'Pbsfile'
		, $Pbsfile
		, $load_package
		, $pbs_config
		,   "use strict ;\n"
		  . "use warnings ;\n"
		  . "use base qw(PBS::Attributes);\n"
		  . "use PBS::Constants ;\n"
		  . "use PBS::Shell ;\n"
		  . "use PBS::Output ;\n"
		  . "use PBS::Rules ;\n"
		  . "use PBS::Triggers ;\n"
		  . "use PBS::PostBuild ;\n"
		  . "use PBS::PBSConfig ;\n"
		  . "use PBS::Config ;\n"
		  . "use PBS::Check ;\n"
		  . "use PBS::PBS ;\n"
		  . "use PBS::Digest;\n"
		  . "use PBS::Rules::Creator;\n"
		  . $add_pbsfile_digest
		  
		, "\n# load OK\n1 ;\n"
		) ;
		
	PBS::Rules::RegisterRule
		(
		'PBS_INTERNAL_' . __FILE__
		, __LINE__
		, $load_package
		, 'BuiltIn'
		, [VIRTUAL, '__INTERNAL']
		, '__ROOT'
		, sub
			{
			my $dependent = shift ;
			
			if($dependent eq $dependency_tree_name)
				{
				my @targets = map 
							{
							if(file_name_is_absolute($_) || /^\.\//)
								{
								"$_" ;
								}
							else
								{
								PrintDebug "Found a target without './' $_\n" ;
								"./$_" ;
								}
							} @$targets ;
				
				return([1, @targets]) ;
				}
			else
				{
				return([0]) ;
				}
			}
		) ;
		
	{
	no warnings ;
	eval "\$user_build = *${load_package}::Build{CODE} ;" ;
	}
		
	$sub_config = PBS::Config::GetPackageConfig($load_package) ; 
	my $rules   = PBS::Rules::GetPackageRules($load_package) ; 
	
        my $rules_namespaces = join ', ', @rule_namespaces ;
	my $config_namspaces = join ', ', @config_namespaces ;
	
	if($user_build && (! defined $pbs_config->{NO_USER_BUILD}) )
		{
                unless($pbs_config->{DISPLAY_NO_STEP_HEADER})
                	{
			PrintInfo("User Build(). package: $package, rules $rules_namespaces, config: $config_namspaces.\n") ;
			}
											
		($build_result, $build_message)
			= $user_build->
				(
				  $Pbsfile
				, $package
				, $load_package
				, $pbs_config
				, \@rule_namespaces
				, $rules
				, \@config_namespaces
				, $sub_config
				, $targets # automatically build in rule 'BuiltIn::__ROOT', given as information only
				, $inserted_nodes
				, $dependency_tree # rule 0 dependent name is in $dependency_tree ->{__NAME}
				, $build_point
				, $depend_and_build
				) ;
			
		}
	else
		{
		if($pbs_config->{DISPLAY_COMPACT_DEPEND_INFORMATION})
			{
			my $number_of_nodes = scalar(keys %$inserted_nodes) ;
			PrintInfo("PBS depend run $pbs_runs at depth: $Pbs_call_depth [$number_of_nodes].        \r", 0) ;
			}
		
		($build_result, $build_message)
			= PBS::DefaultBuild::DefaultBuild
				(
				  $Pbsfile
				, $package
				, $load_package
				, $pbs_config
				, \@rule_namespaces
				, $rules
				, \@config_namespaces
				, $sub_config
				, $targets # automatically build in rule 'BuiltIn::__ROOT', given as information only
				, $inserted_nodes
				, $dependency_tree
				, $build_point
				, $depend_and_build
				) ;
									
		}
	}
else
	{
	PrintError("No '$Pbsfile' to define build.\n") ;
	die ;
	}
	
$Pbs_call_depth-- ;

if($pbs_config->{DISPLAY_DEPENDENCY_TIME})
	{
	PrintInfo(sprintf("Time in Pbsfile: %0.2f s.\n", tv_interval ($t0, [gettimeofday]))) ;
	}
	
return($build_result, $build_message, $dependency_tree, $inserted_nodes, $load_package) ;
}

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

sub SaveConfig
{
my ($targets, $pbsfile, $pbs_config, $parent_config) = @_ ;

my $first_target = $targets->[0] ;
my ($first_target_name, $first_target_path, $sufix) = File::Basename::fileparse($targets->[0], ('\..*')) ;
$first_target_name .= $sufix ;

(my $pbsfile_canonized = $pbsfile) =~ s/[^a-zA-Z0-9]/_/g ;
my $path             = $pbs_config->{BUILD_DIRECTORY} . '/' . $first_target_path ;

my $config_file_name = $path . 'config_' . $pbsfile_canonized . '___' . $first_target_name . '_' . $pbs_config->{SAVE_CONFIG} . '.pl' ;
$config_file_name =~ s/[^a-zA-Z0-9\/.]/_/g ;

use File::Path ;
mkpath($path) unless(-e $path) ;

PrintDebug "Saving Config in $config_file_name\n" ;

open(CONFIG, ">", $config_file_name) or die qq[Can't open '$config_file_name': $!] ;

local $Data::Dumper::Purity = 1 ;
local $Data::Dumper::Indent = 1 ;
local $Data::Dumper::Sortkeys = undef ;

local $SIG{'__WARN__'} = sub 
	{
	if($_[0] =~ 'Encountered CODE ref')
		{
		# ignore this warning
		}
	else
		{
		print STDERR $_[0] ;
		}
	} ;

print CONFIG PBS::Log::GetHeader('Config', $pbs_config) ;
print CONFIG <<EOI ;
# pbsfile: $pbsfile
# target: $first_target

EOI
print CONFIG Data::Dumper->Dump([$parent_config], ['config']) ;
print CONFIG Data::Dumper->Dump([$pbs_config], ['pbs_config']) ;

print CONFIG 'return($pbs_config, $config);';

close(CONFIG) ;
}

#-------------------------------------------------------------------------------
my %files_loaded_via_PbsUse ;
my $pbs_use_level = -1 ;

sub PbsUse
{
my ($package, $file_name, $line) = caller() ;

for my $source_name (@{[@_]})
	{
	if('' ne ref $source_name)
		{
		die  ERROR("PbsUse only accepts strings as input. Called @ $file_name:$line.\n")  ;
		}
		
	unless(defined $source_name)
		{
		die  ERROR("PbsUse must be given a name. Called @ $file_name:$line.\n")  ;
		}
		
	my $t0 = [gettimeofday];
	
	my $global_package_dependency = shift || 1 ; # if set, the use module becomes a dependency for all the package nodes
	
	my $pbs_config = PBS::PBSConfig::GetPbsConfig($package) ;
	my $located_source_name ;
	
	$source_name .= '.pm' unless $source_name =~ /\.pm$/ ;
	
	unless(defined $pbs_config->{LIB_PATH})
		{
		PrintError("Can't search for '$source_name', PBS lib path is not defined (PBS_LIB_PATH)!\n") ;
		die ;
		}
	
	if(file_name_is_absolute($source_name))
		{
		$located_source_name = $source_name ;
		}
	else
		{
		for my $lib_path (@{$pbs_config->{LIB_PATH}})
			{
			$lib_path .= '/' unless $lib_path =~ /\/$/ ;
			
			if(-e $lib_path . $source_name)
				{
				$located_source_name = $lib_path . $source_name ;
				last ;
				}
			}
		}
	
	unless(defined $located_source_name)
		{
		my $paths = join ', ', @{$pbs_config->{LIB_PATH}} ;
		
		die  ERROR("Can't locate '$source_name' in PBS libs [$paths] @ $file_name:$line.\n")  ;
		}
	
	$pbs_use_level++ ; # indent the PbsUse output to make the hierachy more visible
	my $indentation = '   ' x $pbs_use_level ;
	
	PrintInfo("${indentation}PbsUse: '$located_source_name' called at '$file_name:$line'\n") if(defined $pbs_config->{DISPLAY_PBSUSE_VERBOSE}) ;
	PrintInfo("${indentation}PbsUse: '$source_name'\n") if(defined $pbs_config->{DISPLAY_PBSUSE}) ;
	
	
	if(exists $files_loaded_via_PbsUse{$package}{$located_source_name})
		{
		my $load_information = join(':', $package, $file_name, $line) ;
		my $previous_load_information = join(':', @{$files_loaded_via_PbsUse{$package}{$located_source_name}}) ;
		PrintWarning(sprintf("PbsUse: '$source_name' load command ignored[$load_information]! Was already loaded at $previous_load_information.\n")) ;
		}
	else
		{
		my $add_as_package_dependency = '' ;
		
		if($global_package_dependency)
			{
			$add_as_package_dependency = "PBS::Digest::AddPbsLibDependencies('$located_source_name', '$source_name') ;\n" ;
			}
			
		LoadFileInPackage
			(
			''
			, $located_source_name
			, $package
			, $pbs_config
			, "use PBS::Constants ;\n" . $add_as_package_dependency
			) ;
			
		$files_loaded_via_PbsUse{$package}{$located_source_name} = [$package, $file_name, $line];
		}
	
	$pbs_use_level-- ;
	
	my $pbsuse_time = tv_interval ($t0, [gettimeofday]) ;
	
	if(defined $pbs_config->{DISPLAY_PBSUSE_TIME})
		{
		if(defined $pbs_config->{DISPLAY_PBSUSE_TIME_ALL})
			{
			PrintInfo(sprintf("${indentation}Time in PbsUse '$source_name': %0.2f s.\n", $pbsuse_time)) ;
			}
		else
			{
			if(-1 == $pbs_use_level)
				{
				PrintInfo(sprintf("${indentation}Time in PbsUse: %0.2f s.\n", $pbsuse_time)) ;
				}
			}
		}
	
	if(defined $pbs_config->{DISPLAY_PBSUSE_STATISTIC})
		{
		$files_loaded_via_PbsUse{__STATISTIC}{$located_source_name}{LOADS}++ ;
		$files_loaded_via_PbsUse{__STATISTIC}{$located_source_name}{TOTAL_TIME} += $pbsuse_time ;
		$files_loaded_via_PbsUse{__STATISTIC}{TOTAL_LOADS}++ ;
		}
	}
}

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

sub GetPbsUseStatistic
{
return DumpTree($files_loaded_via_PbsUse{__STATISTIC}, "'PbsUse' statistic:", DISPLAY_ADDRESS => 0) ;
}

#-------------------------------------------------------------------------------
sub CanonizePackageName
{
my $package = shift || die ;
$package =~ s/[^a-zA-Z0-9_:]+/_/g ;

return($package) ;
}

sub LoadFileInPackage
{
my $type       = shift ;
my $file       = shift ;
my $package    = CanonizePackageName(shift) ;
my $pbs_config = shift ;
my $pre_code   = shift || '' ;
my $post_code  = shift || '' ;

my $file_body = '' ; #?? can't let this variable undef or perl bugs out!

if($type eq 'Pbsfile')
	{
	PrintInfo("==>Loading file '$file' into package '$package'.\n") if (defined $pbs_config->{DISPLAY_PBSFILE_LOADING}) ;
	
	if(defined $pbs_config->{PBSFILE_CONTENT} && -e $file)
		{
		PrintError("Pbsfile '$file' and PBSFILE_CONTENT can't co-exist.\n") ;
		die ;
		}
	
	if(exists $pbs_config->{PBSFILE_CONTENT})
		{
		$file_body = $pbs_config->{PBSFILE_CONTENT} ;
		}
	}
	
if($file_body eq '')
	{
	open(FILE, '<', $file) or die "LoadFileInPackage: Error opening $file: $!\n" ;
	
	local $/ = undef ;
	$file_body .= <FILE> ;
	close(FILE) ;
	}

PrintDebug <<OPF if defined ($pbs_config->{DISPLAY_PBSFILE_ORIGINAL_SOURCE}) ;
#>>>>> start of original file '$file'
$file_body
#<<<<< end of original file '$file'

OPF

my $source = <<EOS ;
#>>>>> start of file '$file'

#line 0 '$file'
package $package ;
$pre_code

#line 1 '$file' 
$file_body
$post_code
#<<<<< end of file '$file'

EOS

PrintDebug $source if defined ($pbs_config->{DISPLAY_PBSFILE_SOURCE}) ;

my $result = eval $source ;

#~confess "$@ ." if $@ ;
#~ PrintError $@ if $@ ;

die "" if $@ ;

$type .= ': ' unless $type eq '' ;

if((!defined $result) && ($result != 1))
	{
	$result ||= 'undef' ;
	die "$type$file didn't return OK [$result] (did you forget '1 ;' at the last line?)\n"  ;
	}
}

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

1 ;

__END__