Subs::SWCheckInput (version 0.0)

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;
}