=test

change the created node
change one of the dependencies
remove one of the dependencies
change the PbsUse
change the Pbsfile
remove the creator digest
change a md5 in the creator digest
modify the digest so it is not valid perl
change the version, is it needed? isn't the creator link to the pbsfile enough?

Creator rule with builder
Extra builder for node with creator
composite of above two

=cut

PbsUse('Configs/gcc') ; # this should also trigger the re-creation of the node

#---------------------------------------------------------------------------------------
# example Pbsfile using the creator
#---------------------------------------------------------------------------------------

ExcludeFromDigestGeneration('source' => 'dependency') ;
AddRule [VIRTUAL], 'all',   [ 'all' => 'A', 'B'], BuildOk("All finished.");

my $creator = GenerateCreator
		(
		# commands (as for a builder)
		[
		  "touch %FILE_TO_BUILD %DEPENDENCY_LIST" 
		, "echo hi there"  
		#~ , sub { PrintDebug DumpTree(\@_, 'Creator sub:', MAX_DEPTH => 2) ; return(1, "OK") }
		] ,
		#~ # other_info_to_check  and their values
		#~ {
		#~ __touch_version => 'anything specific to this creator version 1'
		#~ } 
		) ;

AddRule 'A creator', [[$creator] => 'A' => 'dependency_to_A', 'dependency_2_to_A'] ;


#~ AddRule 'B', ['B'] ;
AddRule 'B', ['B'], sub { PrintDebug DumpTree(\@_, 'B builder:', MAX_DEPTH => 2) ; return(1, "OK") } ;

# OOPS! creators are run in the oposit order. how do we create a node that is dependent on a created node
# the rule order becomes very important here!

# tests
# creator with builder => expect overriding itself
#~ AddRule 'objects', [[\&Creator] => 'A' => 'dependency_to_A', 'dependency_2_to_A'], sub{PrintDebug" Builder\n" ; return(1,'hi')} ;

# 2 rules for the same node, one is a creator => expect [CREATOR] in ouput
#~ AddRule 'objects', [[\&Creator] => 'A' => 'dependency_to_A', 'dependency_2_to_A'] ;
#~ AddRule 'objects2', ['A'], sub{PrintDebug" Builder in rule that is not creator\n" ; return(1,'hi')} ;

# creator with builder => expect overriding itself
# 2 rules for the same node, one is a creator => expect [CREATOR] in ouput
#~ AddRule 'objects', [[\&Creator] => 'A' => 'dependency_to_A', 'dependency_2_to_A'], sub{1,"hi"} ;
#~ AddRule 'objects2', ['A'], sub{PrintDebug" Builder in rule that is not creator\n" ; return(1,'hi')} ;

# new improved way to declare creators, must have builder
#~ AddRule [CREATOR], 'objects', ['A' => 'dependency_to_A', 'dependency_2_to_A']
	#~ => "touch %FILE_TO_BUILD" ;
	
#---------------------------------------------------------------------------------------

use PBS::Constants ;
use PBS::Rules::Builders ;
use Data::TreeDumper ;
use File::Path ;
use Digest::MD5 qw(md5_hex) ;

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

sub GenerateCreator
{
my $commands = shift ;
my $other_info_to_check = shift ;

return
	(
	sub
		{
		return(DefaultCreator(@_, $commands, $other_info_to_check)) ;
		}
	) ;
}

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

sub DefaultCreator
{
# this creator verifies the dependencies that are passed by the rule definition 
# and will regenerate the $dependent if needed

my
(
  $dependent_to_check
, $config
, $tree
, $inserted_nodes
, $dependencies     # rule local
, $builder_override # rule local
, $rule_definition

# added by GenerateCreator wrapper
, $commands
, $other_info_to_check
) = @_ ;

my $rule_info = "'$rule_definition->{NAME}' @ '$rule_definition->{FILE}:$rule_definition->{LINE}'" ;
   
my ($triggered, @my_dependencies) ;

if(defined $dependencies && @$dependencies && $dependencies->[0] == 1 && @$dependencies > 1)
	{
	# previous depender defined dependencies
	$triggered       = $dependencies->[0] ;
	@my_dependencies = @{$dependencies}[1 .. @$dependencies - 1] ;
	
	my $need_rebuild = CheckCreatorDigest
				(
				  $dependent_to_check
				, $tree
				, \@my_dependencies # MD5 will be generated for these
				, $other_info_to_check
				) ;
	
	if(NEED_REBUILD == $need_rebuild)
		{
		DisplayNodeCreationInfo($tree, $rule_info) ;
		
		my $file_to_build = GetNodeBuildName($tree) ;
		
		my ($basename, $path, $ext) = File::Basename::fileparse($file_to_build, ('\..*')) ;
		mkpath($path) unless(-e $path) ;
		
		# verify the dependencies digest before creating the node
		GenerateCreatorDigest($dependent_to_check, $tree, \@my_dependencies, 0, $rule_info) ;
		
		my ($builder_sub) = GenerateBuilder # other elements returned by this sub are not valid at this point
					(
					  undef #shell
					, $commands
					, $tree->{__LOAD_PACKAGE}
					, $rule_definition->{NAME}
					, $rule_definition->{FILE}
					, $rule_definition->{LINE}
					) ;
				
		#TODO: missing debugger hooks here
		
		my ($build_result, $build_message) ;
		eval
		{
		my @located_dependencies = map {GetBuildName($_, $tree->{__PBS_CONFIG})} @my_dependencies ;
		
		#TODO: compute the triggered node
		my @located_triggered_dependencies = @located_dependencies ;
		
		($build_result, $build_message) = $builder_sub->
							(
							  $tree->{__CONFIG}
							, GetNodeBuildName($tree)
							, \@located_dependencies
							, \@located_triggered_dependencies #$triggered_dependencies
							, $tree
							, {} # not known at this time $inserted_nodes
							) ;
		} ;
		
		die ERROR("Faild creation of '$dependent_to_check' with $rule_info!\n" . DumpTree($@, 'Exception:')) if $@;
		
		unless(defined $build_result || $build_result == BUILD_SUCCESS || $build_result == BUILD_FAILED)
			{
			$build_result = BUILD_FAILED ;
			die ERROR "Faild creation of '$dependent_to_check' with creator $rule_info!\n" ;
			}
		
		WriteCreatorDigest
			(
			  $dependent_to_check
			, $tree
			, \@my_dependencies
			, $other_info_to_check
			, $rule_info
			) ;
		
		push @$dependencies, "__PBS_FORCE_TRIGGER:$dependent_to_check digest rebuilt." ;
		}
	}

#this makes it unnecessay (and checked) that a rule with creator also has a builder.
$builder_override = GenerateCreatorBuilder($rule_definition->{NAME} . '_' . $dependent_to_check, $tree->{__LOAD_PACKAGE}) ;

return($dependencies, $builder_override) ;
}

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

sub DisplayNodeCreationInfo
{
my $node = shift ;
my $rule_info = shift ;

my $pbs_config = $node->{__PBS_CONFIG} ;

my $no_output = defined $PBS::Shell::silent_commands && defined $PBS::Shell::silent_commands_output ;
$no_output = 0 if($pbs_config->{BUILD_AND_DISPLAY_NODE_INFO} || scalar(@{$pbs_config->{DISPLAY_NODE_INFO}})) ;
$no_output = 1 if defined $pbs_config->{DISPLAY_NO_BUILD_HEADER} ;

unless($no_output)
	{
	my $name = $node->{__NAME} ;
	my $build_name = GetNodeBuildName($node) ;
	$rule_info = 'Creator ' . $rule_info . "\n" ;
	
	my $node_header ;
	if(defined $pbs_config->{DISPLAY_NODE_BUILD_NAME})
		{
		$node_header = "Creating node '$name' [$build_name]:\n" ;
		}
	else
		{
		$node_header = "Creating node '$name':\n" ;
		}
	
	my $columns = length($rule_info) > length($node_header) ? length($rule_info) : length($node_header) ;
	my $separator = '#' . ('-' x ($columns - 1)) . "\n"  ;
	
	$node_header = $separator . $node_header  . $rule_info . $separator ;
	
	PrintInfo $node_header ;
	}
	
#TODO: Log
}

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

sub CheckCreatorDigest
{
my ($dependent_to_check, $tree, $dependencies, $other_elements) = @_ ;

my $dependency_file_name = GetCreatorDependencyFileName($dependent_to_check, $tree) ;
my $dependency_file_needs_update = ! NEED_REBUILD ;

if(-e $dependency_file_name)
	{
	our ($digest) ;
	
	if(do $dependency_file_name) 
		{
		my %dependency_md5 ;
		
		unless('HASH' eq ref $digest)
				{
				PrintWarning("Creator: '$dependent_to_check' [Empty].\n") ;
				$dependency_file_needs_update = NEED_REBUILD ;
				}
				
		my $package_digest = PBS::Digest::GetPackageDigest($tree->{__LOAD_PACKAGE}) ;
		for my $key (keys %$package_digest) 
			{
			$dependency_md5{$key} = $package_digest->{$key} ;
			}
		
		for my $key (keys %$other_elements) 
			{
			$dependency_md5{$key} = $other_elements->{$key} ;
			}
			
		for my $dependency (keys %$digest)
			{
			last if $dependency_file_needs_update ;
			
			if(exists $dependency_md5{$dependency})
				{
				# compare with cached MD5
				if($digest->{$dependency} ne $dependency_md5{$dependency})
					{
					$dependency_file_needs_update = NEED_REBUILD ;
					last ;
					}
				}
			else
				{
				$dependency = GetBuildName($dependency, $tree->{__PBS_CONFIG}) ;
				
				my $dependency_md5 ;
				
				if(defined ($dependency_md5 = PBS::Digest::GetFileMD5($dependency)))
					{
					$dependency_md5{$dependency} = $dependency_md5 ;
					}
				else
					{
					PrintInfo("Creator: Can't compute MD5 for '$dependency' (found in dependency file)! Rebuilding!\n") ;
					$dependency_file_needs_update = NEED_REBUILD ;
					last ;
					}
					
				if($digest->{$dependency} ne $dependency_md5{$dependency})
					{
					if(defined $tree->{__PBS_CONFIG}{DISPLAY_C_DEPENDENCY_INFO})
						{
						PrintInfo("Creator: '$dependent_to_check' [MD5 difference]: '$dependency'.\n") ;
						}
						
					$dependency_file_needs_update = NEED_REBUILD ;
					last ;
					}
				}
			}
		}
	else
		{
		PrintWarning "Creator: Couldn't parse '$dependency_file_name': $@" if $@;
		$dependency_file_needs_update = NEED_REBUILD ;
		}
		
	}
else
	{
	if(defined $tree->{__PBS_CONFIG}{DISPLAY_C_DEPENDENCY_INFO})
		{
		PrintInfo("Creator: '$dependent_to_check' [No digest file].\n") ;
		}
		
	$dependency_file_needs_update = NEED_REBUILD ;
	}

return($dependency_file_needs_update) ;
}

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

sub GenerateCreatorDigest
{
my ($dependent_to_check, $tree, $dependencies, $display_info, $caller_info) = @_ ;

if ($display_info)
	{
	PrintInfo "Creator: Generating creator digest for '$dependent_to_check' at rule $caller_info.\n" ;
	}

my %dependency_file_digest ;
my %dependency_md5 ;

for my $dependency (@$dependencies)
	{
	unless(exists $dependency_md5{$dependency})
		{
		$dependency = GetBuildName($dependency, $tree->{__PBS_CONFIG}) ;
		my $dependency_md5 ;
		
		if(defined ($dependency_md5 = PBS::Digest::GetFileMD5($dependency)))
			{
			$dependency_md5{$dependency} = $dependency_md5 ;
			}
		else
			{
			PrintError("Creator: Can't compute '$dependency' MD5 while generating digest for '$dependent_to_check' at rule $caller_info!\n") ;
			die ;
			}
		}
		
	$dependency_file_digest{$dependency} = $dependency_md5{$dependency} ;
	}

my $package_digest = PBS::Digest::GetPackageDigest($tree->{__LOAD_PACKAGE}) ;
for my $key (keys %$package_digest) 
	{
	$dependency_file_digest{$key} = $package_digest->{$key} ;
	}
	
return(\%dependency_file_digest) ;
}

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

sub GetCreatorDependencyFileName
{
my ($dependent, $tree) = @_ ;

my $build_directory    = $tree->{__PBS_CONFIG}{BUILD_DIRECTORY} ;
my $source_directories = $tree->{__PBS_CONFIG}{SOURCE_DIRECTORIES} ;

my ($dependency_file_name, $is_alternative_source, $other_source_index) 
	= PBS::Check::LocateSource
		(
		  "$dependent.creator_md5"
		, $build_directory
		, $source_directories
		, $tree->{__PBS_CONFIG}{DISPLAY_SEARCH_INFO}
		, $tree->{__PBS_CONFIG}{DISPLAY_SEARCH_ALTERNATES}
		) ;
		
return(CollapsePath($dependency_file_name)) ;
}

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

sub GetNodeBuildName
{
my ($node) = @_ ;

my $build_directory    = $node->{__PBS_CONFIG}{BUILD_DIRECTORY} ;
my $source_directories = $node->{__PBS_CONFIG}{SOURCE_DIRECTORIES} ;

my ($build_name, $is_alternative_source, $other_source_index) 
	= PBS::Check::LocateSource
		(
		  $node->{__NAME}
		, $build_directory
		, $source_directories
		, $node->{__PBS_CONFIG}{DISPLAY_SEARCH_INFO}
		, $node->{__PBS_CONFIG}{DISPLAY_SEARCH_ALTERNATES}
		) ;

return($build_name) ;
}

sub GetBuildName
{
my $name = shift ;
my $pbs_config = shift ;

my $build_directory    = $pbs_config->{BUILD_DIRECTORY} ;
my $source_directories = $pbs_config->{SOURCE_DIRECTORIES} ;

my ($build_name, $is_alternative_source, $other_source_index) = 
	PBS::Check::LocateSource
		(
		$name
		, $build_directory
		, $source_directories
 		, $pbs_config->{DISPLAY_SEARCH_INFO}
		, $pbs_config->{DISPLAY_SEARCH_ALTERNATES}
		) ;

return($build_name) ;
}

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

sub WriteCreatorDigest
{
my ($dependent_to_check, $tree, $dependencies, $other_elements, $caller_info) = @_ ;

my $dependency_file_name = GetCreatorDependencyFileName($dependent_to_check, $tree) ;

push @$dependencies, GetNodeBuildName($tree) ;
my $creator_digest = GenerateCreatorDigest($dependent_to_check, $tree, $dependencies, 1, $caller_info) ;

for my $key (keys %$other_elements) 
	{
	$creator_digest->{$key} = $other_elements->{$key} ;
	}

my $creator_dump = "\n" ;

PBS::Digest::WriteDigest($dependency_file_name, "Generated by Creator $caller_info.", $creator_digest, $creator_dump, 1) ;
}

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

sub GenerateCreatorBuilder
{
# rule with a creator shouldn't need a builder
# but when the creator triggers the node to be created (to trigger it's parents)
# PBS looks for a builder to build the node the creator has already created
# this sub generated a dummy rule that can be passed as a builder override

my $name = shift ;
my $package = shift ;

my $rule = PBS::Rules::RegisterRule
		(
		  __FILE__
		, __LINE__
		, $package
		, "__Creator"
		, [META_SLAVE]  #$rule_types
		, $name
		, sub{die} # $depender_definition
		, sub{return(1, "Creator generated builder '$name', always succeeds.") ;} #$builder_definition
		#, $node_subs
		) ;

push @{$rule->{TYPE}}, CREATOR ;

return($rule) ;
}

