From 50c425d49b0bf824c88e34a6167b6e9392829bcb Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Thu, 15 Aug 2013 04:09:24 +0200
Subject: wibble

---
 mkindex.pl | 39 ++++++++++++++++++++-------------------
 1 file changed, 20 insertions(+), 19 deletions(-)

(limited to 'mkindex.pl')

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;
-- 
cgit v1.2.3