diff options
| -rwxr-xr-x | mkindex.pl | 39 |
1 files changed, 20 insertions, 19 deletions
@@ -162,9 +162,9 @@ Requires L<gdalwarp|http://gdal.org/> available on the command line. Requires the perl modules L<Inline|http://search.cpan.org/~sisyphus/Inline-0.53/C/C.pod>, L<Geo::GDAL|http://geoinformatics.aalto.fi/doc/Geo-GDAL/html/>, -L<Geo::OSR|http://geoinformatics.aalto.fi/doc/Geo-GDAL/html/> and -L<Image::Magick|http://www.imagemagick.org/script/perl-magick.php>, -all available on L<CPAN|http://www.cpan.org/>. +L<Geo::OSR|http://geoinformatics.aalto.fi/doc/Geo-GDAL/html/>, and +L<Image::Magick|http://www.imagemagick.org/script/perl-magick.php>. +They are all available on L<CPAN|http://www.cpan.org/>. =back @@ -191,10 +191,10 @@ use Image::Magick; my %config = ( progress => sub { # Geo::GDAL::TermProgress_nocb writes to STDOUT - open my $x, '>&', \*STDOUT or die "Can't dup STDOUT: $!"; - open STDOUT, '>&', STDERR or die "Can't dup STDERR: $!"; + open my $x, '>&', \*STDOUT or die "Error: Can't dup STDOUT: $!"; + open STDOUT, '>&', STDERR or die "Error: Can't dup STDERR: $!"; Geo::GDAL::TermProgress_nocb(@_[0,1]); - open STDOUT, '>&', $x or die "Can't dup X: $!"; + open STDOUT, '>&', $x or die "Error: Can't dup X: $!"; close $x; } , debug => 0 @@ -221,17 +221,17 @@ GetOptions( "q|quiet" => sub { delete $config{progress} } } , "r|resampling=s"=> \$config{resampling} , "b|border=s"=> sub { if ($_[1] =~ /^(?<b>\d*)(?<bc>:.*)?$/) { - $config{border} = $+{b} if $+{b}; - $config{bordercolor} = $1 if $+{bc} =~ /^:(.+)/; + $config{border} = $+{b} if ($+{b} // ''); + $config{bordercolor} = $1 if ($+{bc} // '') =~ /^:(.+)/; } else { pod2usage(2); } } , "f|font=s" => sub { if ($_[1] =~ /^(?<fs>\d*)(?<fc>:.*)?(?<f>:[^:]*)?$/) { - $config{fontsize} = $+{fs} if $+{fs}; - $config{fontcolor} = $1 if $+{fc} =~ /^:(.+)/; - $config{font} = $1 if $+{f} =~ /^:(.+)/; + $config{fontsize} = $+{fs} if $+{fs} // ''; + $config{fontcolor} = $1 if ($+{fc} // '') =~ /^:(.+)/; + $config{font} = $1 if ($+{f} // '') =~ /^:(.+)/; } else { pod2usage(2); @@ -287,8 +287,8 @@ foreach my $map (@mapset) { warn "WARN: To fix '$name', run the following command in a POSIX-compatible shell.\n"; warn "WARN: This is a lossless and usually size-preserving conversion.\n"; my $old = $name; - my ($new,$path,$suffix) = fileparse ($name, qr/\.[^.]*$/); - $new = File::Spec->catfile($path,$new.'_new'.$suffix); + my ($new,$path,$ext) = fileparse ($name, qr/\.[^.]*$/); + $new = File::Spec->catfile($path,$new.'_new'.$ext); my $driver = $ds->GetDriver()->{ShortName}; my %opts = %$gdal_opts; my $compress = $ds->GetMetadata('IMAGE_STRUCTURE')->{COMPRESSION}; @@ -362,6 +362,7 @@ my $driver_type = 'Byte'; die "Error: Unknown driver: '$driver'.\n" unless Geo::GDAL::GetDriverByName($driver); $driver_opts->{$_} //= $gdal_opts->{$_} for (keys %$gdal_opts); +my $driver_ext = Geo::GDAL::GetDriverByName($driver)->Extension(); map &expand_rgba($_), @mapset; my $mosaic = &merge(); @@ -408,7 +409,7 @@ sub expand_rgba { $lookup->[$_] .= chr $e[$_] for (0 .. $dst_nb-1); } - $map->{filename} = &tempfile(SUFFIX => '.tif'); + $map->{filename} = &tempfile(SUFFIX => '.'.$driver_ext); my ($xSize, $ySize) = $src_ds->Size(); my $dst_ds = Geo::GDAL::GetDriverByName($driver)->Create( $map->{filename} , $xSize @@ -455,7 +456,7 @@ sub expand_rgba { # GDALSuggestedWarpOutput() is not available in the Perl (or Python) # API. sub merge { - my $dst_filename = &tempfile(SUFFIX => '.tif'); + my $dst_filename = &tempfile(SUFFIX => '.'.$driver_ext); &debug("Wrapping into file '$dst_filename'..."); my @opts; @@ -480,11 +481,11 @@ sub merge { { # gdalwarp writes to STDOUT; we add >&2 - open my $x, '>&', \*STDOUT or die "Can't dup STDOUT: $!"; - open STDOUT, '>&', STDERR or die "Can't dup STDERR: $!"; + open my $x, '>&', \*STDOUT or die "Error: Can't dup STDOUT: $!"; + open STDOUT, '>&', STDERR or die "Error: Can't dup STDERR: $!"; system 'gdalwarp', @opts, @src_filenames, $dst_filename; - $? == 0 or die "gdalwarp failed.\n"; - open STDOUT, '>&', $x or die "Can't dup X: $!"; + $? == 0 or die "Error: gdalwarp failed.\n"; + open STDOUT, '>&', $x or die "Error: Can't dup X: $!"; close $x; } return $dst_filename; |