package Subs::SWCheckInput; ############################################################################## # # DESCRIPTION: Check and input files and record some info # # HISTORY: # HISTORY: $Log: SWCheckInput.pm,v $ # HISTORY: Revision 1.9 2012/07/31 05:45:52 apsop # HISTORY: Check for duplicate module names in the path, give # HISTORY: an E2 error if find any (we consider it to be a # HISTORY: configuration error). (Code from Bob Wiegand, originally # HISTORY: in a version of Sub.pm. Implemented here by JRG.) # HISTORY: # HISTORY: Revision 1.8 2012/04/26 08:40:35 apsop # HISTORY: Added code to log @INC and %ENV. Then commented it out, # HISTORY: so that it won't be in production but we'll still have it. # HISTORY: # HISTORY: Revision 1.7 2006/02/13 18:23:09 apsop # HISTORY: Add "/" to the list of acceptable characters in object and PI names and job titles. # HISTORY: # HISTORY: Revision 1.6 2006/02/10 16:29:46 apsop # HISTORY: Better checking before sanatizing. # HISTORY: # HISTORY: Revision 1.5 2006/02/10 15:08:34 apsop # HISTORY: Remove process_flags method. Add sanitize_names method # HISTORY: # HISTORY: Revision 1.4 2005/09/26 21:09:50 apsop # HISTORY: Get timeline start and stop times from the queue file. # HISTORY: # HISTORY: Revision 1.3 2005/09/06 20:16:30 apsop # HISTORY: Fix bug in populating the DATALIST hash. # HISTORY: # HISTORY: Revision 1.2 2005/08/31 16:23:05 apsop # HISTORY: Set finalproc parameter in jobpar file as appropriate. # HISTORY: # HISTORY: Revision 1.1 2005/06/01 14:04:17 apsop # HISTORY: New module calls subroutine to store information from the processing flags produced by pipline. # HISTORY: # # # VERSION: 0.0 # ############################################################################# use Subs::Sub; use Subs::CheckInput; @ISA = qw(Subs::CheckInput); use strict; ######################################### # constructor ######################################### sub new { my $proto=shift; my $self=$proto->SUPER::new(); return $self; } ######################################### # body ######################################### sub body { my $self = shift; my $log = $self->log(); ### # (We've decided we DON'T want to do this in production, because ### # the environment and path actually used for each tool are set ### # just before it is run (Util::Tool.pm, HEAdas.pm) and having ### # this in the output would confuse users. But leave it here, ### # commented out, so we'll have it for future tests.) ### # ### # Not sure this is really the BEST place to write out the search ### # path and environment, but Bob recommended putting it here. ### $log->entry("Search path (\@INC array):"); ### $log->text( join("\n", @INC) ); ### $log->entry("Environment (%ENV hash):"); ### my $envstr = ""; # build up the env as a single string from %ENV ### foreach my $envvar (sort keys %ENV) { ### $envstr = $envstr . " $envvar => $ENV{$envvar}\n"; ### } ### $log->text($envstr); # # Check for duplicate module names in the path. Report an E2 level # if any are, because it's a configuration error. proctop() and # comtop() are inherited from com8.N/Subs/Sub.pm. # my $proctop = $self->proctop(); my $comtop = $self->comtop(); # Put all .pm file names from $PROCTOP into a hash (yes, # value of each one is 1) my %procmod = map { ($_ => 1) } listModules($proctop); # See if any of the .pm file names from $proctop are also in $comtop foreach my $module (listModules($comtop)) { if ( exists($procmod{$module}) ) { $log->error(2,"$module is in both $comtop and $proctop\n"); } } $self->verify_input(); $self->sanitize_names(); } # end of subroutine body sub sanitize_names { my $self=shift; my $filename=$self->filename(); my $log =$self->log(); my $jobpar =$self->jobpar(); foreach my $par ('object', 'job_title', 'pi'){ my $val = $jobpar->read($par); $val =~ s/[^\w\.\-\(\)\+\/ ]//g; $jobpar->set({$par => $val}); } } ############################################### # # lisModules: Return an array listing all Perl module (.pm) # files beneath the given directory. # sub listModules { use File::Find; my ($d) = @_; my @pm; my $start = length($d) + 1; # Recursively find files ending in .pm File::Find::find({ no_chdir => 1, wanted => sub { # Push any filenames that end in .pm onto array @pm if (/\.pm$/) { my $relative = substr($_, $start); # print "found '$relative'\n"; push(@pm, $relative); } } }, $d); return @pm; }