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

use 5.006 ;

use strict ;
use warnings ;
use Data::Dumper ;
use Data::TreeDumper ;
use Carp ;
use Tie::IxHash ;
use Tie::Hash::Indexed ;
use Time::HiRes qw(gettimeofday tv_interval) ;

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.02' ;

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) ;

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

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              = $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 ;
	}

undef $pbs_config->{TARGETS} ;
for my $target (@$targets)
	{
	if(File::Spec->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)
	{
	warn 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 = '' ;

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) ;

	
	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"
		  . $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::Spec->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) ; 
	
	if($user_build && (! defined $pbs_config->{NO_USER_BUILD}) )
		{
		PrintInfo("Using user defined Build().\n") unless $pbs_config->{DISPLAY_NO_STEP_HEADER} ;
		
		$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
		{
		my $rules_namespaces = join ', ', @rule_namespaces ;
		my $config_namspaces = join ', ', @config_namespaces ;
		
		unless($pbs_config->{DISPLAY_NO_STEP_HEADER})
			{
			PrintInfo("No user defined [$package] Build(), using DefaultBuild() with [$rules_namespaces] rules and [$config_namspaces] configs.\n") ;
			}
			
		if($pbs_config->{DISPLAY_COMPACT_DEPEND_INFORMATION})
			{
			PrintInfo("PBS depend run $pbs_runs at depth: $Pbs_call_depth.       \r", 0) ;
			}
		
		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($dependency_tree, $inserted_nodes) ;
}

#-------------------------------------------------------------------------------
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")  ;
		}
		
	my $t0 = [gettimeofday];
	
	my $global_package_dependency = shift || 1 ; # if set, the use module becomes adependency 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 ;
		}
	
	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 $pathes = join ', ', @{$pbs_config->{LIB_PATH}} ;
		
		die  ERROR("Can't locate '$source_name' in PBS libs [$pathes] @ $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'\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 LoadFileInPackage
{
my $type       = shift ;
my $file       = shift ;
my $package    = 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_PACKAGE_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 '' ;

unless(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__
=head1 NAME

PBS::PBS - Perl Build System.

=head1 SYNOPSIS

	# 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
		) ;

=head1 DESCRIPTION

Entry point to B<PBS>. Calls PBS::DefaultBuild::DefaultBuild() is no user defined I<build()> exists in the I<Pbsfile>.

=head2 EXPORT

I<PbsUse> imports module within the current package. In B<PBS> case, it imports it in the load package of the I<Pbsfile>.

=head1 AUTHOR

Khemir Nadim ibn Hamouda. nadim@khemir.net

=cut

