@@ -1,78 +1,143 @@
-Revision history for Geo::ShapeFile.
-
-2.52 Fri Sep 14 10:43:34 EDT 2007
- - Fixed the overloading setup in Geo::ShapeFile::Point to keep it from
- failing the tests caused by recent changes in Test::Builder (it was
- definitely my bug though, don't blame the excellent Test modules for
- it!) This bug was reported by Hermann Schwaerzler, Andrew Koebrick,
- Celia Mackie, Andrew McGregor, and probably a lot of other folks
- (you can thank all these people for release 2.52, it was this bug that
- clued me in how many people were actually using the package, I hadn't
- intended to do another release until 3.00 was ready to go.)
- - FINALLY fixed the (hopefully last of) the big-endian problem. I
- hadn't planeed to include this in this release, as I was still trying
- to figure out how to fix it, but while going through my Geo::ShapeFile
- related mail to see if there were any other little problems reported
- that I could include, I discovered a wonderful patch that had been
- sent to me some time ago by Jerry Leibold, which had somehow fallen
- through the cracks. My apologies for taking 2 years to get this
- fixed, but every time I tried to figure out a solution I was stymied
- by my lack of big-endian hardware (not to mention the fact that my
- day job hasn't included mapping for several years, so I have precious
- little free time to spend on maintaining Geo::ShapeFile, and most of
- that time I've been putting into version 3.00) This problem was also
- reported by Josh Narins and probably other people whose emails I have
- since misplaced.
- - Reorganized the package layout a bit, so you can do 'prove -vl t' in
- the distribution directory now.
- - Roger Crew pointed out that the centroid of a polygonal area is
- different from the centroid of its vertices, and contributed a new
- area_centroid() method for Geo::ShapeFile::Shape. I renamed the
- existing centroid() method to vertex_centroid(), although for the
- time being, centroid() is an alias to vertex_centroid().
- - Roger Crew also contributed a contains_point() method for
- Geo::ShapeFile::Shape that determines whether a given point falls
- within the interior of the shape. Miroslav Suchy also contributed
- a similar method, but I used Roger's because it didn't add any more
- external dependencies.
- - Fixed an argument ordering bug in Geo::ShapeFile::bounds_contains_point
- (also reported by Roger Crew, thanks for the all the help Roger!)
-
-2.51 Thu May 12 11:01:41 EDT 2005
- - Corrected a stupid math problem in Geo::ShapeFile::Shape::centroid
- function, reported by an anonymous rt.cpan.org user.
- - Fixed a problem discovered by Celia Mackie, where some complex shape
- types didn't have their Z and M values transferred into the points
- correctly, making it difficult to access those values.
-
-2.50 Sat Jul 3 19:08:50 EDT 2004
- - things calming down at new job, more free time at home for pet projects.
- hopefully this means more Geo::ShapeFile support to come (as well as
- posting some new modules in progress)
- - fixed windows bug reported by Patrick Dughi
- - object caching
- - fixed another windows bug reported by A. B. Jones
- - fixed dumb regexp bug that wouldn't let you use directories with a dot in
- them (doh!). Reported by Leo WEST
- - fixed documentation bug for shapes_in_area reported by Chad Harp
- - fixed endianess bug reported by Daniel Gildea
- - fixed some count issues, and code cleanup reported by Fergus McMenemie
- - documentation clarification suggested by Christopher Eykamp
- - fixed divide by zero bug when using angle_to() on points with the same
- X value, reported by Frank Maas
- - fixed bug where has_point() missed points that fell exactly on the
- boundary of the area specified, reported by Frank Maas
- - modified dbf file reader to correctly load DBF files that don't have
- an end-of-file marker byte. This should correct the 'file size off
- by one byte' bug first reported by Attila Csipa (sorry it took so long,
- I couldn't find data that reproduced it), patch submitted by
- Aleksandar Jelenak.
-
-2.10 Mon Mar 17 14:59:00 2003
- - fixed missing prerequisites in Makefile.PL
- - initial support for creating new shapefiles
- - removed some less-than-useful required modules
-
-1.5 Sun Feb 16 11:35:00 2003
- - initial release
-
+Revision history for Geo::ShapeFile.
+
+2.60 2014-03-14
+ - Add method to obtain the dbf header information.
+ https://github.com/shawnlaffan/Geo-ShapeFile/issues/15
+ - Clean up some POD formatting issues.
+
+2.58 2014-03-06
+ - CPAN testers are green for 2.57_001 so make a production release.
+ - Fix incorrect passing of arguments in the shape index.
+ This should not affect most existing code as the indexing
+ is only used when called explicitly.
+ https://github.com/shawnlaffan/Geo-ShapeFile/issues/14
+ - Croak when an invalid file name is passed.
+ https://github.com/shawnlaffan/Geo-ShapeFile/issues/13
+
+2.57_001 2014-03-05
+ Development release towards 2.58. Changes are listed there.
+
+2.56 2014-02-18
+ - Shawn Laffan
+ - CPAN testers are green for 2.55_001, so bump the version number and release as a full version.
+
+2.55_001 2014-02-17
+ - Shawn Laffan
+ - Add Geo::ShapeFile::Shape::Index as a simple 2-d block based index.
+ - Geo::Shape::ShapeFile now uses a spatial index for the segments.
+ This speeds up the contains_point routines by about 50-70% when used.
+ The index is opt-in at the moment, so will have no effect on existing code.
+ - Geo::ShapeFile::get_part now returns an array ref in scalar context.
+ - Geo::ShapeFile::Point::angle_to now works.
+ - Many of the undocumented methods have been renamed to use a leading underscore,
+ as they are private methods. This avoids a number of POD test warnings.
+ - Add parent, POSIX and autovovofication to the list of dependencies in the makefile.
+
+2.54 2014-02-11
+ - Shawn Laffan
+ - Fix https://rt.cpan.org/Ticket/Display.html?id=89563
+ Thanks to Daniel Smith for reporting, and also providing an optimisation
+ which also handles edge overlap cases.
+ - Reorganise the test suite to allow running of subsets of tests.
+
+2.53_003 2014-02-10
+ - Shawn Laffan
+ - Clear up several longstanding RT tickets:
+ - https://rt.cpan.org/Ticket/Display.html?id=46698
+ Clarify docs such that point objects are passed to has_point, not coordinates.
+ - https://rt.cpan.org/Ticket/Display.html?id=46068
+ Values returned from width and height were swapped. Thanks to Le Goddard for reporting.
+ - https://rt.cpan.org/Ticket/Display.html?id=49054
+ $@ should have been @_ (thanks to rgsave@hotmail.com for reporting)
+ - https://rt.cpan.org/Ticket/Display.html?id=92790
+ DBF field names can now be accessed in file order.
+ - https://rt.cpan.org/Ticket/Display.html?id=63347
+ corners were incorrectly reported. Thanks to Liam Gretton for reporting.
+ - Reorganise the test suite to use subtests, with tests in subs. Add more tests.
+ - General formatting and style changes to the code.
+ - Add List::Util as a dependency.
+ - Development is now on github, so update the metadata to reflect this.
+ https://github.com/shawnlaffan/Geo-ShapeFile
+
+
+2.52 2007-09-14
+ - Jason Kohles
+ - Fixed the overloading setup in Geo::ShapeFile::Point to keep it from
+ failing the tests caused by recent changes in Test::Builder (it was
+ definitely my bug though, don't blame the excellent Test modules for
+ it!) This bug was reported by Hermann Schwaerzler, Andrew Koebrick,
+ Celia Mackie, Andrew McGregor, and probably a lot of other folks
+ (you can thank all these people for release 2.52, it was this bug that
+ clued me in how many people were actually using the package, I hadn't
+ intended to do another release until 3.00 was ready to go.)
+ - FINALLY fixed the (hopefully last of) the big-endian problem. I
+ hadn't planeed to include this in this release, as I was still trying
+ to figure out how to fix it, but while going through my Geo::ShapeFile
+ related mail to see if there were any other little problems reported
+ that I could include, I discovered a wonderful patch that had been
+ sent to me some time ago by Jerry Leibold, which had somehow fallen
+ through the cracks. My apologies for taking 2 years to get this
+ fixed, but every time I tried to figure out a solution I was stymied
+ by my lack of big-endian hardware (not to mention the fact that my
+ day job hasn't included mapping for several years, so I have precious
+ little free time to spend on maintaining Geo::ShapeFile, and most of
+ that time I've been putting into version 3.00) This problem was also
+ reported by Josh Narins and probably other people whose emails I have
+ since misplaced.
+ - Reorganized the package layout a bit, so you can do 'prove -vl t' in
+ the distribution directory now.
+ - Roger Crew pointed out that the centroid of a polygonal area is
+ different from the centroid of its vertices, and contributed a new
+ area_centroid() method for Geo::ShapeFile::Shape. I renamed the
+ existing centroid() method to vertex_centroid(), although for the
+ time being, centroid() is an alias to vertex_centroid().
+ - Roger Crew also contributed a contains_point() method for
+ Geo::ShapeFile::Shape that determines whether a given point falls
+ within the interior of the shape. Miroslav Suchy also contributed
+ a similar method, but I used Roger's because it didn't add any more
+ external dependencies.
+ - Fixed an argument ordering bug in Geo::ShapeFile::bounds_contains_point
+ (also reported by Roger Crew, thanks for the all the help Roger!)
+
+2.51 2005-05-12
+ - Jason Kohles
+ - Corrected a stupid math problem in Geo::ShapeFile::Shape::centroid
+ function, reported by an anonymous rt.cpan.org user.
+ - Fixed a problem discovered by Celia Mackie, where some complex shape
+ types didn't have their Z and M values transferred into the points
+ correctly, making it difficult to access those values.
+
+2.50 2004-07-03
+ - Jason Kohles
+ - things calming down at new job, more free time at home for pet projects.
+ hopefully this means more Geo::ShapeFile support to come (as well as
+ posting some new modules in progress)
+ - fixed windows bug reported by Patrick Dughi
+ - object caching
+ - fixed another windows bug reported by A. B. Jones
+ - fixed dumb regexp bug that wouldn't let you use directories with a dot in
+ them (doh!). Reported by Leo WEST
+ - fixed documentation bug for shapes_in_area reported by Chad Harp
+ - fixed endianess bug reported by Daniel Gildea
+ - fixed some count issues, and code cleanup reported by Fergus McMenemie
+ - documentation clarification suggested by Christopher Eykamp
+ - fixed divide by zero bug when using angle_to() on points with the same
+ X value, reported by Frank Maas
+ - fixed bug where has_point() missed points that fell exactly on the
+ boundary of the area specified, reported by Frank Maas
+ - modified dbf file reader to correctly load DBF files that don't have
+ an end-of-file marker byte. This should correct the 'file size off
+ by one byte' bug first reported by Attila Csipa (sorry it took so long,
+ I couldn't find data that reproduced it), patch submitted by
+ Aleksandar Jelenak.
+
+2.10 2003-03-17
+ - Jason Kohles
+ - fixed missing prerequisites in Makefile.PL
+ - initial support for creating new shapefiles
+ - removed some less-than-useful required modules
+
+1.5 2003-02-16
+ - Jason Kohles
+ - initial release
+
@@ -1,65 +1,100 @@
-Changes
-MANIFEST This list of files
-Makefile.PL
-README
-lib/Geo/ShapeFile.pm
-lib/Geo/ShapeFile/Point.pm
-lib/Geo/ShapeFile/Shape.pm
-eg/shpdump
-t/main_tests.t
-t/test_data.pl
-t/test_data/anno.aux
-t/test_data/anno.dbf
-t/test_data/anno.shp
-t/test_data/anno.shx
-t/test_data/brklinz.dbf
-t/test_data/brklinz.shp
-t/test_data/brklinz.shx
-t/test_data/cities.dbf
-t/test_data/cities.sbn
-t/test_data/cities.sbx
-t/test_data/cities.shp
-t/test_data/cities.shx
-t/test_data/drainage.dbf
-t/test_data/drainage.sbn
-t/test_data/drainage.sbx
-t/test_data/drainage.shp
-t/test_data/drainage.shx
-t/test_data/lakes.dbf
-t/test_data/lakes.sbn
-t/test_data/lakes.sbx
-t/test_data/lakes.shp
-t/test_data/lakes.shx
-t/test_data/masspntz.dbf
-t/test_data/masspntz.shp
-t/test_data/masspntz.shx
-t/test_data/multipnt.dbf
-t/test_data/multipnt.shp
-t/test_data/multipnt.shx
-t/test_data/pline.dbf
-t/test_data/pline.shp
-t/test_data/pline.shx
-t/test_data/polygon.dbf
-t/test_data/polygon.shp
-t/test_data/polygon.shx
-t/test_data/rivers.dbf
-t/test_data/rivers.sbn
-t/test_data/rivers.sbx
-t/test_data/rivers.shp
-t/test_data/rivers.shx
-t/test_data/roads.dbf
-t/test_data/roads.sbn
-t/test_data/roads.sbx
-t/test_data/roads.shp
-t/test_data/roads.shx
-t/test_data/roads_rt.dbf
-t/test_data/roads_rt.sbn
-t/test_data/roads_rt.sbx
-t/test_data/roads_rt.shp
-t/test_data/roads_rt.shx
-t/test_data/states.dbf
-t/test_data/states.sbn
-t/test_data/states.sbx
-t/test_data/states.shp
-t/test_data/states.shx
-META.yml Module meta-data (added by MakeMaker)
+Changes
+eg/shpdump.pl
+lib/Geo/ShapeFile.pm
+lib/Geo/ShapeFile/Point.pm
+lib/Geo/ShapeFile/Shape.pm
+lib/Geo/ShapeFile/Shape/Index.pm
+Makefile.PL
+MANIFEST This list of files
+MANIFEST.SKIP
+META.yml Module meta-data (added by MakeMaker)
+perlcriticrc
+perlcriticrc-conway
+README
+t/lib/Geo/ShapeFile/TestHelpers.pm
+t/main_tests.t
+t/test_data/anno.aux
+t/test_data/anno.dbf
+t/test_data/anno.shp
+t/test_data/anno.shx
+t/test_data/brklinz.dbf
+t/test_data/brklinz.shp
+t/test_data/brklinz.shx
+t/test_data/cities.dbf
+t/test_data/cities.sbn
+t/test_data/cities.sbx
+t/test_data/cities.shp
+t/test_data/cities.shx
+t/test_data/drainage.dbf
+t/test_data/drainage.sbn
+t/test_data/drainage.sbx
+t/test_data/drainage.shp
+t/test_data/drainage.shx
+t/test_data/empty_dbf.dbf
+t/test_data/empty_points.dbf
+t/test_data/empty_points.sbn
+t/test_data/empty_points.sbx
+t/test_data/empty_points.shp
+t/test_data/empty_points.shx
+t/test_data/lakes.dbf
+t/test_data/lakes.sbn
+t/test_data/lakes.sbx
+t/test_data/lakes.shp
+t/test_data/lakes.shx
+t/test_data/masspntz.dbf
+t/test_data/masspntz.shp
+t/test_data/masspntz.shx
+t/test_data/multipnt.dbf
+t/test_data/multipnt.shp
+t/test_data/multipnt.shx
+t/test_data/pline.dbf
+t/test_data/pline.shp
+t/test_data/pline.shx
+t/test_data/poly_to_check_index.dbf
+t/test_data/poly_to_check_index.prj
+t/test_data/poly_to_check_index.sbn
+t/test_data/poly_to_check_index.sbx
+t/test_data/poly_to_check_index.shp
+t/test_data/poly_to_check_index.shp.xml
+t/test_data/poly_to_check_index.shx
+t/test_data/polygon.dbf
+t/test_data/polygon.shp
+t/test_data/polygon.shx
+t/test_data/rivers.dbf
+t/test_data/rivers.sbn
+t/test_data/rivers.sbx
+t/test_data/rivers.shp
+t/test_data/rivers.shx
+t/test_data/roads.dbf
+t/test_data/roads.sbn
+t/test_data/roads.sbx
+t/test_data/roads.shp
+t/test_data/roads.shx
+t/test_data/roads_rt.dbf
+t/test_data/roads_rt.sbn
+t/test_data/roads_rt.sbx
+t/test_data/roads_rt.shp
+t/test_data/roads_rt.shx
+t/test_data/states.dbf
+t/test_data/states.sbn
+t/test_data/states.sbx
+t/test_data/states.shp
+t/test_data/states.shx
+t/test_data/test_shapes_in_area.dbf
+t/test_data/test_shapes_in_area.prj
+t/test_data/test_shapes_in_area.shp
+t/test_data/test_shapes_in_area.shx
+xt/.perlcritic-history
+xt/01-has_versions.t
+xt/02-versions_all_same.t
+xt/03-has_pod.t
+xt/03-test_pod.t
+xt/04-pod-coverage.t
+xt/05-manifest.t
+xt/06-critic.t
+xt/07-notabs.t
+xt/09-use_strict.t
+xt/10-changes_format.t
+xt/bench_contains_indexed.pl
+xt/README.txt
+META.json Module JSON meta-data (added by MakeMaker)
@@ -0,0 +1,22 @@
+.git.+
+
+t/.*\.html
+
+xt/mem_leak_tests
+
+Makefile.old
+MANIFEST.bak
+Makefile$
+MYMETA.yml
+MYMETA.json
+
+.+\.html
+pod2htmd.tmp$
+
+.*\.tar\.gz$
+
+\.sr\.lock
+
+x\.tmp
+
+pm_to_blib
@@ -0,0 +1,31 @@
+{
+ "abstract" : "Perl extension for handling ESRI GIS Shapefiles.",
+ "author" : [
+ "Shawn Laffan <shawnlaffan@gmail.com>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.132830",
+ "license" : [
+ "unknown"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Geo-ShapeFile",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "repository" : {
+ "type" : "git",
+ "url" : "https://github.com/shawnlaffan/Geo-ShapeFile.git",
+ "web" : "https://github.com/shawnlaffan/Geo-ShapeFile"
+ }
+ },
+ "version" : "2.60"
+}
@@ -1,16 +1,19 @@
---- #YAML:1.0
-name: Geo-ShapeFile
-version: 2.52
-abstract: Perl extension for handling ESRI GIS Shapefiles.
-license: ~
-generated_by: ExtUtils::MakeMaker version 6.36
-distribution_type: module
-requires:
- Carp: 0
- IO::File: 0
- Math::Trig: 0
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.2.html
- version: 1.2
-author:
- - Jason Kohles <email@jasonkohles.com>
+---
+abstract: 'Perl extension for handling ESRI GIS Shapefiles.'
+author:
+ - 'Shawn Laffan <shawnlaffan@gmail.com>'
+build_requires: {}
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.132830'
+license: unknown
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Geo-ShapeFile
+no_index:
+ directory:
+ - t
+ - inc
+resources:
+ repository: https://github.com/shawnlaffan/Geo-ShapeFile.git
+version: 2.60
@@ -1,14 +1,31 @@
-use ExtUtils::MakeMaker;
-WriteMakefile(
- 'NAME' => 'Geo::ShapeFile',
- 'VERSION_FROM' => 'lib/Geo/ShapeFile.pm', # finds $VERSION
- 'PREREQ_PM' => {
- 'Carp' => 0,
- 'IO::File' => 0,
- 'Math::Trig' => 0,
- },
- ($] >= 5.005 ? (
- ABSTRACT_FROM => 'lib/Geo/ShapeFile.pm',
- AUTHOR => 'Jason Kohles <email@jasonkohles.com>',
- ) : ()),
-);
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'Geo::ShapeFile',
+ 'VERSION_FROM' => 'lib/Geo/ShapeFile.pm', # finds $VERSION
+ 'PREREQ_PM' => {
+ 'Carp' => 0,
+ 'IO::File' => 0,
+ 'Math::Trig' => 0,
+ 'List::Util' => 0,
+ 'parent' => 0,
+ 'Tree::R' => 0,
+ 'autovivification' => 0,
+ 'POSIX' => 0,
+ },
+ BUILD_REQUIRES => {
+ 'rlib' => 0,
+ },
+ META_MERGE => {
+ 'meta-spec' => { version => 2 },
+ resources => {
+ repository => {
+ type => 'git',
+ url => 'https://github.com/shawnlaffan/Geo-ShapeFile.git',
+ web => 'https://github.com/shawnlaffan/Geo-ShapeFile',
+ },
+ },
+ },
+ ABSTRACT_FROM => 'lib/Geo/ShapeFile.pm',
+ AUTHOR => 'Shawn Laffan <shawnlaffan@gmail.com>',
+);
@@ -1,40 +1,39 @@
-Geo/ShapeFile version 2.52
-==========================
-
-Geo::ShapeFile is a perl library for reading ESRI shape files (such as
-those produced by the ESRI Arc/Info application.
-
-INSTALLATION
-
-To install this module type the following:
-
- perl Makefile.PL
- make
- make test
- make install
-
-DEPENDENCIES
-
-This module requires these other modules and libraries:
-
- Carp
- IO::File
- Math::Trig
- Test::More (if you want to run the tests)
-
-REPORTING BUGS
-
-Please report any bugs or problems by sending email to:
-geo-shapefile-bugs@jasonkohles.com
-
-EXAMPLES
-
-Some example scripts (hopefully documented) can be found in the eg/ directory.
-
-COPYRIGHT AND LICENCE
-
-Copyright (C) 2000-2007 Jason Kohles
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
+Geo/ShapeFile version 2.58
+==========================
+
+Geo::ShapeFile is a perl library for reading ESRI shape files (such as
+those produced by the ESRI ArcGIS application).
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+Or you can use cpanm if it is installed for your perl (see https://metacpan.org/pod/App::cpanminus if not).
+This will get you the latest released version, not the one on the github repo.
+
+ cpanm Geo::ShapeFile
+
+
+REPORTING BUGS
+
+Please report any bugs or problems to:
+https://github.com/shawnlaffan/Geo-ShapeFile/issues
+
+EXAMPLES
+
+Some example scripts (hopefully documented) can be found in the eg/ directory.
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2000-2013 Jason Kohles
+Copyright (C) 2014 Shawn Laffan
+
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
@@ -1,49 +0,0 @@
-#!/home/jason/perl/bin/perl -w
-##############################
-use strict;
-use Geo::ShapeFile::Point comp_includes_z => 0, comp_includes_m => 0;
-use Geo::ShapeFile;
-
-# TODO: not sure if the real shpdump does z or m first
-# TODO: documentation
-
-my $obj = new Geo::ShapeFile(shift());
-
-print "Shapefile Type: ".$obj->shape_type_text." # of Shapes: ".$obj->shapes;
-print "\n\n";
-printf("File Bounds: ( %.3f, %.3f,%d,%d)\n",
- $obj->x_min, $obj->y_min,
- ($obj->m_min || 0), ($obj->z_min || 0),
-);
-printf(" to ( %.3f, %.3f,%d,%d)\n\n",
- $obj->x_max, $obj->y_max,
- ($obj->m_max || 0), ($obj->z_max || 0),
-);
-
-for (1 .. $obj->shapes) {
- my $shape = $obj->get_shp_record($_);
-
- printf("Shape:%d (%s) nVertices=%i, nParts=%i\n",
- $_-1, $shape->shape_type_text,$shape->num_points,$shape->num_parts,
- );
- printf(" Bounds:( %.3f, %.3f,%d,%d)\n",
- $shape->x_min,$obj->y_min,($obj->m_min || 0),($obj->z_min || 0),
- );
- printf(" to ( %.3f, %.3f, %d,%d)\n",
- $obj->x_max,$obj->y_max,($obj->m_max || 0),($obj->z_max || 0),
- );
- foreach my $p (1 .. $shape->num_parts) {
- my @part = $shape->get_part($p);
- my $labeled = 0;
- for(@part) {
- printf(" %1s ( %.3f, %.3f, %d, %d) %s\n",
- ((($p > 0) && (!$labeled))?"+":""),
- $_->X,$_->Y,($_->M || 0),($_->Z || 0),
- ($labeled?"":"Ring"),
- );
-
- $labeled = 1;
- }
- }
- print "\n";
-}
@@ -0,0 +1,49 @@
+#!/home/jason/perl/bin/perl -w
+##############################
+use strict;
+use Geo::ShapeFile::Point comp_includes_z => 0, comp_includes_m => 0;
+use Geo::ShapeFile;
+
+# TODO: not sure if the real shpdump does z or m first
+# TODO: documentation
+
+my $obj = new Geo::ShapeFile(shift());
+
+print "Shapefile Type: ".$obj->shape_type_text." # of Shapes: ".$obj->shapes;
+print "\n\n";
+printf("File Bounds: ( %.3f, %.3f,%d,%d)\n",
+ $obj->x_min, $obj->y_min,
+ ($obj->m_min || 0), ($obj->z_min || 0),
+);
+printf(" to ( %.3f, %.3f,%d,%d)\n\n",
+ $obj->x_max, $obj->y_max,
+ ($obj->m_max || 0), ($obj->z_max || 0),
+);
+
+for (1 .. $obj->shapes) {
+ my $shape = $obj->get_shp_record($_);
+
+ printf("Shape:%d (%s) nVertices=%i, nParts=%i\n",
+ $_-1, $shape->shape_type_text,$shape->num_points,$shape->num_parts,
+ );
+ printf(" Bounds:( %.3f, %.3f,%d,%d)\n",
+ $shape->x_min,$obj->y_min,($obj->m_min || 0),($obj->z_min || 0),
+ );
+ printf(" to ( %.3f, %.3f, %d,%d)\n",
+ $obj->x_max,$obj->y_max,($obj->m_max || 0),($obj->z_max || 0),
+ );
+ foreach my $p (1 .. $shape->num_parts) {
+ my @part = $shape->get_part($p);
+ my $labeled = 0;
+ for(@part) {
+ printf(" %1s ( %.3f, %.3f, %d, %d) %s\n",
+ ((($p > 0) && (!$labeled))?"+":""),
+ $_->X,$_->Y,($_->M || 0),($_->Z || 0),
+ ($labeled?"":"Ring"),
+ );
+
+ $labeled = 1;
+ }
+ }
+ print "\n";
+}
@@ -1,352 +1,393 @@
-package Geo::ShapeFile::Point;
-# TODO - add dimension operators (to specify if 2 or 3 dimensional point)
-use strict;
-use warnings;
-use Math::Trig;
-use Carp;
-our $VERSION = '2.52';
-
-use overload
- '==' => 'eq',
- 'eq' => 'eq',
- '""' => 'stringify',
- '+' => \&add,
- '-' => \&subtract,
- '*' => \&multiply,
- '/' => \÷,
- fallback => 1
-;
-
-my %config = (
- comp_includes_z => 1,
- comp_includes_m => 1,
-);
-
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
-
- my $self = {@_};
-
- bless($self, $class);
-
- return $self;
-}
-
-sub var {
- my $self = shift;
- my $var = shift;
-
- if(@_) {
- return $self->{$var} = shift;
- } else {
- return $self->{$var};
- }
-}
-
-sub X { shift()->var('X',@_); }
-sub Y { shift()->var('Y',@_); }
-sub Z { shift()->var('Z',@_); }
-sub M { shift()->var('M',@_); }
-
-# TODO - document these
-sub x_min { shift()->var('X'); }
-sub x_max { shift()->var('X'); }
-sub y_min { shift()->var('Y'); }
-sub y_max { shift()->var('Y'); }
-sub z_min { shift()->var('Z'); }
-sub z_max { shift()->var('Z'); }
-sub m_min { shift()->var('M'); }
-sub m_max { shift()->var('M'); }
-
-sub import {
- my $self = shift;
- my %args = @_;
-
- foreach(keys %args) { $config{$_} = $args{$_}; }
-}
-
-sub eq {
- my $left = shift;
- my $right = shift;
-
- if($config{comp_includes_z} && (defined $left->Z || defined $right->Z)) {
- return 0 unless defined $left->Z && defined $right->Z;
- return 0 unless $left->Z == $right->Z;
- }
- if($config{comp_includes_m} && (defined $left->M || defined $right->M)) {
- return 0 unless defined $left->M && defined $right->M;
- return 0 unless $left->M == $right->M;
- }
- return ($left->X == $right->X && $left->Y == $right->Y);
-}
-
-sub stringify {
- my $self = shift;
-
- my @foo = ();
- foreach(qw/X Y Z M/) {
- if(defined $self->$_()) {
- push(@foo,"$_=".$self->$_());
- }
- }
- my $r = "Point(".join(',',@foo).")";
-}
-
-sub distance_from {
- my($p1,$p2) = @_;
-
- my $dp = $p2->subtract($p1);
- sqrt( ($dp->X ** 2) + ($dp->Y **2) );
-}
-sub distance_to { distance_from(@_); }
-
-sub angle_to {
- my($p1,$p2) = @_;
-
- my $dp = $p2 - $p1;
- if($dp->Y && $dp->X) { # two distinct points
- return rad2deg( atan( $dp->Y / $dp->X ) );
- } elsif($dp->Y) { # same X value
- return $dp->Y > 0 ? 90 : -90;
- } else { # same point
- return 0;
- }
-}
-
-sub add { mathemagic('add',@_); }
-sub subtract { mathemagic('subtract',@_); }
-sub multiply { mathemagic('multiply',@_); }
-sub divide { mathemagic('divide',@_); }
-
-sub mathemagic {
- my($op,$l,$r,$reverse) = @_;
-
- if($reverse) { ($l,$r) = ($r,$l); } # put them back in the right order
- my($left,$right);
-
- if(UNIVERSAL::isa($l,"Geo::ShapeFile::Point")) { $left = 'point'; }
- if(UNIVERSAL::isa($r,"Geo::ShapeFile::Point")) { $right = 'point'; }
-
- if($l =~ /^[\d\.]+$/) { $left = 'number'; }
- if($r =~ /^[\d\.]+$/) { $right = 'number'; }
-
- unless($left) { croak "Couldn't identify $l for $op"; }
- unless($right) { croak "Couldn't identify $r for $op"; }
-
- my $function = join('_',$op,$left,$right);
-
- unless(defined &{$function}) {
- croak "Don't know how to $op $left and $right";
- } else {
- no strict 'refs';
- return $function->($l,$r);
- }
-}
-
-sub add_point_point {
- my($p1,$p2) = @_;
-
- my $z;
- if(defined($p2->Z) && defined($p1->Z)) { $z = ($p2->Z + $p1->Z); }
-
- new Geo::ShapeFile::Point(
- X => ($p2->X + $p1->X),
- Y => ($p2->Y + $p1->Y),
- Z => $z,
- );
-}
-
-sub add_point_number {
- my($p1,$n) = @_;
-
- my $z;
- if(defined($p1->Z)) { $z = ($p1->Z + $n); }
-
- new Geo::ShapeFile::Point(
- X => ($p1->X + $n),
- Y => ($p1->Y + $n),
- Z => $z,
- );
-}
-sub add_number_point { add_point_number(@_); }
-
-sub subtract_point_point {
- my($p1,$p2) = @_;
-
- my $z;
- if(defined($p2->Z) && defined($p1->Z)) { $z = ($p2->Z - $p1->Z); }
-
- new Geo::ShapeFile::Point(
- X => ($p2->X - $p1->X),
- Y => ($p2->Y - $p1->Y),
- Z => $z,
- );
-}
-sub subtract_point_number {
- my($p1,$n) = @_;
-
- my $z;
- if(defined($p1->Z)) { $z = ($p1->Z - $n); }
-
- new Geo::ShapeFile::Point(
- X => ($p1->X - $n),
- Y => ($p1->Y - $n),
- Z => $z,
- );
-}
-sub subtract_number_point { subtract_point_number(reverse @_); }
-
-sub multiply_point_point {
- my($p1,$p2) = @_;
-
- my $z;
- if(defined($p2->Z) && defined($p1->Z)) { $z = ($p2->Z * $p1->Z); }
-
- new Geo::ShapeFile::Point(
- X => ($p2->X * $p1->X),
- Y => ($p2->Y * $p1->Y),
- Z => $z,
- );
-}
-sub multiply_point_number {
- my($p1,$n) = @_;
-
- my $z;
- if(defined($p1->Z)) { $z = ($p1->Z * $n); }
-
- new Geo::ShapeFile::Point(
- X => ($p1->X * $n),
- Y => ($p1->Y * $n),
- Z => $z,
- );
-}
-sub multiply_number_point { multiply_point_number(reverse @_); }
-
-sub divide_point_point {
- my($p1,$p2) = @_;
-
- my $z;
- if(defined($p2->Z) && defined($p1->Z)) { $z = ($p2->Z / $p1->Z); }
-
- new Geo::ShapeFile::Point(
- X => ($p2->X / $p1->X),
- Y => ($p2->Y / $p1->Y),
- Z => $z,
- );
-}
-sub divide_point_number {
- my($p1,$n) = @_;
-
- my $z;
- if(defined($p1->Z)) { $z = ($p1->Z / $n); }
-
- new Geo::ShapeFile::Point(
- X => ($p1->X / $n),
- Y => ($p1->Y / $n),
- Z => $z,
- );
-}
-sub divide_number_point { divide_point_number(reverse @_); }
-
-1;
-__END__
-=head1 NAME
-
-Geo::ShapeFile::Point - Geo::ShapeFile utility class.
-
-=head1 SYNOPSIS
-
- use Geo::ShapeFile::Point;
- use Geo::ShapeFile;
-
- my $point = new Geo::ShapeFile::Point(X => 12345, Y => 54321);
-
-=head1 ABSTRACT
-
- This is a utility class, used by Geo::ShapeFile.
-
-=head1 DESCRIPTION
-
-This is a utility class, used by Geo::ShapeFile to represent point data,
-you should see the Geo::ShapeFile documentation for more information.
-
-=head2 EXPORT
-
-Nothing.
-
-=head2 IMPORT NOTE
-
-This module uses overloaded operators to allow you to use == or eq to compare
-two point objects. By default points are considered to be equal only if their
-X, Y, Z, and M attributes are equal. If you want to exclude the Z or M
-attributes when comparing, you should use comp_includes_z or comp_includes_m
-when importing the object. Note that you must do this before you load the
-Geo::ShapeFile module, or it will pass it's own arguments to import, and you
-will get the default behavior:
-
- DO:
-
- use Geo::ShapeFile::Point comp_includes_m => 0, comp_includes_z => 0;
- use Geo::ShapeFile;
-
- DONT:
-
- use Geo::ShapeFile;
- use Geo::ShapeFile::Point comp_includes_m => 0, comp_includes_z => 0;
- (Geo::ShapeFile already imported Point for you)
-
-=head1 METHODS
-
-=over 4
-
-=item new(X => $x, Y => $y)
-
-Creates a new Geo::ShapeFile::Point object, takes a has consisting of X, Y, Z,
-and/or M values to be assigned to the point.
-
-=item X() Y() Z() M()
-
-Set/retrieve the X, Y, Z, or M values for this object.
-
-=item x_min() x_max() y_min() y_max()
-
-=item z_min() z_max() m_min() m_max()
-
-These methods are provided for compatibility with Geo::ShapeFile::Shape, but
-for points simply return the X, Y, Z, or M coordinates as appropriate.
-
-=item distance_from($point)
-
-Returns the distance between this point and the specified point. Only
-considers the two-dimensional distance, altitude is not included in the
-calculation.
-
-=item angle_to($point);
-
-Returns the angle (in degress) from this point to some other point. Returns
-0 if the two points are in the same location.
-
-=back
-
-=head1 REPORTING BUGS
-
-Please send any bugs, suggestions, or feature requests to
- E<lt>geo-shapefile-bugs@jasonkohles.comE<gt>.
-
-=head1 SEE ALSO
-
-Geo::ShapeFile
-
-=head1 AUTHOR
-
-Jason Kohles, E<lt>email@jasonkohles.com<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2002,2003 by Jason Kohles
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
+package Geo::ShapeFile::Point;
+# TODO - add dimension operators (to specify if 2 or 3 dimensional point)
+use strict;
+use warnings;
+use Math::Trig;
+use Carp;
+our $VERSION = '2.60';
+
+use overload
+ '==' => 'eq',
+ 'eq' => 'eq',
+ '""' => 'stringify',
+ '+' => \&add,
+ '-' => \&subtract,
+ '*' => \&multiply,
+ '/' => \÷,
+ fallback => 1,
+;
+
+my %config = (
+ comp_includes_z => 1,
+ comp_includes_m => 1,
+);
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self = {@_};
+
+ bless $self, $class;
+
+ return $self;
+}
+
+sub _var {
+ my $self = shift;
+ my $var = shift;
+
+ if (@_) {
+ return $self->{$var} = shift;
+ }
+ else {
+ return $self->{$var};
+ }
+}
+
+# these could be factory generated
+sub X { shift()->_var('X', @_); }
+sub Y { shift()->_var('Y', @_); }
+sub Z { shift()->_var('Z', @_); }
+sub M { shift()->_var('M', @_); }
+
+sub x_min { $_[0]->_var('X'); }
+sub x_max { $_[0]->_var('X'); }
+sub y_min { $_[0]->_var('Y'); }
+sub y_max { $_[0]->_var('Y'); }
+sub z_min { $_[0]->_var('Z'); }
+sub z_max { $_[0]->_var('Z'); }
+sub m_min { $_[0]->_var('M'); }
+sub m_max { $_[0]->_var('M'); }
+
+sub get_x { $_[0]->{X} }
+sub get_y { $_[0]->{Y} }
+sub get_z { $_[0]->{Z} }
+sub get_m { $_[0]->{M} }
+
+
+sub import {
+ my $self = shift;
+ my %args = @_;
+
+ foreach(keys %args) { $config{$_} = $args{$_}; }
+}
+
+sub eq {
+ my $left = shift;
+ my $right = shift;
+
+ if ($config{comp_includes_z} && (defined $left->Z || defined $right->Z)) {
+ return 0 unless defined $left->Z && defined $right->Z;
+ return 0 unless $left->Z == $right->Z;
+ }
+ if ($config{comp_includes_m} && (defined $left->M || defined $right->M)) {
+ return 0 unless defined $left->M && defined $right->M;
+ return 0 unless $left->M == $right->M;
+ }
+
+ return ($left->X == $right->X && $left->Y == $right->Y);
+}
+
+sub stringify {
+ my $self = shift;
+
+ my @foo = ();
+ foreach(qw/X Y Z M/) {
+ if(defined $self->$_()) {
+ push @foo, "$_=" . $self->$_();
+ }
+ }
+ my $r = 'Point(' . join(',', @foo) . ')';
+}
+
+sub distance_from {
+ my ($p1, $p2) = @_;
+
+ my $dp = $p2->subtract($p1);
+ return sqrt ( ($dp->X ** 2) + ($dp->Y **2) );
+}
+
+sub distance_to { distance_from(@_); }
+
+sub angle_to {
+ my ($p1, $p2) = @_;
+
+ my $dp = $p2->subtract ($p1);
+
+ my $x_off = $dp->get_x;
+ my $y_off = $dp->get_y;
+
+ return 0 if !($x_off || $y_off);
+
+ my $bearing = 90 - Math::Trig::rad2deg (Math::Trig::atan2 ($y_off, $x_off));
+ if ($bearing < 0) {
+ $bearing += 360;
+ }
+
+ return $bearing;
+}
+
+sub add { _mathemagic('add', @_); }
+sub subtract { _mathemagic('subtract', @_); }
+sub multiply { _mathemagic('multiply', @_); }
+sub divide { _mathemagic('divide', @_); }
+
+sub _mathemagic {
+ my ($op, $l, $r, $reverse) = @_;
+
+ if ($reverse) { # put them back in the right order
+ ($l, $r) = ($r, $l);
+ }
+ my ($left, $right);
+
+ if (UNIVERSAL::isa($l, 'Geo::ShapeFile::Point')) { $left = 'point'; }
+ if (UNIVERSAL::isa($r, 'Geo::ShapeFile::Point')) { $right = 'point'; }
+
+ if ($l =~ /^[\d\.]+$/) { $left = 'number'; }
+ if ($r =~ /^[\d\.]+$/) { $right = 'number'; }
+
+ unless ($left) { croak "Couldn't identify $l for $op"; }
+ unless ($right) { croak "Couldn't identify $r for $op"; }
+
+ my $function = '_' . join '_', $op, $left, $right;
+
+ croak "Don't know how to $op $left and $right"
+ if !defined &{$function};
+
+ do {
+ no strict 'refs';
+ return $function->($l, $r);
+ }
+}
+
+sub _add_point_point {
+ my ($p1, $p2) = @_;
+
+ my $z;
+ if(defined($p2->Z) && defined($p1->Z)) { $z = ($p2->Z + $p1->Z); }
+
+ Geo::ShapeFile::Point->new(
+ X => ($p2->X + $p1->X),
+ Y => ($p2->Y + $p1->Y),
+ Z => $z,
+ );
+}
+
+sub _add_point_number {
+ my ($p1, $n) = @_;
+
+ my $z;
+ if (defined($p1->Z)) { $z = ($p1->Z + $n); }
+
+ Geo::ShapeFile::Point->new(
+ X => ($p1->X + $n),
+ Y => ($p1->Y + $n),
+ Z => $z,
+ );
+}
+sub _add_number_point { add_point_number(@_); }
+
+sub _subtract_point_point {
+ my($p1, $p2) = @_;
+
+ my $z;
+ if(defined($p2->Z) && defined($p1->Z)) { $z = ($p2->Z - $p1->Z); }
+
+ my $result = Geo::ShapeFile::Point->new(
+ X => ($p1->X - $p2->X),
+ Y => ($p1->Y - $p2->Y),
+ Z => $z,
+ );
+ return $result;
+}
+
+sub _subtract_point_number {
+ my($p1, $n) = @_;
+
+ my $z;
+ if (defined $p1->Z) {
+ $z = ($p1->Z - $n);
+ }
+
+ Geo::ShapeFile::Point->new(
+ X => ($p1->X - $n),
+ Y => ($p1->Y - $n),
+ Z => $z,
+ );
+}
+sub _subtract_number_point { _subtract_point_number(reverse @_); }
+
+sub _multiply_point_point {
+ my ($p1, $p2) = @_;
+
+ my $z;
+ if (defined $p2->Z and defined $p1->Z) {
+ $z = $p2->Z * $p1->Z;
+ }
+
+ Geo::ShapeFile::Point->new(
+ X => ($p2->X * $p1->X),
+ Y => ($p2->Y * $p1->Y),
+ Z => $z,
+ );
+}
+sub _multiply_point_number {
+ my($p1, $n) = @_;
+
+ my $z;
+ if (defined $p1->Z) {
+ $z = $p1->Z * $n;
+ }
+
+ Geo::ShapeFile::Point->new(
+ X => ($p1->X * $n),
+ Y => ($p1->Y * $n),
+ Z => $z,
+ );
+}
+
+sub _multiply_number_point { _multiply_point_number(reverse @_); }
+
+sub _divide_point_point {
+ my($p1, $p2) = @_;
+
+ my $z;
+ if (defined $p2->Z and defined $p1->Z) {
+ $z = $p1->Z / $p2->Z;
+ }
+
+ Geo::ShapeFile::Point->new(
+ X => ($p1->X / $p2->X),
+ Y => ($p1->Y / $p2->Y),
+ Z => $z,
+ );
+}
+
+sub _divide_point_number {
+ my ($p1, $n) = @_;
+
+ my $z;
+ if (defined $p1->Z) {
+ $z = $p1->Z / $n;
+ }
+
+ Geo::ShapeFile::Point->new(
+ X => ($p1->X / $n),
+ Y => ($p1->Y / $n),
+ Z => $z,
+ );
+}
+
+sub _divide_number_point { divide_point_number(reverse @_); }
+
+1;
+__END__
+=head1 NAME
+
+Geo::ShapeFile::Point - Geo::ShapeFile utility class.
+
+=head1 SYNOPSIS
+
+ use Geo::ShapeFile::Point;
+ use Geo::ShapeFile;
+
+ my $point = Geo::ShapeFile::Point->new(X => 12345, Y => 54321);
+
+=head1 ABSTRACT
+
+ This is a utility class, used by Geo::ShapeFile.
+
+=head1 DESCRIPTION
+
+This is a utility class, used by L<Geo::ShapeFile> to represent point data,
+you should see the Geo::ShapeFile documentation for more information.
+
+=head2 EXPORT
+
+Nothing.
+
+=head2 IMPORT NOTE
+
+This module uses overloaded operators to allow you to use == or eq to compare
+two point objects. By default points are considered to be equal only if their
+X, Y, Z, and M attributes are equal. If you want to exclude the Z or M
+attributes when comparing, you should use comp_includes_z or comp_includes_m
+when importing the object. Note that you must do this before you load the
+Geo::ShapeFile module, or it will pass it's own arguments to import, and you
+will get the default behavior:
+
+ DO:
+
+ use Geo::ShapeFile::Point comp_includes_m => 0, comp_includes_z => 0;
+ use Geo::ShapeFile;
+
+ DONT:
+
+ use Geo::ShapeFile;
+ use Geo::ShapeFile::Point comp_includes_m => 0, comp_includes_z => 0;
+ (Geo::ShapeFile already imported Point for you, so it has no effect here)
+
+=head1 METHODS
+
+=over 4
+
+=item new (X => $x, Y => $y)
+
+Creates a new Geo::ShapeFile::Point object, takes a hash consisting of X, Y, Z,
+and/or M values to be assigned to the point.
+
+=item X() Y() Z() M()
+
+Set/retrieve the X, Y, Z, or M values for this object.
+
+=item get_x() get_y() get_z() get_m()
+
+Get the X, Y, Z, or M values for this object. Slightly faster than the
+dual purpose set/retrieve methods so good for heavy usage parts of your code.
+
+=item x_min() x_max() y_min() y_max()
+
+=item z_min() z_max() m_min() m_max()
+
+These methods are provided for compatibility with Geo::ShapeFile::Shape, but
+for points simply return the X, Y, Z, or M coordinates as appropriate.
+
+=item distance_from($point)
+
+Returns the distance between this point and the specified point. Only
+considers the two-dimensional distance. Z and M values are ignored.
+
+=item angle_to($point);
+
+Returns the bearing (in degrees from north) from this point to some other point. Returns
+0 if the two points are in the same location.
+
+=back
+
+=head1 REPORTING BUGS
+
+Please send any bugs, suggestions, or feature requests to
+ L<https://github.com/shawnlaffan/Geo-ShapeFile/issues>.
+
+=head1 SEE ALSO
+
+L<Geo::ShapeFile>
+
+=head1 AUTHOR
+
+Jason Kohles, E<lt>email@jasonkohles.comE<gt>
+
+Shawn Laffan, E<lt>shawnlaffan@gmail.comE<gt>
+
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2002-2013 by Jason Kohles
+
+Copyright 2014 by Shawn Laffan
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
@@ -0,0 +1,226 @@
+package Geo::ShapeFile::Shape::Index;
+#use 5.010; # not yet
+use strict;
+use warnings;
+use POSIX qw /floor/;
+use Carp;
+use autovivification;
+
+our $VERSION = '2.60';
+
+# should also handle X cells
+sub new {
+ my ($class, $n, $x_min, $y_min, $x_max, $y_max) = @_;
+
+ my $self = bless {}, $class;
+
+ $n ||= 10; # need a better default?
+ $n = int $n;
+ die 'Number of blocks must be positive and >=1'
+ if $n <= 0;
+
+ my $y_range = abs ($y_max - $y_min);
+ my $y_tol = $y_range / 1000;
+ $y_range += 2 * $y_tol;
+ $y_min -= $y_tol;
+ $y_max += $y_tol;
+
+ my $block_ht = $y_range / $n;
+
+ $self->{x_min} = $x_min;
+ $self->{y_min} = $y_min;
+ $self->{x_max} = $x_max;
+ $self->{y_max} = $y_max;
+ $self->{y_res} = $block_ht;
+ $self->{y_n} = $n;
+ $self->{x_n} = 1;
+
+ my %blocks;
+ my $y = $y_min;
+ foreach my $i (1 .. $n) {
+ my $key = $self->snap_to_index($x_min, $y); # index by lower left
+ $blocks{$key} = [];
+ $y += $block_ht;
+ }
+ $self->{containers} = \%blocks;
+
+ return $self;
+}
+
+sub get_x_min {$_[0]->{x_min}}
+sub get_x_max {$_[0]->{x_max}}
+sub get_y_min {$_[0]->{y_min}}
+sub get_y_max {$_[0]->{y_max}}
+sub get_y_res {$_[0]->{y_res}}
+
+# return an anonymous array if we are out of the index bounds
+sub _get_container_ref {
+ my ($self, $id) = @_;
+
+ no autovivification;
+
+ my $containers = $self->{containers};
+ my $container = $containers->{$id} || [];
+
+ return $container;
+};
+
+# need to handle X coords as well
+sub snap_to_index {
+ my ($self, $x, $y) = @_;
+
+ #my $x_min = $self->get_x_min;
+ my $y_min = $self->get_y_min;
+ my $y_res = $self->get_y_res;
+
+ # take the floor, but add a small tolerance to
+ # avoid precision issues with snapping
+ my $partial = ($y - $y_min) / $y_res;
+ my $y_block = floor ($partial * 1.001);
+
+ return wantarray ? (0, $y_block) : "0:$y_block";
+}
+
+# inserts into whichever blocks overlap the bounding box
+sub insert {
+ my ($self, $item, @bbox) = @_;
+
+ my @index_id1 = $self->snap_to_index (@bbox[0, 1]);
+ my @index_id2 = $self->snap_to_index (@bbox[2, 3]);
+
+ my $insert_count = 0;
+ foreach my $y ($index_id1[1] .. $index_id2[1]) {
+ my $index_id = "0:$y"; # hackish
+ my $container = $self->_get_container_ref ($index_id);
+ push @$container, $item;
+ $insert_count++;
+ }
+
+ return $insert_count;
+}
+
+# $storage ref arg is for Tree::R compat - still needed?
+sub query_point {
+ my ($self, $x, $y, $storage_ref) = @_;
+
+ my $index_id = $self->snap_to_index ($x, $y);
+ my $container = $self->_get_container_ref ($index_id);
+
+ if ($storage_ref) {
+ push @$storage_ref, @$container;
+ }
+
+ return wantarray ? @$container : [@$container];
+}
+
+
+1;
+
+__END__
+=head1 NAME
+
+Geo::ShapeFile::Shape - Geo::ShapeFile utility class.
+
+=head1 SYNOPSIS
+
+ use Geo::ShapeFile::Shape::Index;
+
+ my $index = Geo::ShapeFile::Shape->new;
+ # $pt1 and $pt2 are point objects in this example.
+ my $segment = [$pt1, $pt2]; # example of something to pack into the index.
+ my @bbox = ($x_min, $y_min, $x_max, $y_max);
+ $index->insert($segment, @bbox);
+
+
+=head1 ABSTRACT
+
+ This is a utility class for L<Geo::ShapeFile> that indexes shape objects.
+
+=head1 DESCRIPTION
+
+This is a 2-d block-based index class for Geo::ShapeFile::Shape objects.
+It probably has more generic applications, of course.
+
+It uses a flat 2-d structure comprising a series of blocks of full width
+which slice the shape along the y-axis (it should really also use blocks
+along the x axis).
+
+The index coordinates are simply the number of blocks across and up
+from the minimum coordinate specified in the new() call. These are stoed as
+strings jpoined by a colon, so 0:0 is the lower left.
+Negative block coordinates can occur if data are added which fall outside the
+speficied bounds. This should not affect the index, though, as it is merely
+a relative offset.
+
+It is used internally by Geo::ShapeFile::Shape, so look there for examples.
+The method names are adapted from Tree::R to make transition easier during development,
+albeit the argument have morphed so it is not a drop-in replacement.
+
+
+=head2 EXPORT
+
+None by default.
+
+=head1 METHODS
+
+=over 4
+
+=item new($n_blocks_y, @bbox)
+
+Creates a new Geo::ShapeFile::Shape::Index objectand returns it.
+
+$n_blocks_y is the number of blocks along the y-axis.
+@bbox is the bounding box the index represents (x_min, y_min, x_max, y_max).
+
+=item insert($item, $min_x, $min_y, $max_x, $max_y)
+
+Adds item $item to the blocks which overlap with the specified bounds.
+Returns the number of blocks the item was added to.
+
+=item query_point($x, $y)
+
+Returns an array of objects on the block contains point $x,$y.
+Returns an arrayref in scalar context.
+
+
+=item get_x_max() get_x_min() get_y_max() get_y_min()
+
+Bounds of the index, as set in the call to ->new().
+There is no guarantee they are the bounds of the data, as
+data outside the original bounds can be indexed.
+
+=item get_y_res()
+
+Block resolution along the y-axis.
+
+=item snap_to_index ($x, $y)
+
+Returns the index key associated with point $x,$y.
+Does not check if it is outside the bounds of the index,
+so negative index values are possible.
+
+
+=back
+
+=head1 REPORTING BUGS
+
+Please send any bugs, suggestions, or feature requests to
+ L<https://github.com/shawnlaffan/Geo-ShapeFile/issues>.
+
+=head1 SEE ALSO
+
+L<Geo::ShapeFile::Shape>
+
+=head1 AUTHOR
+
+Shawn Laffan, E<lt>shawnlaffan@gmail.comE<gt>
+
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2014 by Shawn Laffan
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
@@ -1,778 +1,1027 @@
-package Geo::ShapeFile::Shape;
-use strict;
-use warnings;
-use Carp;
-use Geo::ShapeFile;
-use Geo::ShapeFile::Point;
-
-our @ISA = qw(Geo::ShapeFile);
-our $VERSION = '2.52';
-
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my %args = @_;
-
- my $self = {
- shp_content_length => 0,
- source => undef,
- shp_points => [],
- shp_num_points => 0,
- shp_parts => [],
- shp_record_number => undef,
- shp_shape_type => undef,
- shp_num_parts => 0,
- shp_x_min => undef,
- shp_x_max => undef,
- shp_y_min => undef,
- shp_y_max => undef,
- shp_z_min => undef,
- shp_z_max => undef,
- shp_m_min => undef,
- shp_m_max => undef,
- shp_data => undef,
- };
-
- foreach(keys %args) { $self->{$_} = $args{$_}; }
-
- bless($self, $class);
-
- return $self;
-}
-
-sub parse_shp {
- my $self = shift;
-
- $self->{source} = $self->{shp_data} = shift;
-
- $self->extract_ints('big','shp_record_number','shp_content_length');
- $self->extract_ints('little','shp_shape_type');
-
- my $parser = "parse_shp_".$self->type($self->{shp_shape_type});
- if($self->can($parser)) {
- $self->$parser();
- } else {
- croak "Can't parse shape_type ".$self->{shp_shape_type};
- }
-
- if(length($self->{shp_data})) {
- carp length($self->{shp_data})." byte".
- ((length($self->{shp_data})>1)?'s':'')." remaining in buffer ".
- "after parsing ".$self->shape_type_text()." #".
- $self->shape_id();
- }
-}
-
-sub parse_shp_Null {
- my $self = shift;
-}
-
-# TODO - document this
-sub add_point {
- my $self = shift;
-
- if(@_ == 1) {
- my $point = shift;
- if($point->isa("Geo::ShapeFile::Point")) {
- push(@{$self->{shp_points}}, $point);
- }
- } else {
- my %point_opts = @_;
-
- push(@{$self->{shp_points}}, new Geo::ShapeFile::Point(%point_opts));
- $self->{shp_num_points}++;
- }
-}
-
-# TODO - document this
-sub add_part {
- my $self = shift;
-
- push(@{$self->{shp_parts}},$self->{shp_num_parts}++);
-}
-
-# TODO - finish me
-sub calculate_bounds {
- my $self = shift;
-
- my %bounds = $self->find_bounds($self->points);
- foreach(keys %bounds) {
- $self->{"shp_".$_} = $bounds{$_};
- }
- return %bounds;
-}
-
-sub parse_shp_Point {
- my $self = shift;
-
- $self->extract_doubles('shp_X', 'shp_Y');
- $self->{shp_points} = [new Geo::ShapeFile::Point(
- X => $self->{shp_X},
- Y => $self->{shp_Y},
- )];
- $self->{shp_num_points} = 1;
-}
-# Point
-# Double X // X coordinate
-# Double Y // Y coordinate
-
-sub parse_shp_PolyLine {
- my $self = shift;
-
- $self->extract_bounds();
- $self->extract_parts_and_points();
-}
-# PolyLine
-# Double[4] Box // Bounding Box
-# Integer NumParts // Number of parts
-# Integer NumPoints // Number of points
-# Integer[NumParts] Parts // Index to first point in part
-# Point[NumPoints] Points // Points for all parts
-
-sub parse_shp_Polygon {
- my $self = shift;
-
- $self->extract_bounds();
- $self->extract_parts_and_points();
-}
-# Polygon
-# Double[4] Box // Bounding Box
-# Integer NumParts // Number of Parts
-# Integer NumPoints // Total Number of Points
-# Integer[NumParts] Parts // Index to First Point in Part
-# Point[NumPoints] Points // Points for All Parts
-
-sub parse_shp_MultiPoint {
- my $self = shift;
-
- $self->extract_bounds();
- $self->extract_ints('little','shp_num_points');
- $self->extract_points($self->{shp_num_points},'shp_points');
-}
-# MultiPoint
-# Double[4] Box // Bounding Box
-# Integer NumPoints // Number of Points
-# Point[NumPoints] Points // The points in the set
-
-sub parse_shp_PointZ {
- my $self = shift;
-
- $self->parse_shp_Point();
- $self->extract_doubles('shp_Z', 'shp_M');
- $self->{shp_points}->[0]->Z($self->{shp_Z});
- $self->{shp_points}->[0]->M($self->{shp_M});
-}
-# PointZ
-# Point +
-# Double Z
-# Double M
-
-sub parse_shp_PolyLineZ {
- my $self = shift;
-
- $self->parse_shp_PolyLine();
- $self->extract_z_data();
- $self->extract_m_data();
-}
-# PolyLineZ
-# PolyLine +
-# Double[2] Z Range
-# Double[NumPoints] Z Array
-# Double[2] M Range
-# Double[NumPoints] M Array
-
-sub parse_shp_PolygonZ {
- my $self = shift;
-
- $self->parse_shp_Polygon();
- $self->extract_z_data();
- $self->extract_m_data();
-}
-# PolygonZ
-# Polygon +
-# Double[2] Z Range
-# Double[NumPoints] Z Array
-# Double[2] M Range
-# Double[NumPoints] M Array
-
-sub parse_shp_MultiPointZ {
- my $self = shift;
-
- $self->parse_shp_MultiPoint();
- $self->extract_z_data();
- $self->extract_m_data();
-}
-# MultiPointZ
-# MultiPoint +
-# Double[2] Z Range
-# Double[NumPoints] Z Array
-# Double[2] M Range
-# Double[NumPoints] M Array
-
-sub parse_shp_PointM {
- my $self = shift;
-
- $self->parse_shp_Point();
- $self->extract_doubles('shp_M');
- $self->{shp_points}->[0]->M($self->{shp_M});
-}
-# PointM
-# Point +
-# Double M // M coordinate
-
-sub parse_shp_PolyLineM {
- my $self = shift;
-
- $self->parse_shp_PolyLine();
- $self->extract_m_data();
-}
-# PolyLineM
-# PolyLine +
-# Double[2] MRange // Bounding measure range
-# Double[NumPoints] MArray // Measures for all points
-
-sub parse_shp_PolygonM {
- my $self = shift;
-
- $self->parse_shp_Polygon();
- $self->extract_m_data();
-}
-# PolygonM
-# Polygon +
-# Double[2] MRange // Bounding Measure Range
-# Double[NumPoints] MArray // Measures for all points
-
-sub parse_shp_MultiPointM {
- my $self = shift;
-
- $self->parse_shp_MultiPoint();
- $self->extract_m_datextract_m_data();
-}
-# MultiPointM
-# MultiPoint
-# Double[2] MRange // Bounding measure range
-# Double[NumPoints] MArray // Measures
-
-sub parse_shp_MultiPatch {
- my $self = shift;
-
- $self->extract_bounds();
- $self->extract_parts_and_points();
- $self->extract_z_data();
- $self->extract_m_data();
-}
-# MultiPatch
-# Double[4] BoundingBox
-# Integer NumParts
-# Integer NumPoints
-# Integer[NumParts] Parts
-# Integer[NumParts] PartTypes
-# Point[NumPoints] Points
-# Double[2] Z Range
-# Double[NumPoints] Z Array
-# Double[2] M Range
-# Double[NumPoints] M Array
-
-sub extract_bounds {
- my $self = shift;
-
- $self->extract_doubles(qw/shp_x_min shp_y_min shp_x_max shp_y_max/);
-}
-
-sub extract_ints {
- my $self = shift;
- my $end = shift;
- my @what = @_;
-
- my $template = ($end =~ /^l/i)?'V':'N';
-
- $self->extract_and_unpack(4, $template, @what);
-}
-
-sub extract_count_ints {
- my $self = shift;
- my $count = shift;
- my $end = shift;
- my $label = shift;
-
- my $template = ($end =~ /^l/i)?'V':'N';
-
- my $tmp = substr($self->{shp_data},0,($count*4),'');
- my @tmp = unpack($template.$count,$tmp);
- #my @tmp = unpack($template."[$count]",$tmp);
-
- $self->{$label} = [@tmp];
-}
-
-sub extract_doubles {
- my $self = shift;
- my @what = @_;
- my $size = 8;
- my $template = 'd';
-
- foreach ( @what ) {
- my $tmp = substr( $self->{shp_data}, 0, $size, '' );
- $self->{ $_ } = unpack( 'b', pack( 'S', 1 ) )
- ? unpack( $template, $tmp )
- : unpack( $template, scalar( reverse( $tmp ) ) );
- }
-}
-
-sub extract_count_doubles {
- my $self = shift;
- my $count = shift;
- my $label = shift;
-
- my $tmp = substr($self->{shp_data},0,$count*8,'');
- my @tmp = unpack( 'b', pack( 'S', 1 ) )
- ? unpack( 'd'.$count, $tmp )
- : reverse( unpack( 'd'.$count, scalar( reverse( $tmp ) ) ) );
-
- $self->{$label} = [@tmp];
-}
-
-sub extract_points {
- my $self = shift;
- my $count = shift;
- my $label = shift;
-
- my $data = substr($self->{shp_data},0,$count*16,'');
-
- my @ps = unpack( 'b', pack( 'S', 1 ) )
- ? unpack( 'd*', $data )
- : reverse( unpack( 'd*', scalar( reverse( $data ) ) ) );
-
- my @p = (); # points
- while(@ps) {
- push(@p, new Geo::ShapeFile::Point(X => shift(@ps), Y => shift(@ps)));
- }
- $self->{$label} = [@p];
-}
-
-sub extract_and_unpack {
- my $self = shift;
- my $size = shift;
- my $template = shift;
- my @what = @_;
-
- foreach(@what) {
- my $tmp = substr($self->{shp_data},0,$size,'');
- if ( $template eq 'd' ) {
- $tmp = Geo::ShapeFile->byteswap( $tmp );
- }
- $self->{$_} = unpack($template,$tmp);
- }
-}
-
-sub num_parts { shift()->{shp_num_parts}; }
-sub parts {
- my $self = shift;
-
- my $parts = $self->{shp_parts};
- if(wantarray) {
- if($parts) {
- return @{$parts};
- } else {
- return ();
- }
- } else {
- return $parts;
- }
-}
-
-sub num_points { shift()->{shp_num_points}; }
-sub points {
- my $self = shift;
-
- my $points = $self->{shp_points};
- if(wantarray) {
- if($points) {
- return @{$points};
- } else {
- return ();
- }
- } else {
- return $points;
- }
-}
-
-sub get_part {
- my $self = shift;
- my $index = shift;
-
- $index -= 1; # shift to a 0 index
-
- my @parts = $self->parts;
- my @points = $self->points;
- my $beg = $parts[$index] || 0;
- my $end = $parts[$index+1] || 0;
- $end -= 1;
- if($end < 0) { $end = $#points; }
-
- return @points[$beg .. $end];
-}
-
-sub shape_type {
- my $self = shift;
-
- return $self->{shp_shape_type};
-}
-
-sub shape_id {
- my $self = shift;
- return $self->{shp_record_number};
-}
-
-sub extract_z_data {
- my $self = shift;
-
- $self->extract_doubles('shp_z_min','shp_z_max');
- $self->extract_count_doubles($self->{shp_num_points}, 'shp_z_data');
- my @zdata = @{delete $self->{shp_z_data}};
- for(0 .. $#zdata) { $self->{shp_points}->[$_]->Z($zdata[$_]); }
-}
-
-sub extract_m_data {
- my $self = shift;
-
- $self->extract_doubles('shp_m_min','shp_m_max');
- $self->extract_count_doubles($self->{shp_num_points}, 'shp_m_data');
- my @mdata = @{delete $self->{shp_m_data}};
- for(0 .. $#mdata) { $self->{shp_points}->[$_]->M($mdata[$_]); }
-}
-
-sub extract_parts_and_points {
- my $self = shift;
-
- $self->extract_ints('little','shp_num_parts','shp_num_points');
- $self->extract_count_ints($self->{shp_num_parts},'little','shp_parts');
- $self->extract_points($self->{shp_num_points},'shp_points');
-}
-
-sub x_min { shift()->{shp_x_min}; }
-sub x_max { shift()->{shp_x_max}; }
-sub y_min { shift()->{shp_y_min}; }
-sub y_max { shift()->{shp_y_max}; }
-sub z_min { shift()->{shp_z_min}; }
-sub z_max { shift()->{shp_z_max}; }
-sub m_min { shift()->{shp_m_min}; }
-sub m_max { shift()->{shp_m_max}; }
-
-sub has_point {
- my $self = shift;
- my $point = shift;
-
- return 0 unless $self->bounds_contains_point($point);
-
- foreach($self->points) {
- return 1 if $_ == $point;
- }
-
- return 0;
-}
-
-sub contains_point {
- my ( $self, $point ) = @_;
-
- return 0 unless $self->bounds_contains_point( $point );
-
- my $a = 0;
- my ( $x0, $y0 ) = ( $point->X, $point->Y );
-
- for ( 1 .. $self->num_parts ) {
- my ( $x1, $y1 );
- for my $p2 ( $self->get_part( $_ ) ) {
- my $x2 = $p2->X - $x0;
- my $y2 = $p2->Y - $y0;
-
- if ( defined( $y1 ) && ( ( $y2 >= 0 ) != ( $y1 >= 0 ) ) ) {
- my $isl = $x1*$y2 - $y1*$x2;
- if ( $y2 > $y1 ) {
- --$a if $isl > 0;
- } else {
- ++$a if $isl < 0;
- }
- }
- ( $x1, $y1 ) = ( $x2, $y2 );
- }
- }
- return $a;
-}
-
-sub get_segments {
- my $self = shift;
- my $part = shift;
-
- my @points = $self->get_part($part);
- my @segments = ();
- for(0 .. $#points-1) {
- push(@segments,[$points[$_],$points[$_+1]]);
- }
- return @segments;
-}
-
-sub vertex_centroid {
- my $self = shift;
- my $part = shift;
-
- my $cx = 0;
- my $cy = 0;
-
- my @points = ();
- if($part) {
- @points = $self->get_part($part);
- } else {
- @points = $self->points;
- }
-
- foreach(@points) { $cx += $_->X; $cy += $_->Y; }
-
- new Geo::ShapeFile::Point(
- X => ($cx / @points),
- Y => ($cy / @points),
- );
-}
-*centroid = \&vertex_centroid;
-
-sub area_centroid {
- my ( $self, $part ) = @_;
-
- my ( $cx, $cy ) = ( 0, 0 );
- my $A = 0;
-
- my @points;
- my @parts = ();
- if ( defined( $part ) ) {
- @parts = ( $part );
- } else {
- @parts = 1 .. $self->num_parts;
- }
- for my $part ( @parts ) {
- my ( $p0, @pts ) = $self->get_part( $part );
- my ( $x0, $y0 ) = ( $p0->X, $p0->Y );
- my ( $x1, $y1 ) = ( 0, 0 );
- my ( $cxp, $cyp ) = ( 0, 0 );
- my $Ap = 0;
- for ( @pts ) {
- my $x2 = $_->X - $x0;
- my $y2 = $_->Y - $y0;
- $Ap += ( my $a = $x2*$y1 - $x1*$y2 );
- $cxp += $a * ( $x2 + $x1 ) / 3;
- $cyp += $a * ( $y2 + $y1 ) / 3;
- ( $x1, $y1 ) = ( $x2, $y2 );
- }
- $cx += $Ap * $x0 + $cxp;
- $cy += $Ap * $y0 + $cyp;
- $A += $Ap;
- }
- return Geo::ShapeFile::Point->new( X => ( $cx / $A ), Y => ( $cy / $A ) );
-}
-
-sub dump {
- my $self = shift;
-
- my $return = '';
-
- #$self->points();
- #$self->get_part();
- #$self->x_min,x_max,y_min,y_max,z_min,z_max,m_min,m_max
-
- $return .= sprintf("Shape Type: %s (id: %d) Parts: %d Points: %d\n",
- $self->shape_type_text(),
- $self->shape_id(),
- $self->num_parts(),
- $self->num_points(),
- );
-
- $return .= sprintf("\tX bounds(min=%s, max=%s)\n",
- $self->x_min(),
- $self->x_max(),
- );
-
- $return .= sprintf("\tY bounds(min=%s, max=%s)\n",
- $self->y_min(),
- $self->y_max(),
- );
-
- if(defined $self->z_min() && defined $self->z_max()) {
- $return .= sprintf("\tZ bounds(min=%s, max=%s)\n",
- $self->z_min(),
- $self->z_max(),
- );
- }
-
- if(defined $self->m_min() && defined $self->m_max()) {
- $return .= sprintf("\tM bounds(min=%s, max=%s)\n",
- $self->m_min(),
- $self->m_max(),
- );
- }
-
- for(1 .. $self->num_parts()) {
- $return .= "\tPart $_:\n";
- foreach($self->get_part($_)) {
- $return .= "\t\t$_\n";
- }
- }
-
- $return .= "\n";
-
- return $return;
-}
-
-1;
-__END__
-=head1 NAME
-
-Geo::ShapeFile::Shape - Geo::ShapeFile utility class.
-
-=head1 SYNOPSIS
-
- use Geo::ShapeFile::Shape;
-
- my $shape = new Geo::ShapeFile::Shape;
- $shape->parse_shp($shape_data);
-
-=head1 ABSTRACT
-
- This is a utility class for Geo::ShapeFile that represents shapes.
-
-=head1 DESCRIPTION
-
-This is the Geo::ShapeFile utility class that actually contains shape data
-for an individual shape from the shp file.
-
-=head2 EXPORT
-
-None by default.
-
-=head1 METHODS
-
-=over 4
-
-=item new()
-
-Creates a new Geo::ShapeFile::Shape object, takes no arguments and returns
-the created object. Normally Geo::ShapeFile does this for you when you call
-it's get_shp_record() method, so you shouldn't need to create a new object.
-(Eventually this module will have support for _creating_ shapefiles rather
-than just reading them, then this method will become important.
-
-=item num_parts()
-
-Returns the number of parts that make up this shape.
-
-=item num_points()
-
-Returns the number of points that make up this shape.
-
-=item points()
-
-Returns an array of Geo::ShapeFile::Point objects that contains all the points
-in this shape. Note that because a shape can contain multiple segments, which
-may not be directly connected, you probably don't want to use this to retrieve
-points which you are going to plot. If you are going to draw the shape, you
-probably want to use get_part() to retrieve the individual parts instead.
-
-=item get_part($part_index);
-
-Returns the specified part of the shape. This is the information you want if
-you intend to draw the shape. You can iterate through all the parts that make
-up a shape like this:
-
- for(1 .. $obj->num_parts) {
- my $part = $obj->get_part($_);
- # ... do something here, draw a map maybe
- }
-
-=item shape_type()
-
-Returns the numeric type of this shape, use Geo::ShapeFile::type() to determine
-the human-readable name from this type.
-
-=item shape_id()
-
-Returns the id number for this shape, as contained in the shp file.
-
-=item x_min() x_max() y_min() y_max()
-
-=item z_min() z_max() m_min() m_max()
-
-Returns the minimum/maximum ranges of the X, Y, Z, or M values for this shape,
-as contained in it's header information.
-
-=item has_point($point)
-
-Returns true if the point provided is one of the points in the shape. Note
-that this does a simple comparison with the points that make up the shape, it
-will not find a point that falls along a vertex between two points in the
-shape. See the Geo::ShapeFile::Point documentation for a note about how
-to exclude Z and/or M data from being considered when matching points.
-
-=item contains_point($point);
-
-Returns true if the specified point falls in the interior of this shape
-and false if the point is outside the shape. Return value is unspecified
-if the point is one of the vertices or lies on some segment of the
-bounding polygon.
-
-Note that the return value is actually a winding-number computed ignoring
-Z and M fields and so will be negative if the point is contained within a
-shape winding the wrong way.
-
-=item get_segments($part)
-
-Returns an array consisting of array hashes, which contain the points for
-each segment of a multi-segment part.
-
-=item vertex_centroid( $part );
-
-Returns a L<Geo::ShapeFile::Point> that represents the calculated centroid
-of the shapes vertices. If given a part index, calculates just for that
-part, otherwise calculates it for the entire shape. See L</centroid> for
-more on vertex_centroid vs area_centroid.
-
-=item area_centroid( $part );
-
-Returns a L<Geo::ShapeFile::Point> that represents the calculated area
-centroid of the shape. If given a part index, calculates just for that
-part, otherwise calculates it for the entire shape. See L</centroid> for
-more on vertex_centroid vs area_centroid.
-
-=item centroid($part)
-
-For backwards-compatibility reasons, centroid() is currently an alias to
-vertex_centroid(), although it would probably make more sense for it to
-point to area_centroid(). To avoid confusion (and possible future
-deprecation), you should avoid this and use either vertex_centroid or
-area_centroid.
-
-=item dump()
-
-Returns a text dump of the object, showing the shape type, id number, number
-of parts, number of total points, the bounds for the X, Y, Z, and M ranges,
-and the coordinates of the points in each part of the shape.
-
-=back
-
-=head1 REPORTING BUGS
-
-Please send any bugs, suggestions, or feature requests to
- E<lt>geo-shapefile-bugs@jasonkohles.comE<gt>.
-
-=head1 SEE ALSO
-
-Geo::ShapeFile
-
-=head1 AUTHOR
-
-Jason Kohles, E<lt>email@jasonkohles.com<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2002 by Jason Kohles
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
+package Geo::ShapeFile::Shape;
+use strict;
+use warnings;
+use Carp;
+use Tree::R;
+use List::Util qw /min max/;
+
+use Geo::ShapeFile;
+use Geo::ShapeFile::Point;
+use Geo::ShapeFile::Shape::Index;
+
+use parent qw /Geo::ShapeFile/;
+
+our $VERSION = '2.60';
+
+my $little_endian_sys = unpack 'b', (pack 'S', 1 );
+
+my $index_class = 'Geo::ShapeFile::Shape::Index';
+
+sub new {
+ my $proto = shift;
+ my $class = ref ($proto) || $proto;
+ my %args = @_;
+
+ my $self = {
+ shp_content_length => 0,
+ source => undef,
+ shp_points => [],
+ shp_num_points => 0,
+ shp_parts => [],
+ shp_record_number => undef,
+ shp_shape_type => undef,
+ shp_num_parts => 0,
+ shp_x_min => undef,
+ shp_x_max => undef,
+ shp_y_min => undef,
+ shp_y_max => undef,
+ shp_z_min => undef,
+ shp_z_max => undef,
+ shp_m_min => undef,
+ shp_m_max => undef,
+ shp_data => undef,
+ };
+
+ foreach (keys %args) {
+ $self->{$_} = $args{$_};
+ }
+
+ bless $self, $class;
+
+ return $self;
+}
+
+sub parse_shp {
+ my $self = shift;
+
+ $self->{source} = $self->{shp_data} = shift;
+
+ $self->_extract_ints('big', 'shp_record_number', 'shp_content_length');
+ $self->_extract_ints('little', 'shp_shape_type');
+
+ my $parser = '_parse_shp_' . $self->type($self->{shp_shape_type});
+
+ croak "Can't parse shape_type $self->{shp_shape_type}"
+ if !$self->can($parser);
+
+ $self->$parser();
+
+ if (length($self->{shp_data})) {
+ my $len = length($self->{shp_data});
+ my $byte_plural = $len > 1 ? 's' : '';
+ carp "$len byte$byte_plural remaining in buffer after parsing "
+ . $self->shape_type_text()
+ . ' #'
+ . $self->shape_id();
+ }
+}
+
+sub _parse_shp_Null {
+ my $self = shift;
+}
+
+# TODO - document this
+sub add_point {
+ my $self = shift;
+
+ if(@_ == 1) {
+ my $point = shift;
+ if($point->isa('Geo::ShapeFile::Point')) {
+ push @{$self->{shp_points}}, $point;
+ }
+ }
+ else {
+ my %point_opts = @_;
+
+ push @{$self->{shp_points}}, Geo::ShapeFile::Point->new(%point_opts);
+ $self->{shp_num_points}++;
+ }
+}
+
+# TODO - document this
+sub add_part {
+ my $self = shift;
+
+ push @{$self->{shp_parts}}, $self->{shp_num_parts}++;
+}
+
+# TODO - finish me
+sub calculate_bounds {
+ my $self = shift;
+
+ my %bounds = $self->find_bounds($self->points);
+ foreach (keys %bounds) {
+ $self->{'shp_' . $_} = $bounds{$_};
+ }
+ return %bounds;
+}
+
+sub _parse_shp_Point {
+ my $self = shift;
+ $self->_extract_doubles('shp_X', 'shp_Y');
+ $self->{shp_points} = [Geo::ShapeFile::Point->new(
+ X => $self->{shp_X},
+ Y => $self->{shp_Y},
+ )];
+ $self->{shp_num_points} = 1;
+ $self->{shp_x_min} = $self->{shp_X};
+ $self->{shp_x_max} = $self->{shp_X};
+ $self->{shp_y_min} = $self->{shp_Y};
+ $self->{shp_y_max} = $self->{shp_Y};
+}
+# Point
+# Double X // X coordinate
+# Double Y // Y coordinate
+
+sub _parse_shp_PolyLine {
+ my $self = shift;
+
+ $self->_extract_bounds();
+ $self->_extract_parts_and_points();
+}
+# PolyLine
+# Double[4] Box // Bounding Box
+# Integer NumParts // Number of parts
+# Integer NumPoints // Number of points
+# Integer[NumParts] Parts // Index to first point in part
+# Point[NumPoints] Points // Points for all parts
+
+sub _parse_shp_Polygon {
+ my $self = shift;
+
+ $self->_extract_bounds();
+ $self->_extract_parts_and_points();
+}
+# Polygon
+# Double[4] Box // Bounding Box
+# Integer NumParts // Number of Parts
+# Integer NumPoints // Total Number of Points
+# Integer[NumParts] Parts // Index to First Point in Part
+# Point[NumPoints] Points // Points for All Parts
+
+sub _parse_shp_MultiPoint {
+ my $self = shift;
+
+ $self->_extract_bounds();
+ $self->_extract_ints('little', 'shp_num_points');
+ $self->_extract_points($self->{shp_num_points}, 'shp_points');
+}
+# MultiPoint
+# Double[4] Box // Bounding Box
+# Integer NumPoints // Number of Points
+# Point[NumPoints] Points // The points in the set
+
+sub _parse_shp_PointZ {
+ my $self = shift;
+
+ $self->_parse_shp_Point();
+ $self->_extract_doubles('shp_Z', 'shp_M');
+ $self->{shp_points}->[0]->Z($self->{shp_Z});
+ $self->{shp_points}->[0]->M($self->{shp_M});
+}
+# PointZ
+# Point +
+# Double Z
+# Double M
+
+sub _parse_shp_PolyLineZ {
+ my $self = shift;
+
+ $self->_parse_shp_PolyLine();
+ $self->_extract_z_data();
+ $self->_extract_m_data();
+}
+# PolyLineZ
+# PolyLine +
+# Double[2] Z Range
+# Double[NumPoints] Z Array
+# Double[2] M Range
+# Double[NumPoints] M Array
+
+sub _parse_shp_PolygonZ {
+ my $self = shift;
+
+ $self->_parse_shp_Polygon();
+ $self->_extract_z_data();
+ $self->_extract_m_data();
+}
+# PolygonZ
+# Polygon +
+# Double[2] Z Range
+# Double[NumPoints] Z Array
+# Double[2] M Range
+# Double[NumPoints] M Array
+
+sub _parse_shp_MultiPointZ {
+ my $self = shift;
+
+ $self->_parse_shp_MultiPoint();
+ $self->_extract_z_data();
+ $self->_extract_m_data();
+}
+# MultiPointZ
+# MultiPoint +
+# Double[2] Z Range
+# Double[NumPoints] Z Array
+# Double[2] M Range
+# Double[NumPoints] M Array
+
+sub _parse_shp_PointM {
+ my $self = shift;
+
+ $self->_parse_shp_Point();
+ $self->_extract_doubles('shp_M');
+ $self->{shp_points}->[0]->M($self->{shp_M});
+}
+# PointM
+# Point +
+# Double M // M coordinate
+
+sub _parse_shp_PolyLineM {
+ my $self = shift;
+
+ $self->_parse_shp_PolyLine();
+ $self->_extract_m_data();
+}
+# PolyLineM
+# PolyLine +
+# Double[2] MRange // Bounding measure range
+# Double[NumPoints] MArray // Measures for all points
+
+sub _parse_shp_PolygonM {
+ my $self = shift;
+
+ $self->_parse_shp_Polygon();
+ $self->_extract_m_data();
+}
+# PolygonM
+# Polygon +
+# Double[2] MRange // Bounding Measure Range
+# Double[NumPoints] MArray // Measures for all points
+
+sub _parse_shp_MultiPointM {
+ my $self = shift;
+
+ $self->_parse_shp_MultiPoint();
+ $self->_extract_m_datextract_m_data();
+}
+# MultiPointM
+# MultiPoint
+# Double[2] MRange // Bounding measure range
+# Double[NumPoints] MArray // Measures
+
+sub _parse_shp_MultiPatch {
+ my $self = shift;
+
+ $self->_extract_bounds();
+ $self->_extract_parts_and_points();
+ $self->_extract_z_data();
+ $self->_extract_m_data();
+}
+# MultiPatch
+# Double[4] BoundingBox
+# Integer NumParts
+# Integer NumPoints
+# Integer[NumParts] Parts
+# Integer[NumParts] PartTypes
+# Point[NumPoints] Points
+# Double[2] Z Range
+# Double[NumPoints] Z Array
+# Double[2] M Range
+# Double[NumPoints] M Array
+
+sub _extract_bounds {
+ my $self = shift;
+
+ $self->_extract_doubles(qw/shp_x_min shp_y_min shp_x_max shp_y_max/);
+}
+
+sub _extract_ints {
+ my $self = shift;
+ my $end = shift;
+ my @what = @_;
+
+ my $template = ($end =~ /^l/i) ? 'V' :'N';
+
+ $self->_extract_and_unpack(4, $template, @what);
+}
+
+sub _extract_count_ints {
+ my $self = shift;
+ my $count = shift;
+ my $end = shift;
+ my $label = shift;
+
+ my $template = ($end =~ /^l/i) ? 'V' :'N';
+
+ my $tmp = substr $self->{shp_data}, 0, ($count * 4), '';
+ my @tmp = unpack $template . $count, $tmp;
+ #my @tmp = unpack($template."[$count]",$tmp);
+
+ $self->{$label} = [@tmp];
+}
+
+sub _extract_doubles {
+ my $self = shift;
+ my @what = @_;
+ my $size = 8;
+ my $template = 'd';
+
+ foreach ( @what ) {
+ my $tmp = substr $self->{shp_data}, 0, $size, '';
+ $self->{ $_ } = $little_endian_sys
+ ? (unpack $template, $tmp )
+ : (unpack $template, scalar reverse $tmp );
+ }
+}
+
+sub _extract_count_doubles {
+ my $self = shift;
+ my $count = shift;
+ my $label = shift;
+
+ my $tmp = substr $self->{shp_data}, 0, $count*8, '';
+ my @tmp = $little_endian_sys
+ ? (unpack 'd'.$count, $tmp )
+ : (reverse unpack( 'd' . $count, scalar ( reverse( $tmp ) ) ) );
+
+ $self->{$label} = [@tmp];
+}
+
+sub _extract_points {
+ my $self = shift;
+ my $count = shift;
+ my $label = shift;
+
+ my $data = substr $self->{shp_data}, 0, $count * 16, '';
+
+ my @ps = $little_endian_sys
+ ? (unpack 'd*', $data )
+ : (reverse unpack 'd*', scalar reverse $data );
+
+ my @p = (); # points
+ while(@ps) {
+ my ($x, $y) = (shift @ps, shift @ps);
+ push @p, Geo::ShapeFile::Point->new(X => $x, Y => $y);
+ }
+ $self->{$label} = [@p];
+}
+
+sub _extract_and_unpack {
+ my $self = shift;
+ my $size = shift;
+ my $template = shift;
+ my @what = @_;
+
+ foreach(@what) {
+ my $tmp = substr $self->{shp_data}, 0, $size, '';
+ if ( $template eq 'd' ) {
+ $tmp = Geo::ShapeFile->byteswap( $tmp );
+ }
+ $self->{$_} = unpack $template, $tmp;
+ }
+}
+
+sub num_parts { shift()->{shp_num_parts}; }
+sub parts {
+ my $self = shift;
+
+ my $parts = $self->{shp_parts};
+
+ return wantarray ? @{$parts || []} : $parts;
+}
+
+sub num_points { shift()->{shp_num_points}; }
+sub points {
+ my $self = shift;
+
+ my $points = $self->{shp_points};
+
+ return wantarray ? @{$points || []} : $points;
+}
+
+sub get_part {
+ my $self = shift;
+ my $index = shift;
+
+ croak 'index passed to get_part must be >0'
+ if $index <= 0;
+
+ $index -= 1; # shift to a 0 index
+
+ # $parts is an array of starting indexes in the $points array
+ my $parts = $self->parts;
+ croak 'index exceeds number of parts'
+ if $index > $#$parts;
+
+ my $points = $self->points;
+ my $beg = $parts->[$index] || 0;
+ my $end = $parts->[$index+1] || 0; # if we use 5.010 then we can use the // operator here
+ $end -= 1;
+ if ($end < 0) {
+ $end = $#$points;
+ }
+
+ return wantarray ? @$points[$beg .. $end] : [@$points[$beg .. $end]];
+}
+
+sub shape_type {
+ my $self = shift;
+ return $self->{shp_shape_type};
+}
+
+sub shape_id {
+ my $self = shift;
+ return $self->{shp_record_number};
+}
+
+sub _extract_z_data {
+ my $self = shift;
+
+ $self->_extract_doubles('shp_z_min', 'shp_z_max');
+ $self->_extract_count_doubles($self->{shp_num_points}, 'shp_z_data');
+ my @zdata = @{delete $self->{shp_z_data}};
+ for (0 .. $#zdata) {
+ $self->{shp_points}->[$_]->Z($zdata[$_]);
+ }
+}
+
+sub _extract_m_data {
+ my $self = shift;
+
+ $self->_extract_doubles ('shp_m_min', 'shp_m_max');
+ $self->_extract_count_doubles($self->{shp_num_points}, 'shp_m_data');
+ my @mdata = @{delete $self->{shp_m_data}};
+ for (0 .. $#mdata) {
+ $self->{shp_points}->[$_]->M($mdata[$_]);
+ }
+}
+
+sub _extract_parts_and_points {
+ my $self = shift;
+
+ $self->_extract_ints('little', 'shp_num_parts', 'shp_num_points');
+ $self->_extract_count_ints($self->{shp_num_parts}, 'little', 'shp_parts');
+ $self->_extract_points($self->{shp_num_points}, 'shp_points');
+}
+
+
+# these could be factory generated
+sub x_min { shift()->{shp_x_min}; }
+sub x_max { shift()->{shp_x_max}; }
+sub y_min { shift()->{shp_y_min}; }
+sub y_max { shift()->{shp_y_max}; }
+sub z_min { shift()->{shp_z_min}; }
+sub z_max { shift()->{shp_z_max}; }
+sub m_min { shift()->{shp_m_min}; }
+sub m_max { shift()->{shp_m_max}; }
+
+sub bounds {
+ my $self = shift;
+
+ my @results = (
+ $self->x_min,
+ $self->y_min,
+ $self->x_max,
+ $self->y_max,
+ );
+
+ return wantarray ? @results : \@results;
+}
+
+sub has_point {
+ my $self = shift;
+ my $point = shift;
+
+ return 0 if !$self->bounds_contains_point($point);
+
+ foreach my $check_pt ($self->points) {
+ return 1 if $check_pt == $point;
+ }
+
+ return 0;
+}
+
+sub contains_point {
+ my ( $self, $point, $index_res ) = @_;
+
+ return $self->_contains_point_use_index ($point, $index_res)
+ if $self->get_spatial_index || defined $index_res;
+
+ return 0 if !$self->bounds_contains_point( $point );
+
+ my $a = 0;
+ my ( $x0, $y0 ) = ( $point->get_x, $point->get_y );
+
+ # one day we will track the bounds of the parts
+ # so we can more easily skip parts of multipart polygons
+ my $num_parts = $self->num_parts;
+
+ # $x1, $x2, $y1 and $y2 are offsets from the point we are checking
+ foreach my $part_num (1 .. $num_parts) {
+ my $points = $self->get_part( $part_num );
+
+ my $p_start = shift @$points; # $points is a copy, so no harm in shifting
+ my $x1 = $p_start->get_x - $x0;
+ my $y1 = $p_start->get_y - $y0;
+
+ foreach my $p2 ( @$points ) {
+ my $x2 = $p2->get_x - $x0;
+ my $y2 = $p2->get_y - $y0;
+
+ # does the ray intersect the segment?
+ if (($y2 >= 0) != ($y1 >= 0)) {
+ my $isl = $x1 * $y2 - $y1 * $x2;
+ if ( $y2 > $y1 ) {
+ if ($isl > 0) {
+ $a--;
+ }
+ }
+ else {
+ if ($isl < 0) {
+ $a++;
+ }
+ }
+ }
+ ( $x1, $y1 ) = ( $x2, $y2 );
+ }
+ }
+
+ return $a;
+}
+
+sub _contains_point_use_index {
+ my ( $self, $point, $index_res ) = @_;
+
+ return 0 if !$self->bounds_contains_point( $point );
+
+ my $sp_index_hash = $self->get_spatial_index || $self->build_spatial_index ($index_res);
+
+ my $a = 0;
+ my ( $x0, $y0 ) = ( $point->get_x, $point->get_y );
+
+ my @parts = $self->parts;
+ my $num_parts = scalar @parts;
+
+ # $x1, $x2, $y1 and $y2 are offsets from the point we are checking
+ PART:
+ foreach my $part_index (1 .. $num_parts) {
+ my $sp_index = $sp_index_hash->{$part_index};
+
+ my @results = $sp_index->query_point($x0, $y0);
+
+ # skip if not in this part's bounding box
+ next PART if !scalar @results;
+
+ # segments spanning the index's bounding box
+ for my $segment (@results) {
+
+ # index stores bare x and y coords to avoid method overhead here
+ my $x1 = $segment->[0][0] - $x0;
+ my $y1 = $segment->[0][1] - $y0;
+ my $x2 = $segment->[1][0] - $x0;
+ my $y2 = $segment->[1][1] - $y0;
+
+ # does the ray intersect the segment?
+ if (($y2 >= 0) != ($y1 >= 0)) {
+ my $isl = $x1 * $y2 - $y1 * $x2;
+ if ( $y2 > $y1 ) {
+ if ($isl > 0) {
+ $a--;
+ }
+ }
+ else {
+ if ($isl < 0) {
+ $a++;
+ }
+ }
+ }
+ }
+ }
+
+ return $a;
+}
+
+
+# We could trigger a build if undefined,
+# but save that for later.
+sub get_spatial_index {
+ my $self = shift;
+
+ return $self->{_spatial_indexes};
+}
+
+# Add the polygon's segments to a spatial index
+# where the index boxes are as wide as the part
+# they are in.
+# The set of spatial indexes is a hash keyed by
+# the part ID.
+# $n is the number of boxes - need an automatic way of calculating, poss f(y_range / x_range)
+sub build_spatial_index {
+ my $self = shift;
+ my $n = shift || 10;
+
+ $n = int $n;
+
+ croak 'Cannot build spatial index with <1 boxes'
+ if $n < 1;
+
+ my %sp_indexes;
+
+ my @parts = $self->parts;
+
+ my ($x_min, $x_max, $y_min, $y_max);
+
+ my $part_id = 0;
+ foreach my $part (@parts) {
+ $part_id ++; # parts are indexed base 1
+
+ my $segments = $self->get_segments ($part_id);
+
+ if (@parts > 1) {
+ my %bounds = $self->_get_part_bounds ($part_id);
+ ($x_min, $y_min, $x_max, $y_max) = @bounds{qw /x_min y_min x_max y_max/};
+ }
+ else {
+ ($x_min, $y_min, $x_max, $y_max) = $self->bounds; # faster than searching all points
+ }
+
+ my $n_boxes = @$segments > 20 ? $n : 1;
+ my $sp_index = $index_class->new ($n_boxes, $x_min, $y_min, $x_max, $y_max);
+
+ foreach my $segment (@$segments) {
+ my $p1 = $segment->[0];
+ my $p2 = $segment->[1];
+ my $y0 = $p1->get_y;
+ my $y1 = $p2->get_y;
+
+ # reverse them if needed
+ if ($y1 < $y0) {
+ ($y0, $y1) = ($y1, $y0);
+ }
+
+ # bare metal version
+ my $coords = [
+ [$p1->get_x, $p1->get_y],
+ [$p2->get_x, $p2->get_y],
+ ];
+
+ my @bbox = ($x_min, $y_min, $x_max, $y_max);
+ $sp_index->insert($coords, @bbox);
+ }
+
+ $sp_indexes{$part_id} = $sp_index;
+ }
+
+ $self->{_spatial_indexes} = \%sp_indexes;
+
+ return wantarray ? %sp_indexes : \%sp_indexes;
+}
+
+sub _get_part_bounds {
+ my $self = shift;
+ my $part = shift;
+
+ my $points = $self->get_part($part);
+
+ my $pt1 = shift @$points;
+ my ($x_min, $y_min) = ($pt1->get_x, $pt1->get_y);
+ my ($x_max, $y_max) = ($x_min, $y_min);
+
+ foreach my $pt (@$points) {
+ my $x = $pt->get_x;
+ my $y = $pt->get_y;
+
+ $x_min = min ($x_min, $x);
+ $y_min = min ($y_min, $y);
+ $x_max = max ($x_max, $x);
+ $y_max = max ($y_max, $y);
+ }
+
+ my %bounds = (
+ x_min => $x_min,
+ x_max => $x_max,
+ y_min => $y_min,
+ y_max => $y_max,
+ );
+
+ return wantarray ? %bounds : \%bounds;
+}
+
+sub get_segments {
+ my $self = shift;
+ my $part = shift;
+
+ my $points = $self->get_part($part);
+
+ my @segments;
+ foreach my $i (0 .. $#$points - 1) {
+ push @segments, [$points->[$i], $points->[$i+1]];
+ }
+
+ return wantarray ? @segments : \@segments;
+}
+
+sub vertex_centroid {
+ my $self = shift;
+ my $part = shift;
+
+ my ($cx, $cy) = (0, 0);
+
+ my @points = ();
+ if ($part) {
+ @points = $self->get_part($part);
+ }
+ else {
+ @points = $self->points;
+ }
+
+ foreach (@points) {
+ $cx += $_->X;
+ $cy += $_->Y;
+ }
+
+ Geo::ShapeFile::Point->new(
+ X => $cx / @points,
+ Y => $cy / @points,
+ );
+}
+*centroid = \&vertex_centroid;
+
+sub area_centroid {
+ my ( $self, $part ) = @_;
+
+ my ( $cx, $cy ) = ( 0, 0 );
+ my $A = 0;
+
+ my (@points, @parts);
+
+ if ( defined $part ) {
+ @parts = ( $part );
+ }
+ else {
+ @parts = (1 .. $self->num_parts);
+ }
+
+ for my $part ( @parts ) {
+ my ( $p0, @pts ) = $self->get_part( $part );
+ my ( $x0, $y0 ) = ( $p0->X, $p0->Y );
+ my ( $x1, $y1 ) = ( 0, 0 );
+ my ( $cxp, $cyp ) = ( 0, 0 );
+ my $Ap = 0;
+
+ for ( @pts ) {
+ my $x2 = $_->X - $x0;
+ my $y2 = $_->Y - $y0;
+ $Ap += ( my $a = $x2*$y1 - $x1*$y2 );
+ $cxp += $a * ( $x2 + $x1 ) / 3;
+ $cyp += $a * ( $y2 + $y1 ) / 3;
+ ( $x1, $y1 ) = ( $x2, $y2 );
+ }
+
+ $cx += $Ap * $x0 + $cxp;
+ $cy += $Ap * $y0 + $cyp;
+ $A += $Ap;
+ }
+
+ return Geo::ShapeFile::Point->new(
+ X => $cx / $A,
+ Y => $cy / $A,
+ );
+}
+
+sub dump {
+ my $self = shift;
+
+ my $return = '';
+
+ #$self->points();
+ #$self->get_part();
+ #$self->x_min, x_max, y_min, y_max, z_min, z_max, m_min, m_max
+
+ $return .= sprintf
+ "Shape Type: %s (id: %d) Parts: %d Points: %d\n",
+ $self->shape_type_text(),
+ $self->shape_id(),
+ $self->num_parts(),
+ $self->num_points();
+
+ $return .= sprintf
+ "\tX bounds(min=%s, max=%s)\n",
+ $self->x_min(),
+ $self->x_max();
+
+ $return .= sprintf
+ "\tY bounds(min=%s, max=%s)\n",
+ $self->y_min(),
+ $self->y_max();
+
+ if (defined $self->z_min() && defined $self->z_max()) {
+ $return .= sprintf
+ "\tZ bounds(min=%s, max=%s)\n",
+ $self->z_min(),
+ $self->z_max();
+ }
+
+ if (defined $self->m_min() && defined $self->m_max()) {
+ $return .= sprintf
+ "\tM bounds(min=%s, max=%s)\n",
+ $self->m_min(),
+ $self->m_max();
+ }
+
+ for (1 .. $self->num_parts()) {
+ $return .= "\tPart $_:\n";
+ foreach ($self->get_part($_)) {
+ $return .= "\t\t$_\n";
+ }
+ }
+
+ $return .= "\n";
+
+ return $return;
+}
+
+1;
+__END__
+=head1 NAME
+
+Geo::ShapeFile::Shape - Geo::ShapeFile utility class.
+
+=head1 SYNOPSIS
+
+ use Geo::ShapeFile::Shape;
+
+ my $shape = Geo::ShapeFile::Shape->new;
+ $shape->parse_shp($shape_data);
+
+=head1 ABSTRACT
+
+ This is a utility class for Geo::ShapeFile that represents shapes.
+
+=head1 DESCRIPTION
+
+This is the Geo::ShapeFile utility class that actually contains shape data
+for an individual shape from the shp file.
+
+=head2 EXPORT
+
+None by default.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+Creates a new Geo::ShapeFile::Shape object, takes no arguments and returns
+the created object. Normally L<Geo::ShapeFile> does this for you when you call
+its get_shp_record() method, so you shouldn't need to create a new object.
+(Eventually this module will have support for _creating_ shapefiles rather
+than just reading them, then this method will become important.
+
+=item num_parts()
+
+Returns the number of parts that make up this shape.
+
+=item num_points()
+
+Returns the number of points that make up this shape.
+
+=item points()
+
+Returns an array of Geo::ShapeFile::Point objects that contains all the points
+in this shape. Note that because a shape can contain multiple segments, which
+may not be directly connected, you probably don't want to use this to retrieve
+points which you are going to plot. If you are going to draw the shape, you
+probably want to use get_part() to retrieve the individual parts instead.
+
+=item get_part($part_index);
+
+Returns the specified part of the shape. This is the information you want if
+you intend to draw the shape. You can iterate through all the parts that make
+up a shape like this:
+
+ for(1 .. $obj->num_parts) {
+ my $part = $obj->get_part($_);
+ # ... do something here, draw a map maybe
+ }
+
+=item shape_type()
+
+Returns the numeric type of this shape, use Geo::ShapeFile::type() to determine
+the human-readable name from this type.
+
+=item shape_id()
+
+Returns the id number for this shape, as contained in the shp file.
+
+=item x_min() x_max() y_min() y_max()
+
+=item z_min() z_max() m_min() m_max()
+
+Returns the minimum/maximum ranges of the X, Y, Z, or M values for this shape,
+as contained in it's header information.
+
+=item has_point($point)
+
+Returns true if the point object provided matches one of the points in the shape. Note
+that this does a simple comparison with the points that make up the shape, it
+will not find a point that falls along a vertex between two points in the
+shape. See the L<Geo::ShapeFile::Point> documentation for a note about how
+to exclude Z and/or M data from being considered when matching points.
+
+=item contains_point($point);
+=item contains_point($point, $use_index);
+
+Returns true if the specified point falls in the interior of this shape
+and false if the point is outside the shape. Return value is unspecified
+if the point is one of the vertices or lies on some segment of the
+bounding polygon.
+
+Passing $use_index uses a spatial index if defined (building it if needed).
+See L<build_spatial_index> for more details.
+This will be the default behaviour in a future release.
+
+Note that the algorithm uses a sidedness algorithm ignoring
+Z and M fields and so will likely not work if the point is contained within a
+shape winding the wrong way. Polygon shapes should be anticlockwise for outer boundaries,
+and clockwise for inner void polygons.
+
+=item build_spatial_index ($index_res)
+
+Builds a spatial index for use in contains_point().
+$index_res is a positive integer which sets the nnumber of along the y-axis.
+A value of 0 lets the system determine the number.
+
+=item get_spatial_index()
+
+Gets the spatial index. This is a hash indexed by part number.
+Returns a hash reference in scalar context.
+
+=item bounds
+
+Returns the object's bounds as an array (x_min, y_min, x_max, y_max).
+Returns an array ref in scalar context.
+
+=item get_segments($part)
+
+Returns an array consisting of array hashes, which contain the points for
+each segment of a multi-segment part.
+
+=item vertex_centroid( $part );
+
+Returns a L<Geo::ShapeFile::Point> that represents the calculated centroid
+of the shapes vertices. If given a part index, calculates just for that
+part, otherwise calculates it for the entire shape. See L</centroid> for
+more on vertex_centroid vs area_centroid.
+
+=item area_centroid( $part );
+
+Returns a L<Geo::ShapeFile::Point> that represents the calculated area
+centroid of the shape. If given a part index, calculates just for that
+part, otherwise calculates it for the entire shape. See L</centroid> for
+more on vertex_centroid vs area_centroid.
+
+=item centroid($part)
+
+For backwards-compatibility reasons, centroid() is currently an alias to
+vertex_centroid(), although it would probably make more sense for it to
+point to area_centroid(). To avoid confusion (and possible future
+deprecation), you should avoid this and use either vertex_centroid or
+area_centroid.
+
+=item dump()
+
+Returns a text dump of the object, showing the shape type, id number, number
+of parts, number of total points, the bounds for the X, Y, Z, and M ranges,
+and the coordinates of the points in each part of the shape.
+
+=back
+
+=head1 REPORTING BUGS
+
+Please send any bugs, suggestions, or feature requests to
+ L<https://github.com/shawnlaffan/Geo-ShapeFile/issues>.
+
+=head1 SEE ALSO
+
+L<Geo::ShapeFile>
+
+=head1 AUTHOR
+
+Jason Kohles, E<lt>email@jasonkohles.comE<gt>
+
+Shawn Laffan, E<lt>shawnlaffan@gmail.comE<gt>
+
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2002-2013 by Jason Kohles
+
+Copyright 2014 by Shawn Laffan
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
@@ -1,884 +1,1073 @@
-package Geo::ShapeFile;
-use strict;
-use warnings;
-use Carp;
-use IO::File;
-use Geo::ShapeFile::Shape;
-use Config;
-
-our $VERSION = '2.52';
-
-# Preloaded methods go here.
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
-
- my $self = {};
-
- $self->{filebase} = shift || croak "Must specify filename!";
- $self->{filebase} =~ s/\.\w{3}$//;
-
- $self->{_enable_caching} = {
- shp => 1,
- dbf => 1,
- shx => 1,
- shapes_in_area => 1,
- };
-
- bless($self, $class);
-
- $self->{_change_cache} = {
- shape_type => undef,
- records => undef,
- shp => {},
- dbf => {},
- shx => {},
- };
- $self->{_object_cache} = {
- shp => {},
- dbf => {},
- shx => {},
- shapes_in_area => {},
- };
-
- if(-f $self->{filebase}.".shx") {
- $self->read_shx_header();
- $self->{has_shx} = 1;
- } else {
- $self->{has_shx} = 0;
- }
-
- if(-f $self->{filebase}.".shp") {
- $self->read_shp_header();
- $self->{has_shp} = 1;
- } else {
- $self->{has_shp} = 0;
- }
-
- if(-f $self->{filebase}.".dbf") {
- $self->read_dbf_header();
- $self->{has_dbf} = 1;
- } else {
- $self->{has_dbf} = 0;
- }
-
- return $self;
-}
-
-sub caching {
- my $self = shift;
- my $what = shift;
-
- if(@_) {
- $self->{_enable_caching}->{$what} = shift;
- }
- return $self->{_enable_caching}->{$what};
-}
-
-sub cache {
- my $self = shift;
- my $type = shift;
- my $obj = shift;
-
- if($self->{_change_cache}->{$type} && $self->{_change_cache}->{$type}->{$obj}) {
- return $self->{_change_cache}->{$type}->{$obj};
- }
-
- return unless $self->caching($type);
-
- if($@) {
- $self->{_object_cache}->{$type}->{$obj} = shift;
- }
- return $self->{_object_cache}->{$type}->{$obj};
-}
-
-sub read_shx_header { shift()->read_shx_shp_header('shx',@_); }
-sub read_shp_header { shift()->read_shx_shp_header('shp',@_); }
-sub read_shx_shp_header {
- my $self = shift;
- my $which = shift;
- my $doubles;
-
- $self->{$which."_header"} = $self->get_bytes($which,0,100);
- (
- $self->{$which."_file_code"}, $self->{$which."_file_length"},
- $self->{$which."_version"}, $self->{$which."_shape_type"}, $doubles
- ) = unpack("N x20 N V2 a64",$self->{$which."_header"});
-
- (
- $self->{$which."_x_min"}, $self->{$which."_y_min"},
- $self->{$which."_x_max"}, $self->{$which."_y_max"},
- $self->{$which."_z_min"}, $self->{$which."_z_max"},
- $self->{$which."_m_min"}, $self->{$which."_m_max"},
- ) = (
- unpack( 'b', pack( 'S', 1 ) )
- ? unpack( 'd8', $doubles )
- : reverse( unpack( 'd8', scalar( reverse( $doubles ) ) ) )
- );
-
- return 1;
-}
-
-sub type_is {
- my $self = shift;
- my $type = shift;
-
- return(lc($self->type($self->shape_type)) eq lc($type));
-}
-
-sub read_dbf_header {
- my $self = shift;
-
- $self->{dbf_header} = $self->get_bytes('dbf',0,12);
- (
- $self->{dbf_version},
- $self->{dbf_updated_year},
- $self->{dbf_updated_month},
- $self->{dbf_updated_day},
- $self->{dbf_num_records},
- $self->{dbf_header_length},
- $self->{dbf_record_length},
- ) = unpack("C4 V v v", $self->{dbf_header});
- # unpack changed from c4 l s s to fix endianess problem
- # reported by Daniel Gildea
-
- my $ls = $self->{dbf_header_length} +
- ($self->{dbf_num_records}*$self->{dbf_record_length});
- my $li = -s $self->{filebase}.".dbf";
-
- # some shapefiles (such as are produced by the NOAA NESDIS) don't
- # have a end-of-file marker in their dbf files, Aleksandar Jelenak
- # says the ESRI tools don't have a problem with this, so we shouldn't
- # either
- my $last_byte = $self->get_bytes('dbf',$li-1,1);
- $ls += 1 if (ord $last_byte == 0x1A);
-
- if($ls != $li) {
- croak "dbf: file wrong size (should be $ls, but found $li)";
- }
-
- my $header = $self->get_bytes('dbf',32,$self->{dbf_header_length}-32);
- my $count = 0;
- $self->{dbf_header_info} = [];
-
- while($header) {
- my $tmp = substr($header,0,32,'');
- my $chr = substr($tmp,0,1);
-
- if(ord $chr == 0x0D) { last; }
- if(length($tmp) < 32) { last; }
-
- my %tmp = ();
- (
- $tmp{name},
- $tmp{type},
- $tmp{size},
- $tmp{decimals}
- ) = unpack("Z11 Z x4 C2",$tmp);
-
- $self->{dbf_field_info}->[$count] = {%tmp};
-
- $count++;
- }
- $self->{dbf_fields} = $count;
- if($count < 1) { croak "dbf: Not enough fields ($count < 1)"; }
-
- my @template = ();
- foreach(@{$self->{dbf_field_info}}) {
- if($_->{size} < 1) {
- croak "dbf: Field $_->{name} too short ($_->{size} bytes)";
- }
- if($_->{size} > 4000) {
- croak "dbf: Field $_->{name} too long ($_->{size} bytes)";
- }
-
- push(@template,"A".$_->{size});
- }
- $self->{dbf_record_template} = join(' ',@template);
-
- my @field_names = ();
- foreach(@{$self->{dbf_field_info}}) {
- push(@field_names,$_->{name});
- }
- $self->{dbf_field_names} = [@field_names];
-
- return 1;
-}
-
-sub generate_dbf_header {
- my $self = shift;
-
- #$self->{dbf_header} = $self->get_bytes('dbf',0,12);
- (
- $self->{dbf_version},
- $self->{dbf_updated_year},
- $self->{dbf_updated_month},
- $self->{dbf_updated_day},
- $self->{dbf_num_records},
- $self->{dbf_header_length},
- $self->{dbf_record_length},
- ) = unpack("C4 V v v", $self->{dbf_header});
-
- $self->{_change_cache}->{dbf_cache}->{header} = pack("C4 V v v",
- 3,
- (localtime)[5],
- (localtime)[4]+1,
- (localtime)[3],
- 0, # TODO - num_records,
- 0, # TODO - header_length,
- 0, # TODO - record_length,
- );
-
-# my $ls = $self->{dbf_header_length} +
-# ($self->{dbf_num_records}*$self->{dbf_record_length}) +
-# 1;
-# my $li = -s $self->{filebase}.".dbf";
-#
-# if($ls != $li) {
-# croak "dbf: file wrong size (should be $ls, but found $li)";
-# }
-#
-# my $header = $self->get_bytes('dbf',32,$self->{dbf_header_length}-32);
-# my $count = 0;
-# $self->{dbf_header_info} = [];
-#
-# while($header) {
-# my $tmp = substr($header,0,32,'');
-# my $chr = substr($tmp,0,1);
-#
-# if(ord $chr == 0x0D) { last; }
-# if(length($tmp) < 32) { last; }
-#
-# my %tmp = ();
-# (
-# $tmp{name},
-# $tmp{type},
-# $tmp{size},
-# $tmp{decimals}
-# ) = unpack("Z11 Z x4 C2",$tmp);
-#
-# $self->{dbf_field_info}->[$count] = {%tmp};
-#
-# $count++;
-# }
-# $self->{dbf_fields} = $count;
-# if($count < 1) { croak "dbf: Not enough fields ($count < 1)"; }
-#
-# my @template = ();
-# foreach(@{$self->{dbf_field_info}}) {
-# if($_->{size} < 1) {
-# croak "dbf: Field $_->{name} too short ($_->{size} bytes)";
-# }
-# if($_->{size} > 4000) {
-# croak "dbf: Field $_->{name} too long ($_->{size} bytes)";
-# }
-#
-# push(@template,"A".$_->{size});
-# }
-# $self->{dbf_record_template} = join(' ',@template);
-#
-# my @field_names = ();
-# foreach(@{$self->{dbf_field_info}}) {
-# push(@field_names,$_->{name});
-# }
-# $self->{dbf_field_names} = [@field_names];
-#
-# return 1;
-}
-
-sub get_dbf_record {
- my $self = shift;
- my $entry = shift;
-
- my $dbf = $self->cache('dbf',$entry);
- if(! $dbf) {
- $entry--; # make entry 0-indexed
-
- my $record = $self->get_bytes(
- 'dbf',
- $self->{dbf_header_length}+($self->{dbf_record_length} * $entry),
- $self->{dbf_record_length}+1, # +1 for deleted flag
- );
- my($del,@data) = unpack("c".$self->{dbf_record_template},$record);
-
- map { s/^\s*//; s/\s*$//; } @data;
-
- my %record = ();
- @record{@{$self->{dbf_field_names}}} = @data;
- $record{_deleted} = (ord $del == 0x2A);
- $dbf = {%record};
- $self->cache('dbf',$entry+1,$dbf);
- }
-
- if(wantarray) {
- return %{$dbf};
- } else {
- return $dbf;
- }
-}
-
-sub set_dbf_record {
- my $self = shift;
- my $entry = shift;
- my %record = @_;
-
- $self->{_change_cache}->{dbf}->{$entry} = {%record};
-}
-
-sub get_shp_shx_header_value {
- my $self = shift;
- my $val = shift;
-
- unless($self->{"shx_".$val} || $self->{"shp_".$val}) {
- $self->read_shx_header();
- }
-
- return $self->{"shx_".$val} || $self->{"shp_".$val} || undef;
-}
-
-sub x_min { shift()->get_shp_shx_header_value('x_min'); }
-sub x_max { shift()->get_shp_shx_header_value('x_max'); }
-sub y_min { shift()->get_shp_shx_header_value('y_min'); }
-sub y_max { shift()->get_shp_shx_header_value('y_max'); }
-sub z_min { shift()->get_shp_shx_header_value('z_min'); }
-sub z_max { shift()->get_shp_shx_header_value('z_max'); }
-sub m_min { shift()->get_shp_shx_header_value('m_min'); }
-sub m_max { shift()->get_shp_shx_header_value('m_max'); }
-
-sub upper_left_corner {
- my $self = shift;
-
- return new Geo::ShapeFile::Point(X => $self->x_min, Y => $self->y_min);
-}
-sub upper_right_corner {
- my $self = shift;
-
- return new Geo::ShapeFile::Point(X => $self->x_max, Y => $self->y_min);
-}
-sub lower_right_corner {
- my $self = shift;
-
- return new Geo::ShapeFile::Point(X => $self->x_max, Y => $self->y_max);
-}
-sub lower_left_corner {
- my $self = shift;
-
- return new Geo::ShapeFile::Point(X => $self->x_min, Y => $self->y_max);
-}
-
-sub height {
- my $self = shift;
-
- return $self->x_max - $self->x_min;
-}
-sub width {
- my $self = shift;
-
- return $self->y_max - $self->y_min;
-}
-
-sub corners {
- my $self = shift;
-
- return(
- $self->upper_left_corner,
- $self->upper_right_corner,
- $self->lower_right_corner,
- $self->lower_left_corner,
- );
-}
-
-sub area_contains_point {
- my $self = shift;
- my $point = shift;
- my ($x_min,$y_min,$x_max,$y_max) = @_;
-
- return (
- ($point->X >= $x_min) &&
- ($point->X <= $x_max) &&
- ($point->Y >= $y_min) &&
- ($point->Y <= $y_max)
- );
-}
-
-sub bounds_contains_point {
- my $self = shift;
- my $point = shift;
-
- return $self->area_contains_point(
- $point, $self->x_min, $self->y_min, $self->x_max, $self->y_max,
- );
-}
-
-sub file_version {
- shift()->get_shp_shx_header_value('file_version');
-}
-
-sub shape_type {
- my $self = shift;
-
- if(defined $self->{_change_cache}->{shape_type}) {
- return $self->{_change_cache}->{shape_type};
- } else {
- return $self->get_shp_shx_header_value('shape_type');
- }
-}
-
-sub shapes {
- my $self = shift;
-
- if(defined $self->{_change_cache}->{records}) {
- return $self->{_change_cache}->{records};
- }
- unless($self->{shx_file_length}) { $self->read_shx_header(); }
-
- my $filelength = $self->{shx_file_length};
- $filelength -= 50; # don't count the header
- return ($filelength/4);
-}
-
-sub records {
- my $self = shift;
-
- if(defined $self->{_change_cache}->{records}) {
- return $self->{_change_cache}->{records};
- }
-
- if($self->{shx_file_length}) {
- my $filelength = $self->{shx_file_length};
- $filelength -= 50; # don't count the header
- return ($filelength/4);
- } elsif($self->{dbf_num_records}) {
- return $self->{dbf_num_records};
- }
-}
-
-sub shape_type_text {
- my $self = shift;
-
- return $self->type($self->shape_type());
-}
-
-sub get_shx_record_header { shift()->get_shx_record(@_); }
-sub get_shx_record {
- my $self = shift;
- my $entry = shift;
-
- croak "must specify entry index" unless $entry;
-
- my $shx = $self->cache('shx',$entry);
- unless($shx) {
- my $record = $self->get_bytes('shx',(($entry - 1) * 8) + 100,8);
- $shx = [unpack("N N",$record)];
- $self->cache('shx',$entry,$shx);
- }
- return(@{$shx});
-}
-
-sub get_shp_record_header {
- my $self = shift;
- my $entry = shift;
-
- my($offset) = $self->get_shx_record($entry);
-
- my $record = $self->get_bytes('shp',$offset*2,8);
- my($number,$content_length) = unpack("N N",$record);
-
- return($number,$content_length);
-}
-
-# TODO - cache this
-sub shapes_in_area {
- my $self = shift;
- my @area = @_; # x_min,y_min,x_max,y_max,
-
- my @results = ();
- for(1 .. $self->shapes) {
- my($offset,$content_length) = $self->get_shx_record($_);
- my $type = unpack("V",$self->get_bytes('shp',($offset*2)+8,4));
-
- if($self->type($type) eq 'Null') {
- next;
- } elsif($self->type($type) =~ /^Point/) {
- my $bytes = $self->get_bytes('shp',($offset*2)+12,16);
- my($x,$y) = (
- unpack( 'b', pack( 'S', 1 ) )
- ? unpack( 'dd', $bytes )
- : reverse( unpack( 'dd', scalar( reverse( $bytes ) ) ) )
- );
- my $pt = new Geo::ShapeFile::Point(X => $x, Y => $y);
- if($self->area_contains_point($pt,@area)) {
- push(@results,$_);
- }
- } elsif($self->type($type) =~ /^(PolyLine|Polygon|MultiPoint|MultiPatch)/) {
- my $bytes = $self->get_bytes('shp',($offset*2)+12,32);
- my @p = (
- unpack( 'b', pack( 'S', 1 ) )
- ? unpack( 'd4', $bytes )
- : reverse( unpack( 'd4', scalar( reverse( $bytes ) ) ) )
- );
- if($self->check_in_area(@p,@area) || $self->check_in_area(@area,@p)) {
- push(@results,$_);
- }
- } else {
- print "type=".$self->type($type)."\n";
- }
- }
- return @results;
-}
-
-sub check_in_area {
- my $self = shift;
- my(
- $x1_min,$y1_min,$x1_max,$y1_max,
- $x2_min,$y2_min,$x2_max,$y2_max,
- ) = @_;
-
- my $lhit = $self->between($x1_min,$x2_min,$x2_max);
- my $rhit = $self->between($x1_max,$x2_min,$x2_max);
- my $thit = $self->between($y1_min,$y2_min,$y2_max);
- my $bhit = $self->between($y1_max,$y2_min,$y2_max);
-
- return ( # collision
- ($lhit && $thit) || ($rhit && $thit) || ($lhit && $bhit) || ($rhit && $bhit)
- ) || ( # containment
- ($lhit && $thit) && ($rhit && $thit) && ($lhit && $bhit) && ($rhit && $bhit)
- );
-}
-
-sub between {
- my $self = shift;
-
- my $check = shift;
-
- unless($_[0] < $_[1]) { @_ = reverse @_; }
- return (($check >= $_[0]) && ($check <= $_[1]));
-}
-
-sub bounds {
- my $self = shift;
-
- return($self->x_min,$self->y_min,$self->x_max,$self->y_max);
-}
-
-sub extract_ints {
- my $self = shift;
- my $end = shift;
- my @what = @_;
-
- my $template = ($end =~ /^l/i)?'V':'N';
-
- $self->extract_and_unpack(4, $template, @what);
- foreach(@what) {
- $self->{$_} = $self->{$_};
- }
-}
-
-sub get_shp_record {
- my $self = shift;
- my $entry = shift;
-
- my $shape = $self->cache('shp',$entry);
- unless($shape) {
- my($offset,$content_length) = $self->get_shx_record($entry);
-
- my $record = $self->get_bytes('shp',$offset*2,($content_length*2)+8);
-
- $shape = new Geo::ShapeFile::Shape();
- $shape->parse_shp($record);
- $self->cache('shp',$entry,$shape);
- }
-
- return $shape;
-}
-
-sub shx_handle { shift()->get_handle('shx'); }
-sub shp_handle { shift()->get_handle('shp'); }
-sub dbf_handle { shift()->get_handle('dbf'); }
-sub get_handle {
- my $self = shift;
- my $which = shift;
-
- my $han = $which."_handle";
- unless($self->{$han}) {
- $self->{$han} = new IO::File;
- my $file = join('.', $self->{filebase},$which);
- unless($self->{$han}->open($file, O_RDONLY | O_BINARY)) {
- croak "Couldn't get file handle for $file: $!";
- }
- binmode($self->{$han}); # fix windows bug reported by Patrick Dughi
- }
-
- return $self->{$han};
-}
-
-sub get_bytes {
- my $self = shift;
- my $file = shift;
- my $offset = shift;
- my $length = shift;
-
- my $handle = $file."_handle";
- my $h = $self->$handle();
- $h->seek($offset,0) || confess "Couldn't seek to $offset for $file";;
- my $tmp;
- my $res = $h->read($tmp,$length);
- if(defined $res) {
- if($res == 0) {
- confess "EOF reading $length bytes from $file at offset $offset";
- }
- } else {
- confess "Couldn't read $length bytes from $file at offset $offset ($!)";
- }
- return $tmp;
-}
-
-sub type {
- my $self = shift;
- my $shape = shift;
-
- my %shape_types = qw(
- 0 Null
- 1 Point
- 3 PolyLine
- 5 Polygon
- 8 MultiPoint
- 11 PointZ
- 13 PolyLineZ
- 15 PolygonZ
- 18 MultiPointZ
- 21 PointM
- 23 PolyLineM
- 25 PolygonM
- 28 MultiPointM
- 31 MultiPatch
- );
-
- return $shape_types{$shape};
-}
-
-sub find_bounds {
- my $self = shift;
- my @objects = @_;
-
- my %bounds = (
- x_min => undef,
- y_min => undef,
- x_max => undef,
- y_max => undef,
- );
-
- foreach my $obj (@objects) {
- foreach('x_min','y_min') {
- if((!defined $bounds{$_}) || ($obj->$_() < $bounds{$_})) {
- $bounds{$_} = $obj->$_();
- }
- }
- foreach('x_max','y_max') {
- if((!defined $bounds{$_}) || ($obj->$_() > $bounds{$_})) {
- $bounds{$_} = $obj->$_();
- }
- }
- }
- return(%bounds);
-}
-
-1;
-__END__
-=head1 NAME
-
-Geo::ShapeFile - Perl extension for handling ESRI GIS Shapefiles.
-
-=head1 SYNOPSIS
-
- use Geo::ShapeFile;
-
- my $shapefile = new Geo::ShapeFile("roads");
-
- for(1 .. $shapefile->shapes()) {
- my $shape = $shapefile->get_shp_record($_);
- # see Geo::ShapeFile::Shape docs for what to do with $shape
-
- my %db = $shapefile->get_dbf_record($_);
- }
-
-=head1 ABSTRACT
-
-The Geo::ShapeFile module reads ESRI ShapeFiles containing GIS mapping
-data, it has support for shp (shape), shx (shape index), and dbf (data
-base) formats.
-
-=head1 DESCRIPTION
-
-The Geo::ShapeFile module reads ESRI ShapeFiles containing GIS mapping
-data, it has support for shp (shape), shx (shape index), and dbf (data
-base) formats.
-
-=head1 METHODS
-
-=over 4
-
-=item new($filename_base)
-
-Creates a new shapefile object, the only argument it takes is the basename
-for your data (don't include the extension, the module will automatically
-find the extensions it supports). For example if you have data files called
-roads.shp, roads.shx, and roads.dbf, use 'new Geo::ShapeFile("roads");' to
-create a new object, and the module will load the data it needs from the
-files as it needs it.
-
-=item type_is($numeric_type)
-
-Returns true if the major type of this data file is the same as the type
-passed to type_is().
-
-=item get_dbf_record($record_index)
-
-Returns the data from the dbf file associated with the specified record index
-(shapefile indexes start at 1). If called in a list context, returns a hash,
-if called in a scalar context, returns a hashref.
-
-=item x_min() x_max() y_min() y_max()
-
-=item m_min() m_max() z_min() z_max()
-
-Returns the minimum and maximum values for x, y, z, and m fields as indicated
-in the shp file header.
-
-=item upper_left_corner() upper_right_corner()
-
-=item lower_left_corner() lower_right_corner()
-
-Returns a Geo::ShapeFile::Point object indicating the respective corners.
-
-=item height() width()
-
-Returns the height and width of the area contained in the shp file. Note that
-this likely does not return miles, kilometers, or any other useful measure, it
-simply returns x_max - x_min, or y_max - y_min. Whether this data is a useful
-measure or not depends on your data.
-
-=item corners()
-
-Returns a four element array consisting of the corners of the area contained
-in the shp file. The corners are listed clockwise starting with the upper
-left.
-(upper_left_corner, upper_right_corner, lower_right_corner, lower_left_corner)
-
-=item area_contains_point($point,$x_min,$y_min,$x_max,$y_max)
-
-Utility function that returns true if the Geo::ShapeFile::Point object in
-point falls within the bounds of the rectangle defined by the area
-indicated. See bounds_contains_point() if you want to check if a point falls
-within the bounds of the current shp file.
-
-=item bounds_contains_point($point)
-
-Returns true if the specified point falls within the bounds of the current
-shp file.
-
-=item file_version()
-
-Returns the ShapeFile version number of the current shp/shx file.
-
-=item shape_type()
-
-Returns the shape type contained in the current shp/shx file. The ESRI spec
-currently allows for a file to contain only a single type of shape (null
-shapes are the exception, they may appear in any data file). This returns
-the numeric value for the type, use type() to find the text name of this
-value.
-
-=item shapes()
-
-Returns the number of shapes contained in the current shp/shx file. This is
-the value that allows you to iterate through all the shapes using
-'for(1 .. $obj->shapes()) {'.
-
-=item records()
-
-Returns the number of records contained in the current data. This is similar
-to shapes(), but can be used even if you don't have shp/shx files, so you can
-access data that is stored as dbf, but does not have shapes associated with it.
-
-=item shape_type_text()
-
-Returns the shape type of the current shp/shx file (see shape_type()), but
-as the human-readable string type, rather than an integer.
-
-=item get_shx_record($record_index)
-=item get_shx_record_header($record_index)
-
-Get the contents of an shx record or record header (for compatibility with
-the other get_* functions, both are provided, but in the case of shx data,
-they return the same information). The return value is a two element array
-consisting of the offset in the shp file where the indicated record begins,
-and the content length of that record.
-
-=item get_shp_record_header($record_index)
-
-Retrieve an shp record header for the specified index. Returns a two element
-array consisting of the record number and the content length of the record.
-
-=item get_shp_record($record_index)
-
-Retrieve an shp record for the specified index. Returns a
-Geo::ShapeFile::Shape object.
-
-=item shapes_in_area($x_min,$y_min,$x_max,$y_max)
-
-Returns an array of integers, consisting of the indices of the shapes that
-overlap with the area specified. Currently this is a very oversimplified
-function that actually finds shapes that have any point that falls within
-the specified bounding box. Currently it may miss some shapes that actually
-do overlap with the specified area, if there are two points outside the area
-that cause an edge to pass through the area, but neither of the end points
-of that edge actually fall within the area specified. Patches to make this
-function more useful would be welcome.
-
-=item check_in_area($x1_min,$y1_min,$x1_max,$y1_max,$x2_min,$x2_max,$y2_min,$y2_max)
-
-Returns true if the two specified areas overlap.
-
-=item bounds()
-
-Returns the bounds for the current shp file.
-(x_min, y_min, x_max, y_max)
-
-=item shx_handle() shp_handle() dbf_handle()
-
-Returns the file handles associated with the respective data files.
-
-=item type($shape_type_number)
-
-Returns the name of the type associated with the given type id number.
-
-=item find_bounds(@shapes)
-
-Takes an array of Geo::ShapeFile::Shape objects, and returns a hash, with
-keys of x_min,y_min,x_max,y_max, with the values for each of those ranges.
-
-=back
-
-=head1 REPORTING BUGS
-
-Please send any bugs, suggestions, or feature requests to
- E<lt>geo-shapefile-bugs@jasonkohles.comE<gt>.
-
-=head1 SEE ALSO
-
-Geo::ShapeFile::Shape
-Geo::ShapeFile::Point
-
-=head1 AUTHOR
-
-Jason Kohles, E<lt>email@jasonkohles.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2002,2003 by Jason Kohles
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
+package Geo::ShapeFile;
+
+use strict;
+use warnings;
+use Carp;
+use IO::File;
+use Geo::ShapeFile::Shape;
+use Config;
+use List::Util qw /min max/;
+use Tree::R;
+
+
+our $VERSION = '2.60';
+
+my $little_endian_sys = unpack 'b', (pack 'S', 1 );
+
+# Preloaded methods go here.
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self = {};
+
+ $self->{filebase} = shift || croak "Must specify filename!";
+ $self->{filebase} =~ s/\.\w{3}$//;
+
+ $self->{_enable_caching} = {
+ shp => 1,
+ dbf => 1,
+ shx => 1,
+ shapes_in_area => 1,
+ };
+ $self->{has_shx} = 0;
+ $self->{has_shp} = 0;
+ $self->{has_dbf} = 0;
+
+ bless $self, $class;
+
+ $self->{_change_cache} = {
+ shape_type => undef,
+ records => undef,
+ shp => {},
+ dbf => {},
+ shx => {},
+ };
+ $self->{_object_cache} = {
+ shp => {},
+ dbf => {},
+ shx => {},
+ shapes_in_area => {},
+ };
+
+ if (-f $self->{filebase} . '.shx') {
+ $self->_read_shx_header();
+ $self->{has_shx} = 1;
+ }
+
+ if (-f $self->{filebase} . '.shp') {
+ $self->_read_shp_header();
+ $self->{has_shp} = 1;
+ }
+
+ if (-f $self->{filebase} . '.dbf') {
+ $self->_read_dbf_header();
+ $self->{has_dbf} = 1;
+ }
+
+ if (!$self->{has_dbf}) {
+ croak "$self->{filebase}: shp and/or shx file do not exist or are invalid"
+ if !($self->{has_shp} && $self->{has_shx});
+
+ croak "$self->{filebase}.dbf does not exist or is invalid";
+ }
+
+ return $self;
+}
+
+sub caching {
+ my $self = shift;
+ my $what = shift;
+ my $flag = shift;
+
+ if (defined $flag) {
+ $self->{_enable_caching}->{$what} = $flag;
+ }
+ return $self->{_enable_caching}->{$what};
+}
+
+sub cache {
+ my ($self, $type, $obj, $cache) = @_;
+
+ return $self->{_change_cache}->{$type}->{$obj}
+ if $self->{_change_cache}->{$type} && $self->{_change_cache}->{$type}->{$obj};
+
+ return if !$self->caching($type);
+
+ if ($cache) {
+ $self->{_object_cache}->{$type}->{$obj} = $cache;
+ }
+ return $self->{_object_cache}->{$type}->{$obj};
+}
+
+# This will trigger the various caching
+# so we end up with the file in memory.
+# Not an issue for most files.
+sub get_all_shapes {
+ my $self = shift;
+
+ my @shapes;
+
+ foreach my $id (1 .. $self->shapes()) {
+ my $shape = $self->get_shp_record($id);
+ push @shapes, $shape;
+ }
+
+ return wantarray ? @shapes : \@shapes;
+}
+
+sub get_shapes_sorted {
+ my $self = shift;
+ my $shapes = shift;
+ my $sub = shift;
+
+ if (!defined $sub) {
+ $sub = sub {
+ my ($s1, $s2) = @_;
+ return $s1->{shp_record_number} <=> $s2->{shp_record_number};
+ };
+ }
+
+ if (!defined $shapes) {
+ $shapes = $self->get_all_shapes;
+ }
+
+ my @sorted = sort {$sub->($a, $b)} @$shapes;
+
+ return wantarray ? @sorted : \@sorted;
+}
+
+sub get_shapes_sorted_spatially {
+ my $self = shift;
+ my $shapes = shift;
+ my $sub = shift;
+
+ if (!defined $sub) {
+ $sub = sub {
+ my ($s1, $s2) = @_;
+ return
+ $s1->x_min <=> $s2->x_min
+ || $s1->y_min <=> $s2->y_min
+ || $s1->x_max <=> $s2->x_max
+ || $s1->y_max <=> $s2->y_max
+ || $s1->shape_id <=> $s2->shape_id
+ ;
+ };
+ }
+
+ return $self->get_shapes_sorted ($shapes, $sub);
+}
+
+sub build_spatial_index {
+ my $self = shift;
+
+ my $shapes = $self->get_all_shapes;
+
+ my $rtree = Tree::R->new();
+ foreach my $shape (@$shapes) {
+ my @bbox = ($shape->x_min, $shape->y_min, $shape->x_max, $shape->y_max);
+ $rtree->insert($shape, @bbox);
+ }
+
+ $self->{_spatial_index} = $rtree;
+
+ return $rtree;
+}
+
+sub get_spatial_index {
+ my $self = shift;
+ return $self->{_spatial_index};
+}
+
+
+sub _read_shx_header {
+ shift()->_read_shx_shp_header('shx', @_);
+}
+
+sub _read_shp_header {
+ shift()->_read_shx_shp_header('shp', @_);
+}
+
+sub _read_shx_shp_header {
+ my $self = shift;
+ my $which = shift;
+ my $doubles;
+
+ $self->{$which . '_header'} = $self->_get_bytes($which, 0, 100);
+ (
+ $self->{$which . '_file_code'}, $self->{$which . '_file_length'},
+ $self->{$which . '_version'}, $self->{$which . '_shape_type'}, $doubles
+ ) = unpack 'N x20 N V2 a64', $self->{$which . '_header'};
+
+ (
+ $self->{$which . '_x_min'}, $self->{$which . '_y_min'},
+ $self->{$which . '_x_max'}, $self->{$which . '_y_max'},
+ $self->{$which . '_z_min'}, $self->{$which . '_z_max'},
+ $self->{$which . '_m_min'}, $self->{$which . '_m_max'},
+ ) = (
+ $little_endian_sys
+ ? (unpack 'd8', $doubles )
+ : (reverse unpack 'd8', scalar reverse $doubles)
+ );
+
+ return 1;
+}
+
+sub type_is {
+ my $self = shift;
+ my $type = shift;
+
+ return (lc $self->type($self->shape_type)) eq (lc $type);
+}
+
+sub get_dbf_field_names {
+ my $self = shift;
+
+ croak 'dbf field names not loaded yet'
+ if !defined $self->{dbf_field_names};
+
+ # make sure we return a copy
+ my @fld_names = @{$self->{dbf_field_names}};
+
+ return wantarray ? @fld_names : \@fld_names;
+}
+
+sub _read_dbf_header {
+ my $self = shift;
+
+ $self->{dbf_header} = $self->_get_bytes('dbf', 0, 12);
+ (
+ $self->{dbf_version},
+ $self->{dbf_updated_year},
+ $self->{dbf_updated_month},
+ $self->{dbf_updated_day},
+ $self->{dbf_num_records},
+ $self->{dbf_header_length},
+ $self->{dbf_record_length},
+ ) = unpack 'C4 V v v', $self->{dbf_header};
+ # unpack changed from c4 l s s to fix endianess problem
+ # reported by Daniel Gildea
+
+ my $ls = $self->{dbf_header_length}
+ + $self->{dbf_num_records} * $self->{dbf_record_length};
+ my $li = -s $self->{filebase} . '.dbf';
+
+ # some shapefiles (such as are produced by the NOAA NESDIS) don't
+ # have a end-of-file marker in their dbf files, Aleksandar Jelenak
+ # says the ESRI tools don't have a problem with this, so we shouldn't
+ # either
+ my $last_byte = $self->_get_bytes('dbf', $li-1, 1);
+ $ls ++ if ord $last_byte == 0x1A;
+
+ croak "dbf: file wrong size (should be $ls, but found $li)"
+ if $ls != $li;
+
+ my $header = $self->_get_bytes('dbf', 32, $self->{dbf_header_length} - 32);
+ my $count = 0;
+ $self->{dbf_header_info} = [];
+
+ while ($header) {
+ my $tmp = substr $header, 0, 32, '';
+ my $chr = substr $tmp, 0, 1;
+
+ last if ord $chr == 0x0D;
+ last if length ($tmp) < 32;
+
+ my %tmp = ();
+ (
+ $tmp{name},
+ $tmp{type},
+ $tmp{size},
+ $tmp{decimals}
+ ) = unpack 'Z11 Z x4 C2', $tmp;
+
+ $self->{dbf_field_info}->[$count] = {%tmp};
+
+ $count++;
+ }
+
+ $self->{dbf_fields} = $count;
+ croak "dbf: Not enough fields ($count < 1)"
+ if $count < 1;
+
+ my @template = ();
+ foreach (@{$self->{dbf_field_info}}) {
+ croak "dbf: Field $_->{name} too short ($_->{size} bytes)"
+ if $_->{size} < 1;
+
+ croak "dbf: Field $_->{name} too long ($_->{size} bytes)"
+ if $_->{size} > 4000;
+
+ push @template, 'A' . $_->{size};
+ }
+ $self->{dbf_record_template} = join ' ', @template;
+
+ my @field_names = ();
+ foreach (@{$self->{dbf_field_info}}) {
+ push @field_names, $_->{name};
+ }
+ $self->{dbf_field_names} = [@field_names];
+
+ # should return field names?
+ return 1;
+}
+
+# needed now there is Geo::ShapeFile::Writer?
+sub _generate_dbf_header {
+ my $self = shift;
+
+ #$self->{dbf_header} = $self->_get_bytes('dbf',0,12);
+ (
+ $self->{dbf_version},
+ $self->{dbf_updated_year},
+ $self->{dbf_updated_month},
+ $self->{dbf_updated_day},
+ $self->{dbf_num_records},
+ $self->{dbf_header_length},
+ $self->{dbf_record_length},
+ ) = unpack 'C4 V v v', $self->{dbf_header};
+
+ $self->{_change_cache}->{dbf_cache}->{header}
+ = pack
+ 'C4 V v v',
+ 3,
+ (localtime)[5],
+ (localtime)[4]+1,
+ (localtime)[3],
+ 0, # TODO - num_records,
+ 0, # TODO - header_length,
+ 0, # TODO - record_length,
+ ;
+}
+
+sub get_dbf_field_info {
+ my $self = shift;
+
+ my $header = $self->{dbf_field_info};
+
+ return if !$header;
+
+ # Return a deep copy to avoid callers
+ # messing up the internals
+ my @hdr;
+ foreach my $field (@$header) {
+ my %h = %$field;
+ push @hdr, \%h;
+ }
+
+ return wantarray ? @hdr : \@hdr;
+}
+
+sub get_dbf_record {
+ my $self = shift;
+ my $entry = shift;
+
+ my $dbf = $self->cache('dbf', $entry);
+
+ if (!$dbf) {
+ $entry--; # make entry 0-indexed
+
+ my $record = $self->_get_bytes(
+ 'dbf',
+ $self->{dbf_header_length}+($self->{dbf_record_length} * $entry),
+ $self->{dbf_record_length}+1, # +1 for deleted flag
+ );
+ my ($del, @data) = unpack 'c' . $self->{dbf_record_template}, $record;
+
+ map { s/^\s*//; s/\s*$//; } @data;
+
+ my %record;
+ @record{@{$self->{dbf_field_names}}} = @data;
+ $record{_deleted} = (ord $del == 0x2A);
+ $dbf = {%record};
+ $self->cache('dbf', $entry + 1, $dbf);
+ }
+
+ return wantarray ? %{$dbf} : $dbf;
+}
+
+# needed? not called anywhere
+sub _set_dbf_record {
+ my $self = shift;
+ my $entry = shift;
+ my %record = @_;
+
+ $self->{_change_cache}->{dbf}->{$entry} = {%record};
+}
+
+sub _get_shp_shx_header_value {
+ my $self = shift;
+ my $val = shift;
+
+ if (!($self->{'shx_' . $val} || $self->{'shp_' . $val})) {
+ $self->_read_shx_header();
+ }
+
+ return $self->{'shx_' . $val} || $self->{'shp_' . $val} || undef;
+}
+
+# factory these
+sub x_min { shift()->_get_shp_shx_header_value('x_min'); }
+sub x_max { shift()->_get_shp_shx_header_value('x_max'); }
+sub y_min { shift()->_get_shp_shx_header_value('y_min'); }
+sub y_max { shift()->_get_shp_shx_header_value('y_max'); }
+sub z_min { shift()->_get_shp_shx_header_value('z_min'); }
+sub z_max { shift()->_get_shp_shx_header_value('z_max'); }
+sub m_min { shift()->_get_shp_shx_header_value('m_min'); }
+sub m_max { shift()->_get_shp_shx_header_value('m_max'); }
+
+sub upper_left_corner {
+ my $self = shift;
+
+ return Geo::ShapeFile::Point->new(X => $self->x_min, Y => $self->y_max);
+}
+
+sub upper_right_corner {
+ my $self = shift;
+
+ return Geo::ShapeFile::Point->new(X => $self->x_max, Y => $self->y_max);
+}
+
+sub lower_right_corner {
+ my $self = shift;
+
+ return Geo::ShapeFile::Point->new(X => $self->x_max, Y => $self->y_min);
+}
+
+sub lower_left_corner {
+ my $self = shift;
+
+ return Geo::ShapeFile::Point->new(X => $self->x_min, Y => $self->y_min);
+}
+
+sub height {
+ my $self = shift;
+
+ return if !$self->records;
+
+ return $self->y_max - $self->y_min;
+}
+
+sub width {
+ my $self = shift;
+
+ return if !$self->records;
+
+ return $self->x_max - $self->x_min;
+}
+
+sub corners {
+ my $self = shift;
+
+ return (
+ $self->upper_left_corner,
+ $self->upper_right_corner,
+ $self->lower_right_corner,
+ $self->lower_left_corner,
+ );
+}
+
+sub area_contains_point {
+ my $self = shift;
+ my $point = shift;
+
+ my ($x_min, $y_min, $x_max, $y_max) = @_;
+
+ my $x = $point->get_x;
+ my $y = $point->get_y;
+
+ my $result =
+ ($x >= $x_min) &&
+ ($x <= $x_max) &&
+ ($y >= $y_min) &&
+ ($y <= $y_max);
+
+ return $result;
+}
+
+sub bounds_contains_point {
+ my $self = shift;
+ my $point = shift;
+
+ return $self->area_contains_point (
+ $point,
+ $self->x_min, $self->y_min,
+ $self->x_max, $self->y_max,
+ );
+}
+
+sub file_version {
+ shift()->_get_shp_shx_header_value('file_version');
+}
+
+sub shape_type {
+ my $self = shift;
+
+ return $self->{_change_cache}->{shape_type}
+ if defined $self->{_change_cache}->{shape_type};
+
+ return $self->_get_shp_shx_header_value('shape_type');
+}
+
+sub shapes {
+ my $self = shift;
+
+ return $self->{_change_cache}->{records}
+ if defined $self->{_change_cache}->{records};
+
+ if (!$self->{shx_file_length}) {
+ $self->_read_shx_header();
+ }
+
+ my $filelength = $self->{shx_file_length};
+ $filelength -= 50; # don't count the header
+
+ return $filelength / 4;
+}
+
+sub records {
+ my $self = shift;
+
+ return $self->{_change_cache}->{records}
+ if defined $self->{_change_cache}->{records};
+
+ if ($self->{shx_file_length}) {
+ my $filelength = $self->{shx_file_length};
+ $filelength -= 50; # don't count the header
+ return $filelength / 4;
+ }
+ # should perhaps just return dbf_num_records if we get this far?
+ elsif ($self->{dbf_num_records}) {
+ return $self->{dbf_num_records};
+ }
+
+ return 0;
+}
+
+sub shape_type_text {
+ my $self = shift;
+
+ return $self->type($self->shape_type());
+}
+
+sub get_shx_record_header {
+ shift()->get_shx_record(@_);
+}
+
+sub get_shx_record {
+ my $self = shift;
+ my $entry = shift;
+
+ croak 'must specify entry index'
+ if !$entry;
+
+ my $shx = $self->cache('shx', $entry);
+
+ if (!$shx) {
+ my $record = $self->_get_bytes('shx', (($entry - 1) * 8) + 100, 8);
+ $shx = [unpack 'N N', $record];
+ $self->cache('shx', $entry, $shx);
+ }
+
+ return @{$shx};
+}
+
+sub get_shp_record_header {
+ my $self = shift;
+ my $entry = shift;
+
+ my($offset) = $self->get_shx_record($entry);
+
+ my $record = $self->_get_bytes('shp', $offset * 2, 8);
+ my ($number, $content_length) = unpack 'N N', $record;
+
+ return ($number, $content_length);
+}
+
+
+# returns indexes, not objects - need to change that or add method for shape_objects_in_area
+sub shapes_in_area {
+ my $self = shift;
+ my @area = @_; # x_min, y_min, x_max, y_max,
+
+ if (my $sp_index = $self->get_spatial_index) {
+ my $shapes = [];
+ $sp_index->query_partly_within_rect (@area, $shapes);
+ my @indexes;
+ foreach my $shape (@$shapes) {
+ push @indexes, $shape->shape_id;
+ }
+ return wantarray ? @indexes : \@indexes;
+ }
+
+ my @results = ();
+ SHAPE:
+ foreach my $shp_id (1 .. $self->shapes) {
+ my ($offset, $content_length) = $self->get_shx_record($shp_id);
+ my $type = unpack 'V', $self->_get_bytes ('shp', $offset * 2 + 8, 4);
+
+ next SHAPE if $self->type($type) eq 'Null';
+
+ if ($self->type($type) =~ /^Point/) {
+ my $bytes = $self->_get_bytes('shp', $offset * 2 + 12, 16);
+ my ($x, $y) = (
+ $little_endian_sys
+ ? (unpack 'dd', $bytes )
+ : (reverse unpack 'dd', scalar reverse $bytes)
+ );
+ my $pt = Geo::ShapeFile::Point->new(X => $x, Y => $y);
+ if ($self->area_contains_point($pt, @area)) {
+ push @results, $shp_id;
+ }
+ }
+ elsif ($self->type($type) =~ /^(PolyLine|Polygon|MultiPoint|MultiPatch)/) {
+ my $bytes = $self->_get_bytes('shp', ($offset * 2) + 12, 32);
+ my @p = (
+ $little_endian_sys
+ ? (unpack 'd4', $bytes )
+ : (reverse unpack 'd4', scalar reverse $bytes )
+ );
+ if ($self->check_in_area(@p, @area)) {
+ push @results, $shp_id;
+ }
+ }
+ else {
+ print 'type=' . $self->type($type) . "\n";
+ }
+ }
+
+ return wantarray ? @results : \@results;
+}
+
+sub check_in_area {
+ my $self = shift;
+ my (
+ $x1_min, $y1_min, $x1_max, $y1_max,
+ $x2_min, $y2_min, $x2_max, $y2_max,
+ ) = @_;
+
+ my $result = !(
+ $x1_min > $x2_max
+ or $x1_max < $x2_min
+ or $y1_min > $y2_max
+ or $y1_max < $y2_min
+ );
+
+ return $result;
+}
+
+# SWL: not used anymore - remove?
+sub _between {
+ my $self = shift;
+ my $check = shift;
+
+ # ensure min then max
+ if ($_[0] > $_[1]) {
+ @_ = reverse @_;
+ }
+
+ return ($check >= $_[0]) && ($check <= $_[1]);
+}
+
+sub bounds {
+ my $self = shift;
+
+ return (
+ $self->x_min, $self->y_min,
+ $self->x_max, $self->y_max,
+ );
+}
+
+# is this ever called?
+sub _extract_ints {
+ my $self = shift;
+ my $end = shift;
+ my @what = @_;
+
+ my $template = ($end =~ /^l/i) ? 'V': 'N';
+
+ $self->_extract_and_unpack(4, $template, @what);
+ foreach (@what) {
+ $self->{$_} = $self->{$_};
+ }
+}
+
+sub get_shp_record {
+ my $self = shift;
+ my $entry = shift;
+
+ my $shape = $self->cache('shp', $entry);
+ if (!$shape) {
+ my($offset, $content_length) = $self->get_shx_record($entry);
+
+ my $record = $self->_get_bytes('shp', $offset * 2, $content_length * 2 + 8);
+
+ $shape = Geo::ShapeFile::Shape->new();
+ $shape->parse_shp($record);
+ $self->cache('shp', $entry, $shape);
+ }
+
+ return $shape;
+}
+
+sub shx_handle {
+ shift()->_get_handle('shx');
+}
+
+sub shp_handle {
+ shift()->_get_handle('shp');
+}
+
+sub dbf_handle {
+ shift()->_get_handle('dbf');
+}
+
+sub _get_handle {
+ my $self = shift;
+ my $which = shift;
+
+ my $han = $which . '_handle';
+
+ if (!$self->{$han}) {
+ $self->{$han} = IO::File->new;
+ my $file = join '.', $self->{filebase}, $which;
+ croak "Couldn't get file handle for $file: $!"
+ if not $self->{$han}->open($file, O_RDONLY | O_BINARY);
+ binmode $self->{$han}; # fix windows bug reported by Patrick Dughi
+ }
+
+ return $self->{$han};
+}
+
+sub _get_bytes {
+ my $self = shift;
+ my $file = shift;
+ my $offset = shift;
+ my $length = shift;
+
+ my $handle = $file . '_handle';
+ my $h = $self->$handle();
+ $h->seek ($offset, 0)
+ || croak "Couldn't seek to $offset for $file";
+
+ my $tmp;
+ my $res = $h->read($tmp, $length);
+
+ croak "Couldn't read $length bytes from $file at offset $offset ($!)"
+ if !defined $res;
+
+ croak "EOF reading $length bytes from $file at offset $offset"
+ if $res == 0;
+
+ return $tmp;
+}
+
+
+sub type {
+ my $self = shift;
+ my $shape = shift;
+
+ # should make this a package lexical
+ my %shape_types = qw(
+ 0 Null
+ 1 Point
+ 3 PolyLine
+ 5 Polygon
+ 8 MultiPoint
+ 11 PointZ
+ 13 PolyLineZ
+ 15 PolygonZ
+ 18 MultiPointZ
+ 21 PointM
+ 23 PolyLineM
+ 25 PolygonM
+ 28 MultiPointM
+ 31 MultiPatch
+ );
+
+ return $shape_types{$shape};
+}
+
+sub find_bounds {
+ my $self = shift;
+ my @objects = @_;
+
+ return if !scalar @objects;
+
+ my $obj1 = shift @objects;
+
+ # assign values from first object to start
+ my $x_min = $obj1->x_min();
+ my $y_min = $obj1->y_min();
+ my $x_max = $obj1->x_max();
+ my $y_max = $obj1->y_max();
+
+
+ foreach my $obj (@objects) {
+ $x_min = min ($x_min, $obj->x_min());
+ $y_min = min ($y_min, $obj->y_min());
+ $x_max = max ($x_max, $obj->x_max());
+ $y_max = max ($y_max, $obj->y_max());
+ }
+
+ my %bounds = (
+ x_min => $x_min,
+ y_min => $y_min,
+ x_max => $x_max,
+ y_max => $y_max,
+ );
+
+ return %bounds;
+}
+
+# XML::Generator::SVG::ShapeFile fails because it is calling this method
+# and it does not exist in 2.52 and earlier
+sub DESTROY {}
+
+
+1;
+__END__
+
+=head1 NAME
+
+Geo::ShapeFile - Perl extension for handling ESRI GIS Shapefiles.
+
+=head1 SYNOPSIS
+
+ use Geo::ShapeFile;
+
+ my $shapefile = Geo::ShapeFile->new('roads');
+
+ for(1 .. $shapefile->shapes()) {
+ my $shape = $shapefile->get_shp_record($_);
+ # see Geo::ShapeFile::Shape docs for what to do with $shape
+
+ my %db = $shapefile->get_dbf_record($_);
+ }
+
+=head1 ABSTRACT
+
+The Geo::ShapeFile module reads ESRI ShapeFiles containing GIS mapping
+data, it has support for shp (shape), shx (shape index), and dbf (data
+base) formats.
+
+=head1 DESCRIPTION
+
+The Geo::ShapeFile module reads ESRI ShapeFiles containing GIS mapping
+data, it has support for shp (shape), shx (shape index), and dbf (data
+base) formats.
+
+=head1 METHODS
+
+=over 4
+
+=item new ($filename_base)
+
+Creates a new shapefile object, the only argument it takes is the basename
+for your data (don't include the extension, the module will automatically
+find the extensions it supports). For example if you have data files called
+roads.shp, roads.shx, and roads.dbf, use 'Geo::ShapeFile->new("roads");' to
+create a new object, and the module will load the data it needs from the
+files as it needs it.
+
+=item type_is ($numeric_type)
+
+Returns true if the major type of this data file is the same as the type
+passed to type_is().
+
+=item get_dbf_record ($record_index)
+
+Returns the data from the dbf file associated with the specified record index
+(shapefile indexes start at 1). If called in a list context, returns a hash,
+if called in a scalar context, returns a hashref.
+
+=item x_min() x_max() y_min() y_max()
+
+=item m_min() m_max() z_min() z_max()
+
+Returns the minimum and maximum values for x, y, z, and m fields as indicated
+in the shp file header.
+
+=item upper_left_corner() upper_right_corner()
+
+=item lower_left_corner() lower_right_corner()
+
+Returns a Geo::ShapeFile::Point object indicating the respective corners.
+
+=item height() width()
+
+Returns the height and width of the area contained in the shp file. Note that
+this likely does not return miles, kilometers, or any other useful measure, it
+simply returns x_max - x_min, or y_max - y_min. Whether this data is a useful
+measure or not depends on your data.
+
+=item corners()
+
+Returns a four element array consisting of the corners of the area contained
+in the shp file. The corners are listed clockwise starting with the upper
+left.
+(upper_left_corner, upper_right_corner, lower_right_corner, lower_left_corner)
+
+=item area_contains_point ($point, $x_min, $y_min, $x_max, $y_max)
+
+Utility function that returns true if the Geo::ShapeFile::Point object in
+point falls within the bounds of the rectangle defined by the area
+indicated. See bounds_contains_point() if you want to check if a point falls
+within the bounds of the current shp file.
+
+=item bounds_contains_point ($point)
+
+Returns true if the specified point falls within the bounds of the current
+shp file.
+
+=item file_version()
+
+Returns the ShapeFile version number of the current shp/shx file.
+
+=item shape_type()
+
+Returns the shape type contained in the current shp/shx file. The ESRI spec
+currently allows for a file to contain only a single type of shape (null
+shapes are the exception, they may appear in any data file). This returns
+the numeric value for the type, use type() to find the text name of this
+value.
+
+=item shapes()
+
+Returns the number of shapes contained in the current shp/shx file. This is
+the value that allows you to iterate through all the shapes using
+'for(1 .. $obj->shapes()) {'.
+
+=item records()
+
+Returns the number of records contained in the current data. This is similar
+to shapes(), but can be used even if you don't have shp/shx files, so you can
+access data that is stored as dbf, but does not have shapes associated with it.
+
+=item shape_type_text()
+
+Returns the shape type of the current shp/shx file (see shape_type()), but
+as the human-readable string type, rather than an integer.
+
+=item get_shx_record ($record_index)
+
+=item get_shx_record_header ($record_index)
+
+Get the contents of an shx record or record header (for compatibility with
+the other get_* functions, both are provided, but in the case of shx data,
+they return the same information). The return value is a two element array
+consisting of the offset in the shp file where the indicated record begins,
+and the content length of that record.
+
+=item get_shp_record_header ($record_index)
+
+Retrieve an shp record header for the specified index. Returns a two element
+array consisting of the record number and the content length of the record.
+
+=item get_shp_record ($record_index)
+
+Retrieve an shp record for the specified index. Returns a
+Geo::ShapeFile::Shape object.
+
+=item shapes_in_area ($x_min, $y_min, $x_max, $y_max)
+
+Returns an array of integers listing which shape IDs have
+bounding boxes that overlap with the area specified.
+
+=item check_in_area ($x1_min, $y1_min, $x1_max, $y1_max, $x2_min, $x2_max, $y2_min, $y2_max)
+
+Returns true if the two specified areas overlap.
+
+=item bounds()
+
+Returns the bounds for the current shp file.
+(x_min, y_min, x_max, y_max)
+
+=item shx_handle() shp_handle() dbf_handle()
+
+Returns the file handles associated with the respective data files.
+
+=item type ($shape_type_number)
+
+Returns the name of the type associated with the given type id number.
+
+=item find_bounds (@shapes)
+
+Takes an array of Geo::ShapeFile::Shape objects, and returns a hash, with
+keys of x_min, y_min, x_max, y_max, with the values for each of those bounds.
+
+=item get_dbf_field_names()
+
+Returns an array of the field names in the dbf file, in file order.
+Returns an array reference if used in scalar context.
+
+=item get_all_shapes()
+
+Returns an array (or arrayref in scalar context) with all shape objects in the
+shapefile.
+
+=item get_shapes_sorted()
+
+=item get_shapes_sorted (\@shapes, \&sort_sub)
+
+Returns an array (or arrayref in scalar context) of shape objects sorted by ID.
+Defaults to all shapes, but will also take an array of Geo::ShapeFile::Shape objects.
+Sorts by record number by default, but you can pass your own sub for more fancy work.
+
+=item get_shapes_sorted_spatially()
+
+=item get_shapes_sorted_spatially (\@shapes, \&sort_sub)
+
+Convenience wrapper around get_shapes_sorted to sort spatially (south-west to north-east)
+then by record number. You can pass your own shapes and sort sub.
+The sort sub does not need to be spatial since it will sort by whatever you say,
+but it is your code so do what you like.
+
+
+=item build_spatial_index()
+
+Builds a spatial index (a L<Tree::R> object) and returns it. This will be used internally for
+many of the routines, but you can use it directly if useful.
+
+=item get_spatial_index()
+
+Returns the spatial index object, or C<undef> if one has not been built.
+
+=item get_dbf_field_info()
+
+Returns an array of hashes containing information about the fields.
+Useful if you are modifying the shapes and then writing them out to a
+new shapefile using L<Geo::Shapefile::Writer>.
+
+=back
+
+=head1 REPORTING BUGS
+
+Please send any bugs, suggestions, or feature requests to
+ L<https://github.com/shawnlaffan/Geo-ShapeFile/issues>.
+
+=head1 SEE ALSO
+
+L<Geo::ShapeFile::Shape>,
+L<Geo::ShapeFile::Point>,
+L<Geo::Shapefile::Writer>,
+L<Geo::GDAL>
+
+=head1 AUTHOR
+
+Jason Kohles, E<lt>email@jasonkohles.comE<gt>
+
+Shawn Laffan, E<lt>shawnlaffan@gmail.comE<gt>
+
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2002-2013 by Jason Kohles (versions up to and including 2.52)
+
+Copyright 2014 by Shawn Laffan (versions 2.53 -)
+
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
@@ -0,0 +1,201 @@
+##############################################################################
+# This file is an example of a Perl::Critic configuration file. This
+# file is usually called ".perlcriticrc" and is usually located in
+# your home directory or the working directory of your project.
+# However, you can use the -profile option to tell Perl::Critic use a
+# different file in another location.
+#
+# The area before any of the [Perl::Critic::Policy] sections is used
+# to set default values for the arguments to the Perl::Critic engine.
+# If you are using the "perlcritic" program, you can override these
+# settings at the command-line. Or if you are using the Perl::Critic
+# library, your API arguments will override these settings as well.
+
+
+#-----------------------------------------------------------------------------
+# exclude: Directs Perl::Critic to never apply Policies with names that
+# match one of the patterns. To specify multiple patterns, separate them
+# with whitespace. Do not put quotes around anything.
+
+exclude = Documentation Naming
+
+#-----------------------------------------------------------------------------
+# include: Directs Perl::Critic to always apply Policies with names that
+# match one of the patterns. To specify multiple patterns, separate them
+# with whitespace. Do not put quotes around anything.
+
+include = CodeLayout Modules
+
+#-----------------------------------------------------------------------------
+# force: Directs Perl::Critic to ignore the special "##no critic"
+# comments embedded in the source code. The default is 0. If
+# defined, this should be either 1 or 0.
+
+force = 1
+
+#-----------------------------------------------------------------------------
+# only: Directs Perl::Critic to only choose from Policies that are
+# explicitly mentioned in this file. Otherwise, Perl::Critic chooses
+# from all the Perl::Critic::Policy classes that are found on the
+# local machine. The default is 0. If defined, this should be either
+# 1 or 0.
+
+only = 1
+
+#-----------------------------------------------------------------------------
+# severity: Sets the default minimum severity level for Policies. The
+# default is 5. If defined, this should be an integer from 1 to 5,
+# where 5 is the highest severity.
+
+severity = 3
+
+#-----------------------------------------------------------------------------
+# theme: Sets the default theme. Only Policies that fit into this
+# them shall be applied. If defined, this should be a valid theme
+# expression. See the Perl::Critic POD for more details about this.
+
+theme = danger + risky - pbp
+
+#-----------------------------------------------------------------------------
+# top: Directs Perl::Critic to only report the top N Policy violations,
+# as ranked by their individual severity. If defined, this should be
+# a positive integer.
+
+top = 50
+
+#-----------------------------------------------------------------------------
+# verbose: Sets the format for printing Policy violations. If
+# defined, this should be either a format spcecification, or a numeric
+# verbosity level. See the Perl::Critic POD for more details.
+
+verbose = 5
+
+#-----------------------------------------------------------------------------
+# color-severity-highest: sets the color used for displaying highest
+# severity violations when coloring is in effect. This should be a color
+# specification acceptable to Term::ANSIColor. See the Perl::Critic POD
+# for details. Do not put quotes around the values. The default is 'bold
+# red'.
+
+color-severity-highest = bold red underline
+
+#-----------------------------------------------------------------------------
+# color-severity-high: sets the color used for displaying high severity
+# violations when coloring is in effect. This should be a color
+# specification acceptable to Term::ANSIColor. See the Perl::Critic POD
+# for details. Do not put quotes around the values. The default is
+# 'magenta'.
+
+color-severity-high = bold magenta
+
+#-----------------------------------------------------------------------------
+# color-severity-medium: sets the color used for displaying medium
+# severity violations when coloring is in effect. This should be a color
+# specification acceptable to Term::ANSIColor. See the Perl::Critic POD
+# for details. Do not put quotes around the values. The default is ''.
+
+color-severity-medium = blue
+
+#-----------------------------------------------------------------------------
+# color-severity-low: sets the color used for displaying low severity
+# violations when coloring is in effect. This should be a color
+# specification acceptable to Term::ANSIColor. See the Perl::Critic POD
+# for details. Do not put quotes around the values. The default is ''.
+
+color-severity-low =
+
+#-----------------------------------------------------------------------------
+# color-severity-lowest: sets the color used for displaying lowest
+# severity violations when coloring is in effect. This should be a color
+# specification acceptable to Term::ANSIColor. See the Perl::Critic POD
+# for details. Do not put quotes around the values. The default is ''.
+
+color-severity-lowest =
+
+#-----------------------------------------------------------------------------
+# program-extensions: specifies the file name endings for files that should
+# be interpreted as programs rather than modules. This should be a space-
+# delimited list of the name endings, with leading '.' if that is desired.
+# These are case-sensitive. See the Perl::Critic POD for details, but in
+# general any file beginning with a shebang line, any file whose name ends
+# '.PL', and any file whose name ends in one of the values specified here
+# will be considered a program; any other file will be considered a module.
+# Do not put quotes around the values. The default is ''.
+
+program-extensions =
+
+##############################################################################
+# The rest of the file consists of several named blocks that contain
+# configuration parameters for each of the Policies. The names of
+# each blocks correspond to the names of the Policy modules. For
+# brevity, the "Perl::Critic::Policy" portion of the name can be
+# omitted. See the POD for the appropriate Policy for a complete
+# description of the configuration parameters that it supports.
+
+
+#-----------------------------------------------------------------------------
+# If you vehmently disagree with a particular Policy, putting a "-" in
+# front of the Policy name will effectively disables that Policy. It
+# will never be applied unless you use the "-include" option to apply
+# it explicitly.
+
+[-NamingConventions::Capitalization]
+[-TestingAndDebugging::RequireUseWarnings]
+
+#-----------------------------------------------------------------------------
+# If you agree with a Policy, but feel that it's severity level is not
+# appropriate, then you can change the severity for any Policy. If
+# defined this should be an integer from 1 to 5, where 5 is the
+# highest severity.
+
+[BuiltinFunctions::RequireBlockGrep]
+severity = 2
+
+[CodeLayout::ProhibitHardTabs]
+severity = 1
+
+[ClassHierarchies::ProhibitAutoloading]
+severity = 5
+
+#-----------------------------------------------------------------------------
+# Policies are also organized into themes. Themes are just names for
+# arbitrary groups of Policies. You can define new themes and add
+# them to any Policy. If defined, this should be a string of
+# whitespace-delimited words.
+
+[RegularExpressions::RequireExtendedFormatting]
+add_themes = client_foo
+severity = 3
+
+[RegularExpressions::RequireExtendedFormatting]
+add_themes = client_foo client_bar
+severity = 3
+
+#-----------------------------------------------------------------------------
+# Some Policies also have specialized configuration parameters. In
+# all cases, these are repsented as simple name=value pairs. See the
+# POD for the appropriate Policy for a complete discussion of its
+# configuration parameters.
+
+[ControlStructures::ProhibitPostfixControls]
+allow = for if
+severity = 4
+
+[Documentation::RequirePodSections]
+lib_sections = NAME | SYNOPSIS | METHODS | AUTHOR
+add_themes = my_favorites
+severity = 4
+
+#-----------------------------------------------------------------------------
+# If you set the "only" flag, then Perl::Critic only chooses from
+# Policies that are mentioned in your configuration file. This is
+# helpful when you want to use only a very small subset of the
+# Policies. So just create blocks for any other Policies that you
+# want to use.
+
+[ValuesAndExpressions::ProhibitInterpolationOfLiterals]
+[ValuesAndExpressions::ProhibitLeadingZeros]
+[InputOutput::ProhibitBarewordFileHandles]
+[Miscellanea::ProhibitTies]
+
+
@@ -0,0 +1,283 @@
+##############################################################################
+# This Perl::Critic configuration file sets the Policy severity levels
+# according to Damian Conway's own personal recommendations. Feel free to
+# use this as your own, or make modifications.
+##############################################################################
+
+[Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr]
+severity = 3
+
+[Perl::Critic::Policy::BuiltinFunctions::ProhibitReverseSortBlock]
+severity = 1
+
+[Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect]
+severity = 5
+
+[Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval]
+severity = 5
+
+[Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit]
+severity = 2
+
+[Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalCan]
+severity = 4
+
+[Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalIsa]
+severity = 4
+
+[Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep]
+severity = 3
+
+[Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap]
+severity = 3
+
+[Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep]
+severity = 4
+
+[Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap]
+severity = 4
+
+[Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction]
+severity = 5
+
+[Perl::Critic::Policy::BuiltinFunctions::RequireSimpleSortBlock]
+severity = 3
+
+[Perl::Critic::Policy::ClassHierarchies::ProhibitAutoloading]
+severity = 3
+
+[Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA]
+severity = 4
+
+[Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless]
+severity = 5
+
+[Perl::Critic::Policy::CodeLayout::ProhibitHardTabs]
+severity = 3
+
+[Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins]
+severity = 1
+
+[Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists]
+severity = 2
+
+[Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines]
+severity = 4
+
+[Perl::Critic::Policy::CodeLayout::RequireTidyCode]
+severity = 1
+
+[Perl::Critic::Policy::CodeLayout::RequireTrailingCommas]
+severity = 3
+
+[Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops]
+severity = 3
+
+[Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse]
+severity = 3
+
+[Perl::Critic::Policy::ControlStructures::ProhibitDeepNests]
+severity = 3
+
+[Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions]
+severity = 5
+
+[Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls]
+severity = 4
+
+[Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks]
+severity = 4
+
+[Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode]
+severity = 4
+
+[Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks]
+severity = 4
+
+[Perl::Critic::Policy::Documentation::RequirePodAtEnd]
+severity = 2
+
+[Perl::Critic::Policy::Documentation::RequirePodSections]
+severity = 2
+
+[Perl::Critic::Policy::ErrorHandling::RequireCarping]
+severity = 4
+
+[Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators]
+severity = 3
+
+[Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles]
+severity = 5
+
+[Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest]
+severity = 4
+
+[Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect]
+severity = 4
+
+[Perl::Critic::Policy::InputOutput::ProhibitReadlineInForLoop]
+severity = 5
+
+[Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen]
+severity = 4
+
+[Perl::Critic::Policy::InputOutput::RequireBracedFileHandleWithPrint]
+severity = 3
+
+[Perl::Critic::Policy::Miscellanea::ProhibitFormats]
+severity = 3
+
+[Perl::Critic::Policy::Miscellanea::ProhibitTies]
+severity = 4
+
+[-Perl::Critic::Policy::Miscellanea::RequireRcsKeywords]
+
+[Perl::Critic::Policy::Modules::ProhibitAutomaticExportation]
+severity = 4
+
+[Perl::Critic::Policy::Modules::ProhibitEvilModules]
+severity = 5
+
+[Perl::Critic::Policy::Modules::ProhibitMultiplePackages]
+severity = 4
+
+[Perl::Critic::Policy::Modules::RequireBarewordIncludes]
+severity = 5
+
+[Perl::Critic::Policy::Modules::RequireEndWithOne]
+severity = 4
+
+[Perl::Critic::Policy::Modules::RequireExplicitPackage]
+severity = 4
+
+[Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage]
+severity = 5
+
+[Perl::Critic::Policy::Modules::RequireVersionVar]
+severity = 4
+
+[Perl::Critic::Policy::NamingConventions::ProhibitAmbiguousNames]
+severity = 3
+
+[Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs]
+severity = 1
+
+[Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars]
+severity = 1
+
+[Perl::Critic::Policy::References::ProhibitDoubleSigils]
+severity = 4
+
+[Perl::Critic::Policy::RegularExpressions::ProhibitCaptureWithoutTest]
+severity = 4
+
+[Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting]
+severity = 5
+
+[Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching]
+severity = 5
+
+[Perl::Critic::Policy::Subroutines::ProhibitAmpersandSigils]
+severity = 2
+
+[Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms]
+severity = 4
+
+[Perl::Critic::Policy::Subroutines::ProhibitExcessComplexity]
+severity = 3
+
+[Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef]
+severity = 5
+
+[Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes]
+severity = 4
+
+[Perl::Critic::Policy::Subroutines::ProtectPrivateSubs]
+severity = 3
+
+[Perl::Critic::Policy::Subroutines::RequireFinalReturn]
+severity = 5
+
+[Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict]
+severity = 5
+
+[Perl::Critic::Policy::TestingAndDebugging::ProhibitNoWarnings]
+severity = 4
+
+[Perl::Critic::Policy::TestingAndDebugging::ProhibitProlongedStrictureOverride]
+severity = 4
+
+[Perl::Critic::Policy::TestingAndDebugging::RequireTestLabels]
+severity = 3
+
+[Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict]
+severity = 5
+
+[Perl::Critic::Policy::TestingAndDebugging::RequireUseWarnings]
+severity = 4
+
+[Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma]
+severity = 4
+
+[Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes]
+severity = 2
+
+[Perl::Critic::Policy::ValuesAndExpressions::ProhibitEscapedCharacters]
+severity = 2
+
+[Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals]
+severity = 1
+
+[Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros]
+severity = 5
+
+[Perl::Critic::Policy::ValuesAndExpressions::ProhibitMismatchedOperators]
+severity = 2
+
+[Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators]
+severity = 4
+
+[Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes]
+severity = 2
+
+[Perl::Critic::Policy::ValuesAndExpressions::ProhibitVersionStrings]
+severity = 3
+
+[Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars]
+severity = 1
+
+[Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators]
+severity = 2
+
+[Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator]
+severity = 4
+
+[Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator]
+severity = 4
+
+[Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations]
+severity = 5
+
+[Perl::Critic::Policy::Variables::ProhibitLocalVars]
+severity = 2
+
+[Perl::Critic::Policy::Variables::ProhibitMatchVars]
+severity = 4
+
+[Perl::Critic::Policy::Variables::ProhibitPackageVars]
+severity = 3
+
+[Perl::Critic::Policy::Variables::ProhibitPunctuationVars]
+severity = 2
+
+[Perl::Critic::Policy::Variables::ProtectPrivateVars]
+severity = 3
+
+[Perl::Critic::Policy::Variables::RequireInitializationForLocalVars]
+severity = 5
+
+[Perl::Critic::Policy::Variables::RequireLexicalLoopIterators]
+severity = 5
+
+[Perl::Critic::Policy::Variables::RequireNegativeIndices]
+severity = 4
\ No newline at end of file
@@ -0,0 +1,261 @@
+package Geo::ShapeFile::TestHelpers;
+use strict;
+use warnings;
+
+
+sub get_data {
+ return (
+ _get_data(),
+ _get_empty_point_data(),
+ );
+}
+
+sub get_empty_data {
+ return _get_empty_point_data();
+}
+
+sub get_empty_dbf {
+ return 'empty_dbf';
+}
+
+
+sub _get_data {
+ my %data = (
+ anno => {
+ object => undef,
+ shape_type => 'Polygon',
+ records => 201,
+ shapes => 201,
+ nulls => 0,
+ x_min => 471276.28125,
+ x_max => 492683.5361785888671875,
+ y_min => 4751595.5,
+ y_max => 4765390.412581588141620159149169921875,
+ m_min => undef,
+ m_max => undef,
+ z_min => undef,
+ z_max => undef,
+ #dbf_labels => 'HEIGHT LEVEL NAME_ NAME_ID OFFSETX OFFSETY SYMBOL TEXT X Y _deleted',
+ dbf_labels => 'NAME_ NAME_ID X Y OFFSETX OFFSETY HEIGHT SYMBOL LEVEL TEXT _deleted',
+ },
+ brklinz => {
+ object => undef,
+ shape_type => 'PolyLineZ',
+ records => 122,
+ shapes => 122,
+ nulls => 0,
+ x_min => 6294338.25999999977648258209228515625,
+ x_max => 6296321.860000000335276126861572265625,
+ y_min => 1978444.01000000000931322574615478515625,
+ y_max => 1979694.44999999995343387126922607421875,
+ m_min => undef,
+ m_max => undef,
+ z_min => undef,
+ z_max => undef,
+ dbf_labels => 'ID _deleted',
+ },
+ cities => {
+ object => undef,
+ shape_type => 'Point',
+ records => 36,
+ shapes => 36,
+ nulls => 0,
+ x_min => -115.2942352294921875,
+ x_max => -88.2643585205078125,
+ y_min => 16.6302967071533203125,
+ y_max => 32.620204925537109375,
+ m_min => undef,
+ m_max => undef,
+ z_min => undef,
+ z_max => undef,
+ dbf_labels => 'NAME CAPITAL STATE_NAME POPULATION _deleted',
+ },
+ drainage => {
+ object => undef,
+ shape_type => 'PolyLine',
+ records => 6,
+ shapes => 6,
+ nulls => 0,
+ x_min => -115.04149627685546875,
+ x_max => -90.65814208984375,
+ y_min => 15.4399242401123046875,
+ y_max => 32.72083282470703125,
+ m_min => undef,
+ m_max => undef,
+ z_min => -16125672399481724123986011618587258386906538603886358185620065373269736146054676480,
+ z_max => undef,
+ dbf_labels => 'SYSTEM _deleted',
+ },
+ lakes => {
+ object => undef,
+ shape_type => 'Polygon',
+ records => 3,
+ shapes => 3,
+ nulls => 0,
+ x_min => -103.42584228515625,
+ x_max => -96.3589019775390625,
+ y_min => 18.092777252197265625,
+ y_max => 20.339996337890625,
+ m_min => undef,
+ m_max => undef,
+ z_min => -16125672399481724123986011618587258386906538603886358185620065373269736146054676480,
+ z_max => undef,
+ dbf_labels => 'AREA NAME _deleted',
+ },
+ masspntz => {
+ object => undef,
+ shape_type => 'PointZ',
+ records => 815,
+ shapes => 815,
+ nulls => 0,
+ x_min => 6294340.120000000111758708953857421875,
+ x_max => 6296321.91999999992549419403076171875,
+ y_min => 1978439.78000000002793967723846435546875,
+ y_max => 1979689.88999999989755451679229736328125,
+ m_min => undef,
+ m_max => undef,
+ z_min => undef,
+ z_max => undef,
+ dbf_labels => 'ID _deleted',
+ },
+ multipnt => {
+ object => undef,
+ shape_type => 'MultiPoint',
+ records => 1,
+ shapes => 1,
+ nulls => 0,
+ x_min => 483575.5,
+ x_max => 483575.5,
+ y_min => 4753046,
+ y_max => 4753046,
+ m_min => undef,
+ m_max => undef,
+ z_min => undef,
+ z_max => undef,
+ dbf_labels => 'AREA PERIMETER EAS_ EAS_ID ATLAS_P ATLAS_S EDLOW EDMED EDHIGH HHNUMBER AVGHHINC EDUC POTENT ELAT ELON DIS58 DIS130 DIS208 DIS425 MKTSHR58 MKTSHR130 MKTSHR208 MKTSHR425 LIFESTYLES CUMMKTSHR PENTRA OPPT PRFEDEA AA _deleted',
+ },
+ pline => {
+ object => undef,
+ shape_type => 'PolyLine',
+ records => 460,
+ shapes => 460,
+ nulls => 0,
+ x_min => 1296367.5,
+ x_max => 1302699,
+ y_min => 228199.390625,
+ y_max => 237185.03125,
+ m_min => undef,
+ m_max => undef,
+ z_min => undef,
+ z_max => undef,
+ dbf_labels => 'FNODE_ TNODE_ LPOLY_ RPOLY_ LENGTH PLINE_ PLINE_ID UID GISO_TYPE_ SYMBOL LOCK__ID PHASE__ID OBJECT__ID TYPE SYM_NBR PHASE CKT_NM VOLTAGE CMPN _deleted',
+ },
+ polygon => {
+ object => undef,
+ shape_type => 'Polygon',
+ records => 474,
+ shapes => 474,
+ nulls => 0,
+ x_min => 471127.1875,
+ x_max => 489292.3125,
+ y_min => 4751545,
+ y_max => 4765610.5,
+ m_min => undef,
+ m_max => undef,
+ z_min => undef,
+ z_max => undef,
+ dbf_labels => 'AREA PERIMETER EAS_ EAS_ID ATLAS_P ATLAS_S EDLOW EDMED EDHIGH HHNUMBER AVGHHINC EDUC POTENT ELAT ELON DIS58 DIS130 DIS208 DIS425 MKTSHR58 MKTSHR130 MKTSHR208 MKTSHR425 LIFESTYLES CUMMKTSHR PENTRA OPPT PRFEDEA AA _deleted',
+ },
+ rivers => {
+ object => undef,
+ shape_type => 'PolyLine',
+ records => 30,
+ shapes => 30,
+ nulls => 0,
+ x_min => -115.04149627685546875,
+ x_max => -90.65814208984375,
+ y_min => 15.4399242401123046875,
+ y_max => 32.72083282470703125,
+ m_min => undef,
+ m_max => undef,
+ z_min => -16125672399481724123986011618587258386906538603886358185620065373269736146054676480,
+ z_max => undef,
+ dbf_labels => 'NAME SYSTEM _deleted',
+ },
+ roads => {
+ object => undef,
+ shape_type => 'PolyLine',
+ records => 105,
+ shapes => 105,
+ nulls => 0,
+ x_min => -117.03643035888671875,
+ x_max => -86.843597412109375,
+ y_min => 14.5713672637939453125,
+ y_max => 32.6636810302734375,
+ m_min => undef,
+ m_max => undef,
+ z_min => undef,
+ z_max => undef,
+ dbf_labels => 'LENGTH TYPE ADMN_CLASS TOLL_RD RTE_NUM1 RTE_NUM2 ROUTE _deleted',
+ },
+ roads_rt => {
+ object => undef,
+ shape_type => 'PolyLine',
+ records => 28,
+ shapes => 28,
+ nulls => 0,
+ x_min => -117.03643035888671875,
+ x_max => -86.843597412109375,
+ y_min => 14.5713672637939453125,
+ y_max => 32.6636810302734375,
+ m_min => undef,
+ m_max => undef,
+ z_min => undef,
+ z_max => undef,
+ dbf_labels => 'ROUTE _deleted',
+ },
+ states => {
+ object => undef,
+ shape_type => 'Polygon',
+ records => 32,
+ shapes => 32,
+ nulls => 0,
+ x_min => -117.12237548828125,
+ x_max => -86.7350006103515625,
+ y_min => 14.5505466461181640625,
+ y_max => 32.7208099365234375,
+ m_min => undef,
+ m_max => undef,
+ z_min => 768132343507160766108099947708147205392141761325948192154576281445969786822266109612978357005202339868627839948143029980413485838758710421858995973573516602505672081229247161886287459759546354037365234956463577676596117504,
+ z_max => undef,
+ dbf_labels => 'AREA CODE NAME _deleted',
+ },
+ );
+
+ return %data;
+}
+
+sub _get_empty_point_data {
+ my %empty_point_data = (
+ empty_points => {
+ object => undef,
+ shape_type => 'Point',
+ records => 0,
+ shapes => 0,
+ nulls => 0,
+ x_min => undef,
+ x_max => undef,
+ y_min => undef,
+ y_max => undef,
+ m_min => undef,
+ m_max => undef,
+ z_min => undef,
+ z_max => undef,
+ dbf_labels => 'NAME CAPITAL STATE_NAME POPULATION _deleted',
+ },
+ );
+
+ return %empty_point_data;
+}
+
+1;
@@ -1,164 +1,641 @@
-# $Revision: 2.0 $
-use Test::More tests => 18651;
-use strict;
-BEGIN {
- use_ok('Geo::ShapeFile');
- use_ok('Geo::ShapeFile::Shape');
- use_ok('Geo::ShapeFile::Point');
- use_ok('Carp');
- use_ok('IO::File');
- use_ok('Data::Dumper');
-};
-
-my $dir = "t/test_data";
-
-our %data;
-require "t/test_data.pl";
-
-my @test_points = (
- ['1','1'],
- ['1000000','1000000'],
- ['9999','43525623523525'],
- ['2532525','235253252352'],
- ['2.1352362','1.2315216236236'],
- ['2.2152362','1.2315231236236','1134'],
- ['2.2312362','1.2315236136236','1214','51321'],
- ['2.2351362','1.2315236216236','54311'],
-);
-
-foreach(@test_points) {
- my($x,$y,$m,$z) = @{$_};
- my $txt;
- if(defined $z && defined $m) {
- $txt = "Point(X=$x,Y=$y,Z=$z,M=$m)";
- } elsif(defined $m) {
- $txt = "Point(X=$x,Y=$y,M=$m)";
- } else {
- $txt = "Point(X=$x,Y=$y)";
- }
- my $p1 = new Geo::ShapeFile::Point(X => $x, Y => $y, Z => $z, M => $m);
- my $p2 = new Geo::ShapeFile::Point(Y => $y, X => $x, M => $m, Z => $z);
- print "p1=$p1\n";
- print "p2=$p2\n";
- cmp_ok($p1, '==', $p2, "Points match");
- cmp_ok("$p1", 'eq', $txt);
- cmp_ok("$p2", 'eq', $txt);
-}
-
-foreach my $base (keys %data) {
- foreach my $ext (qw/dbf shp shx/) {
- ok(-f "$dir/$base.$ext", "$ext file exists for $base");
- }
- my $obj = $data{$base}->{object} = new Geo::ShapeFile("$dir/$base");
-
- # test SHP
- cmp_ok(
- $obj->shape_type_text(),
- 'eq',
- $data{$base}->{shape_type},
- "Shape type for $base",
- );
- cmp_ok(
- $obj->shapes(),
- '==',
- $data{$base}->{shapes},
- "Number of shapes for $base"
- );
-
-=pod
- foreach my $measure (qw/x y z m/) {
- foreach my $minmax (qw/min max/) {
- my $var = join('_',$measure,$minmax);
- #diag(sprintf("*+ %100.200e\n",$data{$base}->{$var}));
- #diag(sprintf("*- %100.200e\n",$obj->$var()));
- if($data{$base}->{$var} == $obj->$var()) {
- pass();
- } else {
- fail();
- }
- cmp_ok(
- $data{$base}->{$var},
- '==',
- $obj->$var(),
- "$var match for $base"
- );
- cmp_ok(
- sprintf("%100.200f",$data{$base}->{$var}),
- 'eq',
- sprintf("%100.200f",$obj->$var()),
- "$var match for $base"
- );
- cmp_ok(
- $obj->{"shp_".$var},
- '==',
- $obj->{"shx_".$var},
- "shp/shx $var values match for $base"
- );
- }
- }
-=cut
-
- # test shapes
- my $nulls = 0;
- for my $n (1 .. $obj->shapes()) {
- my($offset, $cl1) = $obj->get_shx_record($n);
- my($number, $cl2) = $obj->get_shp_record_header($n);
-
- cmp_ok($cl1, '==', $cl2, "$base($n) shp/shx record content-lengths");
- cmp_ok($n, '==', $number, "$base($n) shp/shx record ids agree");
-
- my $shp = $obj->get_shp_record($n);
-
- if($shp->shape_type == 0) { $nulls++; }
-
- my $parts = $shp->num_parts;
- my @parts = $shp->parts;
- cmp_ok($parts, '==', scalar(@parts), "$base($n) parts count");
-
- my $points = $shp->num_points;
- my @points = $shp->points;
- cmp_ok($points, '==', scalar(@points), "$base($n) points count");
-
- my $undefs = 0;
- foreach my $pnt (@points) {
- defined($pnt->X) || $undefs++;
- defined($pnt->Y) || $undefs++;
- }
- ok(!$undefs, "undefined points");
-
- my $len = length($shp->{shp_data});
- cmp_ok($len, '==', 0, "$base($n) no leftover data");
- }
- ok($nulls == $data{$base}->{nulls});
-
- # test DBF
- ok($obj->{dbf_version} == 3, "dbf version 3");
-
- cmp_ok(
- $obj->{dbf_num_records},
- '==',
- $obj->shapes(),
- "$base dbf has record per shape",
- );
-
- cmp_ok(
- $obj->records(),
- '==',
- $obj->shapes(),
- "same number of shapes and records",
- );
-
- for my $n (1 .. $obj->shapes()) {
- ok(my $dbf = $obj->get_dbf_record($n), "$base($n) read dbf record");
- }
-
- for my $n (1 .. $obj->records()) {
- my %record = $obj->get_dbf_record($n);
- cmp_ok(
- join(' ',sort keys %record),
- 'eq',
- $data{$base}->{dbf_labels},
- "dbf has correct labels",
- );
- }
-}
+# tests for Geo::ShapeFile
+
+use Test::More;
+use strict;
+use warnings;
+use rlib '../lib', './lib';
+
+use Geo::ShapeFile;
+use Geo::ShapeFile::Shape;
+use Geo::ShapeFile::Point;
+
+# should use $FindBin::bin for this
+my $dir = "t/test_data";
+
+note "Testing Geo::ShapeFile version $Geo::ShapeFile::VERSION\n";
+
+use Geo::ShapeFile::TestHelpers;
+
+# conditional test runs approach from
+# http://www.modernperlbooks.com/mt/2013/05/running-named-perl-tests-from-prove.html
+
+exit main( @ARGV );
+
+sub main {
+ my @args = @_;
+
+ if (@args) {
+ for my $name (@args) {
+ die "No test method test_$name\n"
+ if not my $func = (__PACKAGE__->can( 'test_' . $name ) || __PACKAGE__->can( $name ));
+ $func->();
+ }
+ done_testing;
+ return 0;
+ }
+
+ test_open_croaks();
+
+ test_corners();
+ test_shapes_in_area();
+ #test_end_point_slope();
+ test_shapepoint();
+ test_files();
+ test_empty_dbf();
+ test_points_in_polygon();
+ test_spatial_index();
+ test_angle_to();
+
+ test_shape_indexing();
+
+ done_testing;
+ return 0;
+}
+
+
+
+###########################################
+
+sub test_dbf_header {
+ my %data = Geo::ShapeFile::TestHelpers::get_data();
+
+ foreach my $base (sort keys %data) {
+
+ my $shp = Geo::ShapeFile->new ("$dir/$base");
+
+ my $hdr = $shp->get_dbf_field_info;
+
+ # not the world's best test, but it ensures the returned copy is corrct
+ is_deeply ($hdr, $shp->{dbf_field_info}, "header for $base has correct structure");
+ }
+}
+
+
+sub test_open_croaks {
+ my $filename = "blurfleblargfail";
+
+ my $shp = eval {
+ Geo::ShapeFile->new ($filename);
+ };
+ my $e = $@;
+ ok ($e, 'threw an exception on invalid file');
+
+}
+
+
+
+sub test_shapepoint {
+ my @test_points = (
+ ['1','1'],
+ ['1000000','1000000'],
+ ['9999','43525623523525'],
+ ['2532525','235253252352'],
+ ['2.1352362','1.2315216236236'],
+ ['2.2152362','1.2315231236236','1134'],
+ ['2.2312362','1.2315236136236','1214','51321'],
+ ['2.2351362','1.2315236216236','54311'],
+ );
+
+ my @pnt_objects;
+ foreach my $pts (@test_points) {
+ my ($x,$y,$m,$z) = @$pts;
+ my $txt;
+
+ if(defined $z && defined $m) {
+ $txt = "Point(X=$x,Y=$y,Z=$z,M=$m)";
+ }
+ elsif (defined $m) {
+ $txt = "Point(X=$x,Y=$y,M=$m)";
+ }
+ else {
+ $txt = "Point(X=$x,Y=$y)";
+ }
+ my $p1 = Geo::ShapeFile::Point->new(X => $x, Y => $y, Z => $z, M => $m);
+ my $p2 = Geo::ShapeFile::Point->new(Y => $y, X => $x, M => $m, Z => $z);
+ print "p1=$p1\n";
+ print "p2=$p2\n";
+ cmp_ok ( $p1, '==', $p2, "Points match");
+ cmp_ok ("$p1", 'eq', $txt);
+ cmp_ok ("$p2", 'eq', $txt);
+ push @pnt_objects, $p1;
+ }
+
+
+ return;
+
+}
+
+sub test_angle_to {
+ my $p1 = Geo::ShapeFile::Point->new (X => 0, Y => 0);
+
+ my @checks = (
+ [ 0, 0, 0],
+ [ 1, 0, 90],
+ [ 1, 1, 45],
+ [ 0, 1, 0],
+ [-1, 1, 315],
+ [-1, 0, 270],
+ [-1, -1, 225],
+ [ 0, -1, 180],
+ );
+
+ foreach my $p2_data (@checks) {
+ my ($x, $y, $exp) = @$p2_data;
+ my $p2 = Geo::ShapeFile::Point->new (X => $x, Y => $y);
+ my $angle = $p1->angle_to ($p2);
+
+ is (
+ $angle,
+ $exp,
+ "Got expected angle of $exp for $x,$y",
+ );
+ }
+
+ return;
+}
+
+sub test_end_point_slope {
+ return; # no testing yet - ths was used for debug
+
+ my %data = Geo::ShapeFile::TestHelpers::get_data();
+ my %data2 = (drainage => $data{drainage});
+ %data = %data2;
+
+ my $obj = Geo::ShapeFile->new("$dir/drainage");
+ my $shape = $obj->get_shp_record(1);
+ my $start_pt = Geo::ShapeFile::Point->new(X => $shape->x_min(), Y => $shape->y_min());
+ my $end_pt = Geo::ShapeFile::Point->new(X => $shape->x_min(), Y => $shape->y_max());
+ my $hp = $shape->has_point($start_pt);
+
+ printf
+ "%i : %i\n",
+ $shape->has_point($start_pt),
+ $shape->has_point($end_pt);
+ print;
+
+ return;
+}
+
+
+sub test_files {
+ my %data = Geo::ShapeFile::TestHelpers::get_data();
+
+ foreach my $base (sort keys %data) {
+ foreach my $ext (qw/dbf shp shx/) {
+ ok(-f "$dir/$base.$ext", "$ext file exists for $base");
+ }
+ my $obj = $data{$base}->{object} = Geo::ShapeFile->new("$dir/$base");
+
+ my @expected_fld_names = grep {$_ ne '_deleted'} split /\s+/, $data{$base}{dbf_labels};
+ my @got_fld_names = $obj->get_dbf_field_names;
+
+ is_deeply (
+ \@expected_fld_names,
+ \@got_fld_names,
+ "got expected field names for $base",
+ );
+
+ # test SHP
+ cmp_ok (
+ $obj->shape_type_text(),
+ 'eq',
+ $data{$base}->{shape_type},
+ "Shape type for $base",
+ );
+ cmp_ok(
+ $obj->shapes(),
+ '==',
+ $data{$base}->{shapes},
+ "Number of shapes for $base"
+ );
+
+ # test shapes
+ my $nulls = 0;
+ subtest "$base has valid records" => sub {
+ if (!$obj->records()) {
+ ok (1, "$base has no records, so just pass this subtest");
+ }
+
+ for my $n (1 .. $obj->shapes()) {
+ my($offset, $cl1) = $obj->get_shx_record($n);
+ my($number, $cl2) = $obj->get_shp_record_header($n);
+
+ cmp_ok($cl1, '==', $cl2, "$base($n) shp/shx record content-lengths");
+ cmp_ok($n, '==', $number, "$base($n) shp/shx record ids agree");
+
+ my $shp = $obj->get_shp_record($n);
+
+ if ($shp->shape_type == 0) {
+ $nulls++;
+ }
+
+ my $parts = $shp->num_parts;
+ my @parts = $shp->parts;
+ cmp_ok($parts, '==', scalar(@parts), "$base($n) parts count");
+
+ my $points = $shp->num_points;
+ my @points = $shp->points;
+ cmp_ok($points, '==', scalar(@points), "$base($n) points count");
+
+ my $undefs = 0;
+ foreach my $pnt (@points) {
+ defined($pnt->X) || $undefs++;
+ defined($pnt->Y) || $undefs++;
+ }
+ ok(!$undefs, "undefined points");
+
+ my $len = length($shp->{shp_data});
+ cmp_ok($len, '==', 0, "$base($n) no leftover data");
+ }
+ };
+
+ ok($nulls == $data{$base}->{nulls});
+
+ # need to test the bounds
+ my @shapes_in_file;
+ for my $n (1 .. $obj->shapes()) {
+ push @shapes_in_file, $obj->get_shp_record($n);
+ }
+
+ my %bounds = $obj->find_bounds(@shapes_in_file);
+ for my $bnd (qw /x_min y_min x_max y_max/) {
+ is ($bounds{$bnd}, $data{$base}{$bnd}, "$bnd across objects matches, $base");
+ }
+
+ if (defined $data{$base}{y_max}) {
+ is ($obj->height, $data{$base}{y_max} - $data{$base}{y_min}, "$base has correct height");
+ is ($obj->width, $data{$base}{x_max} - $data{$base}{x_min}, "$base has correct width");
+ }
+ else {
+ is ($obj->height, undef, "$base has correct height");
+ is ($obj->width, undef, "$base has correct width");
+ }
+
+ # test DBF
+ ok($obj->{dbf_version} == 3, "dbf version 3");
+
+ cmp_ok(
+ $obj->{dbf_num_records},
+ '==',
+ $obj->shapes(),
+ "$base dbf has record per shape",
+ );
+
+ cmp_ok(
+ $obj->records(),
+ '==',
+ $obj->shapes(),
+ "same number of shapes and records",
+ );
+
+ subtest "$base: can read each record" => sub {
+ if (!$obj->records()) {
+ ok (1, "$base has no records, so just pass this subtest");
+ }
+
+ for my $n (1 .. $obj->shapes()) {
+ ok (my $dbf = $obj->get_dbf_record($n), "$base($n) read dbf record");
+ }
+ };
+
+ # This is possibly redundant due to get_dbf_field_names check above,
+ # although that does not check against each record.
+ my @expected_flds = sort split (/ /, $data{$base}->{dbf_labels});
+ subtest "dbf for $base has correct labels" => sub {
+ if (!$obj->records()) {
+ ok (1, "$base has no records, so just pass this subtest");
+ }
+ for my $n (1 .. $obj->records()) {
+ my %record = $obj->get_dbf_record($n);
+ is_deeply (
+ [sort keys %record],
+ \@expected_flds,
+ "$base, record $n",
+ );
+ }
+ };
+
+ }
+
+ return;
+}
+
+
+sub test_empty_dbf {
+ my $empty_dbf = Geo::ShapeFile::TestHelpers::get_empty_dbf();
+ my $obj = Geo::ShapeFile->new("$dir/$empty_dbf");
+ my $records = $obj->records;
+ is ($records, 0, 'empty dbf file has zero records');
+}
+
+
+sub test_shapes_in_area {
+ my $shp = Geo::ShapeFile->new ("$dir/test_shapes_in_area");
+
+ my @shapes_in_area = $shp->shapes_in_area (1, 1, 11, 11);
+ is_deeply (
+ [1],
+ \@shapes_in_area,
+ 'Shape is in area'
+ );
+
+ @shapes_in_area = $shp->shapes_in_area (1, 1, 11, 9);
+ is_deeply (
+ [1],
+ \@shapes_in_area,
+ 'Shape is in area'
+ );
+
+ @shapes_in_area = $shp->shapes_in_area (11, 11, 12, 12);
+ is_deeply (
+ [],
+ \@shapes_in_area,
+ 'Shape is not in area'
+ );
+
+ my @bounds;
+
+ @bounds = (1, -1, 9, 11);
+ @shapes_in_area = $shp->shapes_in_area (@bounds);
+ is_deeply (
+ [1],
+ \@shapes_in_area,
+ 'edge overlap on the left, right edge outside bounds',
+ );
+
+
+ @bounds = (0, -1, 9, 11);
+ @shapes_in_area = $shp->shapes_in_area (@bounds);
+ is_deeply (
+ [1],
+ \@shapes_in_area,
+ 'left and right edges outside the bounds, upper and lower within',
+ );
+
+ ### Now check with a larger region
+ $shp = Geo::ShapeFile->new("$dir/lakes");
+
+ # This should get all features
+ @bounds = (-104, 17, -96, 22);
+ @shapes_in_area = $shp->shapes_in_area (@bounds);
+ is_deeply (
+ [1, 2, 3],
+ \@shapes_in_area,
+ 'All lake shapes in bounds',
+ );
+
+ # just the western two features
+ @bounds = (-104, 17, -100, 22);
+ @shapes_in_area = $shp->shapes_in_area (@bounds);
+ is_deeply (
+ [1, 2],
+ \@shapes_in_area,
+ 'Western two lake shapes in bounds',
+ );
+
+ # the western two features with a partial overlap
+ @bounds = (-104, 17, -101.7314, 22);
+ @shapes_in_area = $shp->shapes_in_area (@bounds);
+ is_deeply (
+ [1, 2],
+ \@shapes_in_area,
+ 'Western two lake shapes in bounds, partial overlap',
+ );
+
+ return;
+}
+
+
+sub test_corners {
+ my $shp = Geo::ShapeFile->new("$dir/lakes");
+
+ my $ul = $shp->upper_left_corner();
+ my $ll = $shp->lower_left_corner();
+ my $ur = $shp->upper_right_corner();
+ my $lr = $shp->lower_right_corner();
+
+ is ($ul->X, $ll->X,'corners: min x vals');
+ is ($ur->X, $lr->X,'corners: max x vals');
+ is ($ll->Y, $lr->Y,'corners: min y vals');
+ is ($ul->Y, $ur->Y,'corners: max y vals');
+
+ cmp_ok ($ul->X, '<', $ur->X, 'corners: ul is left of ur');
+ cmp_ok ($ll->X, '<', $lr->X, 'corners: ll is left of lr');
+
+ cmp_ok ($ll->Y, '<', $ul->Y, 'corners: ll is below ul');
+ cmp_ok ($lr->Y, '<', $ur->Y, 'corners: lr is below ur');
+
+ return;
+}
+
+sub test_points_in_polygon {
+ my $shp;
+ my $filename;
+
+ # multipart poly
+ $filename = 'states.shp';
+ $shp = Geo::ShapeFile->new ("$dir/$filename");
+
+ my @in_coords = (
+ [-112.386, 28.950],
+ [-112.341, 29.159],
+ [-112.036, 29.718],
+ [-110.186, 30.486],
+ [-114.845, 32.380],
+ );
+ my @out_coords = (
+ [-111.286, 27.395],
+ [-113.843, 30.140],
+ [-111.015, 31.767],
+ [-112.594, 34.300],
+ [-106.772, 28.420],
+ [-114.397, 24.802],
+ );
+
+ # shape 23 is sonora
+ my $test_poly = $shp->get_shp_record(23);
+
+ subtest "$filename polygon 23 (not indexed) contains points" => sub {
+ foreach my $coord (@in_coords) {
+ my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]);
+ my $result = $test_poly->contains_point ($point);
+ ok ($result, "$point is in $filename polygon 23");
+ }
+ };
+
+ subtest "$filename polygon 23 (not indexed) does not contain points" => sub {
+ foreach my $coord (@out_coords) {
+ my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]);
+ my $result = $test_poly->contains_point ($point);
+ ok (!$result, "$point is not in $filename polygon 23");
+ }
+ };
+
+ # use the spatial index
+ $test_poly->build_spatial_index;
+
+ subtest "$filename polygon 23 (indexed) contains points" => sub {
+ foreach my $coord (@in_coords) {
+ my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]);
+ my $result = $test_poly->contains_point ($point, 0);
+ ok ($result, "$point is in $filename polygon 23 (indexed)");
+ }
+ };
+
+ subtest "$filename polygon 23 (indexed) does not contain points" => sub {
+ foreach my $coord (@out_coords) {
+ my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]);
+ my $result = $test_poly->contains_point ($point);
+ ok (!$result, "$point is not in $filename polygon 23 (indexed)");
+ }
+ };
+
+ # now try with a shapefile with holes in the polys
+ $filename = 'polygon.shp';
+ $shp = Geo::ShapeFile->new ("$dir/$filename");
+ # shape 83 has holes
+ $test_poly = $shp->get_shp_record(83);
+
+ @in_coords = (
+ [477418, 4762016],
+ [476644, 4761530],
+ [477488, 4760789],
+ [477716, 4760055],
+ );
+ @out_coords = (
+ [477521, 4760247], # hole
+ [477414, 4761150], # hole
+ [477388, 4761419], # hole
+ [477996, 4761648], # hole
+ [476810, 4761766], # outside but in bounds
+ [478214, 4760627], # outside but in bounds
+ [477499, 4762436], # outside bounds
+ );
+
+ subtest "$filename polygon 83 (not indexed) contains points" => sub {
+ foreach my $coord (@in_coords) {
+ my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]);
+ my $result = $test_poly->contains_point ($point);
+ ok ($result, "$point is in $filename polygon 83");
+ }
+ };
+
+ subtest "$filename polygon 83 (not indexed) does not contain points" => sub {
+ foreach my $coord (@out_coords) {
+ my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]);
+ my $result = $test_poly->contains_point ($point);
+ ok (!$result, "$point is not in $filename polygon 83");
+ }
+ };
+
+ # Now with the spatial index.
+ $test_poly->build_spatial_index;
+
+ subtest "$filename polygon 83 (indexed) contains points" => sub {
+ foreach my $coord (@in_coords) {
+ my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]);
+ my $result = $test_poly->contains_point ($point, 0);
+ ok ($result, "$point is in $filename polygon 83 (indexed)");
+ }
+ };
+ subtest "$filename polygon 83 (indexed) does not contain points" => sub {
+ foreach my $coord (@out_coords) {
+ my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]);
+ my $result = $test_poly->contains_point ($point);
+ ok (!$result, "$point is not in $filename polygon 83 (indexed)");
+ }
+ };
+
+ return;
+}
+
+
+sub test_spatial_index {
+ # polygon.shp has a variety of polygons
+ my $poly_file = "$dir/polygon";
+
+ my $shp_use_idx = Geo::ShapeFile->new ($poly_file);
+ my $shp_no_idx = Geo::ShapeFile->new($poly_file);
+
+ my $sp_index = $shp_use_idx->build_spatial_index;
+
+ ok ($sp_index, 'got a spatial index');
+
+ my @bounds = $shp_use_idx->bounds;
+ my $objects = [];
+ $sp_index->query_completely_within_rect (@bounds, $objects);
+
+ my @shapes = $shp_use_idx->get_all_shapes;
+
+ is (
+ scalar @$objects,
+ scalar @shapes,
+ 'index contains same number of objects as shapefile',
+ );
+
+ # need to sort the arrays to compare them
+ my @sorted_shapes = $shp_use_idx->get_shapes_sorted;
+ my @sorted_objects = $shp_use_idx->get_shapes_sorted ($objects);
+
+ is_deeply (
+ \@sorted_objects,
+ \@sorted_shapes,
+ 'spatial_index contains all objects',
+ );
+
+ # now get the mid-point for a lower-left bounds
+ my $mid_x = ($bounds[0] + $bounds[2]) / 2;
+ my $mid_y = ($bounds[1] + $bounds[3]) / 2;
+ my @bnd_ll = ($bounds[0], $bounds[1], $mid_x, $mid_y);
+
+ foreach my $expected ([\@bounds, 474], [\@bnd_ll, 130]) {
+ my $bnds = $expected->[0];
+ my $shape_count = $expected->[1];
+
+ my $shapes_in_area_no_idx = $shp_no_idx->shapes_in_area (@$bnds);
+ my $shapes_in_area_use_idx = $shp_use_idx->shapes_in_area (@$bnds);
+
+ my $message = 'shapes_in_area same with and without spatial index, bounds: '
+ . join ' ', @$bnds;
+
+ is (scalar @$shapes_in_area_no_idx, $shape_count, 'got right number of shapes back, no index');
+ is (scalar @$shapes_in_area_use_idx, $shape_count, 'got right number of shapes back, use index');
+
+ is_deeply (
+ [sort @$shapes_in_area_no_idx],
+ [sort @$shapes_in_area_use_idx],
+ $message,
+ );
+ }
+
+}
+
+sub test_shape_indexing {
+ my $poly_file = "$dir/poly_to_check_index";
+
+ my $shp = Geo::ShapeFile->new ($poly_file);
+
+ my @in_coords = (
+ [-1504329.017, -3384142.590],
+ [ -811568.465, -3667544.634],
+ [-1417733.948, -3793501.098],
+ );
+
+ foreach my $size (5, 10, 15, 20, 100) {
+ foreach my $shape ($shp->get_all_shapes) {
+ my %part_indexes = $shape->build_spatial_index ($size);
+ foreach my $part (values %part_indexes) {
+ my $containers = $part->{containers};
+ ok (scalar keys %$containers == $size, "index generated $size containers")
+ }
+ subtest "polygon contains points when using index of size $size" => sub {
+ foreach my $coord (@in_coords) {
+ my $point = Geo::ShapeFile::Point->new(X => $coord->[0], Y => $coord->[1]);
+ my $result = $shape->contains_point ($point);
+ ok ($result, "$point is in polygon");
+ }
+ }
+ }
+ }
+}
+
@@ -1,2 +1,2 @@
-AuxilaryTarget: anno.shp
-METADATA_VEC_1_LAYER_TYPE: WHOLE_POLYGONS
+AuxilaryTarget: anno.shp
+METADATA_VEC_1_LAYER_TYPE: WHOLE_POLYGONS
diff --git a/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_dbf.dbf b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_dbf.dbf
new file mode 100644
index 00000000..d0d5054b
Binary files /dev/null and b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_dbf.dbf differ
diff --git a/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.dbf b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.dbf
new file mode 100644
index 00000000..d0d5054b
Binary files /dev/null and b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.dbf differ
diff --git a/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.sbn b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.sbn
new file mode 100644
index 00000000..79a5619d
Binary files /dev/null and b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.sbn differ
diff --git a/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.sbx b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.sbx
new file mode 100644
index 00000000..f700f057
Binary files /dev/null and b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.sbx differ
diff --git a/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.shp b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.shp
new file mode 100644
index 00000000..d258342e
Binary files /dev/null and b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.shp differ
diff --git a/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.shx b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.shx
new file mode 100644
index 00000000..d258342e
Binary files /dev/null and b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/empty_points.shx differ
diff --git a/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.dbf b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.dbf
new file mode 100644
index 00000000..9cb719a5
Binary files /dev/null and b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.dbf differ
@@ -0,0 +1 @@
+PROJCS["albers_anhat",GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]],PROJECTION["Albers"],PARAMETER["False_Easting",0.0],PARAMETER["False_Northing",0.0],PARAMETER["Central_Meridian",132.0],PARAMETER["Standard_Parallel_1",-36.0],PARAMETER["Standard_Parallel_2",-18.0],PARAMETER["Latitude_Of_Origin",0.0],UNIT["Meter",1.0]]
\ No newline at end of file
diff --git a/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.sbn b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.sbn
new file mode 100644
index 00000000..c2355662
Binary files /dev/null and b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.sbn differ
diff --git a/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.sbx b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.sbx
new file mode 100644
index 00000000..c3bc3d63
Binary files /dev/null and b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.sbx differ
diff --git a/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.shp b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.shp
new file mode 100644
index 00000000..1799ceae
Binary files /dev/null and b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.shp differ
@@ -0,0 +1,2 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<metadata xml:lang="en"><Esri><CreaDate>20140305</CreaDate><CreaTime>09323000</CreaTime><ArcGISFormat>1.0</ArcGISFormat><ArcGISstyle>ISO 19139 Metadata Implementation Specification</ArcGISstyle><SyncOnce>FALSE</SyncOnce><DataProperties><itemProps><itemName Sync="TRUE">SWAFR_dissolve_albers_anhat_simp_buff_plus30km</itemName><imsContentType Sync="TRUE">002</imsContentType><itemSize Sync="TRUE">0.000</itemSize><itemLocation><linkage Sync="TRUE">file://\\BROCK_SAMSON\D$\shawn\svn\Geo-ShapeFile\t\test_data\SWAFR_dissolve_albers_anhat_simp_buff_plus30km</linkage><protocol Sync="TRUE">Local Area Network</protocol></itemLocation></itemProps><coordRef><type Sync="TRUE">Projected</type><geogcsn Sync="TRUE">GCS_WGS_1984</geogcsn><csUnits Sync="TRUE">Linear Unit: Meter (1.000000)</csUnits><peXml Sync="TRUE"><ProjectedCoordinateSystem xsi:type='typens:ProjectedCoordinateSystem' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xmlns:xs='http://www.w3.org/2001/XMLSchema' xmlns:typens='http://www.esri.com/schemas/ArcGIS/10.1'><WKT>PROJCS[&quot;albers_anhat&quot;,GEOGCS[&quot;GCS_WGS_1984&quot;,DATUM[&quot;D_WGS_1984&quot;,SPHEROID[&quot;WGS_1984&quot;,6378137.0,298.257223563]],PRIMEM[&quot;Greenwich&quot;,0.0],UNIT[&quot;Degree&quot;,0.0174532925199433]],PROJECTION[&quot;Albers&quot;],PARAMETER[&quot;False_Easting&quot;,0.0],PARAMETER[&quot;False_Northing&quot;,0.0],PARAMETER[&quot;Central_Meridian&quot;,132.0],PARAMETER[&quot;Standard_Parallel_1&quot;,-36.0],PARAMETER[&quot;Standard_Parallel_2&quot;,-18.0],PARAMETER[&quot;Latitude_Of_Origin&quot;,0.0],UNIT[&quot;Meter&quot;,1.0]]</WKT><XOrigin>-20220900</XOrigin><YOrigin>-14227600</YOrigin><XYScale>222720038.54281932</XYScale><ZOrigin>-100000</ZOrigin><ZScale>10000</ZScale><MOrigin>-100000</MOrigin><MScale>10000</MScale><XYTolerance>0.001</XYTolerance><ZTolerance>0.001</ZTolerance><MTolerance>0.001</MTolerance><HighPrecision>true</HighPrecision></ProjectedCoordinateSystem></peXml><projcsn Sync="TRUE">albers_anhat</projcsn></coordRef><lineage><Process ToolSource="c:\program files (x86)\arcgis\desktop10.0\ArcToolbox\Toolboxes\Data Management Tools.tbx\Dissolve" Date="20120627" Time="080933">Dissolve SWAFR D:\shawn\data3\biodiverse\ACEAS\SWAFR_dissolve.shp # # MULTI_PART DISSOLVE_LINES</Process><Process ToolSource="c:\program files (x86)\arcgis\desktop10.0\ArcToolbox\Toolboxes\Cartography Tools.tbx\SimplifyPolygon" Date="20120627" Time="103452">SimplifyPolygon SWAFR_dissolve_albers_anhat C:\Users\shawn\Documents\ArcGIS\Default.gdb\SWAFR_dissolve_albers_anhat_1 POINT_REMOVE "10000 Meters" "0 SquareMeters" NO_CHECK NO_KEEP</Process><Process ToolSource="c:\program files (x86)\arcgis\desktop10.0\ArcToolbox\Toolboxes\Analysis Tools.tbx\Buffer" Date="20120627" Time="103624">Buffer SWAFR_dissolve_albers_anhat_simp D:\shawn\data3\biodiverse\ACEAS\SWAFR_dissolve_albers_anhat_simp_buff.shp "5000 Meters" FULL ROUND NONE #</Process><Process ToolSource="c:\program files (x86)\arcgis\desktop10.1\ArcToolbox\Toolboxes\Analysis Tools.tbx\Buffer" Date="20121109" Time="142604">Buffer SWAFR_dissolve_albers_anhat_simp_buff D:\shawn\scratch\biodiverse\ACEAS\SWAFR_dissolve_albers_anhat_simp_buff_plus30km.shp "30000 Meters" FULL ROUND NONE #</Process></lineage><copyHistory><copy source="D:\shawn\scratch\biodiverse\ACEAS\shapefiles\SWAFR_dissolve_albers_anhat_simp_buff_plus30km" dest="\\BROCK_SAMSON\D$\shawn\svn\Geo-ShapeFile\t\test_data\SWAFR_dissolve_albers_anhat_simp_buff_plus30km" date="20140305" time="09323000"></copy></copyHistory></DataProperties><SyncDate>20121109</SyncDate><SyncTime>14260400</SyncTime><ModDate>20121109</ModDate><ModTime>14260400</ModTime></Esri><dataIdInfo><envirDesc Sync="TRUE">Microsoft Windows 7 Version 6.1 (Build 7601) Service Pack 1; Esri ArcGIS 10.1.0.3035</envirDesc><dataLang><languageCode value="eng" Sync="TRUE"></languageCode><countryCode value="AUS" Sync="TRUE"></countryCode></dataLang><idCitation><resTitle Sync="TRUE">SWAFR_dissolve_albers_anhat_simp_buff_plus30km</resTitle><presForm><PresFormCd value="005" Sync="TRUE"></PresFormCd></presForm></idCitation><spatRpType><SpatRepTypCd value="001" Sync="TRUE"></SpatRepTypCd></spatRpType></dataIdInfo><mdLang><languageCode value="eng" Sync="TRUE"></languageCode><countryCode value="AUS" Sync="TRUE"></countryCode></mdLang><mdChar><CharSetCd value="004" Sync="TRUE"></CharSetCd></mdChar><distInfo><distFormat><formatName Sync="TRUE">Shapefile</formatName></distFormat><distTranOps><transSize Sync="TRUE">0.000</transSize></distTranOps></distInfo><mdHrLv><ScopeCd value="005" Sync="TRUE"></ScopeCd></mdHrLv><mdHrLvName Sync="TRUE">dataset</mdHrLvName><refSysInfo><RefSystem><refSysID><identCode code="4283" Sync="TRUE" value="0"></identCode><idCodeSpace Sync="TRUE">EPSG</idCodeSpace><idVersion Sync="TRUE">7.4.1</idVersion></refSysID></RefSystem></refSysInfo><spatRepInfo><VectSpatRep><geometObjs Name="SWAFR_dissolve_albers_anhat_simp_buff_plus30km"><geoObjTyp><GeoObjTypCd value="002" Sync="TRUE"></GeoObjTypCd></geoObjTyp><geoObjCnt Sync="TRUE">0</geoObjCnt></geometObjs><topLvl><TopoLevCd value="001" Sync="TRUE"></TopoLevCd></topLvl></VectSpatRep></spatRepInfo><spdoinfo><ptvctinf><esriterm Name="SWAFR_dissolve_albers_anhat_simp_buff_plus30km"><efeatyp Sync="TRUE">Simple</efeatyp><efeageom code="4" Sync="TRUE"></efeageom><esritopo Sync="TRUE">FALSE</esritopo><efeacnt Sync="TRUE">0</efeacnt><spindex Sync="TRUE">FALSE</spindex><linrefer Sync="TRUE">FALSE</linrefer></esriterm></ptvctinf></spdoinfo><eainfo><detailed Name="SWAFR_dissolve_albers_anhat_simp_buff_plus30km"><enttyp><enttypl Sync="TRUE">SWAFR_dissolve_albers_anhat_simp_buff_plus30km</enttypl><enttypt Sync="TRUE">Feature Class</enttypt><enttypc Sync="TRUE">0</enttypc></enttyp><attr><attrlabl Sync="TRUE">FID</attrlabl><attalias Sync="TRUE">FID</attalias><attrtype Sync="TRUE">OID</attrtype><attwidth Sync="TRUE">4</attwidth><atprecis Sync="TRUE">0</atprecis><attscale Sync="TRUE">0</attscale><attrdef Sync="TRUE">Internal feature number.</attrdef><attrdefs Sync="TRUE">ESRI</attrdefs><attrdomv><udom Sync="TRUE">Sequential unique whole numbers that are automatically generated.</udom></attrdomv></attr><attr><attrlabl Sync="TRUE">OBJECTID</attrlabl><attalias Sync="TRUE">OBJECTID</attalias><attrtype Sync="TRUE">Integer</attrtype><attwidth Sync="TRUE">9</attwidth><atprecis Sync="TRUE">9</atprecis><attscale Sync="TRUE">0</attscale><attrdef Sync="TRUE">Internal feature number.</attrdef><attrdefs Sync="TRUE">ESRI</attrdefs><attrdomv><udom Sync="TRUE">Sequential unique whole numbers that are automatically generated.</udom></attrdomv></attr><attr><attrlabl Sync="TRUE">Shape</attrlabl><attalias Sync="TRUE">Shape</attalias><attrtype Sync="TRUE">Geometry</attrtype><attwidth Sync="TRUE">0</attwidth><atprecis Sync="TRUE">0</atprecis><attscale Sync="TRUE">0</attscale><attrdef Sync="TRUE">Feature geometry.</attrdef><attrdefs Sync="TRUE">ESRI</attrdefs><attrdomv><udom Sync="TRUE">Coordinates defining the features.</udom></attrdomv></attr><attr><attrlabl Sync="TRUE">Id</attrlabl><attalias Sync="TRUE">Id</attalias><attrtype Sync="TRUE">Integer</attrtype><attwidth Sync="TRUE">9</attwidth><atprecis Sync="TRUE">9</atprecis><attscale Sync="TRUE">0</attscale></attr><attr><attrlabl Sync="TRUE">Shape_Leng</attrlabl><attalias Sync="TRUE">Shape_Leng</attalias><attrtype Sync="TRUE">Double</attrtype><attwidth Sync="TRUE">19</attwidth><atprecis Sync="TRUE">0</atprecis><attscale Sync="TRUE">0</attscale></attr><attr><attrlabl Sync="TRUE">Shape_Area</attrlabl><attalias Sync="TRUE">Shape_Area</attalias><attrtype Sync="TRUE">Double</attrtype><attwidth Sync="TRUE">19</attwidth><atprecis Sync="TRUE">0</atprecis><attscale Sync="TRUE">0</attscale><attrdef Sync="TRUE">Area of feature in internal units squared.</attrdef><attrdefs Sync="TRUE">ESRI</attrdefs><attrdomv><udom Sync="TRUE">Positive real numbers that are automatically generated.</udom></attrdomv></attr><attr><attrlabl Sync="TRUE">BUFF_DIST</attrlabl><attalias Sync="TRUE">BUFF_DIST</attalias><attrtype Sync="TRUE">Double</attrtype><attwidth Sync="TRUE">19</attwidth><atprecis Sync="TRUE">0</atprecis><attscale Sync="TRUE">0</attscale></attr></detailed></eainfo><mdDateSt Sync="TRUE">20121109</mdDateSt></metadata>
diff --git a/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.shx b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.shx
new file mode 100644
index 00000000..2308a9bc
Binary files /dev/null and b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/poly_to_check_index.shx differ
diff --git a/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/test_shapes_in_area.dbf b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/test_shapes_in_area.dbf
new file mode 100644
index 00000000..e47985c7
Binary files /dev/null and b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/test_shapes_in_area.dbf differ
@@ -0,0 +1 @@
+GEOGCS["GCS_North_American_1927",DATUM["D_North_American_1927",SPHEROID["Clarke_1866",6378206.4,294.9786982]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]]
\ No newline at end of file
diff --git a/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/test_shapes_in_area.shp b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/test_shapes_in_area.shp
new file mode 100644
index 00000000..9af9d93e
Binary files /dev/null and b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/test_shapes_in_area.shp differ
diff --git a/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/test_shapes_in_area.shx b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/test_shapes_in_area.shx
new file mode 100644
index 00000000..805cefda
Binary files /dev/null and b/var/tmp/source/SLAFFAN/Geo-ShapeFile-2.60/Geo-ShapeFile-2.60/t/test_data/test_shapes_in_area.shx differ
@@ -1,210 +0,0 @@
-our %data = (
- anno => {
- object => undef,
- shape_type => 'Polygon',
- records => 201,
- shapes => 201,
- nulls => 0,
- x_min => 471276.28125,
- x_max => 492683.5361785888671875,
- y_min => 4751595.5,
- y_max => 4765390.412581588141620159149169921875,
- m_min => undef,
- m_max => undef,
- z_min => undef,
- z_max => undef,
- dbf_labels => 'HEIGHT LEVEL NAME_ NAME_ID OFFSETX OFFSETY SYMBOL TEXT X Y _deleted',
- },
- brklinz => {
- object => undef,
- shape_type => 'PolyLineZ',
- records => 122,
- shapes => 122,
- nulls => 0,
- x_min => 6294338.25999999977648258209228515625,
- x_max => 6296321.860000000335276126861572265625,
- y_min => 1978444.01000000000931322574615478515625,
- y_max => 1979694.44999999995343387126922607421875,
- m_min => undef,
- m_max => undef,
- z_min => undef,
- z_max => undef,
- dbf_labels => 'ID _deleted',
- },
- cities => {
- object => undef,
- shape_type => 'Point',
- records => 36,
- shapes => 36,
- nulls => 0,
- x_min => -115.2942352294921875,
- x_max => -88.2643585205078125,
- y_min => 16.6302967071533203125,
- y_max => 32.620204925537109375,
- m_min => undef,
- m_max => undef,
- z_min => undef,
- z_max => undef,
- dbf_labels => 'CAPITAL NAME POPULATION STATE_NAME _deleted',
- },
- drainage => {
- object => undef,
- shape_type => 'PolyLine',
- records => 6,
- shapes => 6,
- nulls => 0,
- x_min => -115.04149627685546875,
- x_max => -90.65814208984375,
- y_min => 15.4399242401123046875,
- y_max => 32.72083282470703125,
- m_min => undef,
- m_max => undef,
- z_min => -16125672399481724123986011618587258386906538603886358185620065373269736146054676480,
- z_max => undef,
- dbf_labels => 'SYSTEM _deleted',
- },
- lakes => {
- object => undef,
- shape_type => 'Polygon',
- records => 3,
- shapes => 3,
- nulls => 0,
- x_min => -103.42584228515625,
- x_max => -96.3589019775390625,
- y_min => 18.092777252197265625,
- y_max => 20.339996337890625,
- m_min => undef,
- m_max => undef,
- z_min => -16125672399481724123986011618587258386906538603886358185620065373269736146054676480,
- z_max => undef,
- dbf_labels => 'AREA NAME _deleted',
- },
- masspntz => {
- object => undef,
- shape_type => 'PointZ',
- records => 815,
- shapes => 815,
- nulls => 0,
- x_min => 6294340.120000000111758708953857421875,
- x_max => 6296321.91999999992549419403076171875,
- y_min => 1978439.78000000002793967723846435546875,
- y_max => 1979689.88999999989755451679229736328125,
- m_min => undef,
- m_max => undef,
- z_min => undef,
- z_max => undef,
- dbf_labels => 'ID _deleted',
- },
- multipnt => {
- object => undef,
- shape_type => 'MultiPoint',
- records => 1,
- shapes => 1,
- nulls => 0,
- x_min => 483575.5,
- x_max => 483575.5,
- y_min => 4753046,
- y_max => 4753046,
- m_min => undef,
- m_max => undef,
- z_min => undef,
- z_max => undef,
- dbf_labels => 'AA AREA ATLAS_P ATLAS_S AVGHHINC CUMMKTSHR DIS130 DIS208 DIS425 DIS58 EAS_ EAS_ID EDHIGH EDLOW EDMED EDUC ELAT ELON HHNUMBER LIFESTYLES MKTSHR130 MKTSHR208 MKTSHR425 MKTSHR58 OPPT PENTRA PERIMETER POTENT PRFEDEA _deleted',
- },
- pline => {
- object => undef,
- shape_type => 'PolyLine',
- records => 460,
- shapes => 460,
- nulls => 0,
- x_min => 1296367.5,
- x_max => 1302699,
- y_min => 228199.390625,
- y_max => 237185.03125,
- m_min => undef,
- m_max => undef,
- z_min => undef,
- z_max => undef,
- dbf_labels => 'CKT_NM CMPN FNODE_ GISO_TYPE_ LENGTH LOCK__ID LPOLY_ OBJECT__ID PHASE PHASE__ID PLINE_ PLINE_ID RPOLY_ SYMBOL SYM_NBR TNODE_ TYPE UID VOLTAGE _deleted',
- },
- polygon => {
- object => undef,
- shape_type => 'Polygon',
- records => 474,
- shapes => 474,
- nulls => 0,
- x_min => 471127.1875,
- x_max => 489292.3125,
- y_min => 4751545,
- y_max => 4765610.5,
- m_min => undef,
- m_max => undef,
- z_min => undef,
- z_max => undef,
- dbf_labels => 'AA AREA ATLAS_P ATLAS_S AVGHHINC CUMMKTSHR DIS130 DIS208 DIS425 DIS58 EAS_ EAS_ID EDHIGH EDLOW EDMED EDUC ELAT ELON HHNUMBER LIFESTYLES MKTSHR130 MKTSHR208 MKTSHR425 MKTSHR58 OPPT PENTRA PERIMETER POTENT PRFEDEA _deleted',
- },
- rivers => {
- object => undef,
- shape_type => 'PolyLine',
- records => 30,
- shapes => 30,
- nulls => 0,
- x_min => -115.04149627685546875,
- x_max => -90.65814208984375,
- y_min => 15.4399242401123046875,
- y_max => 32.72083282470703125,
- m_min => undef,
- m_max => undef,
- z_min => -16125672399481724123986011618587258386906538603886358185620065373269736146054676480,
- z_max => undef,
- dbf_labels => 'NAME SYSTEM _deleted',
- },
- roads => {
- object => undef,
- shape_type => 'PolyLine',
- records => 105,
- shapes => 105,
- nulls => 0,
- x_min => -117.03643035888671875,
- x_max => -86.843597412109375,
- y_min => 14.5713672637939453125,
- y_max => 32.6636810302734375,
- m_min => undef,
- m_max => undef,
- z_min => undef,
- z_max => undef,
- dbf_labels => 'ADMN_CLASS LENGTH ROUTE RTE_NUM1 RTE_NUM2 TOLL_RD TYPE _deleted',
- },
- roads_rt => {
- object => undef,
- shape_type => 'PolyLine',
- records => 28,
- shapes => 28,
- nulls => 0,
- x_min => -117.03643035888671875,
- x_max => -86.843597412109375,
- y_min => 14.5713672637939453125,
- y_max => 32.6636810302734375,
- m_min => undef,
- m_max => undef,
- z_min => undef,
- z_max => undef,
- dbf_labels => 'ROUTE _deleted',
- },
- states => {
- object => undef,
- shape_type => 'Polygon',
- records => 32,
- shapes => 32,
- nulls => 0,
- x_min => -117.12237548828125,
- x_max => -86.7350006103515625,
- y_min => 14.5505466461181640625,
- y_max => 32.7208099365234375,
- m_min => undef,
- m_max => undef,
- z_min => 768132343507160766108099947708147205392141761325948192154576281445969786822266109612978357005202339868627839948143029980413485838758710421858995973573516602505672081229247161886287459759546354037365234956463577676596117504,
- z_max => undef,
- dbf_labels => 'AREA CODE NAME _deleted',
- },
-)
@@ -0,0 +1,186 @@
+$VAR1 = [
+ {
+ 'Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes' => 0,
+ 'Perl::Critic::Policy::Modules::ProhibitEvilModules' => 0,
+ 'Perl::Critic::Policy::Variables::RequireLexicalLoopIterators' => 0,
+ 'Perl::Critic::Policy::Modules::RequireBarewordIncludes' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen' => 0,
+ 'Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros' => 0,
+ 'Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict' => 1,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval' => 0,
+ 'Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitNestedSubs' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitReturnSort' => 0,
+ 'Perl::Critic::Policy::InputOutput::RequireEncodingWithUTF8Layer' => 0,
+ 'Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions' => 1,
+ 'Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef' => 0,
+ 'Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations' => 0
+ },
+ {
+ 'Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes' => 0,
+ 'Perl::Critic::Policy::Modules::ProhibitEvilModules' => 0,
+ 'Perl::Critic::Policy::Variables::RequireLexicalLoopIterators' => 0,
+ 'Perl::Critic::Policy::Modules::RequireBarewordIncludes' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen' => 0,
+ 'Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros' => 0,
+ 'Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict' => 1,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval' => 0,
+ 'Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitNestedSubs' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitReturnSort' => 0,
+ 'Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict' => 0,
+ 'Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions' => 1,
+ 'Perl::Critic::Policy::InputOutput::RequireEncodingWithUTF8Layer' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef' => 0,
+ 'Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations' => 0
+ },
+ {
+ 'Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes' => 0,
+ 'Perl::Critic::Policy::Modules::ProhibitEvilModules' => 0,
+ 'Perl::Critic::Policy::Variables::RequireLexicalLoopIterators' => 0,
+ 'Perl::Critic::Policy::Modules::RequireBarewordIncludes' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen' => 0,
+ 'Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros' => 0,
+ 'Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict' => 1,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval' => 0,
+ 'Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitNestedSubs' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitReturnSort' => 0,
+ 'Perl::Critic::Policy::InputOutput::RequireEncodingWithUTF8Layer' => 0,
+ 'Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions' => 1,
+ 'Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef' => 0,
+ 'Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations' => 0
+ },
+ {
+ 'Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes' => 0,
+ 'Perl::Critic::Policy::Modules::ProhibitEvilModules' => 0,
+ 'Perl::Critic::Policy::Variables::RequireLexicalLoopIterators' => 0,
+ 'Perl::Critic::Policy::Modules::RequireBarewordIncludes' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen' => 0,
+ 'Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros' => 0,
+ 'Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict' => 1,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval' => 0,
+ 'Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitNestedSubs' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitReturnSort' => 0,
+ 'Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict' => 0,
+ 'Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions' => 1,
+ 'Perl::Critic::Policy::InputOutput::RequireEncodingWithUTF8Layer' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef' => 0,
+ 'Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations' => 0
+ },
+ {
+ 'Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes' => 0,
+ 'Perl::Critic::Policy::Modules::ProhibitEvilModules' => 0,
+ 'Perl::Critic::Policy::Variables::RequireLexicalLoopIterators' => 0,
+ 'Perl::Critic::Policy::Modules::RequireBarewordIncludes' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen' => 0,
+ 'Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros' => 0,
+ 'Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict' => 1,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval' => 0,
+ 'Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitNestedSubs' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitReturnSort' => 0,
+ 'Perl::Critic::Policy::InputOutput::RequireEncodingWithUTF8Layer' => 0,
+ 'Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions' => 1,
+ 'Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef' => 0,
+ 'Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations' => 0
+ },
+ {
+ 'Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes' => 0,
+ 'Perl::Critic::Policy::Modules::ProhibitEvilModules' => 0,
+ 'Perl::Critic::Policy::Variables::RequireLexicalLoopIterators' => 0,
+ 'Perl::Critic::Policy::Modules::RequireBarewordIncludes' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen' => 0,
+ 'Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros' => 0,
+ 'Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict' => 1,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval' => 0,
+ 'Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitNestedSubs' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitReturnSort' => 0,
+ 'Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict' => 0,
+ 'Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions' => 1,
+ 'Perl::Critic::Policy::InputOutput::RequireEncodingWithUTF8Layer' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef' => 0,
+ 'Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations' => 0
+ },
+ {
+ 'Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes' => 0,
+ 'Perl::Critic::Policy::Modules::ProhibitEvilModules' => 0,
+ 'Perl::Critic::Policy::Variables::RequireLexicalLoopIterators' => 0,
+ 'Perl::Critic::Policy::Modules::RequireBarewordIncludes' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen' => 0,
+ 'Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros' => 0,
+ 'Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict' => 1,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval' => 0,
+ 'Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitNestedSubs' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitReturnSort' => 0,
+ 'Perl::Critic::Policy::InputOutput::RequireEncodingWithUTF8Layer' => 0,
+ 'Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions' => 1,
+ 'Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef' => 0,
+ 'Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations' => 0
+ },
+ {
+ 'Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes' => 0,
+ 'Perl::Critic::Policy::Modules::ProhibitEvilModules' => 0,
+ 'Perl::Critic::Policy::Variables::RequireLexicalLoopIterators' => 0,
+ 'Perl::Critic::Policy::Modules::RequireBarewordIncludes' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen' => 0,
+ 'Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros' => 0,
+ 'Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict' => 1,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect' => 0,
+ 'Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval' => 0,
+ 'Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless' => 0,
+ 'Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitNestedSubs' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitReturnSort' => 0,
+ 'Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict' => 0,
+ 'Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions' => 1,
+ 'Perl::Critic::Policy::InputOutput::RequireEncodingWithUTF8Layer' => 0,
+ 'Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef' => 0,
+ 'Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations' => 0
+ }
+ ];
@@ -0,0 +1,15 @@
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::HasVersion";
+
+if ($@) {
+ plan skip_all => 'Test::HasVersion required for testing for version numbers';
+}
+
+all_pm_version_ok();
+
+#done_testing ();
@@ -0,0 +1,58 @@
+#!perl
+
+# make sure all biodiverse modules are of the same version
+
+use strict;
+use warnings;
+
+
+use Test::More;
+
+#my @files;
+use FindBin qw { $Bin };
+use File::Spec;
+use File::Find; # should switch to use File::Next
+
+use rlib;
+
+# list of files
+our @packages;
+
+my $wanted = sub {
+ # only operate on Perl modules
+ return if $_ !~ m/\.pm$/;
+
+ my $filename = $File::Find::name;
+ $filename =~ s/\.pm$//;
+ $filename =~ s{/}{::}g;
+ if ($filename =~ /lib::(Geo.*)$/) { # get the package part - very clunky
+ $filename = $1;
+ }
+
+
+ push @packages, $filename;
+};
+
+my $lib_dir = File::Spec->catfile( $Bin, '..', 'lib' );
+find ( $wanted, $lib_dir );
+
+require Geo::ShapeFile;
+
+my $version = $Geo::ShapeFile::VERSION;
+
+note ( "Testing Geo::ShapeFile $version, Perl $], $^X" );
+
+my $blah = $Geo::ShapeFile::VERSION;
+
+while (my $file = shift @packages) {
+ my $loaded = eval qq{ require $file };
+ my $msg_extra = q{};
+ if (!$loaded) {
+ $msg_extra = " (Unable to load $file).";
+ }
+ my $this_version = eval '$' . $file . q{::VERSION};
+ my $msg = "$file is $version." . $msg_extra;
+ is ( $this_version, $version, $msg );
+}
+
+done_testing();
@@ -0,0 +1,19 @@
+#!perl
+
+use strict;
+use warnings;
+use Test::More;
+
+#my $run_plan = $ENV{AUTHOR_TESTS};
+#if (!$run_plan) {
+# plan skip_all => "Skipping POD tests - they are for development";
+#}
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+if ($@) {
+ plan skip_all => "Test::Pod $min_tp required for testing POD";
+}
+
+all_pod_files_ok();
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
@@ -0,0 +1,28 @@
+use strict;
+use warnings;
+use Test::More;
+
+local $| = 1;
+
+use rlib;
+
+use English qw ( -no_match_vars );
+
+# Ensure a recent version of Test::Pod::Coverage
+my $min_tpc = 1.08;
+eval "use Test::Pod::Coverage $min_tpc";
+if ($EVAL_ERROR) {
+ plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage";
+}
+
+# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
+# but older versions don't recognize some common documentation styles
+my $min_pc = 0.18;
+eval "use Pod::Coverage $min_pc";
+
+if ($EVAL_ERROR) {
+ plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage";
+}
+
+
+all_pod_coverage_ok();
@@ -0,0 +1,7 @@
+use Test::CheckManifest;
+use Test::More;
+
+
+TODO: {
+ ok_manifest();
+};
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+use Test::More;
+
+local $| = 1;
+use File::Spec;
+
+
+eval { require Test::Perl::Critic::Progressive };
+if ($@) {
+ plan skip_all => 'T::P::C::Progressive required for this test';
+}
+
+use Test::Perl::Critic::Progressive qw( progressive_critic_ok );
+progressive_critic_ok();
+
@@ -0,0 +1,16 @@
+use Test::NoTabs;
+
+use strict;
+use warnings;
+
+local $| = 1;
+use File::Spec;
+
+#use FindBin qw { $Bin };
+#
+#my $bin_path = File::Spec->catfile ($Bin, qw{..}, 'bin');
+#my $lib_path = File::Spec->catfile ($Bin, qw{..}, 'lib');
+#
+#all_perl_files_ok( $bin_path, $lib_path );
+
+all_perl_files_ok( 'eg', 't', , 'xt', 'lib' );
@@ -0,0 +1,26 @@
+use Test::Strict;
+use Test::More;
+
+use strict;
+use warnings;
+
+local $| = 1;
+use File::Spec;
+
+use English qw { -no_match_vars };
+
+# seems to not test properly under Win32
+# finds too many false positives
+if ($OSNAME eq 'MSWin32') {
+ plan skip_all => "Skipping use_strict tests due to false positives on $OSNAME";
+}
+
+all_perl_files_ok( ); # Syntax ok and use strict;
+
+#
+#use FindBin qw { $Bin };
+#my $bin_path = File::Spec->catfile ($Bin, qw{..}, 'bin');
+#my $lib_path = File::Spec->catfile ($Bin, qw{..}, 'lib');
+#my $t_path = File::Spec->catfile ($Bin, qw{..}, 't');
+#
+#all_perl_files_ok( $bin_path, $lib_path, $t_path ); # Syntax ok and use strict;
@@ -0,0 +1,8 @@
+#!/usr/bin/perl -w
+use strict;
+
+
+use Test::More;
+eval 'use Test::CPAN::Changes';
+plan skip_all => 'Test::CPAN::Changes required for this test' if $@;
+changes_ok();
@@ -0,0 +1 @@
+These are author tests
\ No newline at end of file
@@ -0,0 +1,125 @@
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+use English qw / -no_match_vars /;
+
+use 5.010;
+
+use rlib '../lib', '../t/lib';
+
+local $| = 1;
+
+use Geo::ShapeFile;
+use Geo::ShapeFile::Shape;
+
+use Benchmark qw /:all/;
+
+use FindBin;
+
+
+my $reps = $ARGV[0] // -5;
+my $index_res = $ARGV[1] // 10;
+my $prebuild = $ARGV[2] // 0;
+
+
+my $dir = "$FindBin::Bin/../t/test_data";
+my $base = "polygon";
+#$base = "states";
+my $file = "$dir/$base";
+
+
+
+# no index per shape - we can still index the shapes themselves
+my $shp_no_index = Geo::ShapeFile->new ($file);
+$shp_no_index->build_spatial_index;
+
+my $shp_use_index = Geo::ShapeFile->new ($file);
+$shp_use_index->build_spatial_index;
+
+# Generate a set of random points across the bounds
+# Not truly ranodom, but random enough.
+my @bounds = $shp_no_index->bounds;
+my $x_min = $bounds[0];
+my $y_min = $bounds[1];
+my $x_range = $bounds[2] - $x_min;
+my $y_range = $bounds[3] - $y_min;
+
+my $n = 100;
+
+my (@points, %point_hash);
+
+foreach my $i (1 .. $n) {
+ my $x = $x_min + rand($x_range);
+ my $y = $y_min + rand($y_range);
+ my $pt = Geo::ShapeFile::Point->new(X => $x, Y => $y);
+ push @points, $pt;
+ $point_hash{"$pt"} = $pt;
+}
+
+my $sp_index1 = $shp_no_index->get_spatial_index;
+my $sp_index2 = $shp_use_index->get_spatial_index;
+
+# reduce the search space a bit
+my (%shape_set1, %shape_set2);
+
+POINT:
+foreach my $pt (@points) {
+ my @point = ($pt->get_x, $pt->get_y);
+
+ my @shapes1;
+ $sp_index1->query_point(@point, \@shapes1);
+
+ next POINT if !@shapes1; # skip if none there
+
+ $shape_set1{"$pt"} = \@shapes1;
+
+ my @shapes2;
+ $sp_index2->query_point(@point, \@shapes2);
+ $shape_set2{"$pt"} = \@shapes2;
+}
+
+# prebuild the indexes
+if ($prebuild) {
+ say 'prebuilding shape indexes';
+ foreach my $shape ($shp_use_index->get_all_shapes) {
+ $shape->build_spatial_index ($index_res);
+ }
+}
+
+say 'Working with ', scalar (keys %shape_set1), ' points';
+
+# now we finally get to the benchmark
+cmpthese (
+ $reps,
+ {
+ use_index => sub {use_index()},
+ no_index => sub {no_index()},
+ }
+);
+
+
+sub no_index {
+ my $use_index = undef;
+
+ foreach my $pt_id (keys %shape_set1) {
+ my $pt = $point_hash{$pt_id};
+ my $shapes = $shape_set1{$pt_id};
+ foreach my $shp (@$shapes) {
+ my $result = $shp->contains_point ($pt, $use_index);
+ }
+ }
+
+}
+
+sub use_index {
+ my $use_index = $index_res;
+
+ foreach my $pt_id (keys %shape_set2) {
+ my $pt = $point_hash{$pt_id};
+ my $shapes = $shape_set2{$pt_id};
+ foreach my $shp (@$shapes) {
+ my $result = $shp->contains_point ($pt, $use_index);
+ }
+ }
+}
+