use warnings; use strict; $| = 1; #sets buffer to immediately flush my $mydir = 'C:\some\path'; my $destination = 'C:\some\other\path'; opendir (MYDIR, $mydir) or die "Could not opendir $mydir: $!\n"; my @files = grep { /\.ext$/} readdir MYDIR; closedir(MYDIR); for (@files) { &CopyFileProgress("$mydir\\$_","$destination\\$_",\&FileProgress); print "\n"; } sub CopyFileProgress ( ) { my $src = shift; my $dst = shift; my $callback = shift; my $num_read; my $num_wrote; my $buffer; my $total_written = 0; open (SRC, "< $src") or die "Could not open source file [$src]: $!\n"; open (DST, "> $dst") or die "Could not open destination file [$dst]: $!\n"; binmode SRC; binmode DST; my $filesize = (-s $src) or die "File has zero size.\n"; my $blksize = int ($filesize / 10); while (1) { $num_read = sysread(SRC, $buffer, $blksize); last if ($num_read == 0); die ("Error reading from file [$src]: $!\n") if (!defined($num_read)); my $offset = 0; while ($num_read){ $num_wrote = syswrite(DST,$buffer,$num_read,$offset); die ("Error writing to file [$dst]: $!\n") if (!defined($num_wrote)); $num_read -= $num_wrote; $offset += $num_wrote; $total_written += $offset; } my $filename = basename($src); &$callback($filename, $total_written, $filesize) or die ("Copy canceled.\n"); } } sub FileProgress { my $filename = shift; my $wrote = shift; my $size = shift; my $percent = $wrote / $size * 100; printf "%s [%-10s] %3u%% done. %5u MBs\r", $filename, '*' x int( $percent / 10 ), $percent, $wrote / 1024 / 1024; return 1; }