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


In reply to Re: Has my Perl Go Crazy? by TGI
in thread Has my Perl Go Crazy? by Xanthis013

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.