| Subject: | Bug and solution at PDL/IO/Pic.pm 2.4.2, wpic function |
If I call PDL::IO::Pic::wpic:
wpic( $image->slice(":,:,-1:0"),
"$Name.jpg",
{
CONVERTER => 'cjpeg-mmx',
FORMAT => 'JPEG',
FLAGS => '-quality 100 -progressive -verbose',
}
);
Line 473, at sub wpic, we call getconv sub to get the parameters of conversion.
my ($conv, $flags, $format, $referral) = getconv($pdl,$file,$hints);
but getconv return two values (at line 893) if wpic is called with CONVERTER flag set:
return ($$hints{CONVERTER},$$hints{FLAGS})
if defined($$hints{CONVERTER});
So, wpic, at line 494
($pdl,$iform) = chkpdl($pdl,$iform,$hints,$format);
call chkpdl sub with undefined values, then, at chlpdl sub, line 940:
(!$converter{$format}->{ushortok} && $pdl->get_datatype == $PDL_US)) {
show a warning for uninitialized value (because the undefined $format variable):
Use of uninitialized value in hash element at (eval
164)[/usr/share/perl/5.8/SelfLoader.pm:38] line 4 (#1)
Use of uninitialized value in hash element at (eval 164)[/usr/share/perl/5.8/SelfLoader.pm:38] line 4.
at (eval 164)[/usr/share/perl/5.8/SelfLoader.pm:38] line 4
PDL::IO::Pic::chkpdl('PDL=SCALAR(0x95acf14)', 'PPM', 'HASH(0x95acef0)', 'undef') called at /usr/lib/perl5/PDL/IO/Pic.pm line 494
PDL::wpic('PDL=SCALAR(0x95acf14)', 'TERRA_721_20051212.jpg', 'HASH(0x95f9a58)') called at /usr/local/bin/tragsatec_modis_721.pl line 665
main::ProcesaBandas('O') called at /usr/local/bin/tragsatec_modis_721.pl line 157
PDL::IO::Pic::chkpdl((eval 164)[/usr/share/perl/5.8/SelfLoader.pm:38]:11):
Solution:
=========
Rewrite getconv subroutine from:
888 sub getconv {
889 my ($pdl,$file,$hints) = @_;
890
891 return ($$hints{CONVERTER},$$hints{FLAGS})
892 if defined($$hints{CONVERTER}); # somebody knows what he is doing
893
894 my $type = "";
895 if (defined($$hints{'FORMAT'})) {
896 $type = $$hints{'FORMAT'};
897 barf "unsupported (output) image format"
898 unless (exists($converter{$type})
899 && $converter{$type}->{'put'} !~ /NA/);
900 }
901 else {
902 $type = chkext(getext($file),1);
903 if ($type =~ /UNKNOWN/) {
904 barf "can't figure out desired file type, using PNM" ;
905 $type = 'PNM';
906 }
907 }
908
909 my $conv = $converter{$type}->{'put'};
910
911 # the datatype check is only a dirty fix for the ppmquant problem with
912 # types > byte
913 # a ppmquant is anyway only warranted when $isrgb!!!
914 $conv = $converter{$type}->{Prefilt}.$conv
915 if defined($converter{$type}->{Prefilt});
916
917 my $flags = $converter{$type}->{FLAGS};
918 $flags = "$Dflags" unless defined($flags);
919 $flags .= " $$hints{XTRAFLAGS}" if defined($$hints{XTRAFLAGS});
920 if (defined($$hints{'COLOR'}) && $$hints{'COLOR'} =~ /bwdither/) {
921 $flags = " | $conv $flags";
922 $conv = "pgmtopbm -floyd"; }
923
924 my($referral) = $converter{$type}->{referral};
925
926 return ($conv, $flags, $type, $referral);
927 }
928
to:
890 sub getconv {
891 my ($pdl,$file,$hints) = @_;
892
893 my $type = "";
894 if (defined($$hints{'FORMAT'})) {
895 $type = $$hints{'FORMAT'};
896 barf "unsupported (output) image format"
897 unless (exists($converter{$type})
898 && $converter{$type}->{'put'} !~ /NA/);
899 }
900 else {
901 $type = chkext(getext($file),1);
902 if ($type =~ /UNKNOWN/) {
903 barf "can't figure out desired file type, using PNM" ;
904 $type = 'PNM';
905 }
906 }
907
908 my($referral) = $converter{$type}->{referral};
909
910 return ($$hints{CONVERTER},$$hints{FLAGS},$type,$referral)
911 if defined($$hints{CONVERTER}); # somebody knows what he is doing
912
913 my $conv = $converter{$type}->{'put'};
914
915 # the datatype check is only a dirty fix for the ppmquant problem with
916 # types > byte
917 # a ppmquant is anyway only warranted when $isrgb!!!
918 $conv = $converter{$type}->{Prefilt}.$conv
919 if defined($converter{$type}->{Prefilt});
920
921 my $flags = $converter{$type}->{FLAGS};
922 $flags = "$Dflags" unless defined($flags);
923 $flags .= " $$hints{XTRAFLAGS}" if defined($$hints{XTRAFLAGS});
924 if (defined($$hints{'COLOR'}) && $$hints{'COLOR'} =~ /bwdither/) {
925 $flags = " | $conv $flags";
926 $conv = "pgmtopbm -floyd"; }
927
928 return ($conv, $flags, $type, $referral);
929 }
In other words:
1. move the declaration of $referral below the "if (defined($$hints{'FORMAT'})) {",
2. move the "return ... if defined($$hints{CONVERTER});" below this line, and
3. rewrite the return to add two more parameters ($type and $referral).
Diff file:
==========
891,893d892
< return ($$hints{CONVERTER},$$hints{FLAGS})
< if defined($$hints{CONVERTER}); # somebody knows what he is doing
<
908a908,912
Show quoted text
> my($referral) = $converter{$type}->{referral};
>
> return ($$hints{CONVERTER},$$hints{FLAGS},$type,$referral)
> if defined($$hints{CONVERTER}); # somebody knows what he is doing
>
924,925d927
< my($referral) = $converter{$type}->{referral};
<