PerlMagick -- needing to write/read file after every change
Posted: 2012-09-21T14:04:29-07:00
Hi all,
While working with a PerlMagick image, I find myself needing to write the entire file to disk & then re-read it in order to "commit" incremental changes. Please would you review what I'm doing and advise...
My thumbnail approach starts by converting the source image to sRGB:
Then I write & re-read this intermediate sRGB image:
Then, using that intermediate sRGB image, I create all thumbnails:
Shouldn't I be able to eliminate that middle step? When I do, however, the resulting thumbnails are different:
1000px with intermediate rewrite, 263,506 bytes:
http://87.252.62.61/im1/1000x1000.1.jpg
1000px without, 262,934 bytes:
http://87.252.62.61/im1/1000x1000.0.jpg
My photographer customers prefer the thumbs with the intermediate rewrite. There *is* a difference at the byte level (I'm personally not good at comparing almost-identical thumbs so I try to just do whatever my customers prefer).
Is there some PerlMagick function like $im->CommitChangesSoFar() which would let me achieve my middle step without disk activity? Currently the rewrite take 37% of my overall time (1.804 sec total with the rewrite, 1.131 sec without). Or could some IM expert assure me that both sets of thumbs, while binary different, are essentially the same?
Thanks,
James
I'm using ImageMagick 6.7.9-2 2012-08-25 Q16 on Win2003. My images & scripts are at http://87.252.62.61/im1/all.zip. Here is my exact Perl code:
While working with a PerlMagick image, I find myself needing to write the entire file to disk & then re-read it in order to "commit" incremental changes. Please would you review what I'm doing and advise...
My thumbnail approach starts by converting the source image to sRGB:
Code: Select all
$im->Read( 'test.jpg' );
$im->Set( 'colorspace' => 'sRGB' );
$im->Profile( 'sRGB_IEC61966-2-1_black_scaled.icc' );
Code: Select all
$im->Write( 'intermediate.jpg' );
$im = undef();
$im = Image::Magick->new;
$im->Read( 'intermediate.jpg' );
Code: Select all
$im->Thumbnail( '500x500' );
$im->Write( 'thumb.jpg' );
1000px with intermediate rewrite, 263,506 bytes:
http://87.252.62.61/im1/1000x1000.1.jpg
1000px without, 262,934 bytes:
http://87.252.62.61/im1/1000x1000.0.jpg
My photographer customers prefer the thumbs with the intermediate rewrite. There *is* a difference at the byte level (I'm personally not good at comparing almost-identical thumbs so I try to just do whatever my customers prefer).
Is there some PerlMagick function like $im->CommitChangesSoFar() which would let me achieve my middle step without disk activity? Currently the rewrite take 37% of my overall time (1.804 sec total with the rewrite, 1.131 sec without). Or could some IM expert assure me that both sets of thumbs, while binary different, are essentially the same?
Thanks,
James
I'm using ImageMagick 6.7.9-2 2012-08-25 Q16 on Win2003. My images & scripts are at http://87.252.62.61/im1/all.zip. Here is my exact Perl code:
Code: Select all
#!/usr/bin/perl
use strict;
use Image::Magick;
use Time::HiRes;
my $t;
my $s = [Time::HiRes::gettimeofday()];
my $b_commit_to_disk_midway = 1;
my $temp_file = 'temp.jpg';
my $MAX = 10;
for (1..$MAX) {
$t = [Time::HiRes::gettimeofday()];
my $im = Image::Magick->new;
&report( "start test $_" );
$im->Read( 'test.jpg' );
&report( 'initial read' );
$im->Set( 'colorspace' => 'sRGB' );
&report( 'set sRGB' );
$im->Profile( 'sRGB_IEC61966-2-1_black_scaled.icc' );
&report( 'set ICC' );
if ($b_commit_to_disk_midway) {
unlink( $temp_file );
$im->Write( $temp_file );
&report( 'wrote temp' );
$im = undef();
$im = Image::Magick->new;
$im->Read( $temp_file );
&report( 'read temp' );
}
foreach my $px (1000, 500, 100) {
my $size = $px . 'x' . $px;
my $file = "$size.$b_commit_to_disk_midway.jpg";
my $clone = $im->Clone();
$clone->Thumbnail( $size );
&report( "created thumb $size" );
unlink( $file );
$clone->Write( $file );
my $bytes = -s $file || -1;
&report( "wrote thumb $size bytes $bytes" );
}
&report( "done with $_\n" );
}
printf( "Overall %.3f seconds per job\n", Time::HiRes::tv_interval( $s ) / $MAX );
sub report {
printf( "%.3f ms $_[0]\n", Time::HiRes::tv_interval( $t ) );
}