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 e4ae9bf87b42ab97b43b9ba0678c5a7b3399c429..b6131c9633b15c666f75158478b919c78cb0b7ad 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -155,7 +155,7 @@ my %attempted_to_load;
 BEGIN {
   require Exporter;
   @ISA = qw(Exporter);
 BEGIN {
   require Exporter;
   @ISA = qw(Exporter);

-  $VERSION = '0.53';
+  $VERSION = '0.59';

   eval {
     require XSLoader;
     XSLoader::load(Imager => $VERSION);
   eval {
     require XSLoader;
     XSLoader::load(Imager => $VERSION);


@@ -754,7 +754,10 @@ sub crop {
     $self->_set_error("resulting image would have no content");
     return;
   }
     $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);
   my $dst = $self->_sametype(xsize=>$r-$l, ysize=>$b-$t);
 
   i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);


@@ -884,7 +887,7 @@ sub to_rgb8 {
 
   unless (defined wantarray) {
     my @caller = caller;
 
   unless (defined wantarray) {
     my @caller = caller;

-    warn "to_rgb8() called in void context - to_rgb8() returns the cropped image at $caller[1] line $caller[2]\n";
+    warn "to_rgb8() called in void context - to_rgb8() returns the converted image at $caller[1] line $caller[2]\n";

     return;
   }
 
     return;
   }
 


@@ -897,6 +900,26 @@ sub to_rgb8 {
   return $result;
 }
 
   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=>[], @_);
 sub addcolors {
   my $self = shift;
   my %opts = (colors=>[], @_);


@@ -1123,9 +1146,9 @@ sub settag {
 sub _get_reader_io {
   my ($self, $input) = @_;
 
 sub _get_reader_io {
   my ($self, $input) = @_;
 

-       if ($input->{io}) {
-               return $input->{io}, undef;
-       }
+  if ($input->{io}) {
+    return $input->{io}, undef;
+  }

   elsif ($input->{fd}) {
     return io_new_fd($input->{fd});
   }
   elsif ($input->{fd}) {
     return io_new_fd($input->{fd});
   }


@@ -1174,7 +1197,10 @@ sub _get_reader_io {
 sub _get_writer_io {
   my ($self, $input, $type) = @_;
 
 sub _get_writer_io {
   my ($self, $input, $type) = @_;
 

-  if ($input->{fd}) {
+  if ($input->{io}) {
+    return $input->{io};
+  }
+  elsif ($input->{fd}) {

     return io_new_fd($input->{fd});
   }
   elsif ($input->{fh}) {
     return io_new_fd($input->{fd});
   }
   elsif ($input->{fh}) {


@@ -1266,11 +1292,13 @@ sub read {
     return $self;
   }
 
     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;
   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;
     }
     if ( !defined($self->{IMG}) ) {
       $self->{ERRSTR}=$self->_error_as_msg(); return undef;
     }


@@ -1279,7 +1307,7 @@ sub read {
   }
 
   if ( $input{'type'} eq 'pnm' ) {
   }
 
   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;
     if ( !defined($self->{IMG}) ) {
       $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); 
       return undef;


@@ -1298,7 +1326,7 @@ sub read {
   }
 
   if ( $input{'type'} eq 'bmp' ) {
   }
 
   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;
     if ( !defined($self->{IMG}) ) {
       $self->{ERRSTR}=$self->_error_as_msg();
       return undef;


@@ -1328,7 +1356,7 @@ sub read {
       my $page = $input{'page'};
       defined $page or $page = 0;
       $self->{IMG} = i_readgif_single_wiol( $IO, $page );
       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})) ];
       }
        ${ $input{colors} } =
          [ i_getcolors($self->{IMG}, 0, i_colorcount($self->{IMG})) ];
       }


@@ -1672,7 +1700,7 @@ sub write {
       $self->_set_opts(\%input, "bmp_", $self)
         or return undef;
       if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
       $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";
         return undef;
       }
       $self->{DEBUG} && print "writing a bmp file\n";


@@ -1790,8 +1818,15 @@ sub write_multi {
       }
     }
     else {
       }
     }
     else {

-      $ERRSTR = "Sorry, write_multi doesn't support $type yet";
-      return 0;
+      if (@images == 1) {
+       unless ($images[0]->write(%$opts, io => $IO, type => $type)) {
+         return 1;
+       }
+      }
+      else {
+       $ERRSTR = "Sorry, write_multi doesn't support $type yet";
+       return 0;
+      }

     }
   }
 
     }
   }
 


@@ -1859,6 +1894,12 @@ sub read_multi {
       return;
     }
   }
       return;
     }
   }

+  else {
+    my $img = Imager->new;
+    if ($img->read(%opts, io => $IO, type => $type)) {
+      return ( $img );
+    }
+  }

 
   $ERRSTR = "Cannot read multiple images from $type files";
   return;
 
   $ERRSTR = "Cannot read multiple images from $type files";
   return;


@@ -1963,11 +2004,10 @@ sub register_filter {
 
 sub scale {
   my $self=shift;
 
 sub scale {
   my $self=shift;

-  my %opts=(scalefactor=>0.5,'type'=>'max',qtype=>'normal',@_);
+  my %opts=('type'=>'max',qtype=>'normal',@_);

   my $img = Imager->new();
   my $tmp = Imager->new();
   my $img = Imager->new();
   my $tmp = Imager->new();

-
-  my $scalefactor = $opts{scalefactor};
+  my ($x_scale, $y_scale);

 
   unless (defined wantarray) {
     my @caller = caller;
 
   unless (defined wantarray) {
     my @caller = caller;


@@ -1980,45 +2020,67 @@ sub scale {
     return undef;
   }
 
     return undef;
   }
 

+  if ($opts{'xscalefactor'} && $opts{'yscalefactor'}) {
+    $x_scale = $opts{'xscalefactor'};
+    $y_scale = $opts{'yscalefactor'};
+  }
+  elsif ($opts{'xscalefactor'}) {
+    $x_scale = $opts{'xscalefactor'};
+    $y_scale = $opts{'scalefactor'} || $x_scale;
+  }
+  elsif ($opts{'yscalefactor'}) {
+    $y_scale = $opts{'yscalefactor'};
+    $x_scale = $opts{'scalefactor'} || $y_scale;
+  }
+  else {
+    $x_scale = $y_scale = $opts{'scalefactor'} || 0.5;
+  }
+

   # work out the scaling
   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
     my ($xpix, $ypix)=( $opts{xpixels} / $self->getwidth() , 
                        $opts{ypixels} / $self->getheight() );
     if ($opts{'type'} eq 'min') { 
   # work out the scaling
   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
     my ($xpix, $ypix)=( $opts{xpixels} / $self->getwidth() , 
                        $opts{ypixels} / $self->getheight() );
     if ($opts{'type'} eq 'min') { 

-      $scalefactor = _min($xpix,$ypix); 
+      $x_scale = $y_scale = _min($xpix,$ypix); 

     }
     elsif ($opts{'type'} eq 'max') {
     }
     elsif ($opts{'type'} eq 'max') {

-      $scalefactor = _max($xpix,$ypix);
+      $x_scale = $y_scale = _max($xpix,$ypix);
+    }
+    elsif ($opts{'type'} eq 'nonprop' || $opts{'type'} eq 'non-proportional') {
+      $x_scale = $xpix;
+      $y_scale = $ypix;

     }
     else {
       $self->_set_error('invalid value for type parameter');
       return undef;
     }
   } elsif ($opts{xpixels}) { 
     }
     else {
       $self->_set_error('invalid value for type parameter');
       return undef;
     }
   } elsif ($opts{xpixels}) { 

-    $scalefactor = $opts{xpixels} / $self->getwidth();
+    $x_scale = $y_scale = $opts{xpixels} / $self->getwidth();

   }
   elsif ($opts{ypixels}) { 
   }
   elsif ($opts{ypixels}) { 

-    $scalefactor = $opts{ypixels}/$self->getheight();
+    $x_scale = $y_scale = $opts{ypixels}/$self->getheight();

   }
   elsif ($opts{constrain} && ref $opts{constrain}
         && $opts{constrain}->can('constrain')) {
     # we've been passed an Image::Math::Constrain object or something
     # that looks like one
   }
   elsif ($opts{constrain} && ref $opts{constrain}
         && $opts{constrain}->can('constrain')) {
     # we've been passed an Image::Math::Constrain object or something
     # that looks like one

+    my $scalefactor;

     (undef, undef, $scalefactor)
       = $opts{constrain}->constrain($self->getwidth, $self->getheight);
     unless ($scalefactor) {
       $self->_set_error('constrain method failed on constrain parameter');
       return undef;
     }
     (undef, undef, $scalefactor)
       = $opts{constrain}->constrain($self->getwidth, $self->getheight);
     unless ($scalefactor) {
       $self->_set_error('constrain method failed on constrain parameter');
       return undef;
     }

+    $x_scale = $y_scale = $scalefactor;

   }
 
   if ($opts{qtype} eq 'normal') {
   }
 
   if ($opts{qtype} eq 'normal') {

-    $tmp->{IMG} = i_scaleaxis($self->{IMG}, $scalefactor, 0);
+    $tmp->{IMG} = i_scaleaxis($self->{IMG}, $x_scale, 0);

     if ( !defined($tmp->{IMG}) ) { 
       $self->{ERRSTR} = 'unable to scale image';
       return undef;
     }
     if ( !defined($tmp->{IMG}) ) { 
       $self->{ERRSTR} = 'unable to scale image';
       return undef;
     }

-    $img->{IMG}=i_scaleaxis($tmp->{IMG}, $scalefactor, 1);
+    $img->{IMG}=i_scaleaxis($tmp->{IMG}, $y_scale, 1);

     if ( !defined($img->{IMG}) ) { 
       $self->{ERRSTR}='unable to scale image'; 
       return undef;
     if ( !defined($img->{IMG}) ) { 
       $self->{ERRSTR}='unable to scale image'; 
       return undef;


@@ -2027,13 +2089,25 @@ sub scale {
     return $img;
   }
   elsif ($opts{'qtype'} eq 'preview') {
     return $img;
   }
   elsif ($opts{'qtype'} eq 'preview') {

-    $img->{IMG} = i_scale_nn($self->{IMG}, $scalefactor, $scalefactor); 
+    $img->{IMG} = i_scale_nn($self->{IMG}, $x_scale, $y_scale); 

     if ( !defined($img->{IMG}) ) { 
       $self->{ERRSTR}='unable to scale image'; 
       return undef;
     }
     return $img;
   }
     if ( !defined($img->{IMG}) ) { 
       $self->{ERRSTR}='unable to scale image'; 
       return undef;
     }
     return $img;
   }

+  elsif ($opts{'qtype'} eq 'mixing') {
+    my $new_width = int(0.5 + $self->getwidth * $x_scale);
+    my $new_height = int(0.5 + $self->getheight * $y_scale);
+    $new_width >= 1 or $new_width = 1;
+    $new_height >= 1 or $new_height = 1;
+    $img->{IMG} = i_scale_mixing($self->{IMG}, $new_width, $new_height);
+    unless ($img->{IMG}) {
+      $self->_set_error(Imager->_error_as_meg);
+      return;
+    }
+    return $img;
+  }

   else {
     $self->_set_error('invalid value for qtype parameter');
     return undef;
   else {
     $self->_set_error('invalid value for qtype parameter');
     return undef;


@@ -2775,25 +2849,32 @@ sub setpixel {
   if (ref $x && ref $y) {
     unless (@$x == @$y) {
       $self->{ERRSTR} = 'length of x and y mismatch';
   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'}}) {
     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'}}) {
       }
     }
     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')) {
   }
   else {
     if ($color->isa('Imager::Color')) {

-      i_ppix($self->{IMG}, $x, $y, $color);
+      i_ppix($self->{IMG}, $x, $y, $color)
+       and return;

     }
     else {
     }
     else {

-      i_ppixf($self->{IMG}, $x, $y, $color);
+      i_ppixf($self->{IMG}, $x, $y, $color)
+       and return;

     }
   }
 
     }
   }
 


@@ -3205,7 +3286,7 @@ sub string {
   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 
   my %input=('x'=>0, 'y'=>0, @_);
   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'";
 
   unless(defined $input{string}) {
     $self->{ERRSTR}="missing required parameter 'string'";


@@ -3757,6 +3838,8 @@ tags() -  L<Imager::ImageTypes/tags> - fetch image tags
 
 to_paletted() -  L<Imager::ImageTypes/to_paletted>
 
 
 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">
 to_rgb8() - L<Imager::ImageTypes/to_rgb8>
 
 transform() - L<Imager::Engines/"transform">


@@ -3951,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.
 
 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
+
+I like feedback.
+
+If you like or dislike Imager, you can add a public review of Imager
+at CPAN Ratings:

 
 

-Bugs are listed individually for relevant pod pages.
+  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
 
 
 =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
 
 
 =head1 SEE ALSO