[rt #69194] include more information in read()/write() error messages

diff --git a/Changes b/Changes
index fab201106fed93fd3fea75f72288683b5aae3b49..6489a43edf1194aa6910366e8bd6fde03f35531c 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,6 @@
 Imager release history.  Older releases can be found in Changes.old
 
-Imager 0.84 - unreleased
+Imager 0.85 - unreleased
 ===========
 
 Bug fixes:
@@ -9,6 +9,10 @@ Bug fixes:
    checked when reading TIFF files.
    https://rt.cpan.org/Ticket/Display.html?id=69915
 
+ - Provide more information about file format module load errors on a
+   failed image file read() or write().
+   https://rt.cpan.org/Ticket/Display.html?id=69194
+
 Imager 0.84_01 - 8 Aug 2011
 ==============
 

diff --git a/Imager.pm b/Imager.pm
index 6fde54afdfac09fcb20823886496c06f1ccd77a7..7710602171b4b7e6ea61d46bf8acbc01a68428d1 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -119,6 +119,13 @@ my %writers;
 # modules we attempted to autoload
 my %attempted_to_load;
 
+# errors from loading files
+my %file_load_errors;
+
+# what happened when we tried to load
+my %reader_load_errors;
+my %writer_load_errors;
+
 # library keys that are image file formats
 my %file_formats = map { $_ => 1 } qw/tiff pnm gif png jpeg raw bmp tga/;
 
@@ -1322,7 +1329,7 @@ sub _get_reader_io {
 }
 
 sub _get_writer_io {
-  my ($self, $input, $type) = @_;
+  my ($self, $input) = @_;
 
   if ($input->{io}) {
     return $input->{io};
@@ -1389,31 +1396,32 @@ sub read {
 
   my ($IO, $fh) = $self->_get_reader_io(\%input) or return;
 
-  unless ($input{'type'}) {
-    $input{'type'} = i_test_format_probe($IO, -1);
+  my $type = $input{'type'};
+  unless ($type) {
+    $type = i_test_format_probe($IO, -1);
   }
 
-  unless ($input{'type'}) {
-         $self->_set_error('type parameter missing and not possible to guess from extension'); 
+  unless ($type) {
+    $self->_set_error('type parameter missing and not possible to guess from extension'); 
     return undef;
   }
 
-  _reader_autoload($input{type});
+  _reader_autoload($type);
 
-  if ($readers{$input{type}} && $readers{$input{type}}{single}) {
-    return $readers{$input{type}}{single}->($self, $IO, %input);
+  if ($readers{$type} && $readers{$type}{single}) {
+    return $readers{$type}{single}->($self, $IO, %input);
   }
 
-  unless ($formats_low{$input{'type'}}) {
+  unless ($formats_low{$type}) {
     my $read_types = join ', ', sort Imager->read_types();
-    $self->_set_error("format '$input{'type'}' not supported - formats $read_types available for reading");
+    $self->_set_error("format '$type' not supported - formats $read_types available for reading - $reader_load_errors{$type}");
     return;
   }
 
   my $allow_incomplete = $input{allow_incomplete};
   defined $allow_incomplete or $allow_incomplete = 0;
 
-  if ( $input{'type'} eq 'pnm' ) {
+  if ( $type eq 'pnm' ) {
     $self->{IMG}=i_readpnm_wiol( $IO, $allow_incomplete );
     if ( !defined($self->{IMG}) ) {
       $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); 
@@ -1423,7 +1431,7 @@ sub read {
     return $self;
   }
 
-  if ( $input{'type'} eq 'bmp' ) {
+  if ( $type eq 'bmp' ) {
     $self->{IMG}=i_readbmp_wiol( $IO, $allow_incomplete );
     if ( !defined($self->{IMG}) ) {
       $self->{ERRSTR}=$self->_error_as_msg();
@@ -1432,7 +1440,7 @@ sub read {
     $self->{DEBUG} && print "loading a bmp file\n";
   }
 
-  if ( $input{'type'} eq 'gif' ) {
+  if ( $type eq 'gif' ) {
     if ($input{colors} && !ref($input{colors})) {
       # must be a reference to a scalar that accepts the colour map
       $self->{ERRSTR} = "option 'colors' must be a scalar reference";
@@ -1467,7 +1475,7 @@ sub read {
     $self->{DEBUG} && print "loading a gif file\n";
   }
 
-  if ( $input{'type'} eq 'tga' ) {
+  if ( $type eq 'tga' ) {
     $self->{IMG}=i_readtga_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
     if ( !defined($self->{IMG}) ) {
       $self->{ERRSTR}=$self->_error_as_msg();
@@ -1476,7 +1484,7 @@ sub read {
     $self->{DEBUG} && print "loading a tga file\n";
   }
 
-  if ( $input{'type'} eq 'raw' ) {
+  if ( $type eq 'raw' ) {
     unless ( $input{xsize} && $input{ysize} ) {
       $self->_set_error('missing xsize or ysize parameter for raw');
       return undef;
@@ -1575,6 +1583,40 @@ sub write_types {
   return keys %types;
 }
 
+sub _load_file {
+  my ($file, $error) = @_;
+
+  if ($attempted_to_load{$file}) {
+    if ($file_load_errors{$file}) {
+      $$error = $file_load_errors{$file};
+      return 0;
+    }
+    else {
+      return 1;
+    }
+  }
+  else {
+    local $SIG{__DIE__};
+    my $loaded = eval {
+      ++$attempted_to_load{$file};
+      require $file;
+      return 1;
+    };
+    if ($loaded) {
+      return 1;
+    }
+    else {
+      my $work = $@ || "Unknown error loading $file";
+      chomp $work;
+      $work =~ s/\n?Compilation failed in require at .*Imager\.pm line .*\z//m;
+      $work =~ s/\n/\\n/g;
+      $file_load_errors{$file} = $work;
+      $$error = $work;
+      return 0;
+    }
+  }
+}
+
 # probes for an Imager::File::whatever module
 sub _reader_autoload {
   my $type = shift;
@@ -1585,50 +1627,42 @@ sub _reader_autoload {
 
   my $file = "Imager/File/\U$type\E.pm";
 
-  unless ($attempted_to_load{$file}) {
-    eval {
-      ++$attempted_to_load{$file};
-      require $file;
-    };
-    if ($@) {
-      # try to get a reader specific module
-      my $file = "Imager/File/\U$type\EReader.pm";
-      unless ($attempted_to_load{$file}) {
-       eval {
-         ++$attempted_to_load{$file};
-         require $file;
-       };
-      }
+  my $error;
+  my $loaded = _load_file($file, \$error);
+  if (!$loaded && $error =~ /^Can't locate /) {
+    my $filer = "Imager/File/\U$type\EReader.pm";
+    $loaded = _load_file($filer, \$error);
+    if ($error =~ /^Can't locate /) {
+      $error = "Can't locate $file or $filer";
     }
   }
+  unless ($loaded) {
+    $reader_load_errors{$type} = $error;
+  }
 }
 
 # probes for an Imager::File::whatever module
 sub _writer_autoload {
   my $type = shift;
 
-  return if $formats_low{$type} || $readers{$type};
+  return if $formats_low{$type} || $writers{$type};
 
   return unless $type =~ /^\w+$/;
 
   my $file = "Imager/File/\U$type\E.pm";
 
-  unless ($attempted_to_load{$file}) {
-    eval {
-      ++$attempted_to_load{$file};
-      require $file;
-    };
-    if ($@) {
-      # try to get a writer specific module
-      my $file = "Imager/File/\U$type\EWriter.pm";
-      unless ($attempted_to_load{$file}) {
-       eval {
-         ++$attempted_to_load{$file};
-         require $file;
-       };
-      }
+  my $error;
+  my $loaded = _load_file($file, \$error);
+  if (!$loaded && $error =~ /^Can't locate /) {
+    my $filew = "Imager/File/\U$type\EWriter.pm";
+    $loaded = _load_file($filew, \$error);
+    if ($error =~ /^Can't locate /) {
+      $error = "Can't locate $file or $filew";
     }
   }
+  unless ($loaded) {
+    $writer_load_errors{$type} = $error;
+  }
 }
 
 sub _fix_gif_positions {
@@ -1747,35 +1781,36 @@ sub write {
 
   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 
-  if (!$input{'type'} and $input{file}) { 
-    $input{'type'}=$FORMATGUESS->($input{file});
+  my $type = $input{'type'};
+  if (!$type and $input{file}) { 
+    $type = $FORMATGUESS->($input{file});
   }
-  if (!$input{'type'}) { 
+  unless ($type) { 
     $self->{ERRSTR}='type parameter missing and not possible to guess from extension';
     return undef;
   }
 
-  _writer_autoload($input{type});
+  _writer_autoload($type);
 
   my ($IO, $fh);
-  if ($writers{$input{type}} && $writers{$input{type}}{single}) {
-    ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
+  if ($writers{$type} && $writers{$type}{single}) {
+    ($IO, $fh) = $self->_get_writer_io(\%input)
       or return undef;
 
-    $writers{$input{type}}{single}->($self, $IO, %input)
+    $writers{$type}{single}->($self, $IO, %input, type => $type)
       or return undef;
   }
   else {
-    if (!$formats_low{$input{'type'}}) { 
+    if (!$formats_low{$type}) { 
       my $write_types = join ', ', sort Imager->write_types();
-      $self->_set_error("format '$input{'type'}' not supported - formats $write_types available for writing");
+      $self->_set_error("format '$type' not supported - formats $write_types available for writing - $writer_load_errors{$type}");
       return undef;
     }
     
-    ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
+    ($IO, $fh) = $self->_get_writer_io(\%input, $type)
       or return undef;
-    
-    if ( $input{'type'} eq 'pnm' ) {
+  
+    if ( $type eq 'pnm' ) {
       $self->_set_opts(\%input, "pnm_", $self)
         or return undef;
       if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
@@ -1783,7 +1818,8 @@ sub write {
         return undef;
       }
       $self->{DEBUG} && print "writing a pnm file\n";
-    } elsif ( $input{'type'} eq 'raw' ) {
+    }
+    elsif ( $type eq 'raw' ) {
       $self->_set_opts(\%input, "raw_", $self)
         or return undef;
       if ( !i_writeraw_wiol($self->{IMG},$IO) ) {
@@ -1791,17 +1827,8 @@ sub write {
         return undef;
       }
       $self->{DEBUG} && print "writing a raw file\n";
-    } elsif ( $input{'type'} eq 'jpeg' ) {
-      $self->_set_opts(\%input, "jpeg_", $self)
-        or return undef;
-      $self->_set_opts(\%input, "exif_", $self)
-        or return undef;
-      if ( !i_writejpeg_wiol($self->{IMG}, $IO, $input{jpegquality})) {
-        $self->{ERRSTR} = $self->_error_as_msg();
-        return undef;
-      }
-      $self->{DEBUG} && print "writing a jpeg file\n";
-    } elsif ( $input{'type'} eq 'bmp' ) {
+    }
+    elsif ( $type eq 'bmp' ) {
       $self->_set_opts(\%input, "bmp_", $self)
         or return undef;
       if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
@@ -1809,7 +1836,8 @@ sub write {
         return undef;
       }
       $self->{DEBUG} && print "writing a bmp file\n";
-    } elsif ( $input{'type'} eq 'tga' ) {
+    }
+    elsif ( $type eq 'tga' ) {
       $self->_set_opts(\%input, "tga_", $self)
         or return undef;
       
@@ -1818,24 +1846,6 @@ sub write {
         return undef;
       }
       $self->{DEBUG} && print "writing a tga file\n";
-    } elsif ( $input{'type'} eq 'gif' ) {
-      $self->_set_opts(\%input, "gif_", $self)
-        or return undef;
-      # compatibility with the old interfaces
-      if ($input{gifquant} eq 'lm') {
-        $input{make_colors} = 'addi';
-        $input{translate} = 'perturb';
-        $input{perturb} = $input{lmdither};
-      } elsif ($input{gifquant} eq 'gen') {
-        # just pass options through
-      } else {
-        $input{make_colors} = 'webmap'; # ignored
-        $input{translate} = 'giflib';
-      }
-      if (!i_writegif_wiol($IO, \%input, $self->{IMG})) {
-        $self->{ERRSTR} = $self->_error_as_msg;
-        return;
-      }
     }
   }
 
@@ -4007,10 +4017,16 @@ sub _check {
 
   (my $file = $self->[IX_CLASSES]{$key} . ".pm") =~ s(::)(/)g;
   my $value;
-  if (eval { require $file; 1 }) {
+  my $error;
+  my $loaded = Imager::_load_file($file, \$error);
+  if ($loaded) {
     $value = 1;
   }
   else {
+    if ($error =~ /^Can't locate /) {
+      $error = "Can't locate $file";
+    }
+    $reader_load_errors{$key} = $writer_load_errors{$key} = $error;
     $value = undef;
   }
   $self->[IX_FORMATS]{$key} = $value;

diff --git a/MANIFEST b/MANIFEST
index 58cd63fe31ae6fa4da0a2ed1c1c175e41bf78344..aa270c0a4ba2a0938c37fec88cd7209e8d85e83f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -268,7 +268,7 @@ SGI/SGI.xs
 SGI/t/00load.t
 SGI/t/10read.t
 SGI/t/20write.t
-SGI/t/30limit.t                Test size limit checking
+SGI/t/30limit.t                        Test size limit checking
 SGI/testimg/rle.rgb
 SGI/testimg/rle12.rgb
 SGI/testimg/rle16.rgb
@@ -292,6 +292,7 @@ t/t023palette.t                     Test paletted images
 t/t05error.t
 t/t07iolayer.t
 t/t1000files.t                 Format independent file tests
+t/t1000lib/Imager/File/BAD.pm  Test failing to load a file handler
 t/t101nojpeg.t                 Test handling when jpeg not available
 t/t102nopng.t                  Test handling when png not available
 t/t103raw.t

diff --git a/t/t1000files.t b/t/t1000files.t
index b0baac61c20a23c05b6a2b09dd46649d7781c9b3..5f87a401fcceb9200f8b450f9e4ffbc298f4a5cc 100644 (file)
--- a/t/t1000files.t
+++ b/t/t1000files.t
@@ -4,7 +4,7 @@
 # the file format
 
 use strict;
-use Test::More tests => 35;
+use Test::More tests => 43;
 use Imager;
 
 -d "testout" or mkdir "testout";
@@ -67,6 +67,42 @@ ok(Imager->set_file_limits(reset=>1),
 is_deeply([ Imager->get_file_limits() ], [ 0, 0, 0 ],
          "check all are reset");
 
+# test error handling for loading file handers
+{
+  # first, no module at all
+  {
+    my $data = "abc";
+    ok(!Imager->new(data => $data, filetype => "unknown"),
+       "try to read an unknown file type");
+   like(Imager->errstr, qr(^format 'unknown' not supported - formats .* - Can't locate Imager/File/UNKNOWN.pm or Imager/File/UNKNOWNReader.pm$),
+       "check error message");
+  }
+  {
+    my $data;
+    my $im = Imager->new(xsize => 10, ysize => 10);
+    ok(!$im->write(data => \$data, type => "unknown"),
+       "try to write an unknown file type");
+   like($im->errstr, qr(^format 'unknown' not supported - formats .* - Can't locate Imager/File/UNKNOWN.pm or Imager/File/UNKNOWNWriter.pm$),
+       "check error message");
+  }
+  push @INC, "t/t1000lib";
+  {
+    my $data = "abc";
+    ok(!Imager->new(data => $data, filetype => "bad"),
+       "try to read an bad (other load failure) file type");
+   like(Imager->errstr, qr(^format 'bad' not supported - formats .* available for reading - This module fails to load$),
+       "check error message");
+  }
+  {
+    my $data;
+    my $im = Imager->new(xsize => 10, ysize => 10);
+    ok(!$im->write(data => \$data, type => "bad"),
+       "try to write an bad file type");
+   like($im->errstr, qr(^format 'bad' not supported - formats .* available for writing - This module fails to load$),
+       "check error message");
+  }
+}
+
 # check file type probe
 probe_ok("49492A41", undef, "not quite tiff");
 probe_ok("4D4D0041", undef, "not quite tiff");

diff --git a/t/t1000lib/Imager/File/BAD.pm b/t/t1000lib/Imager/File/BAD.pm
new file mode 100644 (file)
index 0000000..6629ccd
--- /dev/null
+++ b/t/t1000lib/Imager/File/BAD.pm
@@ -0,0 +1,6 @@
+package Imager::File::BAD;
+use strict;
+
+die "This module fails to load\n";
+
+1;