|
cristofayre has asked for the wisdom of the Perl Monks concerning the following question:
I am using Imager on a Windows test computer. It is processing about 60 files. I realise image processing is CPU intensive ... but the browser times out before the process has run - about 60 seconds. For PERL, that seems incredibly slow, so I must be doing something wrong
The files are approx 3508px x 2480px -jpg. I am reducing down to 750 wide, and another 150px tall. The third is being rotated 90 degrees anti-clockwise. (I found out it cannot handle type=>jpg,so changed that to "type='jpeg'" wcev though the extension is '.jpg')
I placed the new image outside of the loop thinking that once created, it would use the same variable. Here then is the code:
$dir=$baseURL.$type."/"; # Reads the photos in master folder. Calle
+d 3 times via external loop
opendir my $dh, $dir or die "Could not open '$dir' for reading '$!'\n"
+;
@pics = grep(/\.jpg$/,readdir $dh);
closedir $dh;
shift @pics; ## Removes the dot files
shift @pics;
$tot=@pics;
$img=Imager->new(); # create empty image
for (my $p=0; $p<@pics; $p++){
$img->read(file=>$baseURL.$type.'/'.$pics[$p],type=>'jpeg') or di
+e $img->errstr();
my $med = $img->copy();
my $thumb = $img->copy();
$med = $img->scale(xpixels=>750);# sets width to 750px
$med->write(file=>$baseURL.$type.'/medium/'.$pics[$p]) or die $ima
+ge->errstr; # Write out image
$thumb = $img->scale(ypixels=>150);# sets the height to 150px
$thumb->write(file=>$baseURL.$type.'/thumbs/'.$pics[$p]) or die $i
+mage->errstr; # Write out image
my $rot90 = $img->rotate(degrees=>-90);
$rot90->write(file=>$baseURL.$type.'/upright/'.$pics[$p]) or die $
+image->errstr; # Write out image
my @pic=split(/\./,$pics[$p]); # splits filename at dot [filename]
+[jpg]
$newDat.=$pic[0].'|'; # Used in a latter part of program
}
Just tries a little experiment. Two files of 10630 x 2480 took 10 seconds to process. Add 16 images of 5315px x 2480px, and browser times out after 70 secs before files are processed. (If I cut out the image processing, it can read the files, split filenames and create textfiles in about 0.5sec)
I don't really want to resort to ImageMagic as I cannot get the perlMagic interface to install on Windows offline test machine. And GD produces some poor results, messing with the colours.
Is it perhaps running out of memory, and I somehow need to clear it out before processing each image. The docs don;t eplain that as it seems to mainly work on one image at a time
Oh, and as I'm writing this Dec 23rd, "MERRY CHRISTMAS, ONE AND ALL !!"
|
Re: Imager: Gateway Timeout
by marioroy (Prior) on Dec 25, 2019 at 09:43 UTC
|
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
| [reply]
[d/l]
[select] |
Re: Imager: Gateway Timeout
by bliako (Monsignor) on Dec 23, 2019 at 23:41 UTC
|
First get your operations right. Then try to optimise. You create $med as a copy and then you overwrite that copy with $img->scale. How about this style: $img->copy()->scale(xpixels=>750)->write(file=>...); I will assume that this will free all memory once done writing to disk. If you intend to parallelise (and your server is able to) then you could create one sub to do all the processing for just one file. Then either call this sub sequentially or in parallel.
| [reply]
[d/l]
[select] |
|
|
Thanks for the feedback. I admit, I don't know what i'm doing with program; trial and error trying to snip a bit here and there from the documentation. I made a copy so as not to touch original, and then to scale that copy. But I'll try your suggestion, and see what happens
| [reply] |
|
|
@dir(Standard, large, xl
for loop of @dir
process_img();
}
sub process_img
Create thumbnail and save in appropriate sub folder;
Create medium size and save in appropriate sub folder;
Rotate image 90 and save in appropriate sub folder;
}
So as well as original, I end up with graphics in thumb, medium and upright folders within each of the three folders above
| [reply]
[d/l] |
|
|
| [reply] |
Re: Imager: Gateway Timeout (updated (GD))
by vr (Curate) on Dec 24, 2019 at 09:13 UTC
|
use strict;
use warnings;
use Time::HiRes 'time';
use Imager;
my $t = time;
my $i = Imager-> new( file => 'file.jpg' );
printf "image dimensions: %d x %d\n",
$i-> getwidth, $i-> getheight;
printf "reading: %.2f s\n", time - $t;
$t = time; $i-> copy
-> scale( xpixels => 750, qtype => 'normal' )
-> write( file => 'file+.jpg' );
printf "high quality resize & save: %.2f s\n", time - $t;
$t = time; $i-> copy
-> scale( xpixels => 750, qtype => 'mixing' )
-> write( file => 'file+.jpg' );
printf "medium quality resize & save: %.2f s\n", time - $t;
$t = time; $i-> copy
-> scale( xpixels => 750 * 4, qtype => 'mixing' )
-> scale( xpixels => 750, qtype => 'normal' )
-> write( file => 'file+.jpg' );
printf "medium+ quality resize & save: %.2f s\n", time - $t;
$t = time; $i-> copy
-> scale( xpixels => 750, qtype => 'preview' )
-> write( file => 'file+.jpg' );
printf "low quality resize & save:\t\t %.2f s\n", time - $t;
$t = time; $i-> copy
-> rotate( right => -90 )
-> write( file => 'file+.jpg' );
printf "fast rotate & save: %.2f s\n", time - $t;
$t = time; $i-> copy
-> rotate( degrees => -90 )
-> write( file => 'file+.jpg' );
printf "slow rotate & save: %.2f s\n", time - $t;
__END__
image dimensions: 6083 x 4636
reading: 1.23 s
high quality resize & save: 6.52 s
medium quality resize & save: 1.17 s
medium+ quality resize & save: 3.84 s
low quality resize & save: 0.58 s
fast rotate & save: 3.41 s
slow rotate & save: 19.33 s
Some options were introduced for a reason... + Use medium size image as source for thumb (not shown above).
Updated: GD is so much faster, what do you mean "messed with colors"? Should work fine for geometric transformations.
use strict;
use warnings;
use Time::HiRes 'time';
use GD;
my $t = time;
my $i = GD::Image-> newFromJpeg( 'file.jpg', 1 );
printf "image dimensions: %d x %d\n", $i-> getBounds;
printf "reading: %.2f s\n", time - $t;
for ( 1 .. 20, 22, 23 ) {
$t = time;
$i-> interpolationMethod( $_ );
$i-> copyScaleInterpolated( 750, 572 )
-> _file( 'file+.jpg' );
printf "resize method \"$_\" & save: %.2f s\n", time - $t;
}
$t = time;
$i-> copyRotateInterpolated( 90, 0 )-> _file( 'file+.jpg' );
printf "rotate & save: %.2f s\n", time - $t;
__END__
image dimensions: 6083 x 4636
reading: 1.47 s
resize method "1" & save: 0.59 s
resize method "2" & save: 0.62 s
resize method "3" & save: 0.07 s
resize method "4" & save: 0.25 s
resize method "5" & save: 0.24 s
resize method "6" & save: 0.55 s
resize method "7" & save: 0.53 s
resize method "8" & save: 0.55 s
resize method "9" & save: 0.55 s
resize method "10" & save: 0.55 s
resize method "11" & save: 0.53 s
resize method "12" & save: 0.55 s
resize method "13" & save: 0.55 s
resize method "14" & save: 0.55 s
resize method "15" & save: 0.53 s
resize method "16" & save: 0.04 s
resize method "17" & save: 0.54 s
resize method "18" & save: 0.58 s
resize method "19" & save: 0.62 s
resize method "20" & save: 0.59 s
resize method "22" & save: 0.09 s
resize method "23" & save: 0.12 s
rotate & save: 3.03 s
Interpolation constants here. 21st died on me.
| [reply]
[d/l]
[select] |
|
|
I get it! re: fast rotate vs slow rotate. It's the 90 (right angle, N*PI/2) degrees. so the fast one is just transposing the image pixels where the slow one does all sorts of averaging and interpolations. (Ref: rotations primer from leptonica library ). Imager could either warn user for using the slow rotate for right angles or just ignore user's wishes and do it the fast way. thanks, very enlightening.
| [reply] |
|
|
Gosh. Thanks for this imput. The first one makes a lot of ssense now; Once an image is created with the first $i -> copy, then future commands are simply instructions to the right of arrow, (I know it's not an arrow and has a special name!)as in "You've done this, now do this, and this ..."
Somewhere on the web, I read that GD mutes the colours, and are thus not as vibrant. It might have been in reference to paletted GIF images, I'm not sure
If those timings are correct,6secs, then it IS incredbly slow. It's gonna take 6 mins to process 59 images! If it takes the same sort of time on Linux server, my host (shared) may not be happy with me monopolising the CPU for that length of time! (OK, so this is a one off with this qty, and 'updates' will be in the 10 - 20 images range... but still seems slow
I also heed the logic of creating the thumb from the medium size rather than starting from scratch on the full size image again. Makes more sense
In that respect, GD seems to make more sense in terms of speed, so will give that a try. The 'quality' of medium and thumb are not too important (image preview and shop cart respectively) but people will be using the upright to print from. (I used API2::PDF to place the images in a "grid" so they can simply send the PDF to a commercial printer)
| [reply] |
|
|
Alas, seems Mssr Boutell's site is no more. Did find a zip for it on "PHP.net" ... which contains a series of folders, and no idea what goes where! (I have "C:/php") It also seems that you need to run dmake or sudo (?) to install (and call which file?)... and then you need to load a perl interface to it ... and source and install files to process jpeg files
So looks like I'm back to Imager!
| [reply] |
|
|
Make life easy on yourself, if using Windows just download Strawberry perl, it has all sorts of useful, commonly used things installed be default.
| [reply] |
Re: Imager: Gateway Timeout
by cristofayre (Sexton) on Dec 24, 2019 at 18:21 UTC
|
Finally managed to get things to work. It was via a "keep alive" command that sends data back to the browser every now and then to say "I'm still here ..." I don't profess to know HOW it works ... but it does
I also used an option called "qtype" which allows 'normal' - the default for high quality, or 'preview' for lower quality (but =I= can't see the difference. Apparentely, the former is done via a 'filter' whilst the latter is via a pixel 'near neighbour' (???)
Now just got to master how to place a full size watermark over the medium images. Something for Christmas morn !
$| = 1; # set autoflush
sub processPics(){
$newDat='';
# read image dir to set @pics array
for (my $p=0; $p<@pics; $p++){
print "$pics[$p]<br>";
$img->read(file=>$baseURL.$type.'/'.$pics[$p],type=>'jpeg') or di
+e $img->errstr();
$img->copy()->scale(xpixels=>750, qtype=>'preview')->write(file=>$
+baseURL.$type.'/medium/'.$pics[$p]) or die $image->errstr; # Write ou
+t an image as medium
$img->scale(ypixels=>150, qtype=>'preview')->write(file=>$baseURL.
+$type.'/thumbs/'.$pics[$p]) or die $image->errstr; # Resizes the medi
+um before write out as thumbs
my $rot90 = $img->rotate(degrees=>-90);
$rot90->write(file=>$baseURL.$type.'/upright/'.$pics[$p]) or die $
+image->errstr; # Write out an image as medium
my @pic=split(/\./,$pics[$p]);
$newDat.=$pic[0].'|'; The dat data is stored as one continuous
+string separated with pipe (ie "amazing|beaver|biggus")
}
unless ($_ % 10){ print "<br>" }
}
The magic is via 'autoflush' and the 'unless' entry. (As I say, no idea what "$_ % 10" does ... but it prints data to browser screen every few seconds or so) | [reply]
[d/l] |
|
|
I thought using "degrees" with Imager::rotate was demonstrated to be too slow. I should have said, perhaps, that timings for my previous answer were taken at very old machine, but principle remains the same. Addressing (partially) some of your remarks, (1) I suspect prejudice against GD w.r.t. colour is because "$truecolor" boolean argument was not supplied to its newFromXXX methods; (2) it requires either special test images (example), or, with usual day-to-day photos, quite some training to see re-sampling artefacts, but, for the love of god, please don't use nearest-neighbour interpolation for anything but thumbnail size previews; (3) GD is listed as available for ActiveState PPM and is pre-installed with Strawberry Perl; (4) source image must be physically rotated before being sent to printer? is that so?
It's good you're moving forward with solving the problem, and you can skip what follows -- sorry to hijack this thread for a little demo, moreover not sure if it's exactly 100% Perl. Assuming the task "open jpg/scale1/scale2/rotate original file/save all" exists, downsampling with reasonable quality appears to be quite fast, and slowest part is rotation. I looked here and there, and it seems, for rotation, GD is faster than Imager, and PDL::IO::Image is faster yet. I'd say the latter is wrapper for (some of) FreeImage functions, with abilities to export image data to piddles, and "PDL" in its name doesn't mean that anything PDL-related is required to be used at all.
Looking into FreeImage, it reminded me of lossless JPG transformations, right-angle rotation among them, which is (a) good because it preserves quality, (b) fast because it doesn't require total (de/en)coding. Not implemented in PDL::IO::Image, can't find anything similar on CPAN. Closest would be shelling out and using CL tools.
However, I felt it's good opportunity to also test/demo a kind of parallelization not very frequent with Perl, i.e. OMP. Test subject is 4009*3521 image, let's pretend 8 such files are to be rotated, using reasonably recent i5 with 4 cores, hence "4" threads below. Changing it to "1" results in ~3.5 seconds for FreeImage, still quite faster than GD because of (b). I copied filenames in Perl array to C array so that no Perl functions/macros are used in fragment to be run in parallel, because they are not re-entrant(?). I used pre-compiled FreeImage dll with Strawberry Perl, should be possible to install OS package under Linux.
use strict;
use warnings;
use Time::HiRes 'time';
use GD;
use File::Copy 'copy';
use constant ORIG => 'potw1949a';
my @list; # list of filenames w/o extension
for ( 1 .. 8 ) { # 8 copies
my $s = ORIG . $_;
push @list, $s;
copy ORIG . '.jpg', "$s.jpg" or die;
}
############### GD
my $t = time;
for ( @list ) {
GD::Image-> newFromJpeg( "$_.jpg", 1 )
-> copyRotateInterpolated( 90, 0 )
-> _file( "$_+.jpg" );
}
printf "GD, sequential, %.2f s\n", time - $t;
############### FreeImage
$t = time;
parallel( \@list );
printf "FreeImage, parallel, %.2f s\n", time - $t;
unlink glob ORIG . '?.jpg';
unlink glob ORIG . '?+.jpg';
use Inline C => config => ccflagsex => '-fopenmp',
LIBS => '-lgomp -lFreeImage';
use Inline C => <<'END_OF_C';
#include <FreeImage.h>
#include <omp.h>
void parallel(SV *array) {
int i, nfiles, len;
char *fname, *tmp;
char **fnames;
nfiles = av_len((AV *)SvRV(array));
fnames = malloc((nfiles + 1) * sizeof(char*));
for (i = 0; i <= nfiles; i++) {
tmp = SvPV(*av_fetch((AV *)SvRV(array), i, 0), len);
fname = malloc(len + 1);
memcpy(fname, tmp, len + 1);
fnames[i] = fname;
}
#pragma omp parallel num_threads (4)
{
#pragma omp for
for (i = 0; i <= nfiles; i++) {
char *src, *dst;
asprintf(&src, "%s%s", fnames[i], ".jpg" );
asprintf(&dst, "%s%s", fnames[i], "+.jpg" );
FreeImage_JPEGTransform(src, dst, FIJPEG_OP_ROTATE_90, 0);
}
}
for (i = 0; i <= nfiles; i++) free(fnames[i]);
free(fnames);
}
END_OF_C
__END__
GD, sequential, 7.00 s
FreeImage, parallel, 1.14 s
Edit: Fixed off-by-one error with array length in C code, + couple most obvious "bugs" with my English. Ubuntu (Debian) FreeImage package has "FreeImage_JPEGTransform" family of functions disabled, had to compile from source. Interesting, under Linux GD performs twice as fast and so is slightly ahead of single-threaded FreeImage.
| [reply]
[d/l] |
Re: Imager: Gateway Timeout
by Anonymous Monk on Dec 23, 2019 at 21:51 UTC
|
If you can't speed it up this looks like a perfect use of Image::ParseGIF to provide real-time progress indication to prevent the timeout. OTOH someone we all know and love may know how to get this running on all cores for a massive speedup :-)
🎄
| [reply] |
|
|
| [reply]
[d/l] |
|
|
Alas, the module you mention is for GIF's. I'm working on JPG. But thanks anyway
| [reply] |
|
|
Alas, the module you mention is for GIF's. I'm working on JPG.
Image::ParseGIF would be used to present the progress bar, which is a "deanimated" GIF, not for parsing your original image. Click the given link, then click "browse", then click "examples" for a free progress bar GIF and some example scripts. It would go something like this:
for (my $p=0; $p<@pics; $p++){
$img=Imager->new(); # create empty image
my $gif = Image::ParseGIF->("progress.gif")
or die "failed to parse: $@\n";
$gif->print_header;
$gif->print_percent(0.00);
$img->read(file=>$baseURL.$type.'/'.$pics[$p],type=>'jpeg')
or die $img->errstr();
my $med = $img->copy();
my $thumb = $img->copy();
$med = $img->scale(xpixels=>750);# sets width to 750px
$med->write(file=>$baseURL.$type.'/medium/'.$pics[$p])
or die $image->errstr; # Write out image
$gif->print_percent(0.10); # 10% complete
$thumb = $img->scale(ypixels=>150);# sets the height to 150px
$thumb->write(file=>$baseURL.$type.'/thumbs/'.$pics[$p])
or die $image->errstr; # Write out image
$gif->print_percent(0.25); # 25% complete
my $rot90 = $img->rotate(degrees=>-90);
$rot90->write(file=>$baseURL.$type.'/upright/'.$pics[$p])
or die $image->errstr; # Write out image
$gif->print_percent(0.70); # 70% complete
my @pic=split(/\./,$pics[$p]); # splits filename at dot [filename][j
+pg]
$newDat.=$pic[0].'|'; # Used in a latter part of program
$gif->print_percent(1.00); # done!
$gif->print_trailer;
}
https://metacpan.org/source/BENL/Image-ParseGIF-0.2/examples
https://fastapi.metacpan.org/source/BENL/Image-ParseGIF-0.2/examples/progressbar.gif | [reply]
[d/l] |
|
|
|
|
