1# tests for Geo::ShapeFile 2 3use Test::More; 4use strict; 5use warnings; 6#use rlib '../lib', './lib'; 7use FindBin; 8use lib "$FindBin::Bin/lib"; 9use lib "$FindBin::Bin/../lib"; 10 11use Geo::ShapeFile; 12use Geo::ShapeFile::Shape; 13use Geo::ShapeFile::Point; 14 15# should use $FindBin::bin for this 16my $dir = "t/test_data"; 17 18note "Testing Geo::ShapeFile version $Geo::ShapeFile::VERSION\n"; 19 20use Geo::ShapeFile::TestHelpers; 21 22# conditional test runs approach from 23# http://www.modernperlbooks.com/mt/2013/05/running-named-perl-tests-from-prove.html 24 25exit main( @ARGV ); 26 27sub main { 28 my @args = @_; 29 30 if (@args) { 31 for my $name (@args) { 32 die "No test method test_$name\n" 33 if not my $func = (__PACKAGE__->can( 'test_' . $name ) || __PACKAGE__->can( $name )); 34 $func->(); 35 } 36 done_testing; 37 return 0; 38 } 39 40 test_open_croaks(); 41 test_corners(); 42 test_shapes_in_area(); 43 #test_end_point_slope(); 44 test_shapepoint(); 45 test_files(); 46 test_files_no_caching(); 47 test_file_version_defined(); 48 test_empty_dbf(); 49 test_points_in_polygon(); 50 test_spatial_index(); 51 test_angle_to(); 52 53 test_shape_indexing(); 54 55 test_type(); 56 57 done_testing; 58 return 0; 59} 60 61 62 63########################################### 64 65sub test_file_version_defined { 66 #github #22 67 my $empty_file = "$dir/empty_points"; 68 69 foreach my $type (qw /shx shp/) { 70 my $obj = Geo::ShapeFile->new("${empty_file}.${type}"); 71 my $version = $obj->file_version; 72 73 ok (defined $version, "file_version: got defined value for empty file of type $type"); 74 } 75} 76 77 78sub test_dbf_header { 79 my %data = Geo::ShapeFile::TestHelpers::get_data(); 80 81 foreach my $base (sort keys %data) { 82 83 my $shp = Geo::ShapeFile->new ("$dir/$base"); 84 85 my $hdr = $shp->get_dbf_field_info; 86 87 # not the world's best test, but it ensures the returned copy is corrct 88 is_deeply ($hdr, $shp->{dbf_field_info}, "header for $base has correct structure"); 89 } 90} 91 92 93sub test_open_croaks { 94 my $filename = "blurfleblargfail"; 95 96 my $shp = eval { 97 Geo::ShapeFile->new ($filename); 98 }; 99 my $e = $@; 100 ok ($e, 'threw an exception on invalid file'); 101 102} 103 104 105 106sub test_shapepoint { 107 my @test_points = ( 108 ['1','1'], 109 ['1000000','1000000'], 110 ['9999','43525623523525'], 111 ['2532525','235253252352'], 112 ['2.1352362','1.2315216236236'], 113 ['2.2152362','1.2315231236236','1134'], 114 ['2.2312362','1.2315236136236','1214','51321'], 115 ['2.2351362','1.2315236216236','54311'], 116 ); 117 118 my @pnt_objects; 119 foreach my $pts (@test_points) { 120 my ($x,$y,$m,$z) = @$pts; 121 my $txt; 122 123 if(defined $z && defined $m) { 124 $txt = "Point(X=$x,Y=$y,Z=$z,M=$m)"; 125 } 126 elsif (defined $m) { 127 $txt = "Point(X=$x,Y=$y,M=$m)"; 128 } 129 else { 130 $txt = "Point(X=$x,Y=$y)"; 131 } 132 my $p1 = Geo::ShapeFile::Point->new(X => $x, Y => $y, Z => $z, M => $m); 133 my $p2 = Geo::ShapeFile::Point->new(Y => $y, X => $x, M => $m, Z => $z); 134 print "p1=$p1\n"; 135 print "p2=$p2\n"; 136 cmp_ok ( $p1, '==', $p2, "Points match"); 137 cmp_ok ("$p1", 'eq', $txt); 138 cmp_ok ("$p2", 'eq', $txt); 139 push @pnt_objects, $p1; 140 } 141 142 143 return; 144 145} 146 147sub test_angle_to { 148 my $p1 = Geo::ShapeFile::Point->new (X => 0, Y => 0); 149 150 my @checks = ( 151 [ 0, 0, 0], 152 [ 1, 0, 90], 153 [ 1, 1, 45], 154 [ 0, 1, 0], 155 [-1, 1, 315], 156 [-1, 0, 270], 157 [-1, -1, 225], 158 [ 0, -1, 180], 159 ); 160 161 foreach my $p2_data (@checks) { 162 my ($x, $y, $exp) = @$p2_data; 163 my $p2 = Geo::ShapeFile::Point->new (X => $x, Y => $y); 164 my $angle = $p1->angle_to ($p2); 165 166 is ( 167 $angle, 168 $exp, 169 "Got expected angle of $exp for $x,$y", 170 ); 171 } 172 173 return; 174} 175 176sub test_end_point_slope { 177 return; # no testing yet - ths was used for debug 178 179 my %data = Geo::ShapeFile::TestHelpers::get_data(); 180 my %data2 = (drainage => $data{drainage}); 181 %data = %data2; 182 183 my $obj = Geo::ShapeFile->new("$dir/drainage"); 184 my $shape = $obj->get_shp_record(1); 185 my $start_pt = Geo::ShapeFile::Point->new(X => $shape->x_min(), Y => $shape->y_min()); 186 my $end_pt = Geo::ShapeFile::Point->new(X => $shape->x_min(), Y => $shape->y_max()); 187 my $hp = $shape->has_point($start_pt); 188 189 printf 190 "%i : %i\n", 191 $shape->has_point($start_pt), 192 $shape->has_point($end_pt); 193 print; 194 195 return; 196} 197 198 199sub test_files_no_caching { 200 test_files ('no_cache'); 201} 202 203sub test_files { 204 my $no_cache = shift; 205 206 my %data = Geo::ShapeFile::TestHelpers::get_data(); 207 208 foreach my $base (sort keys %data) { 209 foreach my $ext (qw/dbf shp shx/) { 210 ok(-f "$dir/$base.$ext", "$ext file exists for $base"); 211 } 212 my $fname = "$dir/$base.shp"; 213 my $obj = $data{$base}->{object} 214 = Geo::ShapeFile->new("$dir/$base", {no_cache => $no_cache}); 215 216 my @expected_fld_names 217 = grep 218 {$_ ne '_deleted'} 219 split /\s+/, $data{$base}{dbf_labels}; 220 my @got_fld_names = $obj->get_dbf_field_names; 221 222 is_deeply ( 223 \@expected_fld_names, 224 \@got_fld_names, 225 "got expected field names for $base", 226 ); 227 228 # test SHP 229 cmp_ok ( 230 $obj->shape_type_text(), 231 'eq', 232 $data{$base}->{shape_type}, 233 "Shape type for $base", 234 ); 235 cmp_ok( 236 $obj->shapes(), 237 '==', 238 $data{$base}->{shapes}, 239 "Number of shapes for $base" 240 ); 241 242 # test shapes 243 my $nulls = 0; 244 subtest "$base has valid records" => sub { 245 if (!$obj->records()) { 246 ok (1, "$base has no records, so just pass this subtest"); 247 } 248 249 for my $n (1 .. $obj->shapes()) { 250 my($offset, $cl1) = $obj->get_shx_record($n); 251 my($number, $cl2) = $obj->get_shp_record_header($n); 252 253 cmp_ok($cl1, '==', $cl2, "$base($n) shp/shx record content-lengths"); 254 cmp_ok($n, '==', $number, "$base($n) shp/shx record ids agree"); 255 256 my $shp = $obj->get_shp_record($n); 257 258 if ($shp->shape_type == 0) { 259 $nulls++; 260 } 261 262 my $parts = $shp->num_parts; 263 my @parts = $shp->parts; 264 cmp_ok($parts, '==', scalar(@parts), "$base($n) parts count"); 265 266 my $points = $shp->num_points; 267 my @points = $shp->points; 268 cmp_ok($points, '==', scalar(@points), "$base($n) points count"); 269 270 my $undefs = 0; 271 foreach my $pnt (@points) { 272 defined($pnt->X) || $undefs++; 273 defined($pnt->Y) || $undefs++; 274 } 275 ok(!$undefs, "undefined points"); 276 277 my $len = length($shp->{shp_data}); 278 cmp_ok($len, '==', 0, "$base($n) no leftover data"); 279 } 280 }; 281 282 ok($nulls == $data{$base}->{nulls}); 283 284 # need to test the bounds 285 my @shapes_in_file; 286 for my $n (1 .. $obj->shapes()) { 287 push @shapes_in_file, $obj->get_shp_record($n); 288 } 289 290 my %bounds = $obj->find_bounds(@shapes_in_file); 291 for my $bnd (qw /x_min y_min x_max y_max/) { 292 is ($bounds{$bnd}, $data{$base}{$bnd}, "$bnd across objects matches, $base"); 293 } 294 295 if (defined $data{$base}{y_max}) { 296 is ($obj->height, $data{$base}{y_max} - $data{$base}{y_min}, "$base has correct height"); 297 is ($obj->width, $data{$base}{x_max} - $data{$base}{x_min}, "$base has correct width"); 298 } 299 else { 300 is ($obj->height, undef, "$base has correct height"); 301 is ($obj->width, undef, "$base has correct width"); 302 } 303 304 # test DBF 305 ok($obj->{dbf_version} == 3, "dbf version 3"); 306 307 cmp_ok( 308 $obj->{dbf_num_records}, 309 '==', 310 $obj->shapes(), 311 "$base dbf has record per shape", 312 ); 313 314 cmp_ok( 315 $obj->records(), 316 '==', 317 $obj->shapes(), 318 "same number of shapes and records", 319 ); 320 321 subtest "$base: can read each record" => sub { 322 if (!$obj->records()) { 323 ok (1, "$base has no records, so just pass this subtest"); 324 } 325 326 for my $n (1 .. $obj->shapes()) { 327 ok (my $dbf = $obj->get_dbf_record($n), "$base($n) read dbf record"); 328 } 329 }; 330 331 # This is possibly redundant due to get_dbf_field_names check above, 332 # although that does not check against each record. 333 my @expected_flds = sort split (/ /, $data{$base}->{dbf_labels}); 334 subtest "dbf for $base has correct labels" => sub { 335 if (!$obj->records()) { 336 ok (1, "$base has no records, so just pass this subtest"); 337 } 338 for my $n (1 .. $obj->records()) { 339 my %record = $obj->get_dbf_record($n); 340 is_deeply ( 341 [sort keys %record], 342 \@expected_flds, 343 "$base, record $n", 344 ); 345 } 346 }; 347 348 if ($obj->shapes) { 349 # a bit lazy, as we check for any caching, not specific caching 350 my $expect_cache = !$no_cache; 351 # tests should not know about internals 352 my $object_cache = $obj->{_object_cache}; 353 my $cache_count = 0; 354 foreach my $type (keys %$object_cache) { 355 $cache_count += scalar keys %{$object_cache->{$type}}; 356 } 357 my $nc_msg = defined $no_cache ? 'on' : 'off'; 358 is (!!$cache_count, 359 $expect_cache, 360 "$fname: Got expected caching for no_cache flag: $nc_msg", 361 ); 362 } 363 } 364 365 return; 366} 367 368 369sub test_empty_dbf { 370 my $empty_dbf = Geo::ShapeFile::TestHelpers::get_empty_dbf(); 371 my $obj = Geo::ShapeFile->new("$dir/$empty_dbf"); 372 my $records = $obj->records; 373 is ($records, 0, 'empty dbf file has zero records'); 374} 375 376 377sub test_shapes_in_area { 378 my $shp = Geo::ShapeFile->new ("$dir/test_shapes_in_area"); 379 380 my @shapes_in_area = $shp->shapes_in_area (1, 1, 11, 11); 381 is_deeply ( 382 [1], 383 \@shapes_in_area, 384 'Shape is in area' 385 ); 386 387 @shapes_in_area = $shp->shapes_in_area (1, 1, 11, 9); 388 is_deeply ( 389 [1], 390 \@shapes_in_area, 391 'Shape is in area' 392 ); 393 394 @shapes_in_area = $shp->shapes_in_area (11, 11, 12, 12); 395 is_deeply ( 396 [], 397 \@shapes_in_area, 398 'Shape is not in area' 399 ); 400 401 my @bounds; 402 403 @bounds = (1, -1, 9, 11); 404 @shapes_in_area = $shp->shapes_in_area (@bounds); 405 is_deeply ( 406 [1], 407 \@shapes_in_area, 408 'edge overlap on the left, right edge outside bounds', 409 ); 410 411 412 @bounds = (0, -1, 9, 11); 413 @shapes_in_area = $shp->shapes_in_area (@bounds); 414 is_deeply ( 415 [1], 416 \@shapes_in_area, 417 'left and right edges outside the bounds, upper and lower within', 418 ); 419 420 ### Now check with a larger region 421 $shp = Geo::ShapeFile->new("$dir/lakes"); 422 423 # This should get all features 424 @bounds = (-104, 17, -96, 22); 425 @shapes_in_area = $shp->shapes_in_area (@bounds); 426 is_deeply ( 427 [1, 2, 3], 428 \@shapes_in_area, 429 'All lake shapes in bounds', 430 ); 431 432 # just the western two features 433 @bounds = (-104, 17, -100, 22); 434 @shapes_in_area = $shp->shapes_in_area (@bounds); 435 is_deeply ( 436 [1, 2], 437 \@shapes_in_area, 438 'Western two lake shapes in bounds', 439 ); 440 441 # the western two features with a partial overlap 442 @bounds = (-104, 17, -101.7314, 22); 443 @shapes_in_area = $shp->shapes_in_area (@bounds); 444 is_deeply ( 445 [1, 2], 446 \@shapes_in_area, 447 'Western two lake shapes in bounds, partial overlap', 448 ); 449 450 return; 451} 452 453 454sub test_corners { 455 my $shp = Geo::ShapeFile->new("$dir/lakes"); 456 457 my $ul = $shp->upper_left_corner(); 458 my $ll = $shp->lower_left_corner(); 459 my $ur = $shp->upper_right_corner(); 460 my $lr = $shp->lower_right_corner(); 461 462 is ($ul->X, $ll->X,'corners: min x vals'); 463 is ($ur->X, $lr->X,'corners: max x vals'); 464 is ($ll->Y, $lr->Y,'corners: min y vals'); 465 is ($ul->Y, $ur->Y,'corners: max y vals'); 466 467 cmp_ok ($ul->X, '<', $ur->X, 'corners: ul is left of ur'); 468 cmp_ok ($ll->X, '<', $lr->X, 'corners: ll is left of lr'); 469 470 cmp_ok ($ll->Y, '<', $ul->Y, 'corners: ll is below ul'); 471 cmp_ok ($lr->Y, '<', $ur->Y, 'corners: lr is below ur'); 472 473 return; 474} 475 476sub test_points_in_polygon { 477 my $shp; 478 my $filename; 479 480 # multipart poly 481 $filename = 'states.shp'; 482 $shp = Geo::ShapeFile->new ("$dir/$filename"); 483 484 my @in_coords = ( 485 [-112.386, 28.950], 486 [-112.341, 29.159], 487 [-112.036, 29.718], 488 [-110.186, 30.486], 489 [-114.845, 32.380], 490 ); 491 my @out_coords = ( 492 [-111.286, 27.395], 493 [-113.843, 30.140], 494 [-111.015, 31.767], 495 [-112.594, 34.300], 496 [-106.772, 28.420], 497 [-114.397, 24.802], 498 ); 499 500 # shape 23 is sonora 501 my $test_poly = $shp->get_shp_record(23); 502 503 subtest "$filename polygon 23 (not indexed) contains points" => sub { 504 foreach my $coord (@in_coords) { 505 my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]); 506 my $result = $test_poly->contains_point ($point); 507 ok ($result, "$point is in $filename polygon 23"); 508 } 509 }; 510 511 subtest "$filename polygon 23 (not indexed) does not contain points" => sub { 512 foreach my $coord (@out_coords) { 513 my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]); 514 my $result = $test_poly->contains_point ($point); 515 ok (!$result, "$point is not in $filename polygon 23"); 516 } 517 }; 518 519 # use the spatial index 520 $test_poly->build_spatial_index; 521 522 subtest "$filename polygon 23 (indexed) contains points" => sub { 523 foreach my $coord (@in_coords) { 524 my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]); 525 my $result = $test_poly->contains_point ($point, 0); 526 ok ($result, "$point is in $filename polygon 23 (indexed)"); 527 } 528 }; 529 530 subtest "$filename polygon 23 (indexed) does not contain points" => sub { 531 foreach my $coord (@out_coords) { 532 my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]); 533 my $result = $test_poly->contains_point ($point); 534 ok (!$result, "$point is not in $filename polygon 23 (indexed)"); 535 } 536 }; 537 538 # now try with a shapefile with holes in the polys 539 $filename = 'polygon.shp'; 540 $shp = Geo::ShapeFile->new ("$dir/$filename"); 541 # shape 83 has holes 542 $test_poly = $shp->get_shp_record(83); 543 544 @in_coords = ( 545 [477418, 4762016], 546 [476644, 4761530], 547 [477488, 4760789], 548 [477716, 4760055], 549 ); 550 @out_coords = ( 551 [477521, 4760247], # hole 552 [477414, 4761150], # hole 553 [477388, 4761419], # hole 554 [477996, 4761648], # hole 555 [476810, 4761766], # outside but in bounds 556 [478214, 4760627], # outside but in bounds 557 [477499, 4762436], # outside bounds 558 ); 559 560 subtest "$filename polygon 83 (not indexed) contains points" => sub { 561 foreach my $coord (@in_coords) { 562 my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]); 563 my $result = $test_poly->contains_point ($point); 564 ok ($result, "$point is in $filename polygon 83"); 565 } 566 }; 567 568 subtest "$filename polygon 83 (not indexed) does not contain points" => sub { 569 foreach my $coord (@out_coords) { 570 my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]); 571 my $result = $test_poly->contains_point ($point); 572 ok (!$result, "$point is not in $filename polygon 83"); 573 } 574 }; 575 576 # Now with the spatial index. 577 $test_poly->build_spatial_index; 578 579 subtest "$filename polygon 83 (indexed) contains points" => sub { 580 foreach my $coord (@in_coords) { 581 my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]); 582 my $result = $test_poly->contains_point ($point, 0); 583 ok ($result, "$point is in $filename polygon 83 (indexed)"); 584 } 585 }; 586 subtest "$filename polygon 83 (indexed) does not contain points" => sub { 587 foreach my $coord (@out_coords) { 588 my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]); 589 my $result = $test_poly->contains_point ($point); 590 ok (!$result, "$point is not in $filename polygon 83 (indexed)"); 591 } 592 }; 593 594 return; 595} 596 597 598sub test_spatial_index { 599 # polygon.shp has a variety of polygons 600 my $poly_file = "$dir/polygon"; 601 602 my $shp_use_idx = Geo::ShapeFile->new ($poly_file); 603 my $shp_no_idx = Geo::ShapeFile->new($poly_file); 604 605 my $sp_index = $shp_use_idx->build_spatial_index; 606 607 ok ($sp_index, 'got a spatial index'); 608 609 my @bounds = $shp_use_idx->bounds; 610 my $objects = []; 611 $sp_index->query_completely_within_rect (@bounds, $objects); 612 613 my @shapes = $shp_use_idx->get_all_shapes; 614 615 is ( 616 scalar @$objects, 617 scalar @shapes, 618 'index contains same number of objects as shapefile', 619 ); 620 621 # need to sort the arrays to compare them 622 my @sorted_shapes = $shp_use_idx->get_shapes_sorted; 623 my @sorted_objects = $shp_use_idx->get_shapes_sorted ($objects); 624 625 is_deeply ( 626 \@sorted_objects, 627 \@sorted_shapes, 628 'spatial_index contains all objects', 629 ); 630 631 # now get the mid-point for a lower-left bounds 632 my $mid_x = ($bounds[0] + $bounds[2]) / 2; 633 my $mid_y = ($bounds[1] + $bounds[3]) / 2; 634 my @bnd_ll = ($bounds[0], $bounds[1], $mid_x, $mid_y); 635 636 foreach my $expected ([\@bounds, 474], [\@bnd_ll, 130]) { 637 my $bnds = $expected->[0]; 638 my $shape_count = $expected->[1]; 639 640 my $shapes_in_area_no_idx = $shp_no_idx->shapes_in_area (@$bnds); 641 my $shapes_in_area_use_idx = $shp_use_idx->shapes_in_area (@$bnds); 642 643 my $message = 'shapes_in_area same with and without spatial index, bounds: ' 644 . join ' ', @$bnds; 645 646 is (scalar @$shapes_in_area_no_idx, $shape_count, 'got right number of shapes back, no index'); 647 is (scalar @$shapes_in_area_use_idx, $shape_count, 'got right number of shapes back, use index'); 648 649 is_deeply ( 650 [sort @$shapes_in_area_no_idx], 651 [sort @$shapes_in_area_use_idx], 652 $message, 653 ); 654 } 655 656} 657 658sub test_shape_indexing { 659 my $poly_file = "$dir/poly_to_check_index"; 660 661 my $shp = Geo::ShapeFile->new ($poly_file); 662 663 my @in_coords = ( 664 [-1504329.017, -3384142.590], 665 [ -811568.465, -3667544.634], 666 [-1417733.948, -3793501.098], 667 ); 668 669 foreach my $size (5, 10, 15, 20, 100) { 670 foreach my $shape ($shp->get_all_shapes) { 671 my %part_indexes = $shape->build_spatial_index ($size); 672 foreach my $part (values %part_indexes) { 673 my $containers = $part->{containers}; 674 ok (scalar keys %$containers == $size, "index generated $size containers") 675 } 676 subtest "polygon contains points when using index of size $size" => sub { 677 foreach my $coord (@in_coords) { 678 my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]); 679 my $result = $shape->contains_point ($point); 680 ok ($result, "$point is in polygon"); 681 } 682 } 683 } 684 } 685} 686 687sub test_type { 688 my $poly_file = "$dir/poly_to_check_index"; 689 my $shp = Geo::ShapeFile->new ($poly_file); 690 691 ok !$shp->type_is(200), 'invalid numeric type returns false'; 692 ok !$shp->type_is(5.2), 'floating point numeric type returns false'; 693 ok $shp->type_is(5), 'valid numeric type returns true'; 694 ok $shp->type_is('polygon'), 'valid text type returns true'; 695 ok $shp->type_is('PolygoN'), 'text type is case insensitive'; 696 697} 698