From c4fcf259b4e1b67d1728700ee32b1ed05fd1a01b Mon Sep 17 00:00:00 2001
From: Brian Moses Hall <moseshll@umich.edu>
Date: Thu, 13 Nov 2025 11:33:50 -0500
Subject: [PATCH] ETT-1103 imgsrv must generate resolution metadata in exported
 TIFFs  - Update and test `Process::Image`    - Add `-xresolution`,
 `-yresolution`, and `-resolutionunit` args to `pamtotiff`    - Add 300ppi and
 full resolution TIFF export tests    - Add a comment about deprecated use of
 `-flate` (to be addressed in a new ticket)

---
 imgsrv/lib/Process/Image.pm  | 11 ++++++-
 imgsrv/t/lib/Process/Image.t | 61 ++++++++++++++++++++++++++++++++++++
 2 files changed, 71 insertions(+), 1 deletion(-)
 create mode 100644 imgsrv/t/lib/Process/Image.t

diff --git a/imgsrv/lib/Process/Image.pm b/imgsrv/lib/Process/Image.pm
index f88bc8ac8..7e8c393dc 100644
--- a/imgsrv/lib/Process/Image.pm
+++ b/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, ) {
diff --git a/imgsrv/t/lib/Process/Image.t b/imgsrv/t/lib/Process/Image.t
new file mode 100644
index 000000000..71c2d1927
--- /dev/null
+++ b/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();