The statement @list=<DIR>; after the file open will typically read all newline terminated lines from the file to the array. Each line, if I understand correctly, is a file name.

You then iterate through this array of newline terminated file names with foreach $tmp(@list) { ... }.

Without removing the newline, you try to use the file name in $tmp in a statement like `copy $source\\$tmp $dest\\$tmp`;. A little experimentation shows that the Windows copy function will take a newline in the middle of the string as the end of the command. This will look like copy somewhere\else\file.name and copy to the current directory.

This may be a part of your problem.

And this can be easily fixed by:

chomp( @list );  # remove newline chars
[download]

read all newline terminated lines

and also the last line, even if it is not newline terminated.

Your perl is what I affectionally call a "glorified batch file." Which is fine ... as long as you don't want to maintain it.

  print `dir /b $source\\*.txt > $source\\dir_list.lst`; #$source is d
+eclared just before the sub is called
[download]

  @list = glob "$source\\*.txt";
[download]

Another issue is just that you're probably not using strict or warnings. But that likely comes from the perl-as-a-batch-file-language approach you're using. This manifests as not passing in parameters to functions. There's no point in having functions if you don't use parameters to pass in values to work with. So, instead of setting $source before calling childsup, pass $source in as a parameter. This will make things easier to test and to reuse. Especially the part about putting use strict; and use warnings; at the top of your script.

And "$cnt = $cnt + 1;" is normally written as "$cnt++;" (it's so common that there's a shortcut for it). I highly suggest reading Learning Perl - it'll help you a lot.

All this probably doesn't quite solve your problem, but can make your code easier to use and read. As to your actual problem, I have to wonder if you are running the script as yourself or as another user, and that may cause permission problems. In my day job, my perl code's primary responsibility is copying files over the network (via samba or nfs, so I don't really worry about it), on Windows, Linux, AIX, Sun, and HP. Multiple GB at a go. And I really don't run into this problem, even using File::Copy for the actual copy operation. So I have to start by wondering about actual permissions - who the script runs under. I suspect you may be using the System account for your normal execution, and this would be a problem if true.

For a start: don't use global variables - you never know where they've been.

Always use strictures (use strict; use warnings; - see The strictures, according to Seuss).

Use the three parameter version of open.

or die ... will cause you less grief than || die ....

Investigate readdir and File::Find.

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;
}
[download]

Tanktalus: I really don’t mind you calling what I wrote a glorified Batch file script. That’s what it ends up being.

I understand how your line is more efficient, but it’s my intent to use the dir_list.lst else where. As for the glob function I tried to use it in a copy, but I think I really mucked that up.

as a noub to perl, I’m just not getting some stuff.

AnomalousMonk I understand what you’re implying, so I took a look at the files. But I don’t see anything like a newline terminated, so are you saying that as the file info fills the array, the function puts the /n in the array. In any case as I have  “copy $source\\$temp $dest\\$temp” in the script so that it outputs on the screen what the next line is meant to do. What is outputted is the correct syntax for cmd.

Scorpio17 I tried to use the chomp but is didn’t make and difference.

Oh grate Priest TGI, I thank you so much for all you effort. But alas not only did your script not work for me, it caused the script to crash. No errors from the script, Just perl crashes. BTW I forgot to note that I’m using perl 5.8.1.

I fully expect to be working on more Perl scripts in the Future, so I will take your advice and read threw those tutorials to avoid more mud balls. But my issue is getting weirder. I added another function to the script. I actually copied one working function and edited the name of the file and source. But once again, the script is putting the file in the wrong location. To that end I’m going to attach the whole script. For some reason option 4. instead of putting the files in $dest which would be \\xxxx\\xxxxx\\suntrust\oneworld, it’s putting the file in \\xxx\xxxxx which on my machine is represented as the y: drive. But if you note the syntax of 4 is the same as options 6 and 1 and those work correctly.

@imonth = ("01","02","03","04","05","06","07","08","09","10","11","12"
+);
@iday = ("00","01","02","03","04","05","06","07","08","09");
@timedata = localtime(time);
$mon = @timedata[4];
$month = @imonth[$mon];
$tmpday = @timedata[3];
$hour = @timedata[2];
$min = @timedata[1];
$sec = @timedata[0];
if ($tmpday < 10)
{
  $day = @iday[$tmpday];
} else {
  $day = $tmpday;
}

$year= @timedata[5] + 1900;

$spacer = "_";
$drive = "\\\\xxx\\xxxxx\\ftp\\files";
$in = "\\\\xxx\\xxxxx\\SunTrust";
$script = "\\\\xxx\\xxxxx\\Suntrust\\scripts";
$ap_script = "\\\\xxx\\xxxxxx\ap_scripts";
$payrollin = "$in\\payroll";
$oneworldin = "$in\\oneworld";
$retireein = "$in\\retiree";
$tempin = "$in\\temp";
$valid = 0;
while ( $valid < 1)
{
  # Clear the in directory before retrieving files.
  print `del /Q $in\\ach*.*`;

  $chk = 0;
  $dateline = "$year$month$day";
  system("cls");
  system("color 0A");
  print "\n";
  print "\n";
  print " Bank Master File Send Script\n ";
  print "\n\n";
  print "1.) Payroll ACH Send.\n\n";
  print "2.) Positive Pay Send.\n\n";
  print "3.) AP Positive Pay Send.\n\n";
  print "4.) Echeck Send.\n\n";
  print "5.) PSERM Positive Pay. \n\n";
  print "6.) Payroll Retiree ACH.\n\n";
  print "7.) Exit Menu.\n";
  print "\n";

  $chk = <STDIN>;
  chop ($chk);
  if ($chk eq "1"){
    $source = "\\\\xxx\\xxxxx\\Public\\OneWor~2\\Interfaces";
    $dest = $payrollin;
    $pgpfile = "achout.txt";
    system("cls");
    $avil = 0;
      payach(); # pulls file from dir and archives.
       if ($avil < 1){
       print "********************************************************
+**********\n";
       print "*\n";
       print "*              STOP    STOP     STOP    STOP\n";
       print "*\n";
       print "*   Verify that total matches the amount provided by pay
+roll..\n";
       print "*\n";
       print "*\n";
       print "********************************************************
+**********\n";
       print "\n\n";
       print ".\n";
       print `perl $script\\getach.pl payroll`;
       print `type $dest\\distot.txt`;
       print `echo ************************** >> $dest\\putpayrollach.
+log`;
       print`echo %date% %time% >> $dest\\putpayrollach.log`;

     pgp_file();
     setup_password();
     $sitenum = 17;
     $source_fld = "$in\\payroll";
     $location_fld = "\/ACH";
     $source_file = "achout.txt.pgp";
     send_file();
     ftp_files();
     print `del $in\\payroll\\achout.txt.pgp`;
     }
  }
  if ($chk eq "2"){
    $source = "\\\\xxxxx\\xxxxxx\\Public\\OneWor~2";
    $dest = $payrollin;
    $pgpfile = "positive_pay.txt";
    $type = "payroll";
    system("cls");
    $avil = 0;
      pospay(); # pulls file from dir and archives.
       if ($avil < 1){
       print "********************************************************
+**********\n";
       print "*\n";
       print "*              STOP    STOP     STOP    STOP\n";
       print "*\n";
       print "*              Payroll Positive Pay send..\n";
       print "*\n";
       print "*\n";
       print "********************************************************
+**********\n";
       print "\n\n";
       print ".\n";

     pgp_file();
     setup_password();
     $sitenum = 17;
     $source_fld = "$dest";
     $location_fld = "\/Control_Pay";
     $source_file = "Positive_Pay.txt.pgp";
     send_file();
     ftp_files();
     print `del $dest\\Positive_Pay.txt.pgp`;
     print `del $dest\\Positive_Pay.txt`;
     }
  }
  if ($chk eq "3"){
    $source = "\\\\xxxxx\\xxxxxx\\Public\\OneWor~1";
    $dest = $oneworldin;
    $pgpfile = "positive_pay.txt";
    $type = "Oneworld";
    system("cls");
    $avil = 0;
      pospay(); # pulls file from dir and archives.
       if ($avil < 1){
       print "********************************************************
+**********\n";
       print "*\n";
       print "*              STOP    STOP     STOP    STOP\n";
       print "*\n";
       print "*              Oneworld Positive Pay send..\n";
       print "*\n";
       print "*\n";
       print "********************************************************
+**********\n";
       print "\n\n";
       print ".\n";
       pgp_file();

    setup_password();
     $sitenum = 16;
     $source_fld = "$dest";
     $location_fld = "\/Control_Pay";
     $source_file = "Positive_Pay.txt.pgp";
     send_file();
     ftp_files();
     print `del $dest\\Positive_Pay.txt.pgp`;
     print `del $dest\\Positive_Pay.txt`;
     }
  }
 if ($chk eq "4"){
    $source = "c:\\ACH\\oneworld";
    $dest = $onworldin;
    $pgpfile = "eCheckOW";
    system("cls");
    $avil = 0;
      OWeCheck(); # pulls file from dir and archives.
       if ($avil < 1){
       print "********************************************************
+**********\n";
       print "*\n";
       print "*              STOP    STOP     STOP    STOP\n";
       print "*\n";
       print "*   Notice the total for the Echeck file..\n";
       print "*\n";
       print "*\n";
       print "********************************************************
+**********\n";
       print "\n\n";
       print ".\n";
       print `perl $in\\scripts\\getach.pl oneworld`;
       print `type $dest\\\distot.txt`;
       print `echo ************************** >> $dest\\putecheck.log`
+;
       print `echo %date% %time% >> $dest\\putecheck.log`;

    pgp_file();
    setup_password();
     $sitenum = 18;
     $source_fld = "$dest";
     $location_fld = "\/ACH";
     $source_file = "echeck.pgp";
     send_file();
     #ftp_files();
     }
  }
 if ($chk eq "5"){
    $source = "\\\\xxxxxx\\xxxxxx\\Public\\OneWor~1";
    $dest = $oneworldin;
    $pgpfile = "positive_pay.txt";
    $type = "PSERM";
    system("cls");
    $pserm_arch = "\\\\xxxxx\\xxxxxx\\Public\\PSERM\\Positi~1\\archive
+";
    $avil = 0;
      psermpospay(); # pulls file from dir and archives.
       if ($avil < 1){
       print "********************************************************
+**********\n";
       print "*\n";
       print "*              STOP    STOP     STOP    STOP\n";
       print "*\n";
       print "*              PSERM Positive Pay send..\n";
       print "*\n";
       print "*\n";
       print "********************************************************
+**********\n";
       print "\n\n";
       print ".\n";
       pgp_file();

    setup_password();
     $sitenum = 18;
     $source_fld = "$dest";
     $location_fld = "\/Control_Pay";
     $source_file = "Positive_Pay.txt.pgp";
     send_file();
     ftp_files();
     print `del $dest\\Positive_Pay.txt.pgp`;
     print `del $dest\\Positive_Pay.txt`;
     }
  }
  if ($chk eq "6"){
    $source = "\\\\xxxxx\\xxxxxx\\Public\\OneWor~2\\Interfaces";
    $dest = $retireein;
    $pgpfile = "payach.txt";
    system("cls");
    $avil = 0;
      retpayach(); # pulls file from dir and archives.
       if ($avil < 1){
       print "********************************************************
+**********\n";
       print "*\n";
       print "*              STOP    STOP     STOP    STOP\n";
       print "*\n";
       print "*   Verify that total matches the amount provided by pay
+roll..\n";
       print "*\n";
       print "*\n";
       print "********************************************************
+**********\n";
       print "\n\n";
       print ".\n";
       print `perl $in\\scripts\\getach.pl retiree`;
       print `type $dest\\\distot.txt`;
       print `echo ************************** >> $dest\\putretireeach.
+log`;
       print`echo %date% %time% >> $dest\\putretireeach.log`;

    pgp_file();
    setup_password();
     $sitenum = 17;
     $source_fld = "$dest";
     $location_fld = "\/ACH";
     $source_file = "uapach.txt.pgp";
     send_file();
     ftp_files();
     #print `del $dest\\uapach.txt.pgp`;
     }
  }
 elsif ($chk eq "7")
  {
    $valid = 1;
    system("color 07");
    system("cls");
  }
  else
  {
    print "Invalid Option\n";
  }
}

sub OWeCheck{
  if (-e "$source\\eCheckOW") {
    print `del $dest\\eCheckOW.bkup`;
    $achname = "eCheckOW_$month$day$year.txt";
    print `copy $source\\eCheckOW $dest\\eCheckOW`;
    print `copy $source\\eCheckOW $dest\\echeck\\$achname`;
    print `move $source\\eCheckOW $dest\\eCheckOW.bak`;
  }

  else {
    system("cls");
    system("color cf");
    print "\n";
    print "\n";
    print "The One World eCheck file is not available.\n";
    print "\n";
    print "Please verify manually.\n";
    print "\n";
    $avil = 1;
    print `pause`;
  }
}

sub payach{
  if (-e "$source\\payach") {
    print `del $dest\\achout.txt`;
    $achname = "payach_$month$day$year.txt";
    print `copy $source\\payach $dest\\achout.txt`;
    print `copy $source\\payach $dest\\backup\\$achname`;
    print `del $dest\\backup\\payach.bak`;
    print `move $source\\payach $dest\\backup\\payach.bak`;
  }

  else {
    #system("cls");
    system("color cf");
    print "\n";
    print "\n";
    print "The Payroll Ach file is not available.\n";
    print "\n";
    print "Please verify manually.\n";
    print "\n";
    $avil = 1;
    print `pause`;
  }
}

sub retpayach{
  if (-e "$source\\retiree_payach") {
    print `del $in\\payroll\\uapach.txt`;
    $achname = "retach_$month$day$year.txt";
    print `copy $source\\retiree_payach $dest\\uapach.txt`;
    print `copy $source\\retiree_payach $dest\\backup\\$achname`;
    print `del $dest\\backup\\retach.bak`;
    print `move $source\\retiree_payach $dest\\backup\\retach.bak`;
  }

  else {
    system("cls");
    system("color cf");
    print "\n";
    print "\n";
    print "The Retiree Ach file is not available.\n";
    print "\n";
    print "Please verify manually.\n";
    print "\n";
    $avil = 1;
    print `pause`;
  }
}

sub pospay{
  if (-e "$source\\Interfaces\\positive_pay.txt") {
    print `copy $source\\Interfaces\\positive_pay.txt $dest\\positive_
+pay.txt`;
    print `copy $source\\Interfaces\\positive_pay.txt $source\\Archive
+-positive-pay\\$type\_positive\_pay\_$month$day$year.dat`;
    print `del $source\\Interfaces\\positive_pay.txt`;

  }

  else {
    system("cls");
    system("color cf");
    print "\n";
    print "\n";
    print "There is no Positive Pay file available.\n";
    print "\n";
    print "Please verify manually.\n";
    print "\n";
    $avil = 1;
    print `pause`;
  }
}
sub psermpospay{
  if (-e "$source\\Interfaces\\positive_pay.txt") {
    print `copy $source\\Interfaces\\positive_pay.txt $dest\\positive_
+pay.txt`;
    print `copy $source\\Interfaces\\positive_pay.txt $pserm_arch\\$ty
+pe\_positive\_pay\_$month$day$year.dat`;
    print `del $source\\Interfaces\\positive_pay.txt`;

  }

  else {
    system("cls");
    system("color cf");
    print "\n";
    print "\n";
    print "There is no PSERM Positive Pay file available.\n";
    print "\n";
    print "Please verify manually.\n";
    print "\n";
    $avil = 1;
    print `pause`;
  }
}
sub setup_password {
  #obtain password information for the two remote sites.

  @passline = (Num1,Site1,User1,Pswd1);

  open(PASS,"$drive\\password.ctl")
     || die "cannot open password ctl file.....";
    @pass_ctl=<PASS>;
  close(PASS);

  foreach $pass (@pass_ctl)
  {
    $len = length($pass);
    if ($len > 1) {
      @passline = split(/\|/, $pass);
      $num = $passline[0];
      $numint = int($num);

      @site[$numint] = $passline[1];
      @userid[$numint] = $passline[2];
      @pswd[$numint] = $passline[3];
    }
  }
}

sub send_file {
# Create the text file for sending files to Bank.
open(OUT,">$script\\ftp_put_suntrust.txt")
     || die "cannot open ftp text file";
print OUT "@userid[$sitenum]\n";
print OUT "@pswd[$sitenum]\n";
print OUT "binary\n";
print OUT "lcd $source_fld\n";
print OUT "cd $location_fld\n";
print OUT "mput $source_file\n";
print OUT "bye\n";
close OUT;
}

sub pgp_file{
print `pgp --encrypt  $dest\\$pgpfile --user \"xxxxxx\" --output $dest
+\\$pgpfile.pgp --conventional-passphrase \"xxxxxxxxxx\"`;
}

sub ftp_files {
print `ftp -i -s:$script\\ftp_put_suntrust.txt @site[$sitenum]`;
}
[download]