guacamayo has asked for the wisdom of the Perl Monks concerning the following question:

Hello @all!

How can I optimize this?

The script should read .tiff's, write a text at the top and write again to STDOUT.

until ImageToBlob () takes 0.10 ms,with ImageToBlob it takes up to 3 sec.

Thanks in advance!

#!/usr/bin/perl use strict; use warnings; use Image::Magick; use Data::Dumper; use POSIX; my $def = shift || '/var/www/html/error.tif'; my $uri = $ENV{'PATH_TRANSLATED'} || $def; my $debug = 1; my $img = Image::Magick->new(); $img->Read( "tif:" . ( -e $uri ? $uri : $def ) ); my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mti +me, $ctime, $blksize, $blocks ) = stat($uri); my $scan_date; my $date_create = POSIX::strftime( '%d-%m-%Y %H:%M:%S', localtime $cti +me ); if ( $date_create =~ m/(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2}) +.*/ ) { $date_create = $3 . "." . $2 . "." . $1 . " " . $4 . ":" . $5 . ": +" . $6; } $scan_date = $date_create; $img->Annotate( y => 10, text => "Scanned: " . $scan_date, font => "ArialBkI", pointsize => 36, fill => 'white', gravity => 'north', undercolor => 'black', ); my $out = $img->ImageToBlob(); print "Content-type: image/tiff\n\n" . $out if ( $debug < 1 );

Replies are listed 'Best First'.
Re: Optimize runtime with Image::Magick;
by tangent (Parson) on Mar 07, 2019 at 00:32 UTC
    There is an alternative way to write directly to STDOUT:
    print "Content-type: image/tiff\n\n"; binmode STDOUT; $img->Write('tif:-');
    I thought this might have saved some time but when I tested it on a 75Mb tif image it took 3 seconds using both this method and ImageToBlob(). I guess that's just how long it takes to write the image.
Re: Optimize runtime with Image::Magick;
by vr (Curate) on Mar 07, 2019 at 10:40 UTC

    Perhaps particularly slow TIFF compression method is to blame, e.g. deflate, or, for bilevel images, CCITT Group 4? Do you need compression at all, for your blobs? Here for 10 Mpx RGB image (but veeery slow machine):

    use strict; use warnings; use Time::HiRes 'time'; my $fn = 'test.tif'; { print "\tTesting Magick:\n"; use Image::Magick; my $img = Image::Magick-> new; $img-> Read( $fn ); for ( qw/ None LZW Zip /) { my $t = time; $img-> Set( compression => $_ ); my $blob = $img-> ImageToBlob; printf "Compression: %s \t Size: %d \t Time: %.2f\n", $_, leng +th $blob, time - $t; } } { print "\tTesting Imager:\n"; use Imager; my $img = Imager-> new( file => $fn ); for ( qw/ none lzw zip /) { my $t = time; my $blob; $img-> write( data => \$blob, type => 'tiff', tiff_compression + => $_ ); printf "Compression: %s \t Size: %d \t Time: %.2f\n", $_, leng +th $blob, time - $t; } } __END__ Testing Magick: Compression: None Size: 30063788 Time: 0.20 Compression: LZW Size: 16156294 Time: 1.11 Compression: Zip Size: 13868590 Time: 11.86 Testing Imager: Compression: none Size: 30000294 Time: 0.32 Compression: lzw Size: 26470736 Time: 1.30 Compression: zip Size: 17199450 Time: 3.98

    LZW was designed for speed. Deflate was designed to replace LZW :). ImageMagick is not speed oriented, in general. My attempt was to demonstrate this with Imager, but, sadly, as I see now it writes whole TIFF as single strip, and it's not configurable. That's why its LZW is not only so much larger (for this image), but slower, too.

    Update. If, for any reason, you won't use LZW (older libtiff?), for Zip there's under-documented "quality" setting (rather, zlib compression level), which lowest value of 10 gives quite a boost to speed:

    my $t = time; $img-> Set( compression => 'Zip' ); # default compression level printf "Size: %d \t Time: %.2f\n", length $img-> ImageToBlob, time - $ +t; $t = time; $img-> Set( compression => 'Zip', quality => 10 ); printf "Size: %d \t Time: %.2f\n", length $img-> ImageToBlob, time - $ +t; __END__ Size: 13868590 Time: 11.41 Size: 15694516 Time: 1.92