package PBS::Rules::Metarules ;

use PBS::Debug ;

use 5.006 ;

use strict ;
use warnings ;
use Data::TreeDumper ;
use Carp ;
 
require Exporter ;
use AutoLoader qw(AUTOLOAD) ;

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

use File::Basename ;

use PBS::Shell ;
use PBS::PBSConfig ;
use PBS::Output ;
use PBS::Constants ;
use PBS::Rules ;

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

sub GenerateMetaRule
{
my ($file_name, $line, $package, $class, $rule_types, $name, $depender_definition) = @_ ;

if('ARRAY' eq ref $depender_definition && 'CODE' eq ref $depender_definition->[0] && 'ARRAY' eq ref $depender_definition->[1] && '' eq ref $depender_definition->[2])
	{
	# argument types fine
	}
else
	{
	Carp::carp ERROR("Meta rules take an array argument. The first element is a function reference, the second element is a list of existing rule names and the third argument is the default rule name.\n") ;
	PbsDisplayErrorWithContext($file_name,$line) ;
	die ;
	}

my $meta_rule         = $depender_definition->[0] ; 
my @needed_rule_names = @{$depender_definition->[1]} ;
my $default_rule_name = $depender_definition->[2] ;

my $default_rule_is_part_of_the_rules = 0 ;

if(exists $PBS::Rules::package_rules{$package}{$class})
	{
	# Check if all the needed rules exist in the package
	my %existing_rules ;
	
	for my $rule (@{$PBS::Rules::package_rules{$package}{$class}})
		{
		$existing_rules{$rule->{NAME}} = $rule ;
		}
		
	my @rule_references ;
	for my $needed_rule_name (@needed_rule_names)
		{
		if($needed_rule_name eq $default_rule_name)
			{
			$default_rule_is_part_of_the_rules++ ;
			}

		unless(exists $existing_rules{$needed_rule_name})
			{
			Carp::carp ERROR("'$needed_rule_name', needed by rule '$name', doesn't exist.\n") ;
			PbsDisplayErrorWithContext($file_name,$line) ;
			die ;
			}
			
		push @rule_references, $existing_rules{$needed_rule_name} ;
		
		my $rule_already_tagged_as_slave = 0 ;
		for my $rule_type (@{$existing_rules{$needed_rule_name}{TYPE}})
			{
			$rule_already_tagged_as_slave = 1 if($rule_type eq META_SLAVE) ;
			}
			
		unless($rule_already_tagged_as_slave)
			{
			push @{$existing_rules{$needed_rule_name}{TYPE}}, META_SLAVE ;
			
			my $pbs_config = GetPbsConfig($package) ;

			if(defined $pbs_config->{DEBUG_DISPLAY_RULES})
				{
				PrintInfo "Rule '$name' is making rule '$needed_rule_name' META_SLAVE.\n" ;
				}
			}
		}
		
	unless($default_rule_is_part_of_the_rules)
		{
		Carp::carp ERROR("Default rule '$default_rule_name' is not part of the slave rules!\n") ;
		PbsDisplayErrorWithContext($file_name,$line) ;
		die ;
		}
		
	unless(exists $existing_rules{$default_rule_name})
		{
		Carp::carp ERROR("Default rule '$default_rule_name', needed by rule '$name', doesn't exist.\n") ;
		PbsDisplayErrorWithContext($file_name,$line) ;
		die ;
		}
		
	my @node_subs_from_meta_rule_generator ;
	
	my $meta_sub = # this is a depender
		sub
		{
		my $dependent      = shift ;
		my $config         = shift ;
		my $tree           = shift ;
		my $inserted_nodes = shift ;
		
		# call the meta rule sub passed as argument
		return
			(
			$meta_rule->($dependent, $config, $tree, $inserted_nodes, \@rule_references, $default_rule_name)
			) ;
		} ;
		
	return($meta_sub, \@node_subs_from_meta_rule_generator) ;
	}
else
	{
	Carp::carp ERROR("No rules to slave in [$package::$class] at: '$name'.") ;
	PbsDisplayErrorWithContext($file_name,$line) ;
	die ;
	}
	
}

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

1 ;

__END__
=head1 NAME

PBS::Rules::Metarules -

=head1 DESCRIPTION

This package provides support function for B<PBS::Rules::Rules>

=head2 EXPORT

Nothing.

=head1 AUTHOR

Khemir Nadim ibn Hamouda. nadim@khemir.net

=head1 SEE ALSO

B<PBS> reference manual.

=cut