in reply to Has my Perl Go Crazy?
My eyes! My eyes! I don't know if your Perl has gone crazy but your maintenance programmers will. Please read Learning Perl and or Perl Best Practices. At least wander around this place and read example code until you absorb some better habits. You have the ability to stop building mud balls.
The reason why you want to use carefully controlled, minimal scoping on all your variables is prevent "infectious" errors. Read Coping with Scoping for more info.
What is $dest? Where is it set? Are you sure it is what you think it is? What do $csarch and $cs$file do? They don't seem to be used anywhere?
I rewrote your script. I ditched the intermediate files and copies to weird places. I also didn't set the $avil ($evil?) bit. If you need the files for something, it is trivial to write them to the desired locations. Notice how no subroutine looks to data from outside the routine (unless explicitly passed in). This makes your programs eaier to maintain. For example: if I wanted to pop up a GUI window instead of messing with the console, all I have to do is tweak the display_message sub and it will work.
use strict; use warnings; use File::Copy; # copy files use File::Spec; # file path manipulation use Term::ReadKey; # read 'any key' for pause # do some stuff. archive_child_support_files(); # do other stuff. # Copy child support files from foo to bar. Display an on screen warn +ing if # any errors occur. sub archive_child_support_files { my ($count, $errors) = copy_files( 'foo', 'bar', '.ls' ); if ( $count or @$errors ) { my $error_count = @$errors; my $message = join "\n", '', "Copied $count Files.", "Errors Detected: $error_count", format_errors($errors); my $pause = $error_count ? 1 : 0; my $clear = $error_count ? 1 : 0; my $color = $error_count ? 'cf' : ''; display_message( $message, $clear, $pause, $color ); } else { my $no_files_msg = <<'END_MSG'; No files were archived. Please verify. END_MSG display_message( $no_files_msg, 1, 1, 'cf' ); } } # Copy files that match extension pattern from the source to the targe +t # directories. # Returns the number of files copied and an array ref containing error + informaton. # Error array structure: # [ [ source file 1, destination file 1, error message 1 ], # [ source file 2, destination file 2, error message 2 ], # ... # [ source file n, destination file n, error message n ], # ] sub copy_files { my $source_dir = shift; # Source directory. Copy from here. my $target_dir = shift; # Target directory. Copy to here. my $extension = shift; # File extension. # Read the source dir. Return if error. opendir( my $source_dirh, $source_dir ) or return 0, [[$source_dir, $target_dir, "Unable to read sourc +e directory - $!"]]; # Get list of files to copy my @files_to_copy = grep { /\Q$extension\E$/ } readdir $source_dirh; # Copy the files. my @errors; #keep track of errors detected here. foreach my $file_name ( @files_to_copy ) { my $target = File::Spec->catfile( $target_dir, $file_name ); my $source = File::Spec->catfile( $source_dir, $file_name ); print "Copying $source to $target\n"; if ( -e $target ) { push @errors, [ $source, $target, 'Target file exists.' ]; } else { copy( $source, $target ) or push @errors, [ $source, $target, $! ]; } } return scalar @files_to_copy, \@errors; } # display a message on the screen. # handles optional clear screen and color changes. sub display_message { my $message = shift; # Text to print. my $clear = shift; # Boolean. If true clear screen my $pause = shift; # Boolean. If true pause my $color = shift; # Text. Color spec as per dos color comma +nd. system('cls') if $clear; system("color $color") if $color; print $message; pause() if $pause; } # Format the errors data structure for display. # See copy_files() for information on the error structure. sub format_errors { my $errors = shift || []; my $text = join "\n\n", map { "\tSource: $_->[0]\n\tTarget: $_->[1]\n\tError: $_->[2]\n" } @$errors; return $text; } # Print press any key and block until input is received. sub pause { print "\nPress any key to continue.\n"; ReadMode(4); ReadKey(0); system( 'color 0A' ); return; }
TGI says moo
|
|---|