The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package PBS::Rules::Dependers::Subpbs ;

use PBS::Debug ;

use 5.006 ;

use strict ;
use warnings ;
use Data::TreeDumper ;
use Carp ;
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(GenerateSubpbsDepender) ;
our $VERSION = '0.01' ;

use File::Basename ;

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

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

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

# sub pbs definition
for my $key (keys %$depender_definition)
	{
	if($key !~ /^[A-Z_]+$/)
		{
		Carp::carp ERROR("Invalid sub Pbs rule at: '$name'. Keys must be upper case. '$key' is not at $file_name:$line.\n") ;
		PbsDisplayErrorWithContext($file_name, $line) ;
		die ;
		}
	}
	
unless(exists $depender_definition->{NODE_REGEX})
	{
	Carp::carp ERROR("No 'NODE_REGEX' for '$name' at $file_name:$line.\n") ;
	PbsDisplayErrorWithContext($file_name, $line) ;
	die ;
	}
	
unless(exists $depender_definition->{PBSFILE})
	{
	Carp::carp ERROR("No 'PBSFILE' for '$name' at $file_name:$line.\n") ;
	PbsDisplayErrorWithContext($file_name, $line) ;
	die ;
	}
	
unless
	(
	   exists $depender_definition->{PACKAGE}
	&& defined $depender_definition->{PACKAGE} 
	&& '' eq ref $depender_definition->{PACKAGE}
	&& '' ne $depender_definition->{PACKAGE}
	)
	{
	Carp::carp ERROR("Invalid or missing 'PACKAGE' for '$name' at $file_name:$line.\n") ;
	PbsDisplayErrorWithContext($file_name, $line) ;
	die ;
	}
	
if(exists $depender_definition->{ALIAS})
	{
	if($depender_definition->{ALIAS} eq '')
		{
		Carp::carp ERROR("Empty alias for '$name' at $file_name:$line.\n") ;
		PbsDisplayErrorWithContext($file_name, $line) ;
		die ;
		}
	
	unless(file_name_is_absolute($depender_definition->{ALIAS}) || $depender_definition->{ALIAS} =~ /^\.\//)
		{
		$depender_definition->{ALIAS} = './' . $depender_definition->{ALIAS} ;
		}
	}
	
my $pbs_config = GetPbsConfig($package) ;

if(exists $depender_definition->{BUILD_DIRECTORY} && !file_name_is_absolute($depender_definition->{BUILD_DIRECTORY}))
	{
	$depender_definition->{BUILD_DIRECTORY} =~ s/^\.\/// ;
	$depender_definition->{BUILD_DIRECTORY} = $pbs_config->{BUILD_DIRECTORY} . '/' . $depender_definition->{BUILD_DIRECTORY} ;
	}
	
#~ unless(file_name_is_absolute($depender_definition->{PBSFILE}))
	#~ {
	#~ # make pbsfile full path
	#~ $depender_definition->{PBSFILE} =~ s/^\.\/// ;
	#~ my ($basename, $path, $ext) = File::Basename::fileparse($pbs_config->{PBSFILE}, ('\..*')) ;
	#~ $depender_definition->{PBSFILE} = $path. '/' . $depender_definition->{PBSFILE} ;
	#~ $depender_definition->{PBSFILE} =~ s/\/\//\//g ;
	#~ }
	
my $sub_pbs_dependent_regex ;

if(ref $depender_definition->{NODE_REGEX} eq 'Regexp')
	{
	$sub_pbs_dependent_regex = $depender_definition->{NODE_REGEX} ;
	}
else
	{
	PrintError "NODE_REGEX in rule '$name' @ '$file_name:$line' is not a perl regex.\n" ;
	PbsDisplayErrorWithContext($file_name,$line) ;
	die ;
	}

PBS::PBSConfig::CheckPackageDirectories($depender_definition) ;

return
	(
	sub 
		{
		my $dependent_to_check = shift ; 
		my $config             = shift ;
		my $tree               = shift ;
		
		# not used
		#~ my $inserted_nodes = shift ;
		#~ my $depender_definition = shift ; #usefull to display error messages
		
		if(defined $tree->{__PBS_CONFIG}{DEBUG_DISPLAY_DEPENDENCY_REGEX})
			{
			PrintInfo2("   $dependent_to_check =~ $depender_definition->{NODE_REGEX} [$sub_pbs_dependent_regex]. Subpbs rule '$name' @ $file_name:$line.\n") ;
			}
		
		$dependent_to_check =~ /^$sub_pbs_dependent_regex$/ && return ([1, $depender_definition]) ;
		
		return([0, "$dependent_to_check didn't match subpbs regex '$sub_pbs_dependent_regex'."]) ;
		}
	) ;
}

#-------------------------------------------------------------------------------
1 ;

__END__
=head1 NAME

PBS::Rules::Dependers::Subpbs -

=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