summaryrefslogtreecommitdiffstats
path: root/mkindex.pl
diff options
context:
space:
mode:
Diffstat (limited to 'mkindex.pl')
-rwxr-xr-xmkindex.pl39
1 files changed, 20 insertions, 19 deletions
diff --git a/mkindex.pl b/mkindex.pl
index bfbca3d..912fd55 100755
--- a/mkindex.pl
+++ b/mkindex.pl
@@ -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;