Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Re^2: File::Copy::Recursive - current file/directory being processed

by bigal_george (Acolyte)
on Jan 01, 2020 at 04:41 UTC ( [id://11110818]=note: print w/replies, xml ) Need Help??


in reply to Re: File::Copy::Recursive - current file/directory being processed
in thread File::Copy::Recursive - current file/directory being processed

Hi Dave. I will post what Ive done so far it might be useful. Certainly the tests I am having are showing some really good speed advantages in Linux anyways. As per most of my software works in the past, this is done for love, not for monetary gain and the only thing I would say is for any future user to take absolute care when using it as Ive been programming in Perl for only 3 days and there are bound to be some errors. Davo, your info has been extremely helpful and you pointers taken. I had just been checking the recursive module and it calls File::Copy::copy I did try to hook into that waste of time, yours works, but it seems to be far too re-entrant so I get about 10 x the number of files and directories as a result in dircopy(), more accurate on pathrm() The code below is still under testing, so user beware and there are some extra print statements and tests so its not ready for user. Any tips appreciated.
#!/usr/bin/perl -w # Fastcmd - Fast Copy/Move/Delete whole directory trees like mv -rd rm + -rd #moded by A George; use at your own risk! #EXAMPLE call under linux or windows: perl /home/alistair/perl/fastcmd +.pl del . (deletes everything in current directory) #tested under Linux deleted 30,000 files in 4 seconds on ext4 hdd part +ition #ui error (not bug) couldn't rmdir directory .: Invalid argument at /h +ome/alistair/perl/fastremove.pl line 17. use File::Find; use File::Path qw(make_path); use strict; use warnings FATAL=>"all"; use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove); use File::Basename; use 5.010; $SIG{INT} = \&interrupt; #trap Ctrl-C my ($function, $sourcedir, $targetdir) = @ARGV; die ": missing operand. Usage: $0 <OPTION>... <SOURCE_DIRECTORY>... [T +ARGET_DIRECTORY]... OPTION all the FILE(s) and DIRECTORIES: -c = copy or -co = copy with overwrite -m = move or -mo = move with overwrite -d = delete \n" unless (defined $function && defined $sourcedir); #@ARGV; #check validity input opendir(my $source_handle, $sourcedir) or die "Can't opendir $sourcedi +r: $!\n"; if (!defined($targetdir)) {$targetdir = '.'}; my $overwrite = 0 + (length $function>2) && $function =~ m/..o/ ; #strip last character (dont need the 'o' now) $overwrite>0 && chop($function); #print STDERR "$overwrite $function\n"; #$File::Copy::Recursive::CPRFComp = 1; $File::Copy::Recursive::SkipFlop = 1; #use below later for logfile #$File::Copy::Recursive::RMTrgDir = $overwrite; #$File::Copy::Recursive::RMTrgFil = $overwrite; #Hook information subroutine use Hook::WrapSub qw(wrap_subs); use IO::Handle; use Time::HiRes qw(gettimeofday); my $t0 = gettimeofday( ); my $FDcount = 0; my $lastitem = ""; my $num_of_files_and_dirs = 0; use File::Spec::Functions; sub after_dircopy { #if ($lastitem eq $!) {print STDERR "\n$lastitem"; return;} #$lastitem = $!; my $t1 = gettimeofday( ); my $elapsed = $t1 - $t0; printf("\rFile: Elapsed time since start: H%02d:M%02d:S%02d Approx num +ber of files and directories processed: %02d Ctrl-C breaks", ($t1 - $t0) / (60*60), ($t1 - $t0) / ( 60) % 60, ($t1 - $t0) % 60, ++$FDcount); STDOUT->flush; } wrap_subs sub {}, 'File::Copy::Recursive::fcopy','File::Copy::Recursiv +e::pathrm','File::Copy::Recursive::pathempty',\&after_dircopy; #if user enters './' we replicate source directory, otherwise if '.' d +estination current, otherwise if '' destination still current '.' if ($targetdir =~ /^[.\/]{2}$/) {$targetdir = './'.basename($sourcedir +);} #if ($function ne "-d") #{ #print"\n$overwrite $function, $sourcedir, $targetdir \nConfirm you wi +sh to proceed y/n?"; #chomp(my $input = <STDIN>); #if ($input !~ /^[Y]?$/i) {exit();} #} if ($function eq "-d") #DELETE EVERYTHING { print "This script is DANGEROUS - Are you sure you want to delete EVER +YTHING in directory ",$sourcedir," (y/n): "; #,@ARGV," (y/n): "; chomp(my $input = <STDIN>); if ($input !~ /^[Y]?$/i) {exit();} File::Copy::Recursive::pathrm("$sourcedir/","1") or print"\nProcess co +mpleted\n"; exit; } elsif ($function eq "-m") #MOVE ROUTINE { exit; length $targetdir>0 or die "No target directory given $targetdir/: $!\ +n"; make_path("$targetdir/") or die "Cannot create $targetdir/: $!\n"; $num_of_files_and_dirs = dirmove("$sourcedir/", "$targetdir/") or die "Cannot move $sourcedir/: $!\n"; print"\nFiles & Dirs removed: $num_of_files_and_dirs\n"; exit; } else #COPY ROUTINE { length $targetdir>0 or die "No target directory given $targetdir/: $!\ +n"; $num_of_files_and_dirs = dircopy("$sourcedir/", "$targetdir/") or die +"\nCannot copy $!"; print "\nFiles & Dirs copied: $num_of_files_and_dirs\n"; exit; } sub interrupt {die "\nProcess interrupted with by Ctrl-C\n Number of F +iles: $num_of_files_and_dirs/ processed\n"; exit(0);} #ENDS
  • Comment on Re^2: File::Copy::Recursive - current file/directory being processed
  • Download Code

Replies are listed 'Best First'.
Re^3: File::Copy::Recursive - current file/directory being processed
by jcb (Parson) on Jan 02, 2020 at 00:25 UTC
    Certainly the tests I am having are showing some really good speed advantages in Linux anyways.

    Speed advantages compared to what? While implementing these commands in Perl can be a good exercise, I would be very surprised if a Perl program is faster than the system rm, mv, and cp commands, all of which are implemented in C on GNU systems — and most distributions of Linux use the GNU coreutils package. All of those commands accept the -v option to list the files on which they act and that can be easily translated to "running dots" with Awk: (untested)

    cp -v $FROM $TO | awk '{print "."}'

    I am not entirely convinced that Perl is the right tool for this job, unless, again, you are doing this as a programming exercise.

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others examining the Monastery: (2)
As of 2024-04-26 04:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found