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 =head2 EXPORT Nothing. =head1 AUTHOR Khemir Nadim ibn Hamouda. nadim@khemir.net =head1 SEE ALSO B reference manual. =cut