don't attempt to save the palette if we failed to read the image

[imager.git] / Imager.pm

diff --git a/Imager.pm b/Imager.pm
index 92135e5eb6e101d4075f2411775ff1f67a3879db..b6131c9633b15c666f75158478b919c78cb0b7ad 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -155,7 +155,7 @@ my %attempted_to_load;
 BEGIN {
   require Exporter;
   @ISA = qw(Exporter);
-  $VERSION = '0.53';
+  $VERSION = '0.59';
   eval {
     require XSLoader;
     XSLoader::load(Imager => $VERSION);
@@ -754,7 +754,10 @@ sub crop {
     $self->_set_error("resulting image would have no content");
     return;
   }
-
+  if( $r < $l or $b < $t ) {
+    $self->_set_error("attempting to crop outside of the image");
+    return;
+  }
   my $dst = $self->_sametype(xsize=>$r-$l, ysize=>$b-$t);
 
   i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
@@ -897,6 +900,26 @@ sub to_rgb8 {
   return $result;
 }
 
+# convert a paletted (or any image) to an 8-bit/channel RGB images
+sub to_rgb16 {
+  my $self = shift;
+  my $result;
+
+  unless (defined wantarray) {
+    my @caller = caller;
+    warn "to_rgb16() called in void context - to_rgb8() returns the converted image at $caller[1] line $caller[2]\n";
+    return;
+  }
+
+  if ($self->{IMG}) {
+    $result = Imager->new;
+    $result->{IMG} = i_img_to_rgb16($self->{IMG})
+      or undef $result;
+  }
+
+  return $result;
+}
+
 sub addcolors {
   my $self = shift;
   my %opts = (colors=>[], @_);
@@ -1269,11 +1292,13 @@ sub read {
     return $self;
   }
 
+  my $allow_incomplete = $input{allow_incomplete};
+  defined $allow_incomplete or $allow_incomplete = 0;
+
   if ( $input{'type'} eq 'tiff' ) {
     my $page = $input{'page'};
     defined $page or $page = 0;
-    # Fixme, check if that length parameter is ever needed
-    $self->{IMG}=i_readtiff_wiol( $IO, -1, $page ); 
+    $self->{IMG}=i_readtiff_wiol( $IO, $allow_incomplete, $page ); 
     if ( !defined($self->{IMG}) ) {
       $self->{ERRSTR}=$self->_error_as_msg(); return undef;
     }
@@ -1282,7 +1307,7 @@ sub read {
   }
 
   if ( $input{'type'} eq 'pnm' ) {
-    $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
+    $self->{IMG}=i_readpnm_wiol( $IO, $allow_incomplete );
     if ( !defined($self->{IMG}) ) {
       $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); 
       return undef;
@@ -1301,7 +1326,7 @@ sub read {
   }
 
   if ( $input{'type'} eq 'bmp' ) {
-    $self->{IMG}=i_readbmp_wiol( $IO );
+    $self->{IMG}=i_readbmp_wiol( $IO, $allow_incomplete );
     if ( !defined($self->{IMG}) ) {
       $self->{ERRSTR}=$self->_error_as_msg();
       return undef;
@@ -1331,7 +1356,7 @@ sub read {
       my $page = $input{'page'};
       defined $page or $page = 0;
       $self->{IMG} = i_readgif_single_wiol( $IO, $page );
-      if ($input{colors}) {
+      if ($self->{IMG} && $input{colors}) {
        ${ $input{colors} } =
          [ i_getcolors($self->{IMG}, 0, i_colorcount($self->{IMG})) ];
       }
@@ -1675,7 +1700,7 @@ sub write {
       $self->_set_opts(\%input, "bmp_", $self)
         or return undef;
       if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
-        $self->{ERRSTR}='unable to write bmp image';
+       $self->{ERRSTR} = $self->_error_as_msg;
         return undef;
       }
       $self->{DEBUG} && print "writing a bmp file\n";
@@ -2824,25 +2849,32 @@ sub setpixel {
   if (ref $x && ref $y) {
     unless (@$x == @$y) {
       $self->{ERRSTR} = 'length of x and y mismatch';
-      return undef;
+      return;
     }
+    my $set = 0;
     if ($color->isa('Imager::Color')) {
       for my $i (0..$#{$opts{'x'}}) {
-        i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color);
+        i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color)
+         or ++$set;
       }
     }
     else {
       for my $i (0..$#{$opts{'x'}}) {
-        i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color);
+        i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color)
+         or ++$set;
       }
     }
+    $set or return;
+    return $set;
   }
   else {
     if ($color->isa('Imager::Color')) {
-      i_ppix($self->{IMG}, $x, $y, $color);
+      i_ppix($self->{IMG}, $x, $y, $color)
+       and return;
     }
     else {
-      i_ppixf($self->{IMG}, $x, $y, $color);
+      i_ppixf($self->{IMG}, $x, $y, $color)
+       and return;
     }
   }
 
@@ -3254,7 +3286,7 @@ sub string {
   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 
   my %input=('x'=>0, 'y'=>0, @_);
-  $input{string}||=$input{text};
+  defined($input{string}) or $input{string} = $input{text};
 
   unless(defined $input{string}) {
     $self->{ERRSTR}="missing required parameter 'string'";
@@ -3806,6 +3838,8 @@ tags() -  L<Imager::ImageTypes/tags> - fetch image tags
 
 to_paletted() -  L<Imager::ImageTypes/to_paletted>
 
+to_rgb16() - L<Imager::ImageTypes/to_rgb16>
+
 to_rgb8() - L<Imager::ImageTypes/to_rgb8>
 
 transform() - L<Imager::Engines/"transform">
@@ -4000,14 +4034,47 @@ Please remember to include the versions of Imager, perl, supporting
 libraries, and any relevant code.  If you have specific images that
 cause the problems, please include those too.
 
-=head1 BUGS
+If you don't want to publish your email address on a mailing list you
+can use CPAN::Forum:
+
+  http://www.cpanforum.com/dist/Imager
+
+You will need to register to post.
+
+=head1 CONTRIBUTING TO IMAGER
+
+=head2 Feedback
 
-Bugs are listed individually for relevant pod pages.
+I like feedback.
+
+If you like or dislike Imager, you can add a public review of Imager
+at CPAN Ratings:
+
+  http://cpanratings.perl.org/dist/Imager
+
+This requires a Bitcard Account (http://www.bitcard.org).
+
+You can also send email to the maintainer below.
+
+If you send me a bug report via email, it will be copied to RT.
+
+=head2 Patches
+
+I accept patches, preferably against the main branch in subversion.
+You should include an explanation of the reason for why the patch is
+needed or useful.
+
+Your patch should include regression tests where possible, otherwise
+it will be delayed until I get a chance to write them.
 
 =head1 AUTHOR
 
-Arnar M. Hrafnkelsson and Tony Cook (tony@imager.perl.org) among
-others. See the README for a complete list.
+Tony Cook <tony@imager.perl.org> is the current maintainer for Imager.
+
+Arnar M. Hrafnkelsson is the original author of Imager.
+
+Many others have contributed to Imager, please see the README for a
+complete list.
 
 =head1 SEE ALSO