1use strict; 2use warnings; 3use Test::More qw(no_plan); 4BEGIN { use_ok('Geo::GDAL') }; 5 6use vars qw/%available_driver %test_driver $loaded $verbose @types @fails @tested_drivers/; 7 8$loaded = 1; 9 10$verbose = $ENV{VERBOSE}; 11 12# tests: 13# 14# for pre-tested GDAL drivers: 15# Create dataset 16# Get/SetGeoTransform 17# Get/SetNoDataValue 18# Colortable operations 19# WriteRaster 20# Open dataset 21# ReadRaster 22# GCPs 23# 24# not yet tested: 25# Overviews 26# 27# if verbose = 1, all operations (skip,fail,ok) are printed out 28 29system "rm -rf tmp_ds_*" unless $^O eq 'MSWin32'; 30 31{ 32 # test memory files 33 my $fp = Geo::GDAL::VSIFOpenL('/vsimem/x', 'w'); 34 my $c = Geo::GDAL::VSIFWriteL("hello world!\n", $fp); 35 ok($c == 13, 'Wrote 13 characters to a memory file.'); 36 Geo::GDAL::VSIFCloseL($fp); 37 $fp = Geo::GDAL::VSIFOpenL('/vsimem/x', 'r'); 38 my $b = Geo::GDAL::VSIFReadL(40, $fp); 39 ok($b eq "hello world!\n", 'Read back what I Wrote to a memory file.'); 40 Geo::GDAL::VSIFCloseL($fp); 41 Geo::GDAL::Unlink('/vsimem/x'); 42} 43 44{ 45 my $driver = Geo::GDAL::GetDriver('MEM'); 46 my $dataset = $driver->Create('tmp', 10, 10, 3 , 'Int32', {}); 47 ok($dataset->isa('Geo::GDAL::Dataset'), 'Geo::GDAL::Dataset'); 48 ok($dataset->{RasterXSize} == 10, "Geo::GDAL::Dataset::RasterXSize $dataset->{RasterXSize}"); 49 ok($dataset->{RasterCount} == 3, "Geo::GDAL::Dataset::RasterCount $dataset->{RasterCount}"); 50 my $drv = $dataset->GetDriver; 51 ok($drv->isa('Geo::GDAL::Driver'), 'Geo::GDAL::Dataset::GetDriver'); 52 my @size = $dataset->Size(); 53 ok(is_deeply([10,10], \@size), "Geo::GDAL::Dataset::Size @size"); 54 my $r = $dataset->GetRasterBand(1); 55 my $g = $dataset->GetRasterBand(2); 56 my $b = $dataset->GetRasterBand(3); 57 58 $b->WriteTile([ 59 [1,2,3,4,5,6,7,8,9,10], 60 [1,2,3,4,5,6,7,8,9,10], 61 [1,2,3,4,5,6,7,8,9,10], 62 [1,2,3,0,0,0,0,8,9,10], 63 [1,2,3,0,0,0,0,8,9,10], 64 [1,2,3,0,0,0,0,8,9,10], 65 [1,2,3,0,0,0,0,8,9,10], 66 [1,2,3,4,5,6,7,8,9,10], 67 [1,2,3,4,5,6,7,8,9,10], 68 [1,2,3,4,5,6,7,8,9,10] 69 ]); 70 $r->WriteTile([ 71 [1,2,3,4,5,6,7,8,9,10], 72 [1,2,3,4,5,6,7,8,9,10], 73 [1,2,3,4,5,6,7,8,9,10], 74 [1,2,3,0,0,0,0,8,9,10], 75 [1,2,3,0,0,0,0,8,9,10], 76 [1,2,3,0,0,0,0,8,9,10], 77 [1,2,3,0,0,0,0,8,9,10], 78 [1,2,3,4,5,6,7,8,9,10], 79 [1,2,3,4,5,6,7,8,9,10], 80 [1,2,3,4,5,6,7,8,9,10] 81 ]); 82 $g->WriteTile($b->ReadTile); 83 $b->FillNodata($r); 84 #print STDERR "@$_\n" for (@{$b->ReadTile()}); 85 86 my @histogram; 87 eval { 88 @histogram = $b->GetHistogram(); 89 }; 90 ok($#histogram == 255, "Histogram"); 91 eval { 92 $b->SetDefaultHistogram(1,10,[0..255]); 93 }; 94 my ($min, $max, $histogram); 95 eval { 96 ($min,$max,$histogram) = $b->GetDefaultHistogram(); 97 }; 98 ok(($#$histogram == 255), "Default Histogram $#histogram == 255"); 99 eval { 100 @histogram = $b->GetHistogram(Min=>0, Max=>100, Buckets=>20); 101 }; 102 ok($#histogram == 19, "Histogram with parameters"); 103 104 Geo::GDAL::RegenerateOverview($r, $b, 'GAUSS'); 105 106 my $band = $r; 107 108 my $colors = $band->ColorTable(Geo::GDAL::ColorTable->new); 109 my @table = $colors->ColorTable([10,20,30,40],[20,20,30,40]); 110 for (@table) { 111 @$_ = (1,2,3,4) if $_->[0] == 10; 112 } 113 my @table2 = $colors->ColorTable(@table); 114 ok($table[1]->[1] == 20, "colortable 1"); 115 ok($table2[0]->[2] == 3, "colortable 2"); 116 117 my @data; 118 for my $yoff (0..9) { 119 push @data, [$yoff..9+$yoff]; 120 } 121 $band->WriteTile(\@data); 122 for my $yoff (4..6) { 123 for my $xoff (3..4) { 124 $data[$yoff][$xoff] = 0; 125 } 126 } 127 my $data = $band->ReadTile(3,4,2,3); 128 for my $y (@$data) { 129 for (@$y) { 130 $_ = 0; 131 } 132 } 133 $band->WriteTile($data,3,4); 134 $data = $band->ReadTile(); 135 ok(is_deeply(\@data,$data), "write/read tile"); 136} 137 138{ 139 my $DOWARN = 0; 140 BEGIN { $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN } } 141 my $r = Geo::GDAL::RasterAttributeTable->new; 142 my @t = $r->FieldTypes; 143 my @u = $r->FieldUsages; 144 my %colors = (Red=>1, Green=>1, Blue=>1, Alpha=>1); 145 my @types; 146 my @usages; 147 for my $u (@u) { 148 for my $t (@t) { 149 $r->CreateColumn("$t $u", $t, $u); # do not warn about RAT column types 150 push @types, $t; 151 push @usages, $u; 152 } 153 } 154 $DOWARN = 1; 155 my $n = $r->GetColumnCount; 156 my $n2 = @t * @u; 157 ok($n == $n2, "create rat column"); 158 $r->SetRowCount(1); 159 my $i = 0; 160 for my $c (0..$n-1) { 161 my $usage = $r->GetUsageOfCol($c); 162 ok($usage eq $usages[$c], "usage $usage eq $usages[$c]"); 163 my $type = $r->GetTypeOfCol($c); 164 if ($colors{$usage}) { 165 ok($type eq 'Integer', "type $type eq 'Integer'"); 166 } else { 167 ok($type eq $types[$c], "type $type eq $types[$c]"); 168 } 169 for ($type) { 170 if (/Integer/) { 171 my $v = $r->Value($i, $c, 12); 172 ok($v == 12, "rat int ($i,$c): $v vs 12"); 173 } elsif (/Real/) { 174 my $v = $r->Value($i, $c, 1.23); 175 ok($v == 1.23, "rat real ($i,$c): $v vs 1.23"); 176 } elsif (/String/) { 177 my $v = $r->Value($i, $c, "abc"); 178 ok($v eq 'abc', "rat str ($i,$c): $v vs 'abc'"); 179 } 180 } 181 } 182} 183 184gdal_tests(); 185 186SKIP: { 187 my $src; 188 eval { 189 $src = Geo::OSR::SpatialReference->new(EPSG => 2392); 190 }; 191 192 skip "GDAL support files not found. Please set GDAL_DATA.", 1 if $@; 193 194 my $xml = $src->ExportToXML(); 195 $a = Geo::GDAL::ParseXMLString($xml); 196 $xml = Geo::GDAL::SerializeXMLTree($a); 197 $b = Geo::GDAL::ParseXMLString($xml); 198 ok(is_deeply($a, $b), "xml parsing"); 199} 200 201my @tmp = sort keys %available_driver; 202 203#print STDERR "\nGDAL version: ",Geo::GDAL::VersionInfo,"\n"; 204#print STDERR "Unexpected failures:\n",@fails,"\n" if @fails; 205#print STDERR "Available drivers were ",join(', ',@tmp),"\n"; 206#print STDERR "Drivers used in tests were: ",join(', ',@tested_drivers),"\n"; 207 208system "rm -rf tmp_ds_*" unless $^O eq 'MSWin32'; 209 210########################################### 211# 212# only subs below 213# 214########################################### 215 216sub gdal_tests { 217 218 my $name = 'MEM'; 219 220 my $driver = Geo::GDAL::Driver($name); 221 222 my @create = (qw/Byte Float32 UInt16 Int16 CInt16 CInt32 CFloat32/); 223 224 push @tested_drivers, $name; 225 226 for my $type (@create) { 227 228 my $filename = "tmp_ds_".$driver->{ShortName}."_$type"; 229 my $width = 100; 230 my $height = 50; 231 my $bands = 1; 232 my $options = undef; 233 234 my $dataset; 235 236 eval { 237 $dataset = $driver->Create($filename, $width, $height, $bands, $type, {}); 238 }; 239 240 mytest($dataset, @$, $name, $type, "$name $type dataset create"); 241 next unless $dataset; 242 243 mytest($dataset->{RasterXSize} == $width,'RasterXSize',$name,$type,'RasterXSize'); 244 mytest($dataset->{RasterYSize} == $height,'RasterYSize',$name,$type,'RasterYSize'); 245 246 my $band = $dataset->GetRasterBand(1); 247 248 my $transform = $dataset->GetGeoTransform(); 249 $transform->[5] = 12; 250 $dataset->SetGeoTransform($transform); 251 my $transform2 = $dataset->GetGeoTransform(); 252 mytest($transform->[5] == $transform2->[5], 253 "$transform->[5] != $transform2->[5]",$name,$type,'Get/SetGeoTransform'); 254 255 $band->ColorInterpretation('GreenBand'); 256 my $value = $band->ColorInterpretation; 257 mytest($value eq 'GreenBand',"$value ne GreenBand",$name,$type,'ColorInterpretation'); 258 259 $band->SetNoDataValue(5); 260 my $value = $band->GetNoDataValue; 261 mytest($value == 5,"$value != 5",$name,$type,'Get/SetNoDataValue'); 262 263 my $colortable = Geo::GDAL::ColorTable->new('Gray'); 264 my @rgba = (255,0,0,255); 265 $colortable->SetColorEntry(0, \@rgba); 266 $band->ColorTable($colortable); 267 $colortable = $band->ColorTable; 268 my @rgba2 = $colortable->GetColorEntry(0); 269 270 mytest($rgba[0] == $rgba2[0] and 271 $rgba[1] == $rgba2[1] and 272 $rgba[2] == $rgba2[2] and 273 $rgba[3] == $rgba2[3],"colors do not match",$name,$type,'Colortable'); 274 275 my $pc; 276 eval { 277 $pc = Geo::GDAL::PackCharacter($band->{DataType}); 278 }; 279 280 if ($pc) { 281 $pc = "${pc}[$width]"; 282 my $scanline = pack($pc,(1..$width)); 283 284 for my $yoff (0..$height-1) { 285 $band->WriteRaster( 0, $yoff, $width, 1, $scanline ); 286 } 287 } 288 289 my @gcps = (); 290 push @gcps,new Geo::GDAL::GCP(1.1,2.2); 291 push @gcps,new Geo::GDAL::GCP(2.1,3.2); 292 my $po = "GEOGCS[\"WGS 84\",DATUM[\"WGS_1984\",SPHEROID[\"WGS 84\",6378137,298.257223563,AUTHORITY[\"EPSG\",\"7030\"]],AUTHORITY[\"EPSG\",\"6326\"]],PRIMEM[\"Greenwich\",0,AUTHORITY[\"EPSG\",\"8901\"]],UNIT[\"degree\",0.0174532925199433,AUTHORITY[\"EPSG\",\"9122\"]],AXIS[\"Latitude\",NORTH],AXIS[\"Longitude\",EAST],AUTHORITY[\"EPSG\",\"4326\"]]"; 293 $dataset->SetGCPs(\@gcps,$po); 294 my $c = $dataset->GetGCPCount(); 295 my $p = $dataset->GetGCPProjection(); 296 my $gcps = $dataset->GetGCPs(); 297 my $y1 = $gcps->[0]->{Y}; 298 my $y2 = $gcps->[1]->{Y}; 299 my $y1o = $gcps[0]->{Y}; 300 my $y2o = $gcps[1]->{Y}; 301 mytest(($c == 2 and $p eq $po and $y1 == $y1o and $y2 == $y2o), 302 "$c != 2 or $p ne $po or $y1 != $y1o or $y2 != $y2o",$name,$type,'Set/GetGCPs'); 303 304 undef $band; 305 undef $dataset; 306 307 unless ($name eq 'MEM') { 308 eval { 309 $dataset = Geo::GDAL::Open($filename); 310 }; 311 mytest($dataset,'no message',$name,$type,"open $filename"); 312 } 313 314 if ($dataset) { 315 mytest($dataset->{RasterXSize} == $width,'RasterXSize',$name,$type,'RasterXSize'); 316 mytest($dataset->{RasterYSize} == $height,'RasterYSize',$name,$type,'RasterYSize'); 317 318 my $band = $dataset->GetRasterBand(1); 319 320 { 321 my @a = ('abc','def'); 322 my @b = $band->CategoryNames(@a); 323 ok(is_deeply(\@a, \@b,"$name,$type,CategoryNames")); 324 } 325 326 if ($pc) { 327 328 my $scanline = $band->ReadRaster( 0, 0, $width, 1); 329 my @data = unpack($pc, $scanline); 330 mytest($data[49] == 50,'',$name,$type,'ReadRaster'); 331 332 } 333 334 } 335 undef $dataset; 336 } 337} 338 339sub cmp_ar { 340 my($n,$a1,$a2) = @_; 341 return 0 unless $n == @$a1; 342 return 0 unless $#$a1 == $#$a2; 343 for my $i (0..$#$a1) { 344 return 0 unless abs($a1->[$i] - $a2->[$i]) < 0.001; 345 } 346 return 1; 347} 348 349sub mytest { 350 my $test = shift; 351 my $msg = shift; 352 my $context = join(': ',@_); 353 ok($test, $context); 354 unless ($test) { 355 my $err = $msg; 356 if ($@) { 357 $@ =~ s/\n/ /g; 358 $@ =~ s/\s+$//; 359 $@ =~ s/\s+/ /g; 360 $@ =~ s/^\s+$//; 361 $err = $@ ? "'$@'" : $msg; 362 } 363 $msg = "$context: $err: not ok\n"; 364 push @fails,$msg; 365 } elsif ($test =~ /^skip/) { 366 $msg = "$context: $test.\n"; 367 } else { 368 $msg = "$context: ok.\n"; 369 } 370 print $msg if $verbose; 371 return $msg; 372} 373 374sub dumphash { 375 my $h = shift; 376 for (keys %$h) { 377 print "$_ $h->{$_}\n"; 378 } 379} 380