Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Seek Critique of SFTP program, format, structure, overall "Perl"ness

by mikedshelton (Beadle)
on Dec 07, 2003 at 00:47 UTC ( #312827=perlquestion: print w/replies, xml ) Need Help??

mikedshelton has asked for the wisdom of the Perl Monks concerning the following question:

Oh mighty Monks... I am relatively new to Perl. While I have maintained existing programs, the following

SFTP

code is my first time building a program from scratch. I would greatly appreciate your thoughts on the structure, format and overall "Perl"ness of this program. The program is fully functional and appears to be relatively stable based on my extensive testing. I understand there is more than one way to do something.

I encourage you to tear this one apart.

Please be kind to the coder, not the code. Thank you in advance.
#!/usr/local/bin/perl -w ## SOME FORMATTING CHANGED BASED ON 70 character line on PERLMONKS ## # sftp-file-send.plx # This program logs into remote machine and sends file using SFTP # (secure file transfer protocol). Three modes are available along # with a Debug option: Interactive, Silent & Notify User. All stderr # is written directly to log since $sftp->put() doesn't return errors # in $@. # Debug writes all writeLog statements along with debug statments to # the log and the screen. # Interactive mode - send one file at a time. User enters name & path # of file to send. User is asked to select from the (CF), (CC) dir on # remote machine. All writeLog stmts are written to the log & sent to # screen. # In non interactive mode (Silent and Notify User), all file related # information (filename, filepath, target directory, program mode and # calling program) is provided by a file that is built by the calling # program prior to executing this program. # Silent mode - As defined in the list-of-files-to-sftp file, this # mode sends all writeLog statements & errors to the log. Statements # and errors are NOT sent to the screen (cron jobs version). # Notify User mode - As defined in the list-of-files-to-sftp file, # this mode sends all writeLog statements and errors to the log. # Statements and error ARE sent to the screen (jobs where user wants # to see progress but does not want to enter file-to-sftp information # one at a time). # Pager function sends a single notice that one or more errors # (validation or sftp) have occurred. # Email function sends a summary of status for each file requested to # be sent when page is sent. # Parameters: # -h Print Usage Options # -i Interactive Mode # -d Debug # Date---- Version------- Author------- Comments---- # 20030822 V1.0.MDS.0.0 Mike Shelton Written use 5.0.6; #MSC perl coding standards use strict; #MSC perl coding standards # predeclare subroutines so subs; can be called before being declared # and without () use subs qw(readListOfFilesToSFTP checkForNullValues checkProgramMode +checkFilePathExists checkFilePathPermissions checkFileExists checkFil +ePermissions printHashKeysAndValues writeLog usage getFilePath getFil +eName main init getTargetDir checkTargetDirFormat checkFilePathFormat + callback setupLog sendStderrToLog singleLineSummary); # used with Getopt::Std & params use vars qw ($opt_i $opt_d $opt_h); # file control, enables open/read only to be used in sysopen() call use Fcntl qw( O_RDONLY ); use Fcntl qw( O_WRONLY O_APPEND O_CREAT );#file controls for $log_file #included modules use Net::SFTP; #allows file to be transferred using encrypted tunnel use File::Basename; #allows fileparse() use Getopt::Std; #easy use of parameters use MSC::Page qw(:Basic); #allows paging in sendPage() # basic information my $HOME; #home directory ie /xxx/yyy my $filepath; #path of file to be sent ie /data/send/ my $filename; #name of file to be sent ie file.20030818 my $target_dir; #target directory on remote machine my $BSD_STYLE; #exists to handle getc in getTargetDir() my $version = 'V1.0.MDS.0.0'; my $program = (fileparse( $0, '.plx' ))[0]; #use with writeLog() my $process = $$; #used in writeLog() my $host = '999.999.999.999'; my $user = 'username'; #ssh2 username to login to remote host my $password = 'password'; #ssh2 password to login to remove host my $key = 0; #holds user's selected target directory in getTargetDir() my $debug = 0; #debug mode yes=1 no=0 (default) debug mode option -d my $interactive = 0; #interactive mode option -i my $iteration = 0; #used in callback() my $sftp; #used in new() and put() my $log_file; #used in main() and called in writeLog() my $log_ts; #used in main() and called in writeLog() my %HoHoHoA; #used in readListOfFilesToSFTP() my %original_line; #used in readListOfFilesToSFTP() and main() my $line_number = 0; #used in readListOfFilesToSFTP() # count of lines loaded in readListOfFilesToSFTP() not including # comments nor blank lines my $lines_loaded= 0; # used in main() and subroutines called by main() my $line_number_being_processed=0; my $files_to_sftp; #used in readListOfFilesToSFTP() and main() my $rc; #used in init(); # used in checkFilePathExists() and checkFilePathPermissions() my $fullfilepath; my $file; my $summary = 0; #switch used in singleLineSummary() and writeLog() my $pag = 0; #switch used in sendPage() my $pagegroup = 'pagegroup'; #used in sendPage() my $email_summary; #used in singleLineSummary() and sendEmail() #constants use constant EXIT_SUCCESS => 0; use constant EXIT_FAILURE => 1; use constant TRUE => 1; use constant FALSE => 0; #this is it main() if init(); # # init() : handle parameters -h -i -d # sub init { my (%args, $me); usage unless getopts ('hdi') ; usage if (defined $opt_h); $interactive = 1 if (defined $opt_i); $debug = 1 if (defined $opt_d); return 1; } #end init() # # main() : main subroutine of program # sub main { #unbuffer STDOUT $| = 1; setupLog(); sendStderrToLog(); #notify user program beginning writeLog( "Beginning Program $program.plx to Send File thru Secure Fi +le Transfer Protocol - Version $version" ); #no program mode, write to screen if not debug, interactive print( STDOUT "Beginning Program $program.plx to Send File thru Secur +e File Transfer Protocol - Version $version\n" ) if ( ! $debug && ! $ +interactive ); $HOME = $ENV{'HOME'}; if ( $HOME eq "" ) { writeLog( "* * * ABNORMAL COMPLETION: HOME Could not be defined * * +*" ); #don't have program mode yet, write error to screen print( STDOUT "* * * ABNORMAL COMPLETION: HOME Could not be defined +* * *" ) if ( ! $debug ); exit( EXIT_FAILURE ); } #read in info about files to be SFTP'd readListOfFilesToSFTP() if ( ! $interactive ); #PERFORM ERROR WRITING CHECKS ON HASH BEFORE SFTP LOOP #check for M/T 'Values' in %HoHoHoA checkForNullValues() if ( ! $interactive ); #check for an invalid (non-N non-S) Program Mode in %HoHoHoA checkProgramMode() if ( ! $interactive ); #check full file path ($HOME + $filepath) exists checkFilePathExists() if ( ! $interactive ); #verify we can access the full file path ($HOME + $filepath) checkFilePathPermissions() if ( ! $interactive ); #verify that file exists checkFileExists() if ( ! $interactive ); #verify that we can access the file using sysopen checkFilePermissions() if ( ! $interactive ); #interactive mode needs a lines_loaded = 1 $lines_loaded = 1 if ( $interactive ); writeLog( "lines_loaded = $lines_loaded" ) if ( $debug ); #SFTP FILES from hash HoHoHoA that do not have errors, #SFTP FILES thru interactive mode for ($line_number_being_processed=1; $line_number_being_processed <= +$lines_loaded; $line_number_being_processed++) { writeLog( "line_number_being_processed $line_number_being_processed +lines_loaded $lines_loaded" ) if ( $debug ); if ( ! $interactive ) { writeLog( "\nProcessing line $line_number_being_processed of $lines +_loaded line(s) loaded from file $files_to_sftp. Called by program $H +oHoHoA{$line_number_being_processed}->{'Calling Program'}->{'Value'}" + ); writeLog( "Original line $line_number_being_processed : $original_l +ine{$line_number_being_processed}" ); #if the Validation Error -> Error Flag is Y write {key2} error info +rmation to log and goto next line if ( $HoHoHoA{$line_number_being_processed}->{'Validation Error'}-> +{'Error Flag'} eq 'Y' ) { #write all error messages , value {$key3} to log for this line {$k +ey1} including hash component {$key2} for my $key2 ( keys %{ $HoHoHoA{$line_number_being_processed} } ) +{ #middle anonymous hash if ( $HoHoHoA{$line_number_being_processed}->{$key2}->{'Error Fla +g'} eq 'Y') { foreach my $j ( @{ $HoHoHoA{$line_number_being_processed}->{$key +2}->{'Error Message'} } ) { writeLog( "Error on line # $line_number_being_processed with $k +ey2 - Error Message -> $j" ); } } } writeLog( "skipping $line_number_being_processed" ) if ( $debug ); #switch $page on $page = 1; next; } } #get filepath from user or load from hash getFilePath(); #get filename from user or load from hash getFileName(); #get target directory from user or load from hash getTargetDir(); #check target directory format must have / at end checkTargetDirFormat(); writeLog( "debug - connecting to host $host user $user" ) if ( $debu +g ); #notify user attempting connection writeLog( "Connecting to host : $host as user : $user" ); #open connection with remote machine and login #using SSH2 username and SSH2 password #$sftp->new() does return errors to $@ #$sftp->put() does not return errors to $@ eval { $sftp = Net::SFTP->new( $host, "user"=>$user, "password"=>$password +, debug=>$debug ) ; }; if ( $@ ) { #handle error opening connection chomp( $@ ); writeLog( "* * * ABNORMAL COMPLETION * * * Error: $@ trying to conn +ect to remote Machine $host" ); if ( ! $interactive ) { #update SFTP Results #add error message to SFTP results push @{ $HoHoHoA{$line_number_being_processed}{'SFTP Results'}{'Er +ror Message'} }, ("Error : $@ trying to connect to remote Avfuel FTP Machine $host +"); #set error flag for this element to Y $HoHoHoA{$line_number_being_processed}->{'SFTP Results'}->{'Error +Flag'} = 'Y'; #set status $HoHoHoA{$line_number_being_processed}->{'SFTP Results'}->{'Status +'} = 'Failed'; #set time stamp of error #similar create log_ts my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = + localtime(); $mon += 1; $year += 1900; my $timestamp = sprintf( "%04d%02d%02d %02d:%02d:%02d", $year, $mo +n, $mday, $hour, $min, $sec ); $HoHoHoA{$line_number_being_processed}->{'SFTP Results'}->{'Time S +tamp'} = $timestamp; #switch $page on $page = 1; } next; } writeLog( "debug - connected to host $host user $user" ) if ( $debug + ); #notify user connection made writeLog( "Connected to host : $host as user : $user" ); #create target_file used in $sftp->() my $target_file = $target_dir.$filename; writeLog( "debug - name of file ($target_dir$filename) to be written + on host $host is $target_file" ) if ( $debug ); #notify user file being sent writeLog( "Sending file : $file to remote machine $host" ); #reset $iteration between files-to-sftp $iteration=0; # put file on remote machine # using eval {$sftp->put()} here. # $sftp->put() does not have a return value on success/failure. # NOTHING GETS STORED IN $@ or $! # no warnings eliminates "Use of uninitialized value in string ne at # sftp-file-send.plx line ..." error no warnings; #wrapping eval in if compared to 0 if not die if (eval{$sftp->put( $file, $target_file, \&callback );} ne 0 ) { writeLog( "* * * ABNORMAL COMPLETION * * * Unable to SFTP $filename + to $target_dir on remote machine $host (check log $log_file for addi +tional information)" ); if ( $interactive ) { die("\n"); } if ( ! $interactive ) { # update SFTP Results #add error message to SFTP results push @{ $HoHoHoA{$line_number_being_processed}{'SFTP Results'}{'Er +ror Message'} }, ("Unable to SFTP $filename to $target_dir on remote machine $host + (check log $log_file for additional information)"); #set error flag for this element to Y $HoHoHoA{$line_number_being_processed}->{'SFTP Results'}->{'Error +Flag'} = 'Y'; #set status $HoHoHoA{$line_number_being_processed}->{'SFTP Results'}->{'Status +'} = 'Failed'; #set time stamp of error #similar create log_ts my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = + localtime(); $mon += 1; $year += 1900; my $timestamp = sprintf( "%04d%02d%02d %02d:%02d:%02d", $year, $mo +n, $mday, $hour, $min, $sec ); $HoHoHoA{$line_number_being_processed}->{'SFTP Results'}->{'Time S +tamp'} = $timestamp; #switch $page on $page = 1; } next; } use warnings; # $@ SHOULD HOLD ERRORS CAUGHT AS PART OF EVAL ABOVE BUT DOES NOT # intreactive mode only - skip two lines after $sftp->put() and to # highlight progress meter to user print( STDOUT "\n" ) if ( $interactive || $HoHoHoA{$line_number_bein +g_processed}{'Program Mode'}{'Value'} eq 'N' ); writeLog( "debug - file $file SFTP'd to target directory $target_dir + on host $host using user $user" ) if ( $debug ); if ( ! $interactive ) { #SFTP successful - update SFTP Results #set status $HoHoHoA{$line_number_being_processed}->{'SFTP Results'}->{'Status' +} = 'Successful'; #set time stamp #similar create log_ts my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = +localtime(); $mon += 1; $year += 1900; my $timestamp = sprintf( "%04d%02d%02d %02d:%02d:%02d", $year, $mon +, $mday, $hour, $min, $sec ); $HoHoHoA{$line_number_being_processed}->{'SFTP Results'}->{'Time St +amp'} = $timestamp; #notify user file put on remote machine writeLog( "Normal Completion - File : $filename Successfully Transf +erred to Directory : $target_dir on remote machine : $host" ); # close sftp connection (use subroutine hack) # THERE IS NOT A quit() function that is part of Net::SFTP # closeConnection; # writeLog( "Connection with remote machine $host closed successfully" + ); } } #end for ($line_number_being_processed=1; ... writeLog( "line 1132 final values in \%HoHoHoA" ) if ( $debug && ! $i +nteractive ); printHashKeysAndValues() if ( $debug && ! $interactive ); # write a single line summary to log for each file in $files_to_sftp singleLineSummary() if ( ! $interactive ); # email all one_line_summary information saved as email_summary when # an error has occurred sendEmail() if (( $page == 1 ) && ( ! $interactive )); #send page when one or more errors (pre-SFTP or SFTP) occur sendPage() if (( $page == 1 ) && ( ! $interactive )); writeLog( "Normal Completion - Program $program.plx - Version $versio +n\n" ); # no program mode, write to screen if not debug or not interactive print( STDOUT "\nNormal Completion - Program $program.plx - Version $ +version\n" ) if (( ! $debug ) && ( ! $interactive)); exit( EXIT_SUCCESS ); } #end of MAIN() # # setupLog() : creates log file related variables used in # sendStderrToLog() and writeLog() subroutines # sub setupLog { #create log_file and date_ext my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = lo +caltime(); $mon += 1; $year += 1900; my $date_ext = sprintf( "%04d%02d%02d", $year, $mon, $mday ); $log_file = "/sftp-file-send.$date_ext"; return; } #end setupLog() # # sendStderrToLog() : because $sftp->put() does not return errors to # $@ variable, all standard errors are written to log file created in # setupLog() # sub sendStderrToLog { # send all stderr to logfile (this handles Silent mode that can be # used during cron-type calls) close( STDERR ); #MUST BE THIS WAY TO SEND STDERR to LOG open( STDERR, ">> $log_file" ); # using sysopen does not allow for SSH related messages from host # during $sftp->put() # sysopen( STDERR, ">>$log_file", O_WRONLY | O_APPEND | O_CREAT ); return; } #end sendStderrToLog() # # writeLog() : writes text to log file. each call to writeLog() # writes text on a new line. # sub writeLog { #unbuffer stream; select STDERR; $| = 1; # using the safer sysopen command, this creates | write | appends # text to log file with rw 660 permissions sysopen( LOGFILE, $log_file, O_WRONLY | O_APPEND | O_CREAT ); #create log_ts my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = lo +caltime(); $mon += 1; $year += 1900; $log_ts = sprintf( "%04d%02d%02d %02d:%02d:%02d [$process] ", $year, +$mon, $mday, $hour, $min, $sec ); #write everything to LOGFILE print( LOGFILE "$log_ts " ); print( LOGFILE "$_[0]\n" ); close( LOGFILE ); # write to screen if debug or interactive or Program Mode eq Notify # User and not in singleLineSummary() # if else fixes all but one "Use of uninitialized value in string eq # at sftp-file-send.plx" error if (( %HoHoHoA ) && ( $summary == 0 )) { if ( $debug || $interactive || $HoHoHoA{$line_number_being_processed +}{'Program Mode'}{'Value'} eq 'N' ) { print( STDOUT "$_[0]\n" ); } } else { # if Program Mode not yet defined in %HoHoHoA write debug # or interactive to screen if ( $debug || $interactive ) { print( STDOUT "$_[0]\n" ); } } return; } #end writeLog() # # usage() : usage information # sub usage { $rc = @_ ; print( STDOUT "\nusage : $0 $version [options]\n" ); print( STDOUT "where [options] can include :\n" ); print( STDOUT " -i Interactive mode\n" ); print( STDOUT " -d Debug mode\n" ); print( STDOUT " -h Print this usage information\n\n" ); exit ($rc) ; } #end usage() # # readListOfFilesToSFTP() : in the non interactive (not -i) mode # (Silent or Notify User) the calling program has # written information to a generically named file in a : separated # format (sftp-file-info.txt). # sub readListOfFilesToSFTP { #The sftp-file-info.txt file includes: #calling program name - so we know where SFTP program is called from #mode - Silent or Notify User ie S or N #filepath - path of file to be sent ie /data/send/ #filename - name of file to be sent ie file.20030818 #target directory - target directory on remote machine ie /IN/CF/ #SAMPLE LINES from sftp-file-info.txt #top line(s) of file are comments with preceding # (optional) #first required line is the data format #ie calling program:mode:/filepath/:filename.date:/target/dir/ #sample data #ie "A_CRON_JOB.ksh:S:/data/:send_this_cf_file.20030926:/IN/CF/" #sample data #ie "A_DAILY_PROGRAM:N:/data/:send_this_non_cf_file.20030926:/IN/CC/" #location of list of files to sftp created by calling program $files_to_sftp = $HOME.'/sftp/data/sftp-file-info.txt'; my $linecounter = 0; #counter for lines in files_to_sftp my %line; writeLog( "files_to_sftp $files_to_sftp" ) if ( $debug ); #open data file if ( !( sysopen( FILES_TO_SFTP, $files_to_sftp, O_RDONLY ) ) ) { writeLog("* * * ABNORMAL COMPLETION * * * Error: $!. Unable to open +file $files_to_sftp" ); print( STDOUT "* * * ABNORMAL COMPLETION * * * Error: $!. Unable to +open file $files_to_sftp\n" ) if ( ! $debug ); die("\n"); } if ( $debug ) { writeLog( "$files_to_sftp opened successfully" ); while( <FILES_TO_SFTP> ) { chomp ( $_ ); writeLog( "$linecounter $_" ); $linecounter++; } } # read data into data structure # USING A HASH OF A HASH OF A HASH OF ARRAYS to allow for more # flexible / decriptive model of data including error messages # we have already read the data file above, need to open data file # again for while() below if ( $debug ) { if ( !( sysopen( FILES_TO_SFTP, $files_to_sftp, O_RDONLY ) ) ) { writeLog("* * * ABNORMAL COMPLETION * * * Error: $!. Unable to open + file $files_to_sftp" ); die("\n"); } } $line_number = 1; while( <FILES_TO_SFTP> ) { # skip comments "Programming PERL" pg 595 - next if /^#/; next if /^#/; # skip blank lines "Programming PERL" pg 595 - next if /^$/; next if /^$/; # chomp here chomp ( $_ ); # save each original line as they're read in, adding a line number # this hash does not includes #comments and blank lines # %original_line used in main() $original_line{$line_number} = $_ ; #print out sorted hash of original lines if ( $debug ) { foreach $line_number ( sort keys %original_line ) { writeLog( "original line info $line_number => $original_line{$line +_number}" ); } } #split this line into its elements in preparation for loading hash my @line = split/:/ ; #print out line array elements if ( $debug ) { for (my $i=0; $i<5; $i++) { writeLog( "line $line_number has element $i $line[$i]" ); } } #THIS HoHoHoA is a more descriptive HASH $HoHoHoA{$line_number++} = { 'Calling Program' => { 'Value' => $line[0], 'Error Flag' => 'N', 'Error Message' => [ ], }, 'File Path' => { 'Value' => $line[2], 'Error Flag' => 'N', 'Error Message' => [ ], }, 'File Name' => { 'Value' => $line[3], 'Error Flag' => 'N', 'Error Message' => [ ], }, 'Target Directory'=> { 'Value' => $line[4], 'Error Flag' => 'N', 'Error Message' => [ ], }, 'Program Mode' => { 'Value' => $line[1], 'Error Flag' => 'N', 'Error Message' => [ ], }, 'Validation Error'=> { 'Error Flag' => 'N', }, 'SFTP Results' => { 'Status' => 'Pending', 'Attempts' => 0, 'Time Stamp' => '', 'Error Flag' => 'N', 'Error Message' => [ ], }, }; } #end while( <DATEFILE> ) #save count for future for() loops $lines_loaded = $line_number - 1; printHashKeysAndValues() if ( $debug ); return; } #end readListOfFilesToSFTP() # # checkForNullValues() : loop thru %HoHoHoA & make sure that {key3}s # 'Value' are not null. # if null, write "Empty" error message to {key3} array, update {key3} # 'Error Flag' to 'Y' and # update {key2} Validation Error -> Error Flag to 'Y' # sub checkForNullValues { for my $key1 ( keys %HoHoHoA ) { #outer named hash for my $key2 ( keys %{ $HoHoHoA{$key1} } ) { #middle anonymous hash for my $key3 ( keys %{ $HoHoHoA{$key1}{$key2} } ) { #inner anonymou +s hash if ( $key3 eq 'Value' ) { #Value from $files_to_sftp file if ( $HoHoHoA{$key1}->{$key2}->{$key3} eq '' ) { writeLog( "key1 $key1 key2 $key2 key3 $key3 is Null" ) if ( $deb +ug ); #add error message to array for this element push @{ $HoHoHoA{"$key1"}{"$key2"}{'Error Message'} }, ("NULL $k +ey2"); #set error flag for this element to Y $HoHoHoA{$key1}->{$key2}->{'Error Flag'} = 'Y'; #set Validation Error -> Error Flag to Y $HoHoHoA{$key1}->{'Validation Error'}->{'Error Flag'} = 'Y'; # set status VALIDATION ERRORs CAUSE STATUS TO REMAIN AS 'Pending' # $HoHoHoA{$key1}->{'SFTP Results'}->{'Status'} = 'Failed'; #set time stamp of error my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) + = localtime(); $mon += 1; $year += 1900; my $timestamp = sprintf( "%04d%02d%02d %02d:%02d:%02d", $year, $ +mon, $mday, $hour, $min, $sec ); $HoHoHoA{$key1}->{'SFTP Results'}->{'Time Stamp'} = $timestamp; } } } } } if ( $debug ) { writeLog( "379 after checkForNullValues" ); printHashKeysAndValues(); } return; } # checkProgramMode() : loop thru %HoHoHoA and make sure that Program # Mode is S or N. # if not, write "Invalid" error message to {key3} array, update {key3} # 'Error Flag' to 'Y', update {key2} # Validation Error -> Error Flag to 'Y' and update Program Mode to # 'N' so messages are sent to screen # sub checkProgramMode { for my $key1 ( keys %HoHoHoA ) { #outer named hash if ( $HoHoHoA{$key1}->{'Program Mode'}->{'Value'} ne 'N' and $HoHoHoA{$key1}->{'Program Mode'}->{'Value'} ne 'S' ) { writeLog( "Line # $key1 -> Program Mode -> Value $HoHoHoA{$key1}->{ +'Program Mode'}->{'Value'} <> N and <> S" ) if ( $debug ); #add error message to array for this element push @{ $HoHoHoA{$key1}{'Program Mode'}{'Error Message'} }, ("Inval +id Program Mode : $HoHoHoA{$key1}->{'Program Mode'}->{'Value'}"); #set error flag for this element to Y $HoHoHoA{$key1}->{'Program Mode'}->{'Error Flag'} = 'Y'; #set Validation Error -> Error Flag to Y $HoHoHoA{$key1}->{'Validation Error'}->{'Error Flag'} = 'Y'; #set invalid Program Mode to N $HoHoHoA{$key1}{'Program Mode'}{'Value'} = 'N'; # set status VALIDATION ERRORs CAUSE STATUS TO REMAIN AS 'Pending' # $HoHoHoA{$key1}->{'SFTP Results'}->{'Status'} = 'Failed'; #set time stamp of error my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = +localtime(); $mon += 1; $year += 1900; my $timestamp = sprintf( "%04d%02d%02d %02d:%02d:%02d", $year, $mon +, $mday, $hour, $min, $sec ); $HoHoHoA{$key1}->{'SFTP Results'}->{'Time Stamp'} = $timestamp; } } if ( $debug ) { writeLog( "411 after checkProgramMode" ); printHashKeysAndValues(); } return; } # # checkFilePathExists() : loop thru %HoHoHoA and make sure that # directory ($HOME + $filepath) exists. # if not, write "Invalid" error message to {key3}array, update {key3} # 'Error Flag' to 'Y' and update {key2} # Validation Error -> Error Flag to 'Y'. # sub checkFilePathExists { for my $key1 ( keys %HoHoHoA ) { #outer named hash $fullfilepath = $HOME.$HoHoHoA{$key1}->{'File Path'}->{'Value'}; writeLog( "debug - fullfilepath = $fullfilepath" ) if ( $debug ); if ( !( -d $fullfilepath ) ) { #does directory exists writeLog("* * * ABNORMAL COMPLETION * * * Error $!: Unable to find +directory $fullfilepath" ) if ( $debug ); #add error message to array for this element push @{ $HoHoHoA{$key1}{'File Path'}{'Error Message'} }, ("Director +y Not Found : $fullfilepath"); #set error flag for this element to Y $HoHoHoA{$key1}->{'File Path'}->{'Error Flag'} = 'Y'; #set Validation Error -> Error Flag to Y $HoHoHoA{$key1}->{'Validation Error'}->{'Error Flag'} = 'Y'; } else { writeLog( "debug - found directory $fullfilepath " ) if ( $debug ); } # set status VALIDATION ERRORs CAUSE STATUS TO REMAIN AS 'Pending' # $HoHoHoA{$key1}->{'SFTP Results'}->{'Status'} = 'Failed'; #set time stamp of error my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = l +ocaltime(); $mon += 1; $year += 1900; my $timestamp = sprintf( "%04d%02d%02d %02d:%02d:%02d", $year, $mon, + $mday, $hour, $min, $sec ); $HoHoHoA{$key1}->{'SFTP Results'}->{'Time Stamp'} = $timestamp; } if ( $debug ) { writeLog( "453 after checkFilePathExists" ); printHashKeysAndValues(); } return; } # # checkFilePathPermissions() : loop thru %HoHoHoA and make sure that # directory ($HOME + $filepath) can be # accessed. if not, write "Permission Denied" error message to {key3} # array, update {key3} 'Error Flag' to 'Y' # and update {key2} Validation Error -> Error Flag to 'Y'. # sub checkFilePathPermissions { for my $key1 ( keys %HoHoHoA ) { #outer named hash $fullfilepath = $HOME.$HoHoHoA{$key1}->{'File Path'}->{'Value'}; writeLog( "debug - fullfilepath = $fullfilepath" ) if ( $debug ); # don't check permissions if checkFilePathExists() thru error if ( $HoHoHoA{$key1}->{'File Path'}->{'Error Flag'} eq 'N' ) { if ( !( sysopen( TEST, $fullfilepath, O_RDONLY) ) ) { writeLog("* * * ABNORMAL COMPLETION * * * Error $!: Unable to open + directory $fullfilepath" ) if ( $debug ); #add error message to array for this has element push @{ $HoHoHoA{$key1}{'File Path'}{'Error Message'} }, ("Directo +ry $fullfilepath Found : Permission Denied"); #set error flag for this element to Y $HoHoHoA{$key1}->{'File Path'}->{'Error Flag'} = 'Y'; #set Validation Error -> Error Flag to Y $HoHoHoA{$key1}->{'Validation Error'}->{'Error Flag'} = 'Y'; } else { writeLog( "debug - can open directory $fullfilepath " ) if ( $debu +g ); } # set status VALIDATION ERRORs CAUSE STATUS TO REMAIN AS 'Pending' # $HoHoHoA{$key1}->{'SFTP Results'}->{'Status'} = 'Failed'; #set time stamp of error my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = +localtime(); $mon += 1; $year += 1900; my $timestamp = sprintf( "%04d%02d%02d %02d:%02d:%02d", $year, $mon +, $mday, $hour, $min, $sec ); $HoHoHoA{$key1}->{'SFTP Results'}->{'Time Stamp'} = $timestamp; close ( TEST ); } } if ( $debug ) { writeLog( "489 after checkFilePathPermissions" ); printHashKeysAndValues(); } return; } # # checkFileExists() : loop thru %HoHoHoA and make sure that file # exists. # if not, write "Invalid" error message to {key3}array, update {key3} # 'Error Flag' to 'Y' and update {key2} # Validation Error -> Error Flag to 'Y'. # sub checkFileExists { for my $key1 ( keys %HoHoHoA ) { #outer named hash $file = $HOME.$HoHoHoA{$key1}->{'File Path'}->{'Value'}.$HoHoHoA{$ke +y1}->{'File Name'}->{'Value'}; writeLog( "debug - file = $file" ) if ( $debug ); # don't check file if filepath has error (doesn't exists # or permission denied) if ( $HoHoHoA{$key1}->{'File Path'}->{'Error Flag'} eq 'N' ) { if ( !( -f $file ) ) { writeLog("* * * ABNORMAL COMPLETION * * * Error: $!. Unable to fin +d file $file" ) if ( $debug ); #add error message to array for this has element push @{ $HoHoHoA{$key1}{'File Name'}{'Error Message'} }, ("File No +t Found : $file"); #set error flag for this element to Y $HoHoHoA{$key1}->{'File Name'}->{'Error Flag'} = 'Y'; #set Validation Error -> Error Flag to Y $HoHoHoA{$key1}->{'Validation Error'}->{'Error Flag'} = 'Y'; } else { writeLog( "debug - found file $file " ) if ( $debug ); } # set status VALIDATION ERRORs CAUSE STATUS TO REMAIN AS 'Pending' # $HoHoHoA{$key1}->{'SFTP Results'}->{'Status'} = 'Failed'; #set time stamp of error my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = +localtime(); $mon += 1; $year += 1900; my $timestamp = sprintf( "%04d%02d%02d %02d:%02d:%02d", $year, $mon +, $mday, $hour, $min, $sec ); $HoHoHoA{$key1}->{'SFTP Results'}->{'Time Stamp'} = $timestamp; } } if ( $debug ) { writeLog( "511 after checkFileExists" ); printHashKeysAndValues(); } return; } # # checkFilePermissions() : loop thru %HoHoHoA and make sure that file # can be accessed. # if not, write "Permission Denied" error message to {key3} array, # update {key3} 'Error Flag' to 'Y' # and update {key2} Validation Error -> Error Flag to 'Y'. # sub checkFilePermissions { for my $key1 ( keys %HoHoHoA ) { #outer named hash $file = $HOME.$HoHoHoA{$key1}->{'File Path'}->{'Value'}.$HoHoHoA{$ke +y1}->{'File Name'}->{'Value'}; writeLog( "debug - file = $file" ) if ( $debug ); # don't check file permission if checkFileExists() of if filepath has # error (doesn't exists or permission denied) if ( ( $HoHoHoA{$key1}->{'File Name'}->{'Error Flag'} eq 'N' ) && ( $HoHoHoA{$key1}->{'File Path'}->{'Error Flag'} eq 'N' ) ) { if ( !( sysopen( INPUTFILE, $file, O_RDONLY ) ) ) { writeLog("* * * ABNORMAL COMPLETION * * * Error: $!. Unable to ope +n file $file" ) if ( $debug ); #add error message to array for this has element push @{ $HoHoHoA{$key1}{'File Name'}{'Error Message'} }, ("File $f +ile Found : Permission Denied"); #set error flag for this element to Y $HoHoHoA{$key1}->{'File Name'}->{'Error Flag'} = 'Y'; #set Validation Error -> Error Flag to Y $HoHoHoA{$key1}->{'Validation Error'}->{'Error Flag'} = 'Y'; } else { writeLog( "debug - can open file $file " ) if ( $debug ); } # set status VALIDATION ERRORs CAUSE STATUS TO REMAIN AS 'Pending' # $HoHoHoA{$key1}->{'SFTP Results'}->{'Status'} = 'Failed'; #set time stamp of error my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = +localtime(); $mon += 1; $year += 1900; my $timestamp = sprintf( "%04d%02d%02d %02d:%02d:%02d", $year, $mon +, $mday, $hour, $min, $sec ); $HoHoHoA{$key1}->{'SFTP Results'}->{'Time Stamp'} = $timestamp; close( INPUTFILE ); } } if ( $debug ) { writeLog( "562 after checkFilePermissions" ); printHashKeysAndValues(); } return; } # # getFilePath() : user enters path of filename to be SFTP'd or get # filepath from hash for this line. # This path is in addition to the /xxx/yyy/ directory. # sub getFilePath { if ( $interactive ) { print(STDOUT "\nEnter Directory of File to Send (ie /data/send/ [do +not include /xxx/yyy]) : " ); $filepath = <STDIN>; chomp ( $filepath ); writeLog( "Directory of File to Send (as entered) : $filepath" ) if +( $debug ); #make sure format of path is in /file/path/ format checkFilePathFormat(); #add HOME to beginning of filepath $filepath = $HOME.$filepath; if ( !( -d $filepath ) ) { #check if directory exists writeLog("* * * ABNORMAL COMPLETION * * * Error $!. Unable to find +directory $filepath" ); die("\n"); } else { writeLog( "debug - found directory $filepath " ) if ( $debug ); } if ( !( sysopen( INPUTFILE, $filepath, O_RDONLY ) ) ) { #check if di +rectory can be opened writeLog("* * * ABNORMAL COMPLETION * * * Error: $!. Unable to open + directory $filepath" ); die("\n"); } else { writeLog( "debug - can open file $file " ) if ( $debug ); } close( INPUTFILE ); } else { # set $filepath equal to filepath value in %HoHoHoA for line number $filepath = $HoHoHoA{$line_number_being_processed}{'File Path'}{'Val +ue'} } writeLog( "Directory of File to Send (as loaded) : $filepath" ) if ( +! $interactive ); return; } #end getFilePath() # # getFileName() : user enters filename to be SFTP'd or get filename # from hash for this line # sub getFileName { if ( $interactive ) { print (STDOUT "\nEnter Name of File to Send (ie file.20030818) : " ) +; $filename = <STDIN>; chomp ( $filename ); #filepath already has HOME prefix from getFilePath() $file = $filepath.$filename; if ( !( -f $file ) ) { #check if file exists writeLog("* * * ABNORMAL COMPLETION * * * Error $!. Unable to find +file $file" ); die("\n"); } else { writeLog( "debug - found file $file" ) if ( $debug ); } #check if file can be opened if ( !( sysopen( INPUTFILE, $file, O_RDONLY ) ) ) { writeLog("* * * ABNORMAL COMPLETION * * * Error: $!. Unable to open + file $file" ); die("\n"); } else { writeLog( "debug - can open file $file " ) if ( $debug ); } } else { # set $filename equal to filename value in %HoHoHoA for line number $filename = $HoHoHoA{$line_number_being_processed}{'File Name'}{'Val +ue'}; $file = $HOME.$filepath.$filename; } writeLog( "File to Send : $filename" ); writeLog( "Full File to Send (/path/name) : $file" ); return; } #end getFileName() # # getTargetDir() : user selects target directory from list of # predetermined directories on host or load from hash # sub getTargetDir { if ( $interactive ) { do { print( STDOUT "\n\t1) CF Directory" ); print( STDOUT "\n\t2) CC Directory" ); print( STDOUT "\nSelect Target Directory ([enter] not needed) : " ) +; # prepare for getc if ( $BSD_STYLE ) { system( 'stty', 'cbreak', '</dev/tty', '>/dev/tty', "2>&1" ); } else { system( 'stty', '-icanon', 'eol', "\001" ); } $key = getc(STDIN); print( STDOUT "\n" ); if ( $BSD_STYLE ) { system( 'stty', '-cbreak', '</dev/tty', '>/dev/tty', "2>&1" ); } else { system( 'stty', 'icanon', 'eol', '^@' ); # ASCII null } if ( $debug ) { writeLog( "debug - key = $key" ); } } until ( $key == 1 || $key == 2 ); #assign known target directory based on $key value SWITCH: { #path for CF directory goes here if ( $key == 1 ) { $target_dir = '/IN/CF/'; last SWITCH; } #path for non CF directory goes here if ( $key == 2 ) { $target_dir = '/IN/CC/'; last SWITCH; } } } else { # set $target_dir equal to target directory value in %HoHoHoA # for this line number $target_dir = $HoHoHoA{$line_number_being_processed}{'Target Directo +ry'}{'Value'} } writeLog( "Target Directory Selected : $target_dir" ) if ( $interacti +ve ); writeLog( "Target Directory Loaded : $target_dir" ) if ( ! $interacti +ve ); writeLog( "debug - target directory = $target_dir" ) if ( $debug ); return; } #end getTargetDir() # # checkTargetDirFormat() : debug possible invalid target directory # formats loaded. # check if target directory begins with a single "/". If not, add a # single "/" or chop off additional "/"s. # check if target directory ends with a single "/". If not, add a # single "/" or chop off additional "/"s. # (remote machine requires a single / at beginning of target_dir) # sub checkTargetDirFormat { # check end of target directory for "/" ( /IN/CF becomes IN/CF/ ) writeLog( "debug - checking for / at end of target dir $target_dir" ) + if ( $debug ); #get last character in target_dir my $last_char = substr( $target_dir, length( $target_dir ) - 1, 1 ); writeLog( "debug - last character in target_dir $target_dir = $last_c +har" ) if ( $debug ); if ( $last_char ne '/' ) { writeLog( "debug - adding / to end of target_dir $target_dir" ) if ( + $debug ); #cat "/" to end of target_dir $target_dir .= '/'; } else { writeLog( "debug - / already exists at end. target_dir remains $targ +et_dir" ) if ( $debug ); } writeLog( "debug - target_dir = $target_dir" ) if ( $debug ); #check beginning of target_dir for / ( IN/CF/ becomes /IN/CF/ ) writeLog( "debug - checking for / at beginning of target_dir $target_ +dir" ) if ( $debug ); #get first character in target_dir my $first_char = substr( $target_dir, 0, 1 ); writeLog( "debug - first character in target_dir $target_dir = $first +_char" ) if ( $debug ); if ( $first_char ne '/' ) { writeLog( "debug - adding / to beginning of target_dir $target_dir" +) if ( $debug ); #add "/" to beginning of filepath $target_dir = '/'.$target_dir; } else { writeLog( "debug - / already exists at beginning. target_dir remains + $target_dir" ) if ( $debug ); } #beginning has already been checked for "/" so check for addl # "/"s at position 1 ( ///IN/CF/ becomes /IN/CF/ ) #if position 1 is "/" chop it out and continue until position #1 is not a "/" writeLog( "debug - checking for multiple '/'s at beginning of target +dir $target_dir" ) if ( $debug ); my $second_char = substr( $target_dir, 1, 1); writeLog( "debug - initial second character in target_dir $target_dir + = $second_char" ) if ( $debug ); while ( substr( $target_dir, 1, 1) eq '/' ) { writeLog( "debug - removing / from second character in target_dir $t +arget_dir" ) if ( $debug ); chop( substr( $target_dir, 1, 1 ) ); writeLog( "debug - target_dir = $target_dir" ) if ( $debug ); } writeLog( "debug - target_dir after removing multiple / from beginnin +g = $target_dir" ) if ( $debug ); #ending has already been check for "/" so check for addl "/"s #at position length - 2 (next to last position) #if position length - 2 is "/" chop it out and continue until #position length - 2 is not a "/" #( /IN/CF/// becomes IN/CF/) writeLog( "debug - checking for multiple '/'s at end of target dir $t +arget_dir" ) if ( $debug ); my $next_to_last_char = substr( $target_dir, length( $target_dir ) - +2, 1 ); writeLog( "debug - initial next to last character in target_dir $targ +et_dir = $next_to_last_char" ) if ( $debug ); while ( substr( $target_dir, length( $target_dir ) -2, 1) eq '/' ) { writeLog( "debug - removing / from next to last character in target_ +dir $target_dir" ) if ( $debug ); chop( substr( $target_dir, length( $target_dir ) -2, 1 ) ); writeLog( "debug - target_dir = $target_dir" ) if ( $debug ); } writeLog( "debug - target_dir after all additional / removed from end + = $target_dir" ) if ( $debug ); writeLog( "Directory of File to Send (after checkTargetDirFormat) : $ +target_dir" ) if ( ! $interactive ); return; } #end checkTargetDirFormat() # # checkFilePathFormat() : debug possible invalid file paths # check if user entered or info loaded begins and ends with a "/". # If not, add to beginning and/or end of file path. # check if user entered or info loaded has two or more "/"s at # beginning and/or end. If so, chop additional "/"s. # sub checkFilePathFormat { #check end of filepath for / ( /data becomes /data/ ) writeLog( "debug - checking for / at end of file path $filepath" ) if + ( $debug ); #get last character in filepath my $last_char = substr( $filepath, length( $filepath ) - 1, 1 ); writeLog( "debug - last character in filepath $filepath = $last_char" + ) if ( $debug ); if ( $last_char ne '/' ) { writeLog( "debug - adding / to end of filepath $filepath" ) if ( $de +bug ); #cat "/" to end of filepath $filepath .= '/'; } else { writeLog( "debug - / already exists at end. filepath remains $filepa +th" ) if ( $debug ); } writeLog( "debug - filepath = $filepath" ) if ( $debug ); #check beginning of filepath for / ( data/ becomes /data/ ) writeLog( "debug - checking for / at beginning of file path $filepath +" ) if ( $debug ); #get first character in filepath my $first_char = substr( $filepath, 0, 1 ); writeLog( "debug - first character in filepath $filepath = $first_cha +r" ) if ( $debug ); if ( $first_char ne '/' ) { writeLog( "debug - adding / to beginning of filepath $filepath" ) if + ( $debug ); #add "/" to beginning of filepath $filepath = '/'.$filepath; } else { writeLog( "debug - / already exists at beginning. filepath remains $ +filepath" ) if ( $debug ); } writeLog( "debug - filepath = $filepath" ) if ( $debug ); #check for multiple "/"s at beginning & end of file path and #remove all duplicates #beginning has already been checked for "/" so begin checking #for additional "/"s at position 1 #if position 1 is "/" chop it out and continue until position #1 is not a "/" writeLog( "debug - checking for multiple '/'s at beginning of file pa +th $filepath" ) if ( $debug ); my $second_char = substr( $filepath, 1, 1); writeLog( "debug - initial second character in filepath $filepath = $ +second_char" ) if ( $debug ); while ( substr( $filepath, 1, 1) eq '/' ) { writeLog( "debug - removing / from second character in filepath $fil +epath" ) if ( $debug ); chop( substr( $filepath, 1, 1 ) ); writeLog( "debug - filepath = $filepath" ) if ( $debug ); } writeLog( "debug - filepath after all additional / removed from begin +ning = $filepath" ) if ( $debug ); #ending has already been check for "/" so check for addl "/"s #at position length - 2 (next to last position) #if position length - 2 is "/" chop it out and continue until #position length - 2 is not a "/" writeLog( "debug - checking for multiple '/'s at end of file path $fi +lepath" ) if ( $debug ); my $next_to_last_char = substr( $filepath, length( $filepath ) - 2, 1 + ); writeLog( "debug - initial next to last character in filepath $filepa +th = $next_to_last_char" ) if ( $debug ); while ( substr( $filepath, length( $filepath ) -2, 1) eq '/' ) { writeLog( "debug - removing / from next to last character in filepat +h $filepath" ) if ( $debug ); chop( substr( $filepath, length( $filepath ) -2, 1 ) ); writeLog( "debug - filepath = $filepath" ) if ( $debug ); } writeLog( "debug - filepath after all additional / removed from end = + $filepath" ) if ( $debug ); writeLog( "Directory of File to Send (after checkFilePathFormat) : $f +ilepath" ); return; } #end checkFilePathFormat() # # callback() : used with $sftp->put() & is called at each iteration # of writing data to host. each chunk of data written to host is # typically 8192 bytes but could vary # $sftp is connection with host # $data is the data being written during this iteration # $offset is how far we are from beginning of the file for this # iteration # $size of file being written to host sub callback { my( $sftp, $data, $offset, $size ) = @_; writeLog( "inside callback() iteration $iteration offset $offset size + $size length(data) ", length($data) ) if ( $debug ); #unbuffer STDOUT select STDOUT; $| = 1; #print progress meter to screen if in Notify User mode or #Interactive mode if ((( ! $interactive ) && ( $HoHoHoA{$line_number_being_processed}-> +{'Program Mode'}->{'Value'} eq 'N' )) || ( $interactive )) { #set offset to size of file for last iteration #(so final $percentage_written is 100%) $offset = $size if ( $offset + length($data) == $size ); my $percentage_written = sprintf("%4d", ($offset *100 / $size)); #print progress meter line using variable #$percentage_written due to offset in last iteration #above printf( "Progress Meter -%4d%%", $percentage_written ); #backspace to beginning of line print( STDOUT "\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b" ); } $iteration++; return; } #end callback() # # printHashKeysAndValues() : loop thru %HoHoHoA and print all keys # and values # sub printHashKeysAndValues { for my $key1 ( sort keys %HoHoHoA ) { #outer named hash writeLog("$key1 => " ); for my $key2 ( sort keys %{ $HoHoHoA{$key1} } ) { #middle anonymous +hash writeLog( "\n\t$key2 => " ); for my $key3 ( sort keys %{ $HoHoHoA{$key1}{$key2} } ) { #inner ano +nymous hash if ( $key3 ne 'Error Message' ) { #scalar value writeLog( "\n\t\t$key3 => $HoHoHoA{$key1}->{$key2}->{$key3} " ); } else { #print array for Error Message writeLog( "\n\t\t$key3 => "); foreach my $j ( @{ $HoHoHoA{$key1}->{$key2}->{$key3} } ) { writeLog( "\t\t\t$j" ); } } } } } return; } # # singleLineSummary() : builds a single line summary of results for # each line of file files-to-sftp # sub singleLineSummary { #print header information writeLog( "Line #, SFTP Results, Error Type, Time Stamp, Calling Prog +ram, File Being Sent, Error Message(s)" ); print( STDOUT "\nLine #, SFTP Results, Error Type, Time Stamp, Callin +g Program, File Being Sent, Error Message(s)\n" ) if ( ! $debug ); #loop thru hash building a one line summary for each line in #$files_to_sftp for ($line_number_being_processed=1; $line_number_being_processed <= +$lines_loaded; $line_number_being_processed++) { #reset value between my $one_line_summary = ''; #turn on switch so writeLog() writes one_line_summary #correctly without regard to Program Mode $summary = 1; #build summary for line# with no errors if (( $HoHoHoA{$line_number_being_processed}->{'SFTP Results'}->{'Er +ror Flag'} eq 'N' ) && ( $HoHoHoA{$line_number_being_processed}->{'Validation Error'}->{'Er +ror Flag'} eq 'N' )) { $one_line_summary .= "$HoHoHoA{$line_number_being_processed}->{'SFT +P Results'}->{'Status'}, "; $one_line_summary .= "No Error, "; $one_line_summary .= "$HoHoHoA{$line_number_being_processed}->{'SFT +P Results'}->{'Time Stamp'}, "; $one_line_summary .= "$HoHoHoA{$line_number_being_processed}->{'Cal +ling Program'}->{'Value'}, "; $one_line_summary .= "$HoHoHoA{$line_number_being_processed}->{'Fil +e Name'}->{'Value'},"; foreach my $j ( @{ $HoHoHoA{$line_number_being_processed}->{'SFTP R +esults'}->{'Error Message'} } ) { $one_line_summary .= " $j."; } #TEST print(STDOUT "line $line_number_being_processed with no #errors\n" ); } #build summary for line# with an sftp error elsif ( $HoHoHoA{$line_number_being_processed}->{'SFTP Results'}->{' +Error Flag'} eq 'Y' ) { $one_line_summary .= "$HoHoHoA{$line_number_being_processed}->{'SFT +P Results'}->{'Status'}, "; $one_line_summary .= "SFTP Error, "; $one_line_summary .= "$HoHoHoA{$line_number_being_processed}->{'SFT +P Results'}->{'Time Stamp'}, "; $one_line_summary .= "$HoHoHoA{$line_number_being_processed}->{'Cal +ling Program'}->{'Value'}, "; $one_line_summary .= "$HoHoHoA{$line_number_being_processed}->{'Fil +e Name'}->{'Value'},"; foreach my $j ( @{ $HoHoHoA{$line_number_being_processed}->{'SFTP R +esults'}->{'Error Message'} } ) { $one_line_summary .= " $j."; } #TEST print(STDOUT "line $line_number_being_processed with an sftp #error\n" ); } #build summary for line# with validation error(s) elsif ( $HoHoHoA{$line_number_being_processed}->{'Validation Error'} +->{'Error Flag'} eq 'Y' ) { $one_line_summary .= "$HoHoHoA{$line_number_being_processed}->{'SFT +P Results'}->{'Status'}, "; $one_line_summary .= "Validation Error, "; $one_line_summary .= "$HoHoHoA{$line_number_being_processed}->{'SFT +P Results'}->{'Time Stamp'}, "; $one_line_summary .= "$HoHoHoA{$line_number_being_processed}->{'Cal +ling Program'}->{'Value'}, "; $one_line_summary .= "$HoHoHoA{$line_number_being_processed}->{'Fil +e Name'}->{'Value'},"; for my $key2 ( keys %{ $HoHoHoA{$line_number_being_processed} } ) { + #middle anonymous hash foreach my $j ( @{ $HoHoHoA{$line_number_being_processed}->{$key2} +->{'Error Message'} } ) { #error messages for each middle anonymous h +ash $one_line_summary .= " $j."; } } #TEST print(STDOUT "line $line_number_being_processed with validation #errors\n" ); } #write summary to log writeLog( "Line # $line_number_being_processed $one_line_summary" ); #write summary to screen print(STDOUT "Line # $line_number_being_processed $one_line_summary\ +n" ) if ( ! $debug ); #save all one_line_summary(s) for email beginning with header #information $email_summary .= ("Line #, SFTP Results, Error Type, Time Stamp, Ca +lling Program, File Being Sent, Error Message(s)\n\n") if ( $line_num +ber_being_processed == 1 ); $email_summary .= "Line # $line_number_being_processed $one_line_sum +mary\n\n"; } #end of for #turn off switch so writeLog() writes one_line_summary #correctly without regard to Program Mode $summary = 0; return; } #end singleLineSummary() # # sendPage() : send a single page to pagegroup when one or more # error(s) (validation or sftp) occur # sub sendPage { my $pager = MSC::Page->new; #text sent to pagegroup, calling program sent is based on value in 1s +t line my $message = "$program.plx Error during process [$process] called by + $HoHoHoA{'1'}->{'Calling Program'}->{'Value'}"; $pager->send( $pagegroup, "$message" ); writeLog( "Page sent: $message" ); return; } #end sendPage() # # sendEmail() : send a single email that includes all # one_line_summary(s) built in singleLineSummary() # when one or more error(s) occur (page has been sent) # sub sendEmail { my $to_address = 'myemail@work.com'; open( EMAIL, "|/usr/lib/sendmail -t" ) || die "Cannot open sendmail"; select( EMAIL ); print "Mime-Version: 1.0\n"; #write header info print "To: $to_address\n"; print "From: SFTP_Summary\n"; #MUST HAVE A BLANK LINE BETWEEN HEADER AND BODY print "Subject: SFTP Summary - $program.$log_ts\n\n"; print "$email_summary\n"; #write body info close( EMAIL ); #closing handle sends mail writeLog( "Email sent to $to_address" ); print(STDOUT "Email sent to $to_address\n" ) if ( ! $debug ); return; } # # closeConnection() : #Thru testing, PERL appears to clean up the unclosed connection on #its own #Benjamin Trott, the Net::SFTP auther, kindly sent the following #patch, This patch is NOT TESTED #Exiting a Net::SFTP connection - from "Perl-Users Digest #Tue, 5 Mar 2002 Volume: 10 Number: 2764" # #sub closeConnection { # my $sftp = shift; # my $channel = $sftp->{channel}; # $channel->{istate} = 'CHAN_INPUT_WAIT_DRAIN'; # $channel->send_eof; # $channel->{istate} = 'CHAN_INPUT_CLOSED'; # $sftp->{ssh}->client_loop; #} #end closeConnection()

Edit by tye, add READMORE tags

  • Comment on Seek Critique of SFTP program, format, structure, overall "Perl"ness
  • Download Code

Replies are listed 'Best First'.
Re: Seek Critique of SFTP program, format, structure, overall "Perl"ness
by zengargoyle (Deacon) on Dec 07, 2003 at 02:41 UTC

    You can create a hash with your globals and have Getopt override them if needed.

    use Getopt::Long; sub get_options { my $def = shift; my $cur = {}; $cur->{$_->[0]} = $_->[2] for @$def; my @def = map {$_->[0].$_->[1]} @$def; GetOptions( $cur, @def ); return $cur; } my $defaults = [ [ debug => '' => 0 ], [ help => '' => 0 ], [ interactive => '' => 0 ], [ host => '=s' => '999.999.999' ], [ username => '=s' => 'username' ], [ home => '=s' => $ENV{HOME} ], # ... ]; my $opt = get_options( $defaults ); # if ( $opt->{help} ) { ... } # foo( $opt->{host} );

    You loose strict being able to catch your typo's but it becomes real easy to add new options/variables.

    Some refactoring wouldn't hurt...

    sub debug { my $msg = shift; writeLog( $msg ) if $opt->{debug}; } sub timestamp { my $when = shift || time; my ( $sec, $min, ... ) = localtime( $when ); # ... return $stamp; }

    You might benefit from placing some of your comments into POD format.

    There are places you might be able to do something like:

    # ... my @k = ( 'Status', 'Time Stamp', 'Value', 'Error Message' ); my $h = $HoHoHoA{$line_number_being_processed}; $one_line_summary = $h->{shift(@k)} . 'No Error. '; $one_line_summary .= $h->{$_} . '. ' for @k; $one_line_summary .= "$j.";

    In general, when you see lot's of lines that look the same except for one or two differences there's probably a way to clean it up and make it easier to add one more thing without copying a line from above and changing that one different thing.

    Just a personal thing, when processing hash keys i usually transform them into all lower case and change whitespace to '_' so i don't have to quote them as often.

    my @k = qw/ status time_stamp value error_message /;

    Which just saves a bit of typing here and there.

    Otherwise, if it does what you want it to do...

      Now THIS is the kind of feedback I am looking for. Thank you all. Keep it coming. Mike
Re: Seek Critique of SFTP program, format, structure, overall "Perl"ness
by daddyefsacks (Pilgrim) on Dec 07, 2003 at 04:00 UTC

    To me the amount of comments in the code serve to make it less readable. If you need that many comments to allow people to understand your code perhaps you should rewrite the code to be more understandable. Use comments to explain why you did something and let the code should show how it's done. You write my %HoHoHoA; #used in readListOfFilesToSFTP() What does that serve to tell someone reading your code? I'm not sure what exactly but I am sure Santa Claus is somehow involved.

    You've defined two constants TRUE and FALSE which aren't used anywhere in the code that I see. Check this page for an explanation of why that's usually a silly thing to do.

    There are several blocks of code with a pattern of

    do_this() if (! $interactive); and_this() if (! $interactive); and_this_too() if(! $interactive);
    why not:
    if (!$interactive) { do_this(); and_this(); and_this_too(); }

    If looks like you are trying to see if put succeeds but in a really obscure way..

    if ( eval { $sftp->put( $file, $target_file, \&callback ); } ne 0 )
    Does that work? From looking at the source, put returns undef on failure:
    if ($sftp->put()) { # success } else { # fail }

    There are several areas where you are doing things like this:

    writeLog("* * * ABNORMAL COMPLETION * * * Error: $!. Unable to open +file $files_to_sftp" ); print( STDOUT "* * * ABNORMAL COMPLETION * * * Error: $!. Unable to +open file $files_to_sftp\n" );
    Why don't you make the writeLog function a little smarter rather than littering the code with all those checks for  if (!debug) and if (! $interactive) maybe set up a closure so that the writeLog function knows what mode it is in and knows what to do with the messages it receives something like:
    sub set_up_logger { my ($interactive, $batch, $whatever) = @_; sub writeLog { my $msg = shift; if ($interactive) { print STDOUT $msg; } elsif ($batch) { print FILE $msg; } ## whatever whatever } }

    I see some system calls where the return value isn't being checked, bad idea.

    Anyway those are just some quick comments I had while reading down through your code, I didn't actually run it or check too hard for bugs. I think overall it could benefit from more design work upfront to make it more modular. Best of luck!

Re: Seek Critique of program, format, structure, overall "Perl"ness
by duff (Parson) on Dec 07, 2003 at 01:24 UTC

    I haven't looked through the whole program yet, but you appear to do this:

    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = loc +altime(); $mon += 1; $year += 1900; my $timestamp = sprintf( "%04d%02d%02d %02d:%02d:%02d", $year, $mon +, $mday, $hour, $min, $sec );

    quite a bit. Use strftime() instead.

    use POSIX qw(strftime); my $ts = strftime("%Y%m%d %H:%M:%S", localtime);
Re: Seek Critique of SFTP program, format, structure, overall "Perl"ness
by PodMaster (Abbot) on Dec 07, 2003 at 08:39 UTC
Re: Seek Critique of SFTP program, format, structure, overall "Perl"ness
by waswas-fng (Curate) on Dec 07, 2003 at 02:03 UTC
    also use readmore tags when posting 40 some pages of code. =)


    -Waswas
Re: Seek Critique of SFTP program, format, structure, overall "Perl"ness
by fletcher_the_dog (Friar) on Dec 11, 2003 at 03:31 UTC
    # predeclare subroutines so subs; can be called before being declared # and without ()
    subroutines don't have to be declared before you can use them in your code. The don't even have to be declared at compile time. If you are using AUTOLOAD the don't even have to defined when the are executed at runtime.
    Also, learning the power of regular expressions will make your code more tighty. The following one line could replace your code that follows
    # one line to make sure there is one and only one "/" $target_dir=~s<^/*></>;
    Could replace all this:
    #get first character in target_dir my $first_char = substr( $target_dir, 0, 1 ); writeLog( "debug - first character in target_dir $target_dir = $first +_char" ) if ( $debug ); if ( $first_char ne '/' ) { writeLog( "debug - adding / to beginning of target_dir $target_dir" +) if ( $debug ); #add "/" to beginning of filepath $target_dir = '/'.$target_dir; } else { writeLog( "debug - / already exists at beginning. target_dir remains + $target_dir" ) if ( $debug ); } #beginning has already been checked for "/" so check for addl # "/"s at position 1 ( ///IN/CF/ becomes /IN/CF/ ) #if position 1 is "/" chop it out and continue until position #1 is not a "/" writeLog( "debug - checking for multiple '/'s at beginning of target +dir $target_dir" ) if ( $debug ); my $second_char = substr( $target_dir, 1, 1); writeLog( "debug - initial second character in target_dir $target_dir + = $second_char" ) if ( $debug ); while ( substr( $target_dir, 1, 1) eq '/' ) { writeLog( "debug - removing / from second character in target_dir $t +arget_dir" ) if ( $debug ); chop( substr( $target_dir, 1, 1 ) ); writeLog( "debug - target_dir = $target_dir" ) if ( $debug ); }
    Also your code has some many comments it makes it hard to read.
    #verify that file exists checkFileExists() if ( ! $interactive );
    If your function name is almost exactly the same as your comment, you probably don't need the comment

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://312827]
Approved by tye
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (2)
As of 2022-09-25 05:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I prefer my indexes to start at:




    Results (116 votes). Check out past polls.

    Notices?