X-Git-Url: http://git.imager.perl.org/imager.git/blobdiff_plain/4697b0b935eabee2945e48c72ff2c04856b9466e..83e58721c3dc7cae5baaad465d3ac6a088d6a13c:/Imager.pm diff --git a/Imager.pm b/Imager.pm index 89a3a9a3..9671b049 100644 --- a/Imager.pm +++ b/Imager.pm @@ -3,9 +3,10 @@ package Imager; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR %OPCODES $I2P $FORMATGUESS $warn_obsolete); use IO::File; - +use Scalar::Util; use Imager::Color; use Imager::Font; +use Config; @EXPORT_OK = qw( init @@ -19,17 +20,11 @@ use Imager::Font; unload_plugin i_list_formats - i_has_format i_color_new i_color_set i_color_info - i_img_empty - i_img_empty_ch - i_img_exorcise - i_img_destroy - i_img_info i_img_setmask @@ -61,14 +56,6 @@ use Imager::Font; i_img_diff - i_init_fonts - i_t1_new - i_t1_destroy - i_t1_set_aa - i_t1_cp - i_t1_text - i_t1_bbox - i_tt_set_aa i_tt_cp i_tt_text @@ -103,14 +90,6 @@ use Imager::Font; ); @EXPORT=qw( - init_log - i_list_formats - i_has_format - malloc_state - i_color_new - - i_img_empty - i_img_empty_ch ); %EXPORT_TAGS= @@ -136,6 +115,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/; @@ -154,17 +140,13 @@ my %defaults; BEGIN { require Exporter; - @ISA = qw(Exporter); - $VERSION = '0.78'; - eval { - require XSLoader; - XSLoader::load(Imager => $VERSION); - 1; - } or do { - require DynaLoader; - push @ISA, 'DynaLoader'; - bootstrap Imager $VERSION; + my $ex_version = eval $Exporter::VERSION; + if ($ex_version < 5.57) { + @ISA = qw(Exporter); } + $VERSION = '0.98'; + require XSLoader; + XSLoader::load(Imager => $VERSION); } my %formats_low; @@ -176,6 +158,7 @@ my %format_classes = jpeg => "Imager::File::JPEG", w32 => "Imager::Font::W32", ft2 => "Imager::Font::FT2", + t1 => "Imager::Font::T1", ); tie %formats, "Imager::FORMATS", \%formats_low, \%format_classes; @@ -221,12 +204,18 @@ BEGIN { callsub => sub { my %hsh=@_; i_hardinvertall($hsh{image}); } }; - $filters{autolevels} ={ + $filters{autolevels_skew} ={ callseq => ['image','lsat','usat','skew'], defaults => { lsat=>0.1,usat=>0.1,skew=>0.0 }, callsub => sub { my %hsh=@_; i_autolevels($hsh{image},$hsh{lsat},$hsh{usat},$hsh{skew}); } }; + $filters{autolevels} ={ + callseq => ['image','lsat','usat'], + defaults => { lsat=>0.1,usat=>0.1 }, + callsub => sub { my %hsh=@_; i_autolevels_mono($hsh{image},$hsh{lsat},$hsh{usat}); } + }; + $filters{turbnoise} ={ callseq => ['image'], defaults => { xo=>0.0,yo=>0.0,scale=>10.0 }, @@ -441,7 +430,7 @@ BEGIN { # Non methods # -# initlize Imager +# initialize Imager # NOTE: this might be moved to an import override later on sub import { @@ -459,28 +448,67 @@ sub import { } sub init_log { - i_init_log($_[0],$_[1]); - i_log_entry("Imager $VERSION starting\n", 1); + Imager->open_log(log => $_[0], level => $_[1]); } sub init { my %parms=(loglevel=>1,@_); - if ($parms{'log'}) { - init_log($parms{'log'},$parms{'loglevel'}); - } if (exists $parms{'warn_obsolete'}) { $warn_obsolete = $parms{'warn_obsolete'}; } -# if ($parms{T1LIB_CONFIG}) { $ENV{T1LIB_CONFIG}=$parms{T1LIB_CONFIG}; } -# if ( $ENV{T1LIB_CONFIG} and ( $fontstate eq 'missing conf' )) { -# i_init_fonts(); -# $fontstate='ok'; -# } + if ($parms{'log'}) { + Imager->open_log(log => $parms{log}, level => $parms{loglevel}) + or return; + } + if (exists $parms{'t1log'}) { - i_init_fonts($parms{'t1log'}); + if ($formats{t1}) { + if (Imager::Font::T1::i_init_t1($parms{'t1log'})) { + Imager->_set_error(Imager->_error_as_msg); + return; + } + } + } + + return 1; +} + +{ + my $is_logging = 0; + + sub open_log { + my $class = shift; + my (%opts) = ( loglevel => 1, @_ ); + + $is_logging = i_init_log($opts{log}, $opts{loglevel}); + unless ($is_logging) { + Imager->_set_error(Imager->_error_as_msg()); + return; + } + + Imager->log("Imager $VERSION starting\n", 1); + + return $is_logging; + } + + sub close_log { + i_init_log(undef, -1); + $is_logging = 0; + } + + sub log { + my ($class, $message, $level) = @_; + + defined $level or $level = 1; + + i_log_entry($message, $level); + } + + sub is_logging { + return $is_logging; } } @@ -498,6 +526,12 @@ END { sub load_plugin { my ($filename)=@_; my $i; + + if ($^O eq 'android') { + require File::Spec; + $filename = File::Spec->rel2abs($filename); + } + my ($DSO_handle,$str)=DSO_open($filename); if (!defined($DSO_handle)) { $Imager::ERRSTR="Couldn't load plugin '$filename'\n"; return undef; } my %funcs=DSO_funclist($DSO_handle); @@ -521,6 +555,11 @@ sub load_plugin { sub unload_plugin { my ($filename)=@_; + if ($^O eq 'android') { + require File::Spec; + $filename = File::Spec->rel2abs($filename); + } + if (!$DSOs{$filename}) { $ERRSTR="plugin '$filename' not loaded."; return undef; } my ($DSO_handle,$funcref)=@{$DSOs{$filename}}; for(keys %{$funcref}) { @@ -596,11 +635,13 @@ sub _combine { } sub _valid_image { - my ($self) = @_; + my ($self, $method) = @_; - $self->{IMG} and return 1; + $self->{IMG} && Scalar::Util::blessed($self->{IMG}) and return 1; - $self->_set_error('empty input image'); + my $msg = $self->{IMG} ? "images do not cross threads" : "empty input image"; + $msg = "$method: $msg" if $method; + $self->_set_error($msg); return; } @@ -664,7 +705,9 @@ sub new { sub copy { my $self = shift; - unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } + + $self->_valid_image("copy") + or return; unless (defined wantarray) { my @caller = caller; @@ -682,16 +725,19 @@ sub copy { sub paste { my $self = shift; - unless ($self->{IMG}) { - $self->_set_error('empty input image'); - return; - } + $self->_valid_image("paste") + or return; + my %input=(left=>0, top=>0, src_minx => 0, src_miny => 0, @_); my $src = $input{img} || $input{src}; unless($src) { $self->_set_error("no source image"); return; } + unless ($src->_valid_image("paste")) { + $self->{ERRSTR} = $src->{ERRSTR} . " (for src)"; + return; + } $input{left}=0 if $input{left} <= 0; $input{top}=0 if $input{top} <= 0; @@ -750,7 +796,9 @@ sub paste { sub crop { my $self=shift; - unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } + + $self->_valid_image("crop") + or return; unless (defined wantarray) { my @caller = caller; @@ -838,7 +886,8 @@ sub crop { sub _sametype { my ($self, %opts) = @_; - $self->{IMG} or return $self->_set_error("Not a valid image"); + $self->_valid_image + or return; my $x = $opts{xsize} || $self->getwidth; my $y = $opts{ysize} || $self->getheight; @@ -885,8 +934,8 @@ sub img_set { $self->{IMG} = i_img_16_new($hsh{xsize}, $hsh{ysize}, $hsh{channels}); } else { - $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'}, $hsh{'ysize'}, - $hsh{'channels'}); + $self->{IMG}= i_img_8_new($hsh{'xsize'}, $hsh{'ysize'}, + $hsh{'channels'}); } unless ($self->{IMG}) { @@ -901,7 +950,9 @@ sub img_set { sub masked { my $self = shift; - $self or return undef; + $self->_valid_image("masked") + or return; + my %opts = (left => 0, top => 0, right => $self->getwidth, @@ -913,11 +964,16 @@ sub masked { $result->{IMG} = i_img_masked_new($self->{IMG}, $mask, $opts{left}, $opts{top}, $opts{right} - $opts{left}, $opts{bottom} - $opts{top}); + unless ($result->{IMG}) { + $self->_set_error(Imager->_error_as_msg); + return; + } + # keep references to the mask and base images so they don't # disappear on us $result->{DEPENDS} = [ $self->{IMG}, $mask ]; - $result; + return $result; } # convert an RGB image into a paletted image @@ -937,24 +993,40 @@ sub to_paletted { return; } + $self->_valid_image("to_paletted") + or return; + my $result = Imager->new; - $result->{IMG} = i_img_to_pal($self->{IMG}, $opts); + unless ($result->{IMG} = i_img_to_pal($self->{IMG}, $opts)) { + $self->_set_error(Imager->_error_as_msg); + return; + } - #print "Type ", i_img_type($result->{IMG}), "\n"; + return $result; +} - if ($result->{IMG}) { - return $result; - } - else { - $self->{ERRSTR} = $self->_error_as_msg; +sub make_palette { + my ($class, $quant, @images) = @_; + + unless (@images) { + Imager->_set_error("make_palette: supply at least one image"); return; } + my $index = 1; + for my $img (@images) { + unless ($img->{IMG}) { + Imager->_set_error("make_palette: image $index is empty"); + return; + } + ++$index; + } + + return i_img_make_palette($quant, map $_->{IMG}, @images); } -# convert a paletted (or any image) to an 8-bit/channel RGB images +# convert a paletted (or any image) to an 8-bit/channel RGB image sub to_rgb8 { my $self = shift; - my $result; unless (defined wantarray) { my @caller = caller; @@ -962,44 +1034,69 @@ sub to_rgb8 { return; } - if ($self->{IMG}) { - $result = Imager->new; - $result->{IMG} = i_img_to_rgb($self->{IMG}) - or undef $result; + $self->_valid_image("to_rgb8") + or return; + + my $result = Imager->new; + unless ($result->{IMG} = i_img_to_rgb($self->{IMG})) { + $self->_set_error(Imager->_error_as_msg()); + return; } return $result; } -# convert a paletted (or any image) to an 8-bit/channel RGB images +# convert a paletted (or any image) to a 16-bit/channel RGB image 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"; + warn "to_rgb16() called in void context - to_rgb16() 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; + $self->_valid_image("to_rgb16") + or return; + + my $result = Imager->new; + unless ($result->{IMG} = i_img_to_rgb16($self->{IMG})) { + $self->_set_error(Imager->_error_as_msg()); + return; } return $result; } -sub addcolors { +# convert a paletted (or any image) to an double/channel RGB image +sub to_rgb_double { my $self = shift; - my %opts = (colors=>[], @_); - unless ($self->{IMG}) { - $self->_set_error("empty input image"); + unless (defined wantarray) { + my @caller = caller; + warn "to_rgb16() called in void context - to_rgb_double() returns the converted image at $caller[1] line $caller[2]\n"; + return; + } + + $self->_valid_image("to_rgb_double") + or return; + + my $result = Imager->new; + unless ($result->{IMG} = i_img_to_drgb($self->{IMG})) { + $self->_set_error(Imager->_error_as_msg()); return; } + return $result; +} + +sub addcolors { + my $self = shift; + my %opts = (colors=>[], @_); + + $self->_valid_image("addcolors") + or return -1; + my @colors = @{$opts{colors}} or return undef; @@ -1018,10 +1115,8 @@ sub setcolors { my $self = shift; my %opts = (start=>0, colors=>[], @_); - unless ($self->{IMG}) { - $self->_set_error("empty input image"); - return; - } + $self->_valid_image("setcolors") + or return; my @colors = @{$opts{colors}} or return undef; @@ -1040,6 +1135,10 @@ sub setcolors { sub getcolors { my $self = shift; my %opts = @_; + + $self->_valid_image("getcolors") + or return; + if (!exists $opts{start} && !exists $opts{count}) { # get them all $opts{start} = 0; @@ -1051,52 +1150,82 @@ sub getcolors { elsif (!exists $opts{start}) { $opts{start} = 0; } - - $self->{IMG} and - return i_getcolors($self->{IMG}, $opts{start}, $opts{count}); + + return i_getcolors($self->{IMG}, $opts{start}, $opts{count}); } sub colorcount { - i_colorcount($_[0]{IMG}); + my ($self) = @_; + + $self->_valid_image("colorcount") + or return -1; + + return i_colorcount($self->{IMG}); } sub maxcolors { - i_maxcolors($_[0]{IMG}); + my $self = shift; + + $self->_valid_image("maxcolors") + or return -1; + + i_maxcolors($self->{IMG}); } sub findcolor { my $self = shift; my %opts = @_; - $opts{color} or return undef; - $self->{IMG} and i_findcolor($self->{IMG}, $opts{color}); + $self->_valid_image("findcolor") + or return; + + unless ($opts{color}) { + $self->_set_error("findcolor: no color parameter"); + return; + } + + my $color = _color($opts{color}) + or return; + + return i_findcolor($self->{IMG}, $color); } sub bits { my $self = shift; - my $bits = $self->{IMG} && i_img_bits($self->{IMG}); + + $self->_valid_image("bits") + or return; + + my $bits = i_img_bits($self->{IMG}); if ($bits && $bits == length(pack("d", 1)) * 8) { $bits = 'double'; } - $bits; + return $bits; } sub type { my $self = shift; - if ($self->{IMG}) { - return i_img_type($self->{IMG}) ? "paletted" : "direct"; - } + + $self->_valid_image("type") + or return; + + return i_img_type($self->{IMG}) ? "paletted" : "direct"; } sub virtual { my $self = shift; - $self->{IMG} and i_img_virtual($self->{IMG}); + + $self->_valid_image("virtual") + or return; + + return i_img_virtual($self->{IMG}); } sub is_bilevel { my ($self) = @_; - $self->{IMG} or return; + $self->_valid_image("is_bilevel") + or return; return i_img_is_monochrome($self->{IMG}); } @@ -1104,7 +1233,8 @@ sub is_bilevel { sub tags { my ($self, %opts) = @_; - $self->{IMG} or return; + $self->_valid_image("tags") + or return; if (defined $opts{name}) { my @result; @@ -1140,7 +1270,9 @@ sub addtag { my $self = shift; my %opts = @_; - return -1 unless $self->{IMG}; + $self->_valid_image("addtag") + or return; + if ($opts{name}) { if (defined $opts{value}) { if ($opts{value} =~ /^\d+$/) { @@ -1188,7 +1320,8 @@ sub deltag { my $self = shift; my %opts = @_; - return 0 unless $self->{IMG}; + $self->_valid_image("deltag") + or return 0; if (defined $opts{'index'}) { return i_tags_delete($self->{IMG}, $opts{'index'}); @@ -1208,6 +1341,9 @@ sub deltag { sub settag { my ($self, %opts) = @_; + $self->_valid_image("settag") + or return; + if ($opts{name}) { $self->deltag(name=>$opts{name}); return $self->addtag(name=>$opts{name}, value=>$opts{value}); @@ -1232,12 +1368,11 @@ sub _get_reader_io { return io_new_fd($input->{fd}); } elsif ($input->{fh}) { - my $fd = fileno($input->{fh}); - unless (defined $fd) { + unless (Scalar::Util::openhandle($input->{fh})) { $self->_set_error("Handle in fh option not opened"); return; } - return io_new_fd($fd); + return Imager::IO->new_fh($input->{fh}); } elsif ($input->{file}) { my $file = IO::File->new($input->{file}, "r"); @@ -1274,26 +1409,24 @@ sub _get_reader_io { } sub _get_writer_io { - my ($self, $input, $type) = @_; + my ($self, $input) = @_; + my $buffered = exists $input->{buffered} ? $input->{buffered} : 1; + + my $io; + my @extras; if ($input->{io}) { - return $input->{io}; + $io = $input->{io}; } elsif ($input->{fd}) { - return io_new_fd($input->{fd}); + $io = io_new_fd($input->{fd}); } elsif ($input->{fh}) { - my $fd = fileno($input->{fh}); - unless (defined $fd) { + unless (Scalar::Util::openhandle($input->{fh})) { $self->_set_error("Handle in fh option not opened"); return; } - # flush it - my $oldfh = select($input->{fh}); - # flush anything that's buffered, and make sure anything else is flushed - $| = 1; - select($oldfh); - return io_new_fd($fd); + $io = Imager::IO->new_fh($input->{fh}); } elsif ($input->{file}) { my $fh = new IO::File($input->{file},"w+"); @@ -1302,28 +1435,30 @@ sub _get_writer_io { return; } binmode($fh) or die; - return (io_new_fd(fileno($fh)), $fh); + $io = io_new_fd(fileno($fh)); + push @extras, $fh; } elsif ($input->{data}) { - return io_new_bufchain(); + $io = io_new_bufchain(); } elsif ($input->{callback} || $input->{writecb}) { - if ($input->{maxbuffer}) { - return io_new_cb($input->{callback} || $input->{writecb}, - $input->{readcb}, - $input->{seekcb}, $input->{closecb}, - $input->{maxbuffer}); - } - else { - return io_new_cb($input->{callback} || $input->{writecb}, - $input->{readcb}, - $input->{seekcb}, $input->{closecb}); + if ($input->{maxbuffer} && $input->{maxbuffer} == 1) { + $buffered = 0; } + $io = io_new_cb($input->{callback} || $input->{writecb}, + $input->{readcb}, + $input->{seekcb}, $input->{closecb}); } else { $self->_set_error("file/fd/fh/data/callback parameter missing"); return; } + + unless ($buffered) { + $io->set_buffered(0); + } + + return ($io, @extras); } # Read an image from file @@ -1341,31 +1476,39 @@ 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); + } + + if ($input{file} && !$type) { + # guess the type + $type = $FORMATGUESS->($input{file}); } - unless ($input{'type'}) { - $self->_set_error('type parameter missing and not possible to guess from extension'); + unless ($type) { + my $msg = "type parameter missing and it couldn't be determined from the file contents"; + $input{file} and $msg .= " or file name"; + $self->_set_error($msg); 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(); @@ -1375,7 +1518,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(); @@ -1384,42 +1527,7 @@ sub read { $self->{DEBUG} && print "loading a bmp file\n"; } - if ( $input{'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"; - return undef; - } - if ($input{'gif_consolidate'}) { - if ($input{colors}) { - my $colors; - ($self->{IMG}, $colors) =i_readgif_wiol( $IO ); - if ($colors) { - ${ $input{colors} } = [ map { NC(@$_) } @$colors ]; - } - } - else { - $self->{IMG} =i_readgif_wiol( $IO ); - } - } - else { - my $page = $input{'page'}; - defined $page or $page = 0; - $self->{IMG} = i_readgif_single_wiol( $IO, $page ); - if ($self->{IMG} && $input{colors}) { - ${ $input{colors} } = - [ i_getcolors($self->{IMG}, 0, i_colorcount($self->{IMG})) ]; - } - } - - if ( !defined($self->{IMG}) ) { - $self->{ERRSTR}=$self->_error_as_msg(); - return undef; - } - $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(); @@ -1428,7 +1536,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; @@ -1527,6 +1635,41 @@ 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"; + chomp $work; + $work =~ s/\n?Compilation failed in require at .*Imager\.pm line .*\z//m; + $work =~ s/\n/\\n/g; + $work =~ s/\s*\.?\z/ loading $file/; + $file_load_errors{$file} = $work; + $$error = $work; + return 0; + } + } +} + # probes for an Imager::File::whatever module sub _reader_autoload { my $type = shift; @@ -1537,50 +1680,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 { @@ -1694,40 +1829,42 @@ sub write { fax_fine=>1, @_); my $rc; + $self->_valid_image("write") + or return; + $self->_set_opts(\%input, "i_", $self) or return undef; - 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) ) { @@ -1735,7 +1872,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) ) { @@ -1743,17 +1881,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) ) { @@ -1761,7 +1890,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; @@ -1770,24 +1900,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; - } } } @@ -1815,9 +1927,13 @@ sub write_multi { return; } # translate to ImgRaw - if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) { - $class->_set_error('Usage: Imager->write_multi({ options }, @images)'); - return 0; + my $index = 1; + for my $img (@images) { + unless ($img->_valid_image("write_multi")) { + $class->_set_error($img->errstr . " (image $index)"); + return; + } + ++$index; } $class->_set_opts($opts, "i_", @images) or return; @@ -1887,7 +2003,9 @@ sub read_multi { } unless ($type) { - $ERRSTR = "No type parameter supplied and it couldn't be guessed"; + my $msg = "type parameter missing and it couldn't be determined from the file contents"; + $opts{file} and $msg .= " or file name"; + Imager->_set_error($msg); return; } @@ -1949,7 +2067,9 @@ sub filter { my $self=shift; my %input=@_; my %hsh; - unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } + + $self->_valid_image("filter") + or return; if (!$input{'type'}) { $self->{ERRSTR}='type parameter missing'; return undef; } @@ -2124,10 +2244,8 @@ sub scale { return; } - unless ($self->{IMG}) { - $self->_set_error('empty input image'); - return undef; - } + $self->_valid_image("scale") + or return; my ($x_scale, $y_scale, $new_width, $new_height) = $self->scale_calculate(%opts) @@ -2181,10 +2299,8 @@ sub scaleX { return; } - unless ($self->{IMG}) { - $self->{ERRSTR} = 'empty input image'; - return undef; - } + $self->_valid_image("scaleX") + or return; my $img = Imager->new(); @@ -2221,7 +2337,8 @@ sub scaleY { return; } - unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } + $self->_valid_image("scaleY") + or return; my $img = Imager->new(); @@ -2252,13 +2369,15 @@ sub scaleY { sub transform { my $self=shift; - unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } my %opts=@_; my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre); # print Dumper(\%opts); # xopcopdes + $self->_valid_image("transform") + or return; + if ( $opts{'xexpr'} and $opts{'yexpr'} ) { if (!$I2P) { eval ("use Affix::Infix2Postfix;"); @@ -2350,6 +2469,15 @@ sub transform2 { $opts->{variables} = [ qw(x y) ]; my ($width, $height) = @{$opts}{qw(width height)}; if (@imgs) { + my $index = 1; + for my $img (@imgs) { + unless ($img->_valid_image("transform2")) { + Imager->_set_error($img->errstr . " (input image $index)"); + return; + } + ++$index; + } + $width ||= $imgs[0]->getwidth(); $height ||= $imgs[0]->getheight(); my $img_num = 1; @@ -2404,13 +2532,12 @@ sub rubthrough { my $self=shift; my %opts= @_; - unless ($self->{IMG}) { - $self->{ERRSTR}='empty input image'; - return undef; - } - unless ($opts{src} && $opts{src}->{IMG}) { - $self->{ERRSTR}='empty input image for src'; - return undef; + $self->_valid_image("rubthrough") + or return; + + unless ($opts{src} && $opts{src}->_valid_image("rubthrough")) { + $self->{ERRSTR} = $opts{src}{ERRSTR} . ' (for src)'; + return; } %opts = (src_minx => 0, @@ -2447,18 +2574,16 @@ sub compose { @_ ); - unless ($self->{IMG}) { - $self->_set_error("compose: empty input image"); - return; - } + $self->_valid_image("compose") + or return; unless ($opts{src}) { $self->_set_error("compose: src parameter missing"); return; } - unless ($opts{src}{IMG}) { - $self->_set_error("compose: src parameter empty image"); + unless ($opts{src}->_valid_image("compose")) { + $self->_set_error($opts{src}->errstr . " (for src)"); return; } my $src = $opts{src}; @@ -2494,8 +2619,8 @@ sub compose { my $combine = $self->_combine($opts{combine}, 'normal'); if ($opts{mask}) { - unless ($opts{mask}{IMG}) { - $self->_set_error("compose: mask parameter empty image"); + unless ($opts{mask}->_valid_image("compose")) { + $self->_set_error($opts{mask}->errstr . " (for mask)"); return; } @@ -2507,16 +2632,20 @@ sub compose { defined $mask_top or $mask_top = $opts{mask_miny}; defined $mask_top or $mask_top = 0; - i_compose_mask($self->{IMG}, $src->{IMG}, $opts{mask}{IMG}, + unless (i_compose_mask($self->{IMG}, $src->{IMG}, $opts{mask}{IMG}, $left, $top, $src_left, $src_top, $mask_left, $mask_top, $width, $height, - $combine, $opts{opacity}) - or return; + $combine, $opts{opacity})) { + $self->_set_error(Imager->_error_as_msg); + return; + } } else { - i_compose($self->{IMG}, $src->{IMG}, $left, $top, $src_left, $src_top, - $width, $height, $combine, $opts{opacity}) - or return; + unless (i_compose($self->{IMG}, $src->{IMG}, $left, $top, $src_left, $src_top, + $width, $height, $combine, $opts{opacity})) { + $self->_set_error(Imager->_error_as_msg); + return; + } } return $self; @@ -2525,6 +2654,10 @@ sub compose { sub flip { my $self = shift; my %opts = @_; + + $self->_valid_image("flip") + or return; + my %xlate = (h=>0, v=>1, hv=>2, vh=>2); my $dir; return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}}; @@ -2543,6 +2676,9 @@ sub rotate { return; } + $self->_valid_image("rotate") + or return; + if (defined $opts{right}) { my $degrees = $opts{right}; if ($degrees < 0) { @@ -2568,7 +2704,7 @@ sub rotate { } } elsif (defined $opts{radians} || defined $opts{degrees}) { - my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180; + my $amount = $opts{radians} || $opts{degrees} * 3.14159265358979 / 180; my $back = $opts{back}; my $result = Imager->new; @@ -2602,6 +2738,9 @@ sub matrix_transform { my $self = shift; my %opts = @_; + $self->_valid_image("matrix_transform") + or return; + unless (defined wantarray) { my @caller = caller; warn "copy() called in void context - copy() returns the copied image at $caller[1] line $caller[2]\n"; @@ -2650,10 +2789,8 @@ sub box { my $self=shift; my $raw = $self->{IMG}; - unless ($raw) { - $self->{ERRSTR}='empty input image'; - return undef; - } + $self->_valid_image("box") + or return; my %opts = @_; @@ -2687,7 +2824,12 @@ sub box { $color = i_color_new(255,255,255,255); } - i_box_filled($raw, $xmin, $ymin,$xmax, $ymax, $color); + if ($color->isa("Imager::Color")) { + i_box_filled($raw, $xmin, $ymin,$xmax, $ymax, $color); + } + else { + i_box_filledf($raw, $xmin, $ymin,$xmax, $ymax, $color); + } } elsif ($opts{fill}) { unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) { @@ -2726,7 +2868,10 @@ sub box { sub arc { my $self=shift; - unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } + + $self->_valid_image("arc") + or return; + my $dflcl= [ 255, 255, 255, 255]; my $good = 1; my %opts= @@ -2828,7 +2973,9 @@ sub line { my %opts=(color=>$dflcl, endp => 1, @_); - unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } + + $self->_valid_image("line") + or return; unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; } unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; } @@ -2859,7 +3006,8 @@ sub polyline { my $dflcl=i_color_new(0,0,0,0); my %opts=(color=>$dflcl,@_); - unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } + $self->_valid_image("polyline") + or return; if (exists($opts{points})) { @points=@{$opts{points}}; } if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) { @@ -2898,7 +3046,8 @@ sub polygon { my $dflcl = i_color_new(0,0,0,0); my %opts = (color=>$dflcl, @_); - unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } + $self->_valid_image("polygon") + or return; if (exists($opts{points})) { $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ]; @@ -2945,7 +3094,8 @@ sub polybezier { my $dflcl=i_color_new(0,0,0,0); my %opts=(color=>$dflcl,@_); - unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } + $self->_valid_image("polybezier") + or return; if (exists $opts{points}) { $opts{'x'}=map { $_->[0]; } @{$opts{'points'}}; @@ -2971,6 +3121,9 @@ sub flood_fill { my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ ); my $rc; + $self->_valid_image("flood_fill") + or return; + unless (exists $opts{'x'} && exists $opts{'y'}) { $self->{ERRSTR} = "missing seed x and y parameters"; return undef; @@ -3044,6 +3197,9 @@ sub flood_fill { sub setpixel { my ($self, %opts) = @_; + $self->_valid_image("setpixel") + or return; + my $color = $opts{color}; unless (defined $color) { $color = $self->{fg}; @@ -3051,50 +3207,67 @@ sub setpixel { } unless (ref $color && UNIVERSAL::isa($color, "Imager::Color")) { - $color = _color($color) - or return undef; + unless ($color = _color($color, 'setpixel')) { + $self->_set_error("setpixel: " . Imager->errstr); + return; + } } unless (exists $opts{'x'} && exists $opts{'y'}) { - $self->{ERRSTR} = 'missing x and y parameters'; - return undef; + $self->_set_error('setpixel: missing x or y parameter'); + return; } my $x = $opts{'x'}; my $y = $opts{'y'}; - if (ref $x && ref $y) { - unless (@$x == @$y) { - $self->{ERRSTR} = 'length of x and y mismatch'; + if (ref $x || ref $y) { + $x = ref $x ? $x : [ $x ]; + $y = ref $y ? $y : [ $y ]; + unless (@$x) { + $self->_set_error("setpixel: x is a reference to an empty array"); + return; + } + unless (@$y) { + $self->_set_error("setpixel: y is a reference to an empty array"); return; } + + # make both the same length, replicating the last element + if (@$x < @$y) { + $x = [ @$x, ($x->[-1]) x (@$y - @$x) ]; + } + elsif (@$y < @$x) { + $y = [ @$y, ($y->[-1]) x (@$x - @$y) ]; + } + my $set = 0; if ($color->isa('Imager::Color')) { - for my $i (0..$#{$opts{'x'}}) { + for my $i (0..$#$x) { i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color) or ++$set; } } else { - for my $i (0..$#{$opts{'x'}}) { + for my $i (0..$#$x) { 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) - and return; + and return "0 but true"; } else { i_ppixf($self->{IMG}, $x, $y, $color) - and return; + and return "0 but true"; } - } - $self; + return 1; + } } sub getpixel { @@ -3102,48 +3275,74 @@ sub getpixel { my %opts = ( "type"=>'8bit', @_); + $self->_valid_image("getpixel") + or return; + unless (exists $opts{'x'} && exists $opts{'y'}) { - $self->{ERRSTR} = 'missing x and y parameters'; - return undef; + $self->_set_error('getpixel: missing x or y parameter'); + return; } my $x = $opts{'x'}; my $y = $opts{'y'}; - if (ref $x && ref $y) { - unless (@$x == @$y) { - $self->{ERRSTR} = 'length of x and y mismatch'; - return undef; + my $type = $opts{'type'}; + if (ref $x || ref $y) { + $x = ref $x ? $x : [ $x ]; + $y = ref $y ? $y : [ $y ]; + unless (@$x) { + $self->_set_error("getpixel: x is a reference to an empty array"); + return; + } + unless (@$y) { + $self->_set_error("getpixel: y is a reference to an empty array"); + return; + } + + # make both the same length, replicating the last element + if (@$x < @$y) { + $x = [ @$x, ($x->[-1]) x (@$y - @$x) ]; + } + elsif (@$y < @$x) { + $y = [ @$y, ($y->[-1]) x (@$x - @$y) ]; } + my @result; - if ($opts{"type"} eq '8bit') { - for my $i (0..$#{$opts{'x'}}) { + if ($type eq '8bit') { + for my $i (0..$#$x) { push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i])); } } - else { - for my $i (0..$#{$opts{'x'}}) { + elsif ($type eq 'float' || $type eq 'double') { + for my $i (0..$#$x) { push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i])); } } + else { + $self->_set_error("getpixel: type must be '8bit' or 'float'"); + return; + } return wantarray ? @result : \@result; } else { - if ($opts{"type"} eq '8bit') { + if ($type eq '8bit') { return i_get_pixel($self->{IMG}, $x, $y); } - else { + elsif ($type eq 'float' || $type eq 'double') { return i_gpixf($self->{IMG}, $x, $y); } + else { + $self->_set_error("getpixel: type must be '8bit' or 'float'"); + return; + } } - - $self; } sub getscanline { my $self = shift; my %opts = ( type => '8bit', x=>0, @_); - $self->_valid_image or return; + $self->_valid_image("getscanline") + or return; defined $opts{width} or $opts{width} = $self->getwidth - $opts{x}; @@ -3178,7 +3377,8 @@ sub setscanline { my $self = shift; my %opts = ( x=>0, @_); - $self->_valid_image or return; + $self->_valid_image("setscanline") + or return; unless (defined $opts{'y'}) { $self->_set_error("missing y parameter"); @@ -3239,6 +3439,9 @@ sub getsamples { my $self = shift; my %opts = ( type => '8bit', x=>0, offset => 0, @_); + $self->_valid_image("getsamples") + or return; + defined $opts{width} or $opts{width} = $self->getwidth - $opts{x}; unless (defined $opts{'y'}) { @@ -3246,24 +3449,20 @@ sub getsamples { return; } - unless ($opts{channels}) { - $opts{channels} = [ 0 .. $self->getchannels()-1 ]; - } - if ($opts{target}) { my $target = $opts{target}; my $offset = $opts{offset}; if ($opts{type} eq '8bit') { my @samples = i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, - $opts{y}, @{$opts{channels}}) + $opts{y}, $opts{channels}) or return; - @{$target}{$offset .. $offset + @samples - 1} = @samples; + @{$target}[$offset .. $offset + @samples - 1] = @samples; return scalar(@samples); } elsif ($opts{type} eq 'float') { my @samples = i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, - $opts{y}, @{$opts{channels}}); - @{$target}{$offset .. $offset + @samples - 1} = @samples; + $opts{y}, $opts{channels}); + @{$target}[$offset .. $offset + @samples - 1] = @samples; return scalar(@samples); } elsif ($opts{type} =~ /^(\d+)bit$/) { @@ -3272,7 +3471,7 @@ sub getsamples { my @data; my $count = i_gsamp_bits($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, $opts{y}, $bits, $target, - $offset, @{$opts{channels}}); + $offset, $opts{channels}); unless (defined $count) { $self->_set_error(Imager->_error_as_msg); return; @@ -3288,18 +3487,18 @@ sub getsamples { else { if ($opts{type} eq '8bit') { return i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, - $opts{y}, @{$opts{channels}}); + $opts{y}, $opts{channels}); } elsif ($opts{type} eq 'float') { return i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, - $opts{y}, @{$opts{channels}}); + $opts{y}, $opts{channels}); } elsif ($opts{type} =~ /^(\d+)bit$/) { my $bits = $1; my @data; i_gsamp_bits($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, - $opts{y}, $bits, \@data, 0, @{$opts{channels}}) + $opts{y}, $bits, \@data, 0, $opts{channels}) or return; return @data; } @@ -3312,35 +3511,66 @@ sub getsamples { sub setsamples { my $self = shift; - my %opts = ( x => 0, offset => 0, @_ ); - unless ($self->{IMG}) { - $self->_set_error('setsamples: empty input image'); - return; + $self->_valid_image("setsamples") + or return; + + my %opts = ( x => 0, offset => 0 ); + my $data_index; + # avoid duplicating the data parameter, it may be a large scalar + my $i = 0; + while ($i < @_ -1) { + if ($_[$i] eq 'data') { + $data_index = $i+1; + } + else { + $opts{$_[$i]} = $_[$i+1]; + } + + $i += 2; } - unless(defined $opts{data} && ref $opts{data}) { - $self->_set_error('setsamples: data parameter missing or invalid'); + unless(defined $data_index) { + $self->_set_error('setsamples: data parameter missing'); return; } - - unless ($opts{channels}) { - $opts{channels} = [ 0 .. $self->getchannels()-1 ]; + unless (defined $_[$data_index]) { + $self->_set_error('setsamples: data parameter not defined'); + return; } - unless ($opts{type} && $opts{type} =~ /^(\d+)bit$/) { - $self->_set_error('setsamples: type parameter missing or invalid'); - return; + my $type = $opts{type}; + defined $type or $type = '8bit'; + + my $width = defined $opts{width} ? $opts{width} + : $self->getwidth() - $opts{x}; + + my $count; + if ($type eq '8bit') { + $count = i_psamp($self->{IMG}, $opts{x}, $opts{y}, $opts{channels}, + $_[$data_index], $opts{offset}, $width); + } + elsif ($type eq 'float') { + $count = i_psampf($self->{IMG}, $opts{x}, $opts{y}, $opts{channels}, + $_[$data_index], $opts{offset}, $width); } - my $bits = $1; + elsif ($type =~ /^([0-9]+)bit$/) { + my $bits = $1; - unless (defined $opts{width}) { - $opts{width} = $self->getwidth() - $opts{x}; + unless (ref $_[$data_index]) { + $self->_set_error("setsamples: data must be an array ref for type not 8bit or float"); + return; + } + + $count = i_psamp_bits($self->{IMG}, $opts{x}, $opts{y}, $bits, + $opts{channels}, $_[$data_index], $opts{offset}, + $width); + } + else { + $self->_set_error('setsamples: type parameter invalid'); + return; } - my $count = i_psamp_bits($self->{IMG}, $opts{x}, $opts{y}, $bits, - $opts{channels}, $opts{data}, $opts{offset}, - $opts{width}); unless (defined $count) { $self->_set_error(Imager->_error_as_msg); return; @@ -3365,6 +3595,9 @@ sub convert { my ($self, %opts) = @_; my $matrix; + $self->_valid_image("convert") + or return; + unless (defined wantarray) { my @caller = caller; warn "convert() called in void context - convert() returns the converted image at $caller[1] line $caller[2]\n"; @@ -3460,12 +3693,53 @@ sub convert { $new->{IMG} = i_convert($self->{IMG}, $matrix); unless ($new->{IMG}) { # most likely a bad matrix + i_push_error(0, "convert"); $self->{ERRSTR} = _error_as_msg(); return undef; } return $new; } +# combine channels from multiple input images, a class method +sub combine { + my ($class, %opts) = @_; + + my $src = delete $opts{src}; + unless ($src) { + $class->_set_error("src parameter missing"); + return; + } + my @imgs; + my $index = 0; + for my $img (@$src) { + unless (eval { $img->isa("Imager") }) { + $class->_set_error("src must contain image objects"); + return; + } + unless ($img->_valid_image("combine")) { + $Imager::ERRSTR = $img->{ERRSTR} . " (src->[$index])"; + return; + } + push @imgs, $img->{IMG}; + } + my $result; + if (my $channels = delete $opts{channels}) { + $result = i_combine(\@imgs, $channels); + } + else { + $result = i_combine(\@imgs); + } + unless ($result) { + $class->_set_error($class->_error_as_msg); + return; + } + + my $img = $class->new; + $img->{IMG} = $result; + + return $img; +} + # general function to map an image through lookup tables @@ -3473,6 +3747,9 @@ sub map { my ($self, %opts) = @_; my @chlist = qw( red green blue alpha ); + $self->_valid_image("map") + or return; + if (!exists($opts{'maps'})) { # make maps from channel maps my $chnum; @@ -3493,15 +3770,17 @@ sub map { sub difference { my ($self, %opts) = @_; + $self->_valid_image("difference") + or return; + defined $opts{mindist} or $opts{mindist} = 0; defined $opts{other} or return $self->_set_error("No 'other' parameter supplied"); - defined $opts{other}{IMG} - or return $self->_set_error("No image data in 'other' image"); - - $self->{IMG} - or return $self->_set_error("No image data"); + unless ($opts{other}->_valid_image("difference")) { + $self->_set_error($opts{other}->errstr . " (other image)"); + return; + } my $result = Imager->new; $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG}, @@ -3525,12 +3804,10 @@ sub border { sub getwidth { my $self = shift; - if (my $raw = $self->{IMG}) { - return i_img_get_width($raw); - } - else { - $self->{ERRSTR} = 'image is empty'; return undef; - } + $self->_valid_image("getwidth") + or return; + + return i_img_get_width($self->{IMG}); } # Get the height of an image @@ -3538,19 +3815,20 @@ sub getwidth { sub getheight { my $self = shift; - if (my $raw = $self->{IMG}) { - return i_img_get_height($raw); - } - else { - $self->{ERRSTR} = 'image is empty'; return undef; - } + $self->_valid_image("getheight") + or return; + + return i_img_get_height($self->{IMG}); } # Get number of channels in an image sub getchannels { my $self = shift; - if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; } + + $self->_valid_image("getchannels") + or return; + return i_img_getchannels($self->{IMG}); } @@ -3558,7 +3836,10 @@ sub getchannels { sub getmask { my $self = shift; - if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; } + + $self->_valid_image("getmask") + or return; + return i_img_getmask($self->{IMG}); } @@ -3567,14 +3848,15 @@ sub getmask { sub setmask { my $self = shift; my %opts = @_; - if (!defined($self->{IMG})) { - $self->{ERRSTR} = 'image is empty'; - return undef; - } + + $self->_valid_image("setmask") + or return; + unless (defined $opts{mask}) { $self->_set_error("mask parameter required"); return; } + i_img_setmask( $self->{IMG} , $opts{mask} ); 1; @@ -3585,7 +3867,10 @@ sub setmask { sub getcolorcount { my $self=shift; my %opts=('maxcolors'=>2**30,@_); - if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; } + + $self->_valid_image("getcolorcount") + or return; + my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'}); return ($rc==-1? undef : $rc); } @@ -3594,7 +3879,10 @@ sub getcolorcount { # values are the number of pixels in this colour. sub getcolorusagehash { my $self = shift; - + + $self->_valid_image("getcolorusagehash") + or return; + my %opts = ( maxcolors => 2**30, @_ ); my $max_colors = $opts{maxcolors}; unless (defined $max_colors && $max_colors > 0) { @@ -3602,11 +3890,6 @@ sub getcolorusagehash { return; } - unless (defined $self->{IMG}) { - $self->_set_error('empty input image'); - return; - } - my $channels= $self->getchannels; # We don't want to look at the alpha channel, because some gifs using it # doesn't define it for every colour (but only for some) @@ -3630,6 +3913,9 @@ sub getcolorusagehash { sub getcolorusage { my $self = shift; + $self->_valid_image("getcolorusage") + or return; + my %opts = ( maxcolors => 2**30, @_ ); my $max_colors = $opts{maxcolors}; unless (defined $max_colors && $max_colors > 0) { @@ -3637,11 +3923,6 @@ sub getcolorusage { return; } - unless (defined $self->{IMG}) { - $self->_set_error('empty input image'); - return undef; - } - return i_get_anonymous_color_histo($self->{IMG}, $max_colors); } @@ -3649,7 +3930,9 @@ sub getcolorusage { sub string { my $self = shift; - unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } + + $self->_valid_image("string") + or return; my %input=('x'=>0, 'y'=>0, @_); defined($input{string}) or $input{string} = $input{text}; @@ -3676,10 +3959,9 @@ sub align_string { my $img; if (ref $self) { - unless ($self->{IMG}) { - $self->{ERRSTR}='empty input image'; - return; - } + $self->_valid_image("align_string") + or return; + $img = $self; } else { @@ -3734,6 +4016,41 @@ sub get_file_limits { i_get_image_file_limits(); } +my @check_args = qw(width height channels sample_size); + +sub check_file_limits { + my $class = shift; + + my %opts = + ( + channels => 3, + sample_size => 1, + @_, + ); + + if ($opts{sample_size} && $opts{sample_size} eq 'float') { + $opts{sample_size} = length(pack("d", 0)); + } + + for my $name (@check_args) { + unless (defined $opts{$name}) { + $class->_set_error("check_file_limits: $name must be defined"); + return; + } + unless ($opts{$name} == int($opts{$name})) { + $class->_set_error("check_file_limits: $name must be a positive integer"); + return; + } + } + + my $result = i_int_check_image_file_limits(@opts{@check_args}); + unless ($result) { + $class->_set_error($class->_error_as_msg()); + } + + return $result; +} + # Shortcuts that can be exported sub newcolor { Imager::Color->new(@_); } @@ -3770,21 +4087,39 @@ sub _set_error { # Default guess for the type of an image from extension +my @simple_types = qw(png tga gif raw ico cur xpm mng jng ilbm pcx psd eps); + +my %ext_types = + ( + ( map { $_ => $_ } @simple_types ), + tiff => "tiff", + tif => "tiff", + pbm => "pnm", + pgm => "pnm", + ppm => "pnm", + pnm => "pnm", # technically wrong, but historically it works in Imager + jpeg => "jpeg", + jpg => "jpeg", + bmp => "bmp", + dib => "bmp", + rgb => "sgi", + bw => "sgi", + sgi => "sgi", + fit => "fits", + fits => "fits", + rle => "utah", + ); + sub def_guess_type { my $name=lc(shift); - my $ext; - $ext=($name =~ m/\.([^\.]+)$/)[0]; - return 'tiff' if ($ext =~ m/^tiff?$/); - return 'jpeg' if ($ext =~ m/^jpe?g$/); - return 'pnm' if ($ext =~ m/^p[pgb]m$/); - return 'png' if ($ext eq "png"); - return 'bmp' if ($ext eq "bmp" || $ext eq "dib"); - return 'tga' if ($ext eq "tga"); - return 'sgi' if ($ext eq "rgb" || $ext eq "bw" || $ext eq "sgi" || $ext eq "rgba"); - return 'gif' if ($ext eq "gif"); - return 'raw' if ($ext eq "raw"); - return lc $ext; # best guess - return (); + + my ($ext) = $name =~ /\.([^.]+)$/ + or return; + + my $type = $ext_types{$ext} + or return; + + return $type; } sub combines { @@ -3873,6 +4208,64 @@ sub Inline { # threads shouldn't try to close raw Imager objects sub Imager::ImgRaw::CLONE_SKIP { 1 } +sub preload { + # this serves two purposes: + # - a class method to load the file support modules included with Imager + # (or were included, once the library dependent modules are split out) + # - something for Module::ScanDeps to analyze + # https://rt.cpan.org/Ticket/Display.html?id=6566 + local $@; + eval { require Imager::File::GIF }; + eval { require Imager::File::JPEG }; + eval { require Imager::File::PNG }; + eval { require Imager::File::SGI }; + eval { require Imager::File::TIFF }; + eval { require Imager::File::ICO }; + eval { require Imager::Font::W32 }; + eval { require Imager::Font::FT2 }; + eval { require Imager::Font::T1 }; +} + +package Imager::IO; +use IO::Seekable; + +sub new_fh { + my ($class, $fh) = @_; + + if (tied(*$fh)) { + return $class->new_cb + ( + sub { + local $\; + + return print $fh $_[0]; + }, + sub { + my $tmp; + my $count = CORE::read $fh, $tmp, $_[1]; + defined $count + or return undef; + $count + or return ""; + return $tmp; + }, + sub { + if ($_[1] != SEEK_CUR || $_[0] != 0) { + unless (CORE::seek $fh, $_[0], $_[1]) { + return -1; + } + } + + return tell $fh; + }, + undef, + ); + } + else { + return $class->_new_perlio($fh); + } +} + # backward compatibility for %formats package Imager::FORMATS; use strict; @@ -3892,10 +4285,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; @@ -3996,7 +4395,7 @@ Imager - Perl extension for Generating 24 bit Images my $format; # see Imager::Files for information on the read() method - my $im = Imager->new(file=>$file) + my $img = Imager->new(file=>$file) or die Imager->errstr(); $file =~ s/\.[^.]*$//; @@ -4041,6 +4440,10 @@ Overview. =item * +L - installation notes for Imager. + +=item * + L - a brief introduction to Imager. =item * @@ -4107,6 +4510,10 @@ L - Helper for making gradient profiles. =item * +L - Imager I/O abstraction. + +=item * + L - using Imager's C API =item * @@ -4121,6 +4528,14 @@ L - using Imager's C API from Inline::C L - tools to get access to Imager's C API. +=item * + +L - brief security notes. + +=item * + +L - brief information on working with threads. + =back =head2 Basic Overview @@ -4147,7 +4562,7 @@ the C method to find out why: =over -=item C +=item errstr() Returns the last error message in that context. @@ -4175,230 +4590,256 @@ L. Where to find information on methods for Imager class objects. -addcolors() - L - add colors to a +addcolors() - L - add colors to a paletted image -addtag() - L - add image tags +addtag() - L - add image tags -align_string() - L - draw text aligned on a +align_string() - L - draw text aligned on a point -arc() - L - draw a filled arc +arc() - L - draw a filled arc -bits() - L - number of bits per sample for the +bits() - L - number of bits per sample for the image -box() - L - draw a filled or outline box. +box() - L - draw a filled or outline box. + +check_file_limits() - L + +circle() - L - draw a filled circle -circle() - L - draw a filled circle +close_log() - L - close the Imager +debugging log. -colorcount() - L - the number of colors in an -image's palette (paletted images only) +colorcount() - L - the number of +colors in an image's palette (paletted images only) -combines() - L - return a list of the different -combine type keywords +combine() - L - combine channels +from one or more images. -compose() - L - compose one image +combines() - L - return a list of the +different combine type keywords + +compose() - L - compose one image over another. -convert() - L - -transform the color space +convert() - L - transform the color +space -copy() - L - make a duplicate of an +copy() - L - make a duplicate of an image -crop() - L - extract part of an image +crop() - L - extract part of an image -def_guess_type() - L - default function +def_guess_type() - L - default function used to guess the output file format based on the output file name -deltag() - L - delete image tags +deltag() - L - delete image tags -difference() - L - produce a -difference images from two input images. +difference() - L - produce a difference +images from two input images. -errstr() - L<"Basic Overview"> - the error from the last failed -operation. +errstr() - L - the error from the last failed operation. -filter() - L - image filtering +filter() - L - image filtering -findcolor() - L - search the image +findcolor() - L - search the image palette, if it has one -flip() - L - flip an image, vertically, +flip() - L - flip an image, vertically, horizontally -flood_fill() - L - fill an enclosed or same +flood_fill() - L - fill an enclosed or same color area -getchannels() - L - the number of +getchannels() - L - the number of samples per pixel for an image -getcolorcount() - L - the number of +getcolorcount() - L - the number of different colors used by an image (works for direct color images) -getcolors() - L - get colors from the image +getcolors() - L - get colors from the image palette, if it has one -getcolorusage() - L +getcolorusage() - L -getcolorusagehash() - L +getcolorusagehash() - L -get_file_limits() - L +get_file_limits() - L -getheight() - L - height of the image in +getheight() - L - height of the image in pixels -getmask() - L - write mask for the image +getmask() - L - write mask for the image -getpixel() - L - retrieve one or more pixel +getpixel() - L - retrieve one or more pixel colors -getsamples() - L - retrieve samples from a +getsamples() - L - retrieve samples from a row or partial row of pixels. -getscanline() - L - retrieve colors for a +getscanline() - L - retrieve colors for a row or partial row of pixels. -getwidth() - L - width of the image in +getwidth() - L - width of the image in pixels. -img_set() - L - re-use an Imager object +img_set() - L - re-use an Imager object for a new image. -init() - L +init() - L -is_bilevel() - L - returns whether +is_bilevel() - L - returns whether image write functions should write the image in their bilevel (blank and white, no gray levels) format -line() - L - draw an interval +is_logging() L - test if the debug +log is active. + +line() - L - draw an interval + +load_plugin() - L + +log() - L - send a message to the debugging +log. -load_plugin() - L +make_palette() - L - produce a +color palette from one or more input images. -map() - L - remap color +map() - L - remap color channel values -masked() - L - make a masked image +masked() - L - make a masked image -matrix_transform() - L +matrix_transform() - L -maxcolors() - L +maxcolors() - L -NC() - L +NC() - L -NCF() - L +NCF() - L -new() - L +new() - L -newcolor() - L +newcolor() - L -newcolour() - L +newcolour() - L -newfont() - L +newfont() - L -NF() - L +NF() - L -open() - L - an alias for read() +open() - L - an alias for read() + +open_log() - L - open the debug log. =for stopwords IPTC -parseiptc() - L - parse IPTC data from a JPEG +parseiptc() - L - parse IPTC data from a JPEG +image + +paste() - L - draw an image onto an image -paste() - L - draw an image onto an image +polygon() - L -polygon() - L +polyline() - L -polyline() - L +preload() - L -read() - L - read a single image from an image file +read() - L - read a single image from an image file -read_multi() - L - read multiple images from an image +read_multi() - L - read multiple images from an image file -read_types() - L - list image types Imager +read_types() - L - list image types Imager can read. -register_filter() - L +register_filter() - L + +register_reader() - L -register_reader() - L +register_writer() - L -register_writer() - L +rotate() - L -rotate() - L +rubthrough() - L - draw an image +onto an image and use the alpha channel -rubthrough() - L - draw an image onto an -image and use the alpha channel +scale() - L -scale() - L +scale_calculate() - L -scale_calculate() - L +scaleX() - L -scaleX() - L +scaleY() - L -scaleY() - L +setcolors() - L - set palette colors +in a paletted image -setcolors() - L - set palette colors in -a paletted image +set_file_limits() - L -set_file_limits() - L +setmask() - L -setmask() - L +setpixel() - L -setpixel() - L +setsamples() - L -setsamples() - L +setscanline() - L -setscanline() - L +settag() - L -settag() - L +string() - L - draw text on an image -string() - L - draw text on an image +tags() - L - fetch image tags -tags() - L - fetch image tags +to_paletted() - L -to_paletted() - L +to_rgb16() - L -to_rgb16() - L +to_rgb8() - L -to_rgb8() - L +to_rgb_double() - L - convert to +double per sample image. -transform() - L +transform() - L -transform2() - L +transform2() - L -type() - L - type of image (direct vs paletted) +type() - L - type of image (direct vs paletted) -unload_plugin() - L +unload_plugin() - L -virtual() - L - whether the image has it's own +virtual() - L - whether the image has it's own data -write() - L - write an image to a file +write() - L - write an image to a file -write_multi() - L - write multiple image to an image +write_multi() - L - write multiple image to an image file. -write_types() - L - list image types Imager +write_types() - L - list image types Imager can write. =head1 CONCEPT INDEX animated GIF - L -aspect ratio - L, -L, L +aspect ratio - C, C, C in +L. blend - alpha blending one image onto another -L +L -blur - L, L +blur - L, L -boxes, drawing - L +boxes, drawing - L changes between image - L +channels, combine into one image - L + color - L color names - L, L @@ -4411,22 +4852,22 @@ contrast - L, L convolution - L -cropping - L +cropping - L CUR files - L C images - L -dpi - L, +dpi - C, C in L, L -drawing boxes - L +drawing boxes - L -drawing lines - L +drawing lines - L -drawing text - L, L +drawing text - L, L -error message - L<"ERROR HANDLING"> +error message - L files, font - L @@ -4434,18 +4875,18 @@ files, image - L filling, types of fill - L -filling, boxes - L +filling, boxes - L -filling, flood fill - L +filling, flood fill - L -flood fill - L +flood fill - L fonts - L -fonts, drawing with - L, -L, L +fonts, drawing with - L, +L, L -fonts, metrics - L, L +fonts, metrics - L, L fonts, multiple master - L @@ -4455,15 +4896,15 @@ L GIF files - L -GIF files, animated - L +GIF files, animated - L gradient fill - L, L, L, L -gray scale, convert image to - L +gray scale, convert image to - L -guassian blur - L +gaussian blur - L hatch fills - L @@ -4476,13 +4917,13 @@ JPEG - L limiting image sizes - L -lines, drawing - L +lines, drawing - L matrix - L, -L, -L +L, +L -metadata, image - L +metadata, image - L, L mosaic - L @@ -4491,11 +4932,11 @@ noise, filter - L noise, rendered - L, L -paste - L, -L +paste - L, +L -pseudo-color image - L, -L +pseudo-color image - L, +L =for stopwords posterize @@ -4505,37 +4946,44 @@ PNG files - L, L PNM - L -rectangles, drawing - L +rectangles, drawing - L -resizing an image - L, -L +resizing an image - L, +L RGB (SGI) files - L saving an image - L -scaling - L +scaling - L + +security - L SGI files - L sharpen - L, L -size, image - L, -L +size, image - L, +L -size, text - L +size, text - L tags, image metadata - L -text, drawing - L, L, +text, drawing - L, L, L text, wrapping text in an area - L -text, measuring - L, L +text, measuring - L, L + +threads - L tiles, color - L +transparent images - L, +L + =for stopwords unsharp unsharp mask - L @@ -4544,15 +4992,6 @@ watermark - L writing an image to a file - L -=head1 THREADS - -Imager doesn't support perl threads. - -Imager has limited code to prevent double frees if you create images, -colors etc, and then create a thread, but has no code to prevent two -threads entering Imager's error handling code, and none is likely to -be added. - =head1 SUPPORT The best place to get help with Imager is the mailing list. @@ -4620,22 +5059,52 @@ Tracker. =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. +I accept patches, preferably against the master branch in git. Please +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. +To browse Imager's git repository: + + http://git.imager.perl.org/imager.git + +To clone: + + git clone git://git.imager.perl.org/imager.git + +My preference is that patches are provided in the format produced by +C, for example, if you made your changes in a branch +from master you might do: + + git format-patch -k --stdout master >my-patch.txt + +and then attach that to your bug report, either by adding it as an +attachment in your email client, or by using the Request Tracker +attachment mechanism. + =head1 AUTHOR -Tony Cook is the current maintainer for Imager. +Tony Cook is the current maintainer for Imager. Arnar M. Hrafnkelsson is the original author of Imager. Many others have contributed to Imager, please see the C for a complete list. +=head1 LICENSE + +Imager is licensed under the same terms as perl itself. + +=for stopwords +makeblendedfont Fontforge + +A test font, generated by the Debian packaged Fontforge, +F, contains a Postscript operator definition +copyrighted by Adobe. See F in the source for license +information. + =head1 SEE ALSO L(1), L(3), L(3), @@ -4650,6 +5119,13 @@ L(3), L(3) Other perl imaging modules include: -L(3), L(3), L(3). +L(3), L(3), +L(3), +L, L. + +For manipulating image metadata see L. + +If you're trying to use Imager for array processing, you should +probably using L. =cut