From 50c425d49b0bf824c88e34a6167b6e9392829bcb Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 15 Aug 2013 04:09:24 +0200 Subject: wibble --- mkindex.pl | 39 ++++++++++++++++++++------------------- 1 file 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 available on the command line. Requires the perl modules L, L, -L and -L, -all available on L. +L, and +L. +They are all available on L. =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] =~ /^(?\d*)(?:.*)?$/) { - $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] =~ /^(?\d*)(?:.*)?(?:[^:]*)?$/) { - $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