Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
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

In reply to Re^2: File::Copy::Recursive - current file/directory being processed by bigal_george
in thread File::Copy::Recursive - current file/directory being processed by bigal_george

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



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others avoiding work at the Monastery: (4)
As of 2024-04-20 01:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found