ETT-1103 imgsrv must generate resolution metadata in exported TIFFs

imgsrv/lib/Process/Image.pm

@@ -10,6 +10,7 @@ use File::stat;
 use File::Copy;
 
 use Image::Utils;
+use SRV::Utils qw();
 
 use Data::Dumper;
 
@@ -492,9 +493,17 @@ sub _process_output {
                 push @args, '-color';
                 push @args, '-truecolor';
             }
+            # Deprecated option:
+            # "Warning, Creating TIFF with legacy Deflate codec identifier, COMPRESSION_ADOBE_DEFLATE is more widely supported."
+            # Should replace with -adobeflate ?
             push @args, '-flate';
         }
-
+        if ( $xres && $yres ) {
+          # Multiply by 1 in case xres and/or yres is Image::TIFF::Rational
+          push @args, '-xresolution=' . ($xres * 1);
+          push @args, '-yresolution=' . ($yres * 1);
+          push @args, '-resolutionunit=inch';
+        }
         $self->_add_step([$Process::Globals::pamtotiff, @args])
     } elsif ( $mimetype eq 'image/png' ) {
         if ( $self->_is_grayscale($self->source->{metadata}) || $self->quality =~ m,gray|bitonal, ) {

imgsrv/t/lib/Process/Image.t

@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+use File::Spec;
+use Test::More;
+
+use lib File::Spec->catdir($ENV{SDRROOT}, 'imgsrv', 't');
+use TestHelper qw(setup_context_for_volume);
+
+use Auth::Auth;
+use Access::Rights;
+use Context;
+use MdpItem;
+use Process::Image;
+
+my $C = setup_context_for_volume('test.pd_open');
+my $mdpItem = $C->get_object('MdpItem');
+
+subtest 'tiff export' => sub {
+  subtest 'full resolution' => sub {
+    my $output_file = '/tmp/t_lib_process_image_full.tif';
+    my $processor = new Process::Image;
+    $processor->mdpItem($C->get_object('MdpItem'));
+    my $seq = 1;
+    my $source_path = $mdpItem->GetFilePathMaybeExtract($seq, 'imagefile');
+    $processor->source( filename => $source_path);
+    $processor->output( filename => $output_file);
+    $processor->format('tif');
+    $processor->watermark(1);
+    #$processor->restricted(0);
+    $processor->quality('full');
+    $processor->process();
+    ok(-e $output_file, 'output TIFF file exists');
+    my $identify_output = `identify -verbose $output_file`;
+    ok($identify_output =~ /Resolution:\s+400x400/, 'image has original (400x400) resolution');
+  };
+
+  subtest '300 ppi resolution' => sub {
+    my $output_file = '/tmp/t_lib_process_image_300.tif';
+    my $processor = new Process::Image;
+    $processor->mdpItem($C->get_object('MdpItem'));
+    my $seq = 1;
+    my $source_path = $mdpItem->GetFilePathMaybeExtract($seq, 'imagefile');
+    $processor->source( filename => $source_path);
+    $processor->output( filename => $output_file);
+    $processor->format('tif');
+    $processor->watermark(1);
+    #$processor->restricted(0);
+    $processor->quality('full');
+    $processor->size('ppi:300');
+    $processor->process();
+    ok(-e $output_file, 'output TIFF file exists');
+    my $identify_output = `identify -verbose $output_file`;
+    ok($identify_output =~ /Resolution:\s+300x300/, 'image has 300x300 resolution');
+  };
+};
+
+done_testing();