Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Re^3: Super simple progress

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


in reply to Re^2: Super simple progress
in thread Super simple progress

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

Replies are listed 'Best First'.
Re^4: Super simple progress
by bigal_george (Acolyte) on Dec 30, 2019 at 17:49 UTC
    Excellent thanks. I was just wondering is there any particular reason for using print '.'; STDOUT->flush; rather than print STDERR "."; ???

      STDERR would be fine. And local $| = 1 would be fine in place of $handle->flush (where $handle is STDOUT or STDERR).

      One thing to keep in mind is if anyone is capturing output through redirection or piping. Things that are normal behavior, then, should go to STDOUT and things that need to be "out of band" go to STDERR. I don't know if the dots belong in-band or out-of-band from standard output. I could see a case being made for either behavior. I just picked one and went with it.


      Dave

Re^4: Super simple progress
by bigal_george (Acolyte) on Dec 30, 2019 at 20:09 UTC
    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;
Re^4: Super simple progress
by bigal_george (Acolyte) on Dec 30, 2019 at 22:04 UTC
    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;

      You totally changed modules without taking time to understand how the solution I provided works. File::Copy::Recursive isn't even involved in your new solution, so wrapping it is useless. And File::Find already provides a wanted function that you can hook into; you don't need wrap_subs at all.

      A File::Find solution is just a matter of putting print statements in the wanted function that fire off IF the path meets your wanted criteria. I don't have time right now to help you rewrite it, but to that point, please don't rely on me individually to answer your questions; we have a community here. Also keep in mind most of us are here to teach people how to program, not to provide a crutch for avoiding learning to program.


      Dave

Log In?
Username:
Password:

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

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



    Results (21 votes). Check out past polls.

    Notices?