Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Re: Super simple progress

by davido (Cardinal)
on Dec 30, 2019 at 16:45 UTC ( #11110771=note: print w/replies, xml ) Need Help??


in reply to Super simple progress

Out of curiosity, how will you know the file count ahead of time so that you can present a meaningful progress bar?


Dave

Replies are listed 'Best First'.
Re^2: Super simple progress
by bigal_george (Acolyte) on Dec 30, 2019 at 16:49 UTC
    Hi there. Its not important; and just another distraction waiting for the system to work out initial state. Thats why I simply printed a contiguous series of dots - the user knows each dot is file progress (also I add a directory print each time one of those is deleted).

      Fair enough, so you need a sort of "I'm still doing something" row of dots that emerges as work progresses.

      It's a little unfortunate how File::Copy::Recursive implements recursion in dircopy. I mean it works great, but it's hard to hook into. However, the dircopy subroutine calls fcopy which is easier to wrap. So this seems to work as I had hoped:

      #!/usr/bin/env perl use strict; use warnings; use File::Copy::Recursive qw(dircopy); use Hook::WrapSub qw(wrap_subs); use IO::Handle; sub after_dircopy { print '.'; STDOUT->flush; } wrap_subs sub {}, 'File::Copy::Recursive::fcopy', \&after_dircopy; dircopy('/tmp/test1', '/tmp/test2'); print "\n";

      I'm wrapping the fcopy function, which dircopy calls by adding a sub that fires off after each fcopy call. The wrapper prints a dot and flushes STDOUT.

      One warning: This depends on an implementation detail of dircopy. There are no guarantees the module's author couldn't change how dircopy works, rendering this broken.


      Dave

        Excellent thanks. I was just wondering is there any particular reason for using print '.'; STDOUT->flush; rather than print STDERR "."; ???
        Hi Dave. That routine was great. Took the guts from it and ended up with below. Im having a wee problem getting my head around printf( as in it would be good to be able to have each information on a new line, but using formatters \r overwrites a line and \n because its re-entrant just scrolls each time it enters. So Ive ended up with a single line:
        #Hook information subroutine use Hook::WrapSub qw(wrap_subs); use IO::Handle; use Time::HiRes qw(gettimeofday); my $t0 = gettimeofday( ); my $FDcount = 0; sub after_dircopy { my $t1 = gettimeofday( ); my $elapsed = $t1 - $t0; printf("\rElapsed time since start: H%02d:M%02d:S%02d Number 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',\&after_dircopy;
        Dave I wonder if you could help a bit more; I wanted to make the callback for a delete routine. Mine wont active the callback when I try this:
        wrap_subs sub {}, 'File::Copy::Recursive::fcopy', 'File::Find::find',\ +&after_dircopy; find { bydepth => 1, no_chdir => 1, wanted => sub { if (!-l && -d _) { #rmdir && print STDERR "\nDeleted: $_\n" or warn "couldn't rmdir direc +tory $_: $!"; rmdir or warn "couldn't rmdir directory $_: $!"; ($_ ne $sourcedir && $_ ne ".") or die "Process completed"; } else { #print STDERR "."; unlink or warn "couldn't unlink file $_: $!"; } } } => $sourcedir;

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (4)
As of 2020-06-07 10:22 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you really want to know if there is extraterrestrial life?



    Results (42 votes). Check out past polls.

    Notices?