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

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

Hi cristofayre and Merry Christmas,

Thank you for posting on PerlMonks. I have uncovered a bug on Windows with MCE::Channel. Fixed in MCE 1.865.

The first thing I do is enable strict and warnings. Then tested all die statements and updated to use the correct variable name (i.e. die $med->errstr). Finally, tested on macOS and Windows. The latter using Strawberry Perl.

Non-Parallel

use strict; use warnings; use Imager; processPics("./images"); sub processPics { my $dir = shift; my $newDat = ''; # build list of jpg files to process opendir my $dh, $dir or die "Could not open '$dir' for reading '$! +'\n"; my @pics = grep(/\.jpg$/, readdir $dh); closedir $dh; # check for subdirs and make if missing mkdir "${dir}/medium" unless (-d "${dir}/medium"); mkdir "${dir}/thumbs" unless (-d "${dir}/thumbs"); mkdir "${dir}/upright" unless (-d "${dir}/upright"); # process image dir for my $p (@pics) { my $img = Imager->new(file=>"${dir}/${p}", type=>'jpeg') or die Imager->errstr(); my $med = $img->copy(); my $thumb = $img->copy(); my $rot90; # sets width to 750px, write out image $med = $img->scale(xpixels=>750); $med->write(file=>"${dir}/medium/${p}") or die $med->errstr; # sets the height to 150px, write out image $thumb = $img->scale(ypixels=>150); $thumb->write(file=>"${dir}/thumbs/${p}") or die $thumb->errst +r; # rotate image, write out image $rot90 = $img->rotate(degrees=>-90); $rot90->write(file=>"${dir}/upright/${p}") or die $rot90->errs +tr; # append filename without the extension $newDat .= (split(/\./, $p))[0] . '|'; } # display $newDat after removing trailing | chop $newDat if $newDat; print "completed: ${newDat}\n"; }

Parallel - MCE

Notice how the outer for loop above moved to the MCE user_func block. The code is quite similar. MCE handles passing data to workers.

use strict; use warnings; use Imager; use MCE; processPics("./images"); sub processPics { my $dir = './images'; my $newDat = ''; # build list of jpg files to process opendir my $dh, $dir or die "Could not open '$dir' for reading '$! +'\n"; my @pics = grep(/\.jpg$/, readdir $dh); closedir $dh; # check for subdirs and make if missing mkdir "${dir}/medium" unless (-d "${dir}/medium"); mkdir "${dir}/thumbs" unless (-d "${dir}/thumbs"); mkdir "${dir}/upright" unless (-d "${dir}/upright"); # construct MCE object my $mce = MCE->new( max_workers => MCE::Util::get_ncpu(), chunk_size => 1, gather => sub { $newDat .= $_[0]; }, # called inside pare +nt user_func => sub { my $p = $_; my $img = Imager->new(file=>"${dir}/${p}", type=>'jpeg') or die Imager->errstr(); my $med = $img->copy(); my $thumb = $img->copy(); my $rot90; # sets width to 750px, write out image $med = $img->scale(xpixels=>750); $med->write(file=>"${dir}/medium/${p}") or die $med->errst +r; # sets the height to 150px, write out image $thumb = $img->scale(ypixels=>150); $thumb->write(file=>"${dir}/thumbs/${p}") or die $thumb->e +rrstr; # rotate image, write out image $rot90 = $img->rotate(degrees=>-90); $rot90->write(file=>"${dir}/upright/${p}") or die $rot90-> +errstr; # append filename without the extension MCE->gather( (split(/\./, $p))[0] . '|' ); }, ); # process image dir in parallel $mce->process(\@pics); $mce->shutdown(); # display $newDat line after removing trailing | chop $newDat if $newDat; print "completed: ${newDat}\n"; }

Parallel - MCE::Child

Workers persist in this demonstration, awaiting work from the manager process.

use strict; use warnings; use Imager; use MCE::Child 1.865; use MCE::Channel; my $chnl = MCE::Channel->new(); # Create worker pool early in the script. MCE::Child->create('consumerTask') for 1..MCE::Util::get_ncpu(); # Simulating a persistent web-service. for (1..1) { # process image dir in parallel processPics("./images"); # do something else # ... } # Signal workers no more work and reap prior to exiting. $chnl->end(), MCE::Child->waitall(); exit(0); #================================== # Producer and Consumer Subroutines #================================== sub processPics { my $dir = shift; my $newDat = ''; # build list of jpg files to process opendir my $dh, $dir or die "Could not open '$dir' for reading '$! +'\n"; my @pics = grep(/\.jpg$/, readdir $dh); closedir $dh; # check for subdirs and make if missing mkdir "${dir}/medium" unless (-d "${dir}/medium"); mkdir "${dir}/thumbs" unless (-d "${dir}/thumbs"); mkdir "${dir}/upright" unless (-d "${dir}/upright"); # send parameters ($dir,$p) to worker pool $chnl->send($dir, $_) for (@pics); # wait and gather data from workers $newDat .= $chnl->recv2() for (1..@pics); # display $newDat after removing trailing | chop $newDat if $newDat; print "completed: ${newDat}\n"; } sub consumerTask { local $SIG{__DIE__} = sub { warn $_[0]; MCE::Signal::stop_and_exit('TERM'); }; while ( my ($dir, $p) = $chnl->recv() ) { my $img = Imager->new(file=>"${dir}/${p}", type=>'jpeg') or die Imager->errstr(); my $med = $img->copy(); my $thumb = $img->copy(); my $rot90; # sets width to 750px, write out image $med = $img->scale(xpixels=>750); $med->write(file=>"${dir}/medium/${p}") or die $med->errstr; # sets the height to 150px, write out image $thumb = $img->scale(ypixels=>150); $thumb->write(file=>"${dir}/thumbs/${p}") or die $thumb->errst +r; # rotate image, write out image $rot90 = $img->rotate(degrees=>-90); $rot90->write(file=>"${dir}/upright/${p}") or die $rot90->errs +tr; # append filename without the extension $chnl->send2( (split(/\./, $p))[0] . '|' ); } }

I am happy to report that the three examples work on Windows. Of all things, consume many CPU cores.

Regards, Mario


In reply to Re: Imager: Gateway Timeout by marioroy
in thread Imager: Gateway Timeout by cristofayre

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 musing on the Monastery: (5)
As of 2024-03-29 13:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found