[libgeo-shapelib-perl] 01/02: Import Upstream version 0.22
Francesco Lovergine
frankie at moszumanska.debian.org
Thu Jan 4 19:31:19 UTC 2018
This is an automated email from the git hooks/post-receive script.
frankie pushed a commit to branch master
in repository libgeo-shapelib-perl.
commit d252f27da8275cca67b3b10681d74952382d600b
Author: Francesco Paolo Lovergine <frankie at debian.org>
Date: Sun Dec 31 16:28:16 2017 +0100
Import Upstream version 0.22
---
Changes | 78 ++++
LICENSE | 202 ++++++++
MANIFEST | 16 +
META.json | 49 ++
META.yml | 25 +
Makefile.PL | 85 ++++
README.md | 36 ++
Shapelib.xs | 673 +++++++++++++++++++++++++++
example/xyz.dbf | Bin 0 -> 80101 bytes
example/xyz.sbn | Bin 0 -> 33284 bytes
example/xyz.sbx | Bin 0 -> 2492 bytes
example/xyz.shp | Bin 0 -> 80040 bytes
example/xyz.shx | Bin 0 -> 22940 bytes
lib/Geo/Shapelib.pm | 1282 +++++++++++++++++++++++++++++++++++++++++++++++++++
t/00.t | 201 ++++++++
typemap | 4 +
16 files changed, 2651 insertions(+)
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..064d6e3
--- /dev/null
+++ b/Changes
@@ -0,0 +1,78 @@
+Revision history for Perl extension Geo::Shapelib.
+
+0.01 Thu Aug 24 13:48:52 2000
+ - original version; created by h2xs 1.20 with options
+ -n Shape shapelib-1.2.8/shapefil
+0.02 Fri Aug 25 14:29:26 EEST 2000
+ - save implemented
+0.03 released Sep 13. 2001
+ - changes from Quinn Hart <qjhart at ucdavis.edu>, see README.Debian
+ - included the debian files into MANIFEST
+0.04 released Mar 4 2003
+ - changes from Leif Pedersen <pedersen at meridian-enviro.com>
+0.05 released Oct 20 2003
+ - as Geo::Shapelib in CPAN
+ - removed the debian files, sorry
+0.06 released Oct 22 2003
+ - included Shapelib-1.2.10 tree into the distro
+0.07 released Jan 14 2004
+ - change suggested by Stephen Woodbridge <woodbri at swoodbridge.com>
+ ("it would be nice to be able to define the size of the the DBF fields")
+ - changes to shputils.c (#include <stdlib.h>,int findunit(char *unit);)
+0.08 released May 14 2004
+ - notes on installation in Windows from daniel.babault at mbda.fr
+0.09 released May 27 2004
+ - DBFWrite.. bugs fixed (thanks Joaquin Ferrero)
+0.10 released August 20 2004
+ - ForceStrings and other options for the new method (thanks Massimiliano )
+ - save bails out if shape is empty
+0.11 released November 15 2004
+ - ShapeID, NParts, NVertices optional (they are set in save method)
+ - Removed the DB method
+0.12 released January 8 2005
+ - bug fix: $self->{Options} gets set in all cases
+ - Fieldwidths in dbf files are used
+ - rewrote if($self->{Options}{UnhashFields}) in new method
+ - set_sizes method
+ - failure of DBFWriteAttribute gets correctly tested
+ - many bug fixes in dump method
+ - brush up of the man page
+ - new parameters for the constructor
+ - SHPType optional
+ - test.pl rewritten
+0.13 released Feb 8 2005
+ - changes to Shapelib.xs to make it compile with gcc 2.96 (as
+ suggested by Greg Machala)
+0.14 released Apr 11 2005
+ - use Tree:R, optionally build a R-tree of the shapes
+ - new methods: clear_selections, select_vertices, move_selected_vertices
+ - use $shapefile instead of $shape in the docs, $shapefile is
+ the whole object, $shape is either and individual shape or an index
+ to an individual shape
+0.15 released Apr 11 2005
+ - fixed small bugs in 0.14
+0.16 released Apr 21 2005
+ - select_vertices more options (all, one shape, vertices)
+ - Rtree handling in move_selected_vertices
+0.17 released May 26 2005
+ - LoadRecords to control whether load records into Perl vars or not
+ - fixed a bug which made open, save fail
+0.18 released June 11 2005
+ - fixed bugs pointed out by Ethan Alpert:
+ - in xs: in _CreateObject parts and vertices were not read correctly always, wrote tests for these
+ - edited pod, Parts, CombineVertices
+ - new method set_bounds
+0.19 released Jan 15 2006
+ - new constructor options: Like, Load
+ - get_record_hashref
+ - create, add, close
+ - lengths
+0.20 released Jan 15 2006
+ - some bugfixes related to NShapes
+0.21 released Sep 15 2015
+ - remove shapelib from the distribution
+ - add quadtree support
+0.22 released Jan 26 2017
+ - fix error https://rt.cpan.org/Public/Bug/Display.html?id=119994
+ - do not run file size comparison tests
+
\ No newline at end of file
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..55a2b1d
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,202 @@
+ The Artistic License 2.0
+
+ Copyright (c) 2015 Ari Jolma
+
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+Preamble
+
+This license establishes the terms under which a given free software
+Package may be copied, modified, distributed, and/or redistributed.
+The intent is that the Copyright Holder maintains some artistic
+control over the development of that Package while still keeping the
+Package available as open source and free software.
+
+You are always permitted to make arrangements wholly outside of this
+license directly with the Copyright Holder of a given Package. If the
+terms of this license do not permit the full use that you propose to
+make of the Package, you should contact the Copyright Holder and seek
+a different licensing arrangement.
+
+Definitions
+
+ "Copyright Holder" means the individual(s) or organization(s)
+ named in the copyright notice for the entire Package.
+
+ "Contributor" means any party that has contributed code or other
+ material to the Package, in accordance with the Copyright Holder's
+ procedures.
+
+ "You" and "your" means any person who would like to copy,
+ distribute, or modify the Package.
+
+ "Package" means the collection of files distributed by the
+ Copyright Holder, and derivatives of that collection and/or of
+ those files. A given Package may consist of either the Standard
+ Version, or a Modified Version.
+
+ "Distribute" means providing a copy of the Package or making it
+ accessible to anyone else, or in the case of a company or
+ organization, to others outside of your company or organization.
+
+ "Distributor Fee" means any fee that you charge for Distributing
+ this Package or providing support for this Package to another
+ party. It does not mean licensing fees.
+
+ "Standard Version" refers to the Package if it has not been
+ modified, or has been modified only in ways explicitly requested
+ by the Copyright Holder.
+
+ "Modified Version" means the Package, if it has been changed, and
+ such changes were not explicitly requested by the Copyright
+ Holder.
+
+ "Original License" means this Artistic License as Distributed with
+ the Standard Version of the Package, in its current version or as
+ it may be modified by The Perl Foundation in the future.
+
+ "Source" form means the source code, documentation source, and
+ configuration files for the Package.
+
+ "Compiled" form means the compiled bytecode, object code, binary,
+ or any other form resulting from mechanical transformation or
+ translation of the Source form.
+
+
+Permission for Use and Modification Without Distribution
+
+(1) You are permitted to use the Standard Version and create and use
+Modified Versions for any purpose without restriction, provided that
+you do not Distribute the Modified Version.
+
+
+Permissions for Redistribution of the Standard Version
+
+(2) You may Distribute verbatim copies of the Source form of the
+Standard Version of this Package in any medium without restriction,
+either gratis or for a Distributor Fee, provided that you duplicate
+all of the original copyright notices and associated disclaimers. At
+your discretion, such verbatim copies may or may not include a
+Compiled form of the Package.
+
+(3) You may apply any bug fixes, portability changes, and other
+modifications made available from the Copyright Holder. The resulting
+Package will still be considered the Standard Version, and as such
+will be subject to the Original License.
+
+
+Distribution of Modified Versions of the Package as Source
+
+(4) You may Distribute your Modified Version as Source (either gratis
+or for a Distributor Fee, and with or without a Compiled form of the
+Modified Version) provided that you clearly document how it differs
+from the Standard Version, including, but not limited to, documenting
+any non-standard features, executables, or modules, and provided that
+you do at least ONE of the following:
+
+ (a) make the Modified Version available to the Copyright Holder
+ of the Standard Version, under the Original License, so that the
+ Copyright Holder may include your modifications in the Standard
+ Version.
+
+ (b) ensure that installation of your Modified Version does not
+ prevent the user installing or running the Standard Version. In
+ addition, the Modified Version must bear a name that is different
+ from the name of the Standard Version.
+
+ (c) allow anyone who receives a copy of the Modified Version to
+ make the Source form of the Modified Version available to others
+ under
+
+ (i) the Original License or
+
+ (ii) a license that permits the licensee to freely copy,
+ modify and redistribute the Modified Version using the same
+ licensing terms that apply to the copy that the licensee
+ received, and requires that the Source form of the Modified
+ Version, and of any works derived from it, be made freely
+ available in that license fees are prohibited but Distributor
+ Fees are allowed.
+
+
+Distribution of Compiled Forms of the Standard Version
+or Modified Versions without the Source
+
+(5) You may Distribute Compiled forms of the Standard Version without
+the Source, provided that you include complete instructions on how to
+get the Source of the Standard Version. Such instructions must be
+valid at the time of your distribution. If these instructions, at any
+time while you are carrying out such distribution, become invalid, you
+must provide new instructions on demand or cease further distribution.
+If you provide valid instructions or cease distribution within thirty
+days after you become aware that the instructions are invalid, then
+you do not forfeit any of your rights under this license.
+
+(6) You may Distribute a Modified Version in Compiled form without
+the Source, provided that you comply with Section 4 with respect to
+the Source of the Modified Version.
+
+
+Aggregating or Linking the Package
+
+(7) You may aggregate the Package (either the Standard Version or
+Modified Version) with other packages and Distribute the resulting
+aggregation provided that you do not charge a licensing fee for the
+Package. Distributor Fees are permitted, and licensing fees for other
+components in the aggregation are permitted. The terms of this license
+apply to the use and Distribution of the Standard or Modified Versions
+as included in the aggregation.
+
+(8) You are permitted to link Modified and Standard Versions with
+other works, to embed the Package in a larger work of your own, or to
+build stand-alone binary or bytecode versions of applications that
+include the Package, and Distribute the result without restriction,
+provided the result does not expose a direct interface to the Package.
+
+
+Items That are Not Considered Part of a Modified Version
+
+(9) Works (including, but not limited to, modules and scripts) that
+merely extend or make use of the Package, do not, by themselves, cause
+the Package to be a Modified Version. In addition, such works are not
+considered parts of the Package itself, and are not subject to the
+terms of this license.
+
+
+General Provisions
+
+(10) Any use, modification, and distribution of the Standard or
+Modified Versions is governed by this Artistic License. By using,
+modifying or distributing the Package, you accept this license. Do not
+use, modify, or distribute the Package, if you do not accept this
+license.
+
+(11) If your Modified Version has been derived from a Modified
+Version made by someone other than you, you are nevertheless required
+to ensure that your Modified Version complies with the requirements of
+this license.
+
+(12) This license does not grant you the right to use any trademark,
+service mark, tradename, or logo of the Copyright Holder.
+
+(13) This license includes the non-exclusive, worldwide,
+free-of-charge patent license to make, have made, use, offer to sell,
+sell, import and otherwise transfer the Package with respect to any
+patent claims licensable by the Copyright Holder that are necessarily
+infringed by the Package. If you institute patent litigation
+(including a cross-claim or counterclaim) against any party alleging
+that the Package constitutes direct or contributory patent
+infringement, then this Artistic License to you shall terminate on the
+date that such litigation is filed.
+
+(14) Disclaimer of Warranty:
+THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS
+IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
+WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
+NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL
+LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL
+BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
+DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF
+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..fc27dfd
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,16 @@
+Changes
+LICENSE
+MANIFEST
+README.md
+typemap
+Makefile.PL
+t/00.t
+lib/Geo/Shapelib.pm
+Shapelib.xs
+example/xyz.dbf
+example/xyz.sbn
+example/xyz.sbx
+example/xyz.shp
+example/xyz.shx
+META.yml Module YAML meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
diff --git a/META.json b/META.json
new file mode 100644
index 0000000..9d664d4
--- /dev/null
+++ b/META.json
@@ -0,0 +1,49 @@
+{
+ "abstract" : "Perl extension for reading and writing shapefiles as defined by ESRI(r)",
+ "author" : [
+ "Ari Jolma <https://github.com/ajolma>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Geo-Shapelib",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "Tree::R" : "0.01"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "repository" : {
+ "type" : "git",
+ "url" : "https://github.com/ajolma/Geo-Shapelib.git",
+ "web" : "https://github.com/ajolma/Geo-Shapelib"
+ }
+ },
+ "version" : "0.22",
+ "x_serialization_backend" : "JSON::PP version 2.27400"
+}
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..979bdce
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,25 @@
+---
+abstract: 'Perl extension for reading and writing shapefiles as defined by ESRI(r)'
+author:
+ - 'Ari Jolma <https://github.com/ajolma>'
+build_requires:
+ ExtUtils::MakeMaker: '0'
+configure_requires:
+ ExtUtils::MakeMaker: '0'
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: '1.4'
+name: Geo-Shapelib
+no_index:
+ directory:
+ - t
+ - inc
+requires:
+ Tree::R: '0.01'
+resources:
+ repository: https://github.com/ajolma/Geo-Shapelib.git
+version: '0.22'
+x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..b785e46
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,85 @@
+use strict;
+use ExtUtils::MakeMaker;
+use File::Basename qw(fileparse);
+
+# The location of shapelib (libshp) can be given as a command line
+# param or as an env var.
+my %ARGV;
+for (@ARGV) {
+ $ARGV{$1} = $2 if /^--(.*?)\=(.*)/;
+ $_ = '' if /^--shapelib/;
+}
+$ARGV{shapelib} = $ENV{PERL_SHAPELIB} unless defined $ARGV{shapelib};
+
+# If not given, search.
+unless (defined $ARGV{shapelib}) {
+ # scan known possible locations in the order of preference:
+ my @locs;
+ for (qw(/usr/lib /usr/lib64 /usr/lib/x86_64-linux-gnu /usr/local/lib /usr/local/lib64)) {
+ # prefer a shared lib
+ my $lib = $_ . '/libshp.so';
+ $lib = $_ . '/libshp.a' unless -e $lib;
+ push @locs, $lib if -e $lib;
+ }
+ if (@locs) {
+ print "Found shapelib(s): '",join("', '", @locs),"'.\n";
+ $ARGV{shapelib} = $locs[0];
+ print "Will use '$ARGV{shapelib}'.\n";
+ }
+}
+die "Can't find shapelib.\n".
+ "Please install a development version of shapelib or\n".
+ "specify the location of libshp.a or libshp.so with\n".
+ "command line parameter --shapelib= or with environment\n".
+ "variable PERL_SHAPELIB.\n".
+ "You can get shapelib from http://download.osgeo.org/shapelib/."
+ unless -e $ARGV{shapelib};
+
+# Does the shapelib define SHPSearchDiskTree?
+my $HAS_SEARCH_DISK_TREE;
+if ($ARGV{shapelib} =~ /\.a$/) {
+ my @ret = `nm $ARGV{shapelib} | grep SHPSearchDiskTree`;
+ $HAS_SEARCH_DISK_TREE = $ret[0] ne '';
+} else {
+ my @ret = `readelf -Ws $ARGV{shapelib} | grep SHPSearchDiskTree`;
+ $HAS_SEARCH_DISK_TREE = $ret[0] ne '';
+}
+
+warn "Warning: Shapelib is old version. You will not be able to save quadtree index." unless $HAS_SEARCH_DISK_TREE;
+my ($file, $path, $suffix) = fileparse($ARGV{shapelib});
+
+my $libs;
+my $inc;
+my $define;
+if ($HAS_SEARCH_DISK_TREE) {
+ $libs = ["-L$path -lshp"];
+ $inc = "-I$path";
+ $define = '-DHAS_SEARCH_DISK_TREE';
+} else {
+ $libs = ["-L$path -lshp"];
+ $inc = "-I$path";
+ $define = undef;
+}
+
+WriteMakefile(
+ NAME => 'Geo::Shapelib',
+ VERSION_FROM => 'lib/Geo/Shapelib.pm',
+ PREREQ_PM => {'Tree::R' => 0.01}, # e.g., Module::Name => 1.1
+ ABSTRACT_FROM => 'lib/Geo/Shapelib.pm',
+ LIBS => $libs,
+ DEFINE => $define,
+ INC => $inc,
+ clean => {'FILES' => 'stations.* example/test.*'},
+ AUTHOR => 'Ari Jolma <https://github.com/ajolma>',
+ LICENSE => 'perl_5',
+ META_MERGE => {
+ 'meta-spec' => { version => 2 },
+ resources => {
+ repository => {
+ type => 'git',
+ web => 'https://github.com/ajolma/Geo-Shapelib',
+ url => 'https://github.com/ajolma/Geo-Shapelib.git',
+ },
+ },
+ }
+);
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..7cedeb9
--- /dev/null
+++ b/README.md
@@ -0,0 +1,36 @@
+Perl extension Geo::Shapelib
+===================
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+Geo::Shapelib.pm requires Shapefile C Library from
+http://shapelib.maptools.org/
+
+Chances are that you can install it with sudo apt-get install
+libshp-dev or something similar.
+
+COPYRIGHT AND LICENSE
+
+Copyright (c) 2000- Ari Jolma.
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of The Artistic License 2.0.
+
+ACKNOWLEDGEMENTS
+
+The example shapefile set is taken from the Shapelib examples. The following
+people have sent comments and/or bug fixes
+
+Massimiliano Galanti
+Leif Pedersen
+Daniel Babault
+woodbri
diff --git a/Shapelib.xs b/Shapelib.xs
new file mode 100644
index 0000000..6a6ef5c
--- /dev/null
+++ b/Shapelib.xs
@@ -0,0 +1,673 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <shapefil.h>
+
+#undef min
+#define min(x, y) ((x)<(y) ? (x) : (y))
+
+MODULE = Geo::Shapelib PACKAGE = Geo::Shapelib
+
+
+SHPHandle
+SHPOpen(pszShapeFile,pszAccess)
+ char *pszShapeFile
+ char *pszAccess
+
+SV *
+SHPGetInfo(hSHP)
+ SHPHandle hSHP
+ CODE:
+ {
+ int NShapes;
+ int Shapetype;
+ double MinBounds[4];
+ double MaxBounds[4];
+ int count;
+ AV *av;
+ HV *hv;
+ SV *sv;
+
+ SHPGetInfo(hSHP, &NShapes, &Shapetype, MinBounds, MaxBounds);
+ if (!(hv = newHV())) goto BREAK;
+ if (!(sv = newSViv(NShapes))) goto BREAK;
+ hv_store(hv, "NShapes", 7, sv, 0);
+ if (!(sv = newSViv(Shapetype))) goto BREAK;
+ hv_store(hv, "Shapetype", 9, sv, 0);
+
+ /* Make MinBounds */
+ if (!(av = newAV())) goto BREAK;
+ for (count = 0; count < 4; count++) {
+ if (!(sv = newSVnv(MinBounds[count]))) goto BREAK;
+ av_push(av, sv);
+ }
+ if (!(sv = newRV_noinc((SV*) av))) goto BREAK;
+ hv_store(hv, "MinBounds", 9, sv, 0);
+
+ /* Make MaxBounds */
+ if (!(av = newAV())) goto BREAK;
+ for (count = 0; count < 4; count++) {
+ if (!(sv = newSVnv(MaxBounds[count]))) goto BREAK;
+ av_push(av, sv);
+ }
+ if (!(sv = newRV_noinc((SV*) av))) goto BREAK;
+ hv_store(hv, "MaxBounds", 9, sv, 0);
+
+ if (!(sv = newRV_noinc((SV *) hv))) goto BREAK;
+ goto DONE;
+ BREAK:
+ fprintf(stderr,"Out of memory!\n");
+ hv = NULL;
+ DONE:
+ RETVAL = sv;
+ }
+ OUTPUT:
+ RETVAL
+
+SV *
+SHPReadObject(hSHP, which, combine_vertices)
+ SHPHandle hSHP
+ int which
+ int combine_vertices
+ CODE:
+ {
+ HV *hv = NULL;
+ SV *sv = NULL;
+ AV *av = NULL;
+ int count;
+
+ SHPObject *shape = SHPReadObject( hSHP, which );
+ if (!shape) goto DONE;
+
+ hv = newHV();
+ if (!hv) goto BREAK;
+
+ if (!(sv = newSViv(shape->nSHPType))) goto BREAK;
+ hv_store(hv, "SHPType", 7, sv, 0);
+ if (!(sv = newSViv(shape->nShapeId))) goto BREAK;
+ hv_store(hv, "ShapeId", 7, sv, 0);
+ if (!(sv = newSViv(shape->nParts))) goto BREAK;
+ hv_store(hv, "NParts", 6, sv, 0);
+
+ /* Make MinBounds */
+ if (!(av = newAV())) goto BREAK;
+ if (!(sv = newSVnv(shape->dfXMin))) goto BREAK;
+ av_push(av, sv);
+ if (!(sv = newSVnv(shape->dfYMin))) goto BREAK;
+ av_push(av, sv);
+ if (!(sv = newSVnv(shape->dfZMin))) goto BREAK;
+ av_push(av, sv);
+ if (!(sv = newSVnv(shape->dfMMin))) goto BREAK;
+ av_push(av, sv);
+ if (!(sv = newRV_noinc((SV*) av))) goto BREAK;
+ hv_store(hv, "MinBounds", 9, sv, 0);
+
+ /* Make MaxBounds */
+ if (!(av = newAV())) goto BREAK;
+ if (!(sv = newSVnv(shape->dfXMax))) goto BREAK;
+ av_push(av, sv);
+ if (!(sv = newSVnv(shape->dfYMax))) goto BREAK;
+ av_push(av, sv);
+ if (!(sv = newSVnv(shape->dfZMax))) goto BREAK;
+ av_push(av, sv);
+ if (!(sv = newSVnv(shape->dfMMax))) goto BREAK;
+ av_push(av, sv);
+ if (!(sv = newRV_noinc((SV*) av))) goto BREAK;
+ hv_store(hv, "MaxBounds", 9, sv, 0);
+
+ if (combine_vertices) {
+ /* This is the default, make a separate
+ array of parts and vertices */
+
+ /* Make array of parts */
+ if (!(av = newAV())) goto BREAK;
+ for (count = 0; count < shape->nParts; count++) {
+ AV *av2;
+ if (!(av2 = newAV())) goto BREAK;
+ if (!(sv = newSViv(shape->panPartStart[count]))) goto BREAK;
+ av_push(av2, sv);
+ if (!(sv = newSViv(shape->panPartType[count]))) goto BREAK;
+ av_push(av2, sv);
+ if (!(sv = newRV_noinc((SV*) av2))) goto BREAK;
+ av_push(av, sv);
+ }
+ if (!(sv = newRV_noinc((SV*) av))) goto BREAK;
+ hv_store(hv, "Parts", 5, sv, 0);
+
+ /* Make array of vertices */
+ if (!(sv = newSViv(shape->nVertices))) goto BREAK;
+ hv_store(hv, "NVertices", 9, sv, 0);
+ if (!(av = newAV())) goto BREAK;
+ for (count = 0; count < shape->nVertices; count++) {
+ AV *av2;
+ if (!(av2 = newAV())) goto BREAK;
+ if (!(sv = newSVnv(shape->padfX[count]))) goto BREAK;
+ av_push(av2, sv);
+ if (!(sv = newSVnv(shape->padfY[count]))) goto BREAK;
+ av_push(av2, sv);
+ if (!(sv = newSVnv(shape->padfZ[count]))) goto BREAK;
+ av_push(av2, sv);
+ if (!(sv = newSVnv(shape->padfM[count]))) goto BREAK;
+ av_push(av2, sv);
+ if (!(sv = newRV_noinc((SV*) av2))) goto BREAK;
+ av_push(av, sv);
+ }
+ if (!(sv = newRV_noinc((SV*) av))) goto BREAK;
+ hv_store(hv, "Vertices", 8, sv, 0);
+ } else {
+ /* Make array of parts, each containing an array of vertices */
+ if (!(av = newAV())) goto BREAK;
+ for (count = 0; count < shape->nParts; count++) {
+ HV *hv2;
+ AV *av2;
+ int count2, num_vertices, first_vertex;
+
+ if (!(hv2 = newHV())) goto BREAK; /* hv2 represents this part */
+ if (!(sv = newSViv(count))) goto BREAK;
+ hv_store(hv2, "PartId", 6, sv, 0);
+ if (!(sv = newSViv(shape->panPartType[count]))) goto BREAK;
+ hv_store(hv2, "PartType", 8, sv, 0);
+
+ /* Make array of vertices for this part */
+ first_vertex = shape->panPartStart[count];
+ if(count + 1 < shape->nParts)
+ num_vertices = shape->panPartStart[count + 1] - first_vertex;
+ else
+ num_vertices = shape->nVertices - first_vertex;
+ if (!(sv = newSViv(num_vertices))) goto BREAK;
+ hv_store(hv2, "NVertices", 9, sv, 0);
+
+ if (!(av2 = newAV())) goto BREAK;
+ for (count2 = 0; count2 < num_vertices; count2++) {
+ AV *av3;
+
+ if (!(av3 = newAV())) goto BREAK;
+ if (!(sv = newSVnv(shape->padfX[first_vertex + count2]))) goto BREAK;
+ av_push(av3, sv);
+ if (!(sv = newSVnv(shape->padfY[first_vertex + count2]))) goto BREAK;
+ av_push(av3, sv);
+ if (!(sv = newSVnv(shape->padfZ[first_vertex + count2]))) goto BREAK;
+ av_push(av3, sv);
+ if (!(sv = newSVnv(shape->padfM[first_vertex + count2]))) goto BREAK;
+ av_push(av3, sv);
+
+ if (!(sv = newRV_noinc((SV*) av3))) goto BREAK;
+ av_push(av2, sv);
+ }
+
+ if (!(sv = newRV_noinc((SV*) av2))) goto BREAK;
+ hv_store(hv2, "Vertices", 8, sv, 0);
+
+ if (!(sv = newRV_noinc((SV*) hv2))) goto BREAK;
+ av_push(av, sv);
+ }
+ if (!(sv = newRV_noinc((SV*) av))) goto BREAK;
+ hv_store(hv, "Parts", 5, sv, 0);
+ }
+
+ SHPDestroyObject(shape);
+ if (!(sv = newRV_noinc((SV*) hv))) goto BREAK;
+ goto DONE;
+ BREAK:
+ fprintf(stderr,"Out of memory!\n");
+ sv = NULL;
+ DONE:
+ RETVAL = sv;
+ }
+ OUTPUT:
+ RETVAL
+
+void
+SHPClose(hSHP)
+ SHPHandle hSHP
+
+SHPHandle
+SHPCreate(pszShapeFile, nShapeType)
+ char *pszShapeFile
+ int nShapeType
+
+SHPObject *
+_SHPCreateObject(nSHPType, iShape, nParts, Parts, nVertices, Vertices)
+ int nSHPType
+ int iShape
+ int nParts
+ SV *Parts
+ int nVertices
+ SV *Vertices
+ CODE:
+ {
+ int *panPartStart = NULL;
+ int *panPartType = NULL;
+ double *padfX = NULL;
+ double *padfY = NULL;
+ double *padfZ = NULL;
+ double *padfM = NULL;
+ AV *p = NULL;
+ AV *v = NULL;
+ int i;
+ int n;
+ if (nParts) p = (AV *)SvRV(Parts);
+ v = (AV *)SvRV(Vertices);
+ if (nParts) {
+ Newx(panPartStart, nParts, int);
+ Newx(panPartType, nParts, int);
+ }
+ Newx(padfX, nVertices, double);
+ Newx(padfY, nVertices, double);
+ Newx(padfZ, nVertices, double);
+ Newx(padfM, nVertices, double);
+ if (nParts && (SvTYPE(p) != SVt_PVAV)) {
+ fprintf(stderr,"Parts is not a list\n");
+ goto BREAK;
+ }
+ if (v && (SvTYPE(v) != SVt_PVAV)) {
+ fprintf(stderr,"Vertices is not a list\n");
+ goto BREAK;
+ }
+ n = nParts;
+ if (p) n = min(n,av_len(p)+1);
+ for (i = 0; i < n; i++) {
+ SV **pa = av_fetch(p, i, 0);
+ AV *pi;
+ if (!pa) {
+ fprintf(stderr,"NULL value in Parts array at index %i\n", i);
+ goto BREAK;
+ }
+ pi = (AV *)SvRV(*pa);
+ if (SvTYPE(pi) == SVt_PVAV) {
+ SV **ps = av_fetch(pi, 0, 0);
+ SV **pt = av_fetch(pi, 1, 0);
+ panPartStart[i] = SvIV(*ps);
+ panPartType[i] = SvIV(*pt);
+ } else {
+ fprintf(stderr,"Parts is not a list of lists\n");
+ goto BREAK;
+ }
+ }
+ n = nVertices;
+ if (v) n = min(n,av_len(v)+1);
+ for (i = 0; i < n; i++) {
+ SV **va = av_fetch(v, i, 0);
+ AV *vi;
+ if (!va) {
+ fprintf(stderr,"NULL value in Vertices array at index %i\n", i);
+ goto BREAK;
+ }
+ vi =(AV *)SvRV(*va);
+ if (SvTYPE(vi) == SVt_PVAV) {
+ SV **x = av_fetch(vi, 0, 0);
+ SV **y = av_fetch(vi, 1, 0);
+ SV **z = av_fetch(vi, 2, 0);
+ SV **m = av_fetch(vi, 3, 0);
+ padfX[i] = SvNV(*x);
+ padfY[i] = SvNV(*y);
+ if (z)
+ padfZ[i] = SvNV(*z);
+ else
+ padfZ[i] = 0;
+ if (m)
+ padfM[i] = SvNV(*m);
+ else
+ padfM[i] = 0;
+ } else {
+ fprintf(stderr,"Vertices is not a list of lists\n");
+ goto BREAK;
+ }
+ }
+ RETVAL = SHPCreateObject(nSHPType, iShape, nParts,
+ panPartStart, panPartType, nVertices, padfX, padfY, padfZ, padfM);
+ goto DONE;
+ BREAK:
+ RETVAL = NULL;
+ DONE:
+ if (panPartStart) Safefree(panPartStart);
+ if (panPartType) Safefree(panPartType);
+ if (padfX) Safefree(padfX);
+ if (padfY) Safefree(padfY);
+ if (padfZ) Safefree(padfZ);
+ if (padfM) Safefree(padfM);
+ }
+ OUTPUT:
+ RETVAL
+
+int
+SHPCreateSpatialIndex(filename, iMaxDepth, hSHP)
+ char *filename
+ int iMaxDepth
+ SHPHandle hSHP
+ INIT:
+ SHPTree *psTree;
+ CODE:
+#ifdef HAS_SEARCH_DISK_TREE
+ psTree = SHPCreateTree( hSHP, 2, iMaxDepth, NULL, NULL );
+ SHPTreeTrimExtraNodes( psTree );
+ SHPWriteTree( psTree, filename );
+ SHPDestroyTree( psTree );
+ RETVAL = access( filename, F_OK ) != -1;
+#else
+ RETVAL = 1;
+#endif
+ OUTPUT:
+ RETVAL
+
+SV *
+SHPSearchDiskTree(hSHP, filename, svBounds, MaxDepth)
+ SHPHandle hSHP
+ char *filename
+ SV * svBounds
+ int MaxDepth
+ INIT:
+ AV * results;
+ double adfSearchMin[4], adfSearchMax[4];
+ int i, *panResult, nResultCount = 0, iResult;
+
+ if ((!SvROK(svBounds))
+ || (SvTYPE(SvRV(svBounds)) != SVt_PVAV)
+ || (( av_len((AV *)SvRV(svBounds))) != 3) )
+ {
+ fprintf(stderr,"Bounds array reference incorrectly defined!\n");
+ XSRETURN_UNDEF;
+ }
+ adfSearchMin[0] = SvNV(*av_fetch((AV *)SvRV(svBounds), 0, 0));
+ adfSearchMin[1] = SvNV(*av_fetch((AV *)SvRV(svBounds), 1, 0));
+ adfSearchMax[0] = SvNV(*av_fetch((AV *)SvRV(svBounds), 2, 0));
+ adfSearchMax[1] = SvNV(*av_fetch((AV *)SvRV(svBounds), 3, 0));
+ adfSearchMin[2] = adfSearchMax[2] = 0.0;
+ adfSearchMin[3] = adfSearchMax[3] = 0.0;
+ if( adfSearchMin[0] > adfSearchMax[0]
+ || adfSearchMin[1] > adfSearchMax[1] )
+ {
+ fprintf(stderr,"Min greater than max in search criteria.\n" );
+ XSRETURN_UNDEF;
+ }
+
+ results = (AV *)sv_2mortal((SV *)newAV());
+ CODE:
+ SHPTree *tree = NULL;
+#ifdef HAS_SEARCH_DISK_TREE
+ FILE *qix = fopen(filename, "r");
+ if (!qix) {
+ tree = SHPCreateTree( hSHP, 2, 0, NULL, NULL );
+ SHPTreeTrimExtraNodes( tree );
+ SHPWriteTree( tree, filename );
+ panResult = SHPTreeFindLikelyShapes( tree, adfSearchMin, adfSearchMax,
+ &nResultCount );
+ } else {
+ panResult = SHPSearchDiskTree( qix, adfSearchMin, adfSearchMax,
+ &nResultCount );
+
+ }
+#else
+ tree = SHPCreateTree( hSHP, 2, 0, NULL, NULL );
+ SHPTreeTrimExtraNodes( tree );
+ panResult = SHPTreeFindLikelyShapes( tree, adfSearchMin, adfSearchMax,
+ &nResultCount );
+#endif
+ for( iResult = 0; iResult < nResultCount; iResult++ )
+ {
+ SHPObject *psObject;
+ psObject = SHPReadObject( hSHP, panResult[iResult] );
+ if( psObject == NULL )
+ continue;
+ if( SHPCheckBoundsOverlap( adfSearchMin, adfSearchMax,
+ &(psObject->dfXMin),
+ &(psObject->dfXMax),
+ 2 ) )
+ {
+ av_push(results, newSViv(panResult[iResult]));
+ }
+ SHPDestroyObject( psObject );
+ }
+ free( panResult );
+ if (tree)
+ SHPDestroyTree( tree );
+#ifdef HAS_SEARCH_DISK_TREE
+ if (qix)
+ fclose(qix);
+#endif
+ RETVAL = newRV((SV *)results);
+ OUTPUT:
+ RETVAL
+
+int
+SHPWriteObject(hSHP, iShape, psObject)
+ SHPHandle hSHP
+ int iShape
+ SHPObject *psObject
+
+void
+SHPDestroyObject(psObject)
+ SHPObject *psObject
+
+DBFHandle
+DBFOpen(pszDBFFile,pszAccess)
+ char *pszDBFFile
+ char *pszAccess
+
+int
+DBFGetRecordCount(hDBF)
+ DBFHandle hDBF
+
+SV *
+ReadDataModel(hDBF, bForceStrings)
+ DBFHandle hDBF
+ int bForceStrings
+ CODE:
+ {
+ HV *hv = NULL;
+ SV *sv = NULL;
+ AV *av = NULL;
+ int num_fields;
+ int num_records;
+ int record, field;
+
+ if (!(hv = newHV())) goto BREAK;
+
+ num_fields = DBFGetFieldCount(hDBF);
+ num_records = DBFGetRecordCount(hDBF);
+
+ for (field = 0; field < num_fields; field++) {
+ char field_name[12], *field_type;
+ int nWidth, nDecimals, iType;
+
+ iType = DBFGetFieldInfo(hDBF, field, field_name, &nWidth, &nDecimals);
+
+ /* Force Type to String */
+ if (1 == bForceStrings)
+ iType = FTString;
+
+ switch (iType) {
+ case FTString:
+ field_type = "String";
+ break;
+ case FTInteger:
+ field_type = "Integer";
+ break;
+ case FTDouble:
+ field_type = "Double";
+ break;
+ default:
+ field_type = "Invalid";
+ }
+
+ /*if (!(sv = newSVpv(field_type, 0))) goto BREAK;*/
+ if (nDecimals) {
+ if (!(sv = newSVpvf("%s:%i:%i",field_type,nWidth,nDecimals))) goto BREAK;
+ } else {
+ if (!(sv = newSVpvf("%s:%i",field_type,nWidth))) goto BREAK;
+ }
+ hv_store(hv, field_name, strlen(field_name), sv, 0);
+ }
+
+ goto DONE;
+ BREAK:
+ fprintf(stderr,"Out of memory!\n");
+ hv = NULL;
+ DONE:
+ RETVAL = newRV_noinc((SV *)hv);
+ }
+ OUTPUT:
+ RETVAL
+
+SV *
+ReadData(hDBF, bForceStrings)
+ DBFHandle hDBF
+ int bForceStrings
+ CODE:
+ {
+ AV *av = NULL;
+ int num_fields;
+ int num_records;
+ int record, field;
+
+ num_fields = DBFGetFieldCount(hDBF);
+ num_records = DBFGetRecordCount(hDBF);
+
+ if (!(av = newAV())) goto BREAK;
+ for (record = 0; record < num_records; record++) {
+ HV *hv = NULL;
+ SV *sv = NULL;
+ if (!(hv = newHV())) goto BREAK;
+ for (field = 0; field < num_fields; field++) {
+ char field_name[12];
+ int nWidth, nDecimals, iType;
+
+ iType = DBFGetFieldInfo(hDBF, field, field_name, &nWidth, &nDecimals);
+
+ /* Force Type to String */
+ if (1 == bForceStrings)
+ iType = FTString;
+
+ switch (iType) {
+ case FTString:
+ if (!(sv = newSVpv((char *)DBFReadStringAttribute(hDBF,record,field),0))) goto BREAK;
+ break;
+ case FTInteger:
+ if (!(sv = newSViv(DBFReadIntegerAttribute(hDBF,record,field)))) goto BREAK;
+ break;
+ case FTDouble:
+ if (!(sv = newSVnv(DBFReadDoubleAttribute(hDBF,record,field)))) goto BREAK;
+ break;
+ }
+
+ hv_store(hv, field_name, strlen(field_name), sv, 0);
+ }
+ if (!(sv = newRV_noinc((SV*) hv))) goto BREAK;
+ av_push(av, sv);
+ }
+
+ goto DONE;
+ BREAK:
+ fprintf(stderr,"Out of memory!\n");
+ av = NULL;
+ DONE:
+ RETVAL = newRV_noinc((SV *)av);
+ }
+ OUTPUT:
+ RETVAL
+
+SV *
+ReadRecord(hDBF, bForceStrings, record)
+ DBFHandle hDBF
+ int bForceStrings
+ int record
+ CODE:
+ {
+ HV *hv = NULL;
+ int num_fields;
+ int num_records;
+ int field;
+
+ num_fields = DBFGetFieldCount(hDBF);
+ num_records = DBFGetRecordCount(hDBF);
+
+ if (!(hv = newHV())) goto BREAK;
+
+ if (record >= 0 && record < num_records) {
+ SV *sv = NULL;
+ for (field = 0; field < num_fields; field++) {
+ char field_name[12];
+ int nWidth, nDecimals, iType;
+
+ iType = DBFGetFieldInfo(hDBF, field, field_name, &nWidth, &nDecimals);
+
+ /* Force Type to String */
+ if (1 == bForceStrings)
+ iType = FTString;
+
+ switch (iType) {
+ case FTString:
+ if (!(sv = newSVpv((char *)DBFReadStringAttribute(hDBF,record,field),0))) goto BREAK;
+ break;
+ case FTInteger:
+ if (!(sv = newSViv(DBFReadIntegerAttribute(hDBF,record,field)))) goto BREAK;
+ break;
+ case FTDouble:
+ if (!(sv = newSVnv(DBFReadDoubleAttribute(hDBF,record,field)))) goto BREAK;
+ break;
+ }
+
+ hv_store(hv, field_name, strlen(field_name), sv, 0);
+ }
+ }
+
+ goto DONE;
+ BREAK:
+ fprintf(stderr,"Out of memory!\n");
+ hv = NULL;
+ DONE:
+ RETVAL = newRV_noinc((SV *)hv);
+ }
+ OUTPUT:
+ RETVAL
+
+DBFHandle
+DBFCreate(pszDBFFile)
+ char *pszDBFFile
+
+int
+_DBFAddField(hDBF, pszFieldName, type, nWidth, nDecimals)
+ DBFHandle hDBF
+ char *pszFieldName
+ int type
+ int nWidth
+ int nDecimals
+ CODE:
+ {
+ DBFFieldType eType;
+ switch (type) {
+ case 1: eType = FTString; break;
+ case 2: eType = FTInteger; break;
+ case 3: eType = FTDouble; break;
+ }
+ RETVAL = DBFAddField(hDBF, pszFieldName, eType, nWidth, nDecimals);
+ }
+ OUTPUT:
+ RETVAL
+
+int
+DBFWriteIntegerAttribute(hDBF, iShape, iField, nFieldValue)
+ DBFHandle hDBF
+ int iShape
+ int iField
+ int nFieldValue
+
+int
+DBFWriteDoubleAttribute(hDBF, iShape, iField, dFieldValue)
+ DBFHandle hDBF
+ int iShape
+ int iField
+ double dFieldValue
+
+int
+DBFWriteStringAttribute(hDBF, iShape, iField, pszFieldValue)
+ DBFHandle hDBF
+ int iShape
+ int iField
+ char *pszFieldValue
+
+void
+DBFClose(hDBF)
+ DBFHandle hDBF
+
diff --git a/example/xyz.dbf b/example/xyz.dbf
new file mode 100755
index 0000000..9747a01
Binary files /dev/null and b/example/xyz.dbf differ
diff --git a/example/xyz.sbn b/example/xyz.sbn
new file mode 100755
index 0000000..208d9d4
Binary files /dev/null and b/example/xyz.sbn differ
diff --git a/example/xyz.sbx b/example/xyz.sbx
new file mode 100755
index 0000000..253c34b
Binary files /dev/null and b/example/xyz.sbx differ
diff --git a/example/xyz.shp b/example/xyz.shp
new file mode 100755
index 0000000..6a263ff
Binary files /dev/null and b/example/xyz.shp differ
diff --git a/example/xyz.shx b/example/xyz.shx
new file mode 100755
index 0000000..ab0681c
Binary files /dev/null and b/example/xyz.shx differ
diff --git a/lib/Geo/Shapelib.pm b/lib/Geo/Shapelib.pm
new file mode 100644
index 0000000..098550d
--- /dev/null
+++ b/lib/Geo/Shapelib.pm
@@ -0,0 +1,1282 @@
+package Geo::Shapelib;
+
+use strict;
+use Carp;
+use Tree::R;
+use File::Basename qw(fileparse);
+use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS @EXPORT_OK $AUTOLOAD);
+use vars qw(%ShapeTypes %PartTypes);
+
+require Exporter;
+require DynaLoader;
+use AutoLoader 'AUTOLOAD';
+
+ at ISA = qw(Exporter DynaLoader);
+
+$VERSION = '0.22';
+
+bootstrap Geo::Shapelib $VERSION;
+
+# Preloaded methods go here.
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+# Page 4 of the ESRI Shapefile Technical Description, July 1998
+%ShapeTypes = (
+ 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',
+);
+
+# Page 21 of the ESRI Shapefile Technical Description, July 1998
+%PartTypes = (
+ 0 => 'TriStrip',
+ 1 => 'TriFan',
+ 2 => 'OuterRing',
+ 3 => 'InnerRing',
+ 4 => 'FirstRing',
+ 5 => 'Ring',
+);
+
+# Create the SUBROUTINES FOR ShapeTypes and PartTypes
+# We could prefix these with SHPT_ and SHPP_ respectively
+{
+ my %typeval = (map(uc,reverse(%ShapeTypes)),map(uc,reverse(%PartTypes)));
+
+ for my $datum (keys %typeval) {
+ no strict "refs"; # to register new methods in package
+ *$datum = sub { $typeval{$datum}; }
+ }
+}
+
+# Add Extended Exports
+%EXPORT_TAGS = ('constants' => [ map(uc,values(%ShapeTypes)),
+ map(uc,values(%PartTypes))
+ ],
+ 'types' =>[ qw(%ShapeTypes %PartTypes) ] );
+$EXPORT_TAGS{all}=[ @{ $EXPORT_TAGS{constants} },
+ @{ $EXPORT_TAGS{types} } ];
+
+ at EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+ at EXPORT = qw();
+
+
+=pod
+
+=head1 NAME
+
+Geo::Shapelib - Perl extension for reading and writing shapefiles as defined by ESRI(r)
+
+=head1 SYNOPSIS
+
+ use Geo::Shapelib qw/:all/;
+
+or
+
+ use Geo::Shapelib qw/:all/;
+
+ my $shapefile = new Geo::Shapelib {
+ Name => 'stations',
+ Shapetype => POINT,
+ FieldNames => ['Name','Code','Founded'],
+ FieldTypes => ['String:50','String:10','Integer:8']
+ };
+
+ while (<DATA>) {
+ chomp;
+ my($station,$code,$founded,$x,$y) = split /\|/;
+ push @{$shapefile->{Shapes}},{ Vertices => [[$x,$y,0,0]] };
+ push @{$shapefile->{ShapeRecords}}, [$station,$code,$founded];
+ }
+
+ $shapefile->save();
+
+
+=head1 DESCRIPTION
+
+This is a library for reading, creating, and writing shapefiles as
+defined by ESRI(r) using Perl. The Perl code uses Frank Warmerdam's
+Shapefile C Library (http://shapelib.maptools.org/). The library
+is included in this distribution.
+
+Currently no methods exist for populating an empty Shape. You need
+to do it in your own code. This is how:
+
+First you include the module into your code. If you want to define the
+shape type using its name, import all:
+
+ use Geo::Shapelib qw/:all/;
+
+Create the shapefile object and specify its name and type:
+
+ $shapefile = new Geo::Shapelib {
+ Name => <filename>,
+ Shapetype => <type from the list>,
+ FieldNames => <field name list>,
+ FieldTypes => <field type list>
+ }
+
+The name (filename, may include path) of the shapefile, the extension
+is not used (it is stripped in the save method).
+
+The shape type is an integer. This module defines shape type names as
+constants (see below).
+
+The field name list is an array reference of the names of the data
+items assigned to each shape.
+
+The field type list is an array reference of the types of the data
+items. Field type is either 'Integer', 'Double', or 'String'.
+
+The types may have optional 'width' and 'decimals' fields defined,
+like this:
+
+ 'Integer[:width]' defaults: width = 10
+ 'Double[:width[:decimals]]' defaults: width = 10, decimals = 4
+ 'String[:width]' defaults: width = 255
+
+There are some other attributes which can be defined in the
+constructor (see below), they are rarely needed. The shape object will
+need or get a couple of other attributes as well. They should be
+treated as private:
+
+ $shapefile->{NShapes} is the number of shapes in your
+ object. Shapefile is a collection of shapes. This is usually
+ automatically deduced from the Shapes array when needed.
+
+ $shapefile->{MinBounds} is set by shapelib C functions.
+
+ $shapefile->{MaxBounds} is set by shapelib C functions.
+
+Create the shapes and respective shape records and put them into the
+shape:
+
+ for many times {
+ make $s, a new shape as a reference to a hash
+ push @{$shapefile->{Shapes}}, $s;
+ make $r, a shape record as a reference to an array
+ push @{$shapefile->{ShapeRecords}}, $r;
+ }
+
+how to create $s? It is a (reference to an) hash.
+
+set:
+
+ $s->{Vertices} this is a reference to an array of arrays of four
+ values, one for each vertex: x, y, z, and m of the vertex. There
+ should be at least one vertex in $s. Point has only one vertex.
+
+$s->{Parts}:
+
+ $s->{Parts} is not needed in simple cases. $s->{Parts} is a
+ reference to an array (a) of arrays (b). There is one (b) array
+ for each part. In a (b) array the first value is an index to the
+ Vertices array denoting the first vertex of that part. The second
+ value is the type of the part (NOTE: not the type of the
+ shape). The type is 5 (Ring) unless the shape is of type
+ Multipatch. The third value is set as the type of the part as a
+ string when reading from a file but the save method requires only
+ the first two values.
+
+ The index of the last vertex of any part is implicitly the index
+ of the next part minus one or the index of the last vertex.
+
+forget these:
+
+ $s->{ShapeId} may be left undefined. The save method sets it to
+ the index in the Shapes array. Instead create and use an id field
+ in the record.
+
+ $s->{NParts} and $s->{NVertices} may be set but that is usually
+ not necessary since they are calculated in the save method. You
+ only need to set these if you want to save less parts or vertices
+ than there actually are in the Parts or Vertices arrays.
+
+ $s->{SHPType} is the type of the shape and it is automatically set
+ to $shape->{Shapetype} unless defined (which you should not do)
+
+The shape record is simply an array reference, for example:
+
+ $r = [item1,item2,item3,...];
+
+That's all. Then save it and start your shapefile viewer to look at
+the result.
+
+=head1 EXPORT
+
+None by default. The following export tags are defined.
+
+=over 8
+
+=item :constants
+
+This exports constant functions for the individual types of shapefile
+Types and shapefile part types. They all return scalar (integer)
+values. The shapetype functions: POINT, ARC, POLYGON, MULTIPOINT,
+POINTZ, ARCZ, POLYGONZ, MULTIPOINTZ, POINTM, ARCM, POLYGONM,
+MULTIPOINTM, MULTIPATCH are defined. The shapefile part
+types: TRISTRIP, TRIFAN, OUTERRING, INNERRING, FIRSTRING, RING are
+defined.
+
+=item :types
+
+Exports two hashs: %ShapeTypes, %PartTypes which map the shapelib type
+integers to string values.
+
+=item :all
+
+All possible exports are included.
+
+
+=back
+
+=head1 CONSTRUCTORS
+
+This one reads in an existing shapefile:
+
+ $shapefile = new Geo::Shapelib "myshapefile", {<options>};
+
+This one creates a new, blank Perl shapefile object:
+
+ $shapefile = new Geo::Shapelib {<options>};
+
+{<options>} is optional in both cases, an example (note the curly braces):
+
+ $shapefile = new Geo::Shapelib {
+ Name => $shapefile,
+ Shapetype => POINT,
+ FieldNames => ['Name','Code','Founded'],
+ FieldTypes => ['String:50','String:10','Integer:8']
+ };
+
+ $shapefile = new Geo::Shapelib "myshapefile" {
+ Rtree => 1
+ };
+
+=item Options:
+
+Like:
+
+ A shapefile from which to copy ShapeType, FieldNames, and FieldTypes.
+
+Name:
+
+ Default is "shapefile". The filename (if given) becomes the name
+ for the shapefile unless overridden by this.
+
+Shapetype:
+
+ Default "POINT". The type of the shapes. (All non-null shapes in a
+ shapefile are required to be of the same shape type.)
+
+FieldNames:
+
+ Default is [].
+
+FieldTypes:
+
+ Default is [].
+
+ForceStrings:
+
+ Default is 0. If 1, sets all FieldTypes to string, may be useful
+ if values are very large ints
+
+Rtree:
+
+ Default is 0. If 1, creates an R-tree of the shapes into an
+ element Rtree. (Requires LoadAll.)
+
+
+When a shapefile is read from files they end up in a bit different
+kind of data structure than what is expected by the save method for
+example and what is described above. These flags enable the
+conversion, they are not normally needed.
+
+CombineVertices:
+
+ Default is 1. CombineVertices is experimental. The default
+ behavior is to put all vertices into the Vertices array and part
+ indexes into the Parts array. If CombineVertices is set to 0 there
+ is no Vertices array and all data goes into the Parts. Currently
+ setting CombineVertices to 0 breaks saving of shapefiles.
+
+UnhashFields:
+
+ Default is 1. Makes $self's attributes FieldNames, FieldTypes refs
+ to lists, and ShapeRecords a list of lists.
+
+
+The default is to load all data into Perl variables in the
+constructor. With these options the data can be left into the files
+to be loaded on-demand.
+
+Load:
+
+ Default is 1. If 0, has the same effect as LoadRecords=>0 and
+ LoadAll=>0.
+
+LoadRecords:
+
+ Default is 1. Reads shape records into $self->{ShapeRecords}
+ automatically in the constructor using the
+ get_record($shape_index) method
+
+LoadAll:
+
+ Default is 1. Reads shapes (the geometry data) into
+ $self->{Shapes} automatically in the constructor using the
+ get_shape($shape_index) method
+
+
+=cut
+
+sub new {
+ my $package = shift;
+ my $filename;
+ my $options = shift;
+ unless (ref $options) {
+ $filename = $options;
+ $options = shift;
+ }
+ croak "usage: new Geo::Shapelib <filename>, {<options>};" if (defined $options and not ref $options);
+
+ my $self = {};
+ bless $self => (ref($package) or $package);
+
+ $self->{Name} = $filename if $filename;
+
+ my %defaults = ( Like => 0,
+ Name => 'shapefile',
+ Shapetype => 'POINT',
+ FieldNames => [],
+ FieldTypes => [],
+ CombineVertices => 1,
+ UnhashFields => 1,
+ Load => 1,
+ LoadRecords => 1,
+ LoadAll => 1,
+ ForceStrings => 0,
+ Rtree => 0 );
+
+ for (keys %defaults) {
+ next if defined $self->{$_};
+ $self->{$_} = $defaults{$_};
+ }
+
+ if (defined $options and ref $options) {
+ for (keys %$options) {
+ croak "unknown constructor option for Geo::Shapelib: $_" unless defined $defaults{$_}
+ }
+ for (keys %defaults) {
+ next unless defined $options->{$_};
+ $self->{$_} = $options->{$_};
+ }
+ if ($self->{Like}) {
+ for ('Shapetype','FieldNames','FieldTypes') {
+ $self->{$_} = $options->{Like}->{$_};
+ }
+ }
+ }
+
+ return $self unless $filename;
+
+# print "\n\n";
+# for (keys %$self) {
+# print "$_ $self->{$_}\n";
+# }
+
+ # Read the specified file
+
+ # Get 'NShapes', 'FieldTypes' and 'ShapeRecords' from the dbf
+ my $dbf_handle = DBFOpen($self->{Name}, 'rb');
+ unless ($dbf_handle) {
+ croak("DBFOpen $self->{Name} failed");
+ return undef;
+ }
+ $self->{NShapes} = DBFGetRecordCount($dbf_handle);
+ $self->{FieldNames} = '';
+ $self->{FieldTypes} = ReadDataModel($dbf_handle, $self->{ForceStrings});
+
+ if ($self->{Load} and $self->{LoadRecords}) {
+ $self->{ShapeRecords} = ReadData($dbf_handle, $self->{ForceStrings});
+ }
+
+ DBFClose($dbf_handle);
+ #return undef unless $dbf; # Here, not above, so the dbf always gets closed.
+
+ # Get 'Shapetype', 'MinBounds', and 'MaxBounds'
+ $self->{SHPHandle} = SHPOpen($self->{Name}, 'rb');
+ unless ($self->{SHPHandle}) {
+ carp("SHPOpen $self->{Name} failed!");
+ return undef;
+ }
+ my $info = SHPGetInfo($self->{SHPHandle}); # DESTROY closes SHPHandle
+ unless ($info) {
+ carp("SHPGetInfo failed!");
+ return undef;
+ }
+ @$self{keys %$info} = values %$info;
+ $self->{ShapetypeString} = $ShapeTypes{ $self->{Shapetype} };
+
+ if ($self->{UnhashFields}) {
+ ($self->{FieldNames}, $self->{FieldTypes}) = data_model($self);
+ if ($self->{Load} and $self->{LoadRecords}) {
+ for my $i (0..$self->{NShapes}-1) {
+ $self->{ShapeRecords}->[$i] = get_record_arrayref($self, $i, undef, 1);
+ }
+ }
+ }
+
+ if ($self->{Load} and $self->{LoadAll}) {
+ for (my $i = 0; $i < $self->{NShapes}; $i++) {
+ my $shape = get_shape($self, $i, 1);
+ push @{$self->{Shapes}}, $shape;
+ }
+ }
+
+ $self->Rtree() if $self->{Rtree};
+
+ return $self;
+}
+
+=pod
+
+=head1 METHODS
+
+=head2 data_model
+
+Returns data model converted into two arrays.
+
+If in a constructor a filename is given, then the data model is read
+from the dbf file and stored as a hashref in the attribute FieldTypes.
+This converts the hashref into two arrays: FieldNames and respective
+FieldTypes. These arrayrefs are stored in attributes of those names if
+UnhashFields is TRUE.
+
+=cut
+
+sub data_model {
+ my $self = shift;
+ my @FieldNames;
+ my @FieldTypes;
+ while (my($name,$type) = each %{$self->{FieldTypes}}) {
+ push @FieldNames,$name;
+ push @FieldTypes,$type;
+ }
+ return (\@FieldNames,\@FieldTypes);
+}
+
+=pod
+
+=head2 get_shape(shape_index, from_file)
+
+Returns a shape nr. shape_index+1 (first index is 0). The shape is
+read from a file even if array Shapes exists if from_file is TRUE.
+
+Option CombineVertices is in operation here.
+
+Use this method to get a shape unless you know what you are doing.
+
+=cut
+
+sub get_shape {
+ my ($self, $i, $from_file) = @_;
+ if (!$from_file and $self->{Shapes}) {
+
+ return $self->{Shapes}->[$i];
+
+ } else {
+
+ my $shape = SHPReadObject($self->{SHPHandle}, $i, $self->{CombineVertices}?1:0) or return undef;
+
+ # $shape->{ShapeRecords} = $self->{ShapeRecords}[$i];
+
+ if($self->{CombineVertices}) {
+ for my $part (@{$shape->{Parts}}) {
+ $part->[2] = $PartTypes{ $part->[1] };
+ }
+ }
+ return $shape;
+
+ }
+}
+
+=pod
+
+=head2 get_record(shape_index, from_file)
+
+Returns the record which belongs to shape nr. shape_index+1 (first
+index is 0). The record is read from a file even if array ShapeRecords
+exists if from_file is TRUE.
+
+=cut
+
+sub get_record {
+ my ($self, $i, $from_file) = @_;
+ if (!$from_file and $self->{ShapeRecords}) {
+
+ return $self->{ShapeRecords}->[$i];
+
+ } else {
+
+ my $dbf_handle = DBFOpen($self->{Name}, 'rb');
+ unless ($dbf_handle) {
+ croak("DBFOpen $self->{Name} failed");
+ return undef;
+ }
+ my $rec = ReadRecord($dbf_handle, $self->{ForceStrings}, $i);
+ DBFClose($dbf_handle);
+ return $rec;
+
+ }
+}
+
+=pod
+
+=head2 get_record_arrayref(shape_index, FieldNames, from_file)
+
+Returns the record which belongs to shape nr. shape_index+1 (first
+index is 0) as an arrayref. The parameter FieldNames may be undef but
+if defined, it is used as the array according to which the record
+array is sorted. This in case the ShapeRecords contains hashrefs. The
+record is read from the file even if array ShapeRecords exists if
+from_file is TRUE.
+
+Use this method to get a record of a shape unless you know what you
+are doing.
+
+=cut
+
+sub get_record_arrayref {
+ my ($self, $i, $FieldNames, $from_file) = @_;
+ my $rec = get_record($self, $i, $from_file);
+ if (ref $rec eq 'HASH') {
+ my @rec;
+ $FieldNames = $self->{FieldNames} unless defined $FieldNames;
+ for (@$FieldNames) {
+ push @rec,$rec->{$_};
+ }
+ return \@rec;
+ }
+ return $rec;
+}
+
+=pod
+
+=head2 get_record_hashref(shape_index, from_file)
+
+Returns the record which belongs to shape nr. shape_index+1 (first
+index is 0) as a hashref. The record is read from the file even if
+array ShapeRecords exists if from_file is TRUE. If records are in the
+array ShapeRecords as a list of lists, then FieldNames _must_ contain
+the names of the fields.
+
+Use this method to get a record of a shape unless you know what you
+are doing.
+
+=cut
+
+sub get_record_hashref {
+ my ($self, $i, $from_file) = @_;
+ my $rec = get_record($self, $i, $from_file);
+ if (ref $rec eq 'ARRAY') {
+ my %rec;
+ for my $i (0..$#{$self->{FieldNames}}) {
+ $rec{$self->{FieldNames}->[$i]} = $rec->[$i];
+ }
+ return \%rec;
+ }
+ return $rec;
+}
+
+=pod
+
+=head2 lengths(shape)
+
+Returns the lengths of the parts of the shape. This is lengths of the
+parts of polyline or the length of the boundary of polygon. 2D and 3D
+data is taken into account.
+
+=cut
+
+sub lengths {
+ my ($self, $shape) = @_;
+ my @l;
+ if ($shape->{NParts}) {
+
+ my $pindex = 0;
+ my $pmax = $shape->{NParts};
+ while($pindex < $pmax) {
+
+ my $l = 0;
+ my $prev = 0;
+
+ my $part = $shape->{Parts}[$pindex];
+
+ if($self->{CombineVertices}) {
+ my $vindex = $part->[0];
+ my $vmax = $shape->{Parts}[$pindex+1][0];
+ $vmax = $shape->{NVertices} unless defined $vmax;
+ while($vindex < $vmax) {
+
+ my $vertex = $shape->{Vertices}[$vindex];
+ if ($prev) {
+ my $c2 = 0;
+ if ($self->{Shapetype} < 10) { # x,y
+ for (0..1) {
+ $c2 += ($vertex->[$_] - $prev->[$_])**2;
+ }
+ } else {
+ for (0..2) {
+ $c2 += ($vertex->[$_] - $prev->[$_])**2;
+ }
+ }
+ $l += sqrt($c2);
+ }
+ $prev = $vertex;
+
+ $vindex++;
+ }
+ } else {
+ for my $vertex (@{$part->{Vertices}}) {
+
+ if ($prev) {
+ my $c2 = 0;
+ if ($self->{Shapetype} < 10) { # x,y
+ for (0..1) {
+ $c2 += ($vertex->[$_] - $prev->[$_])**2;
+ }
+ } else {
+ for (0..2) {
+ $c2 += ($vertex->[$_] - $prev->[$_])**2;
+ }
+ }
+ $l += sqrt($c2);
+ }
+ $prev = $vertex;
+
+ }
+ }
+
+ push @l,$l;
+ $pindex++;
+ }
+
+ } else {
+
+ my $l = 0;
+ my $prev = 0;
+ for my $vertex (@{$shape->{Vertices}}) {
+
+ if ($prev) {
+ my $c2 = 0;
+ if ($self->{Shapetype} < 10) { # x,y
+ for (0..1) {
+ $c2 += ($vertex->[$_] - $prev->[$_])**2;
+ }
+ } else {
+ for (0..2) {
+ $c2 += ($vertex->[$_] - $prev->[$_])**2;
+ }
+ }
+ $l += sqrt($c2);
+ }
+ $prev = $vertex;
+ }
+ push @l,$l;
+
+ }
+
+ return @l;
+}
+
+=pod
+
+=head2 Using shapefile quadtree spatial indexing
+
+Obtain a list of shape ids within the specified bound using a shapefile quadtree
+index:
+
+ $shapefile->query_within_rect($bounds, $maxdepth = 0);
+
+$bounds should be an array reference of 4 elements (xmin, ymin, xmax, ymax)
+
+This method uses the quadtree indices defined by Shapelib *not* ESRI
+spatial index files (.sbn, .sbx). If a quadtree index (<basename>.qix)
+does not exist, one is created and saved as a file.
+
+To just create an index you can also use the method:
+
+ $shapefile->create_spatial_index($maxdepth = 0);
+
+$maxdepth (optional) is the maximum depth of the index to create. Default is 0
+meaning that shapelib will calculate a reasonable default depth.
+
+=cut
+
+sub query_within_rect {
+ my ($self, $bounds, $maxdepth) = @_;
+ croak "Shapefile is not open." unless $self->{SHPHandle};
+ my $fn = $self->qix_filename;
+ $maxdepth ||= 0;
+ my $found = SHPSearchDiskTree($self->{SHPHandle}, $fn, $bounds, $maxdepth);
+ return $found;
+}
+
+sub create_spatial_index {
+ my ($self, $maxdepth, $quiet) = @_;
+ $maxdepth ||= 0;
+ croak "Shapefile is not open." unless $self->{SHPHandle};
+ my $fn = $self->qix_filename;
+ my $ret = SHPCreateSpatialIndex($fn, $maxdepth, $self->{SHPHandle});
+ croak "Could not create the spatial index file: $fn." if !$ret;
+ return $ret;
+}
+
+sub qix_filename {
+ my $self = shift;
+ my ($file, $path, $suffix) = fileparse( $self->{Name}, '.shp' );
+ return "$path$file.qix";
+}
+
+=pod
+
+=head2 Rtree and editing the shapefile
+
+Building a R-tree for the shapes:
+
+ $shapefile->Rtree();
+
+This is automatically done if Rtree-option is set when a shapefile is
+loaded from files.
+
+You can then use methods like (there are not yet any wrappers for
+these).
+
+ my @shapes;
+ $shapefile->{Rtree}->query_point(@xy,\@shapes); # or
+ $shapefile->{Rtree}->query_completely_within_rect(@rect,\@shapes); # or
+ $shapefile->{Rtree}->query_partly_within_rect(@rect,\@shapes);
+
+To get a list of shapes (indexes to the shape array), which you can
+feed for example to the select_vertices function.
+
+ for my $shape (@shapes) {
+ my $vertices = $shapefile->select_vertices($shape, at rect);
+ my $n = @$vertices;
+ print "you selected $n vertices from shape $shape\n";
+ }
+
+The shapefile object remembers the selected vertices and calling the
+function
+
+ $shapefile->move_selected_vertices($dx,$dy);
+
+moves the vertices. The bboxes of the affected shapes, and the R-tree,
+if one exists, are updated automatically. To clear all selections from
+all shapes, call:
+
+ $selected->clear_selections();
+
+=cut
+
+sub Rtree {
+ my $self = shift @_;
+ unless (defined $self->{NShapes}) {
+ croak "no shapes" unless $self->{Shapes} and ref $self->{Shapes} eq 'ARRAY' and @{$self->{Shapes}};
+ $self->{NShapes} = @{$self->{Shapes}};
+ }
+ $self->{Rtree} = new Tree::R @_;
+ for my $sindex (0..$self->{NShapes}-1) {
+ my $shape = get_shape($self, $sindex);
+ my @rect;
+ @rect[0..1] = @{$shape->{MinBounds}}[0..1];
+ @rect[2..3] = @{$shape->{MaxBounds}}[0..1];
+
+ $self->{Rtree}->insert($sindex, at rect);
+ }
+}
+
+sub clear_selections {
+ my($self) = @_;
+ for my $shape (@{$self->{Shapes}}) {
+ $shape->{SelectedVertices} = [];
+ }
+}
+
+sub select_vertices {
+ my($self,$shape,$minx,$miny,$maxx,$maxy) = @_;
+ unless (defined $shape) {
+ for my $sindex (0..$self->{NShapes}-1) {
+ $self->select_vertices($sindex);
+ }
+ return;
+ }
+ $shape = $self->{Shapes}->[$shape];
+ my @vertices;
+ unless (defined $maxy) {
+ @vertices = (0..$shape->{NVertices}-1);
+ $shape->{SelectedVertices} = \@vertices;
+ return \@vertices;
+ }
+ my $v = $shape->{Vertices};
+ my $i;
+ for ($i = 0; $i < $shape->{NVertices}; $i++) {
+ next unless
+ $v->[$i]->[0] >= $minx and
+ $v->[$i]->[0] <= $maxx and
+ $v->[$i]->[1] >= $miny and
+ $v->[$i]->[1] <= $maxy;
+ push @vertices,$i;
+ }
+ $shape->{SelectedVertices} = \@vertices;
+ return \@vertices;
+}
+
+sub move_selected_vertices {
+ my($self,$dx,$dy) = @_;
+ return unless $self->{NShapes};
+
+ my $count = 0;
+ for my $sindex (0..$self->{NShapes}-1) {
+ my $shape = $self->{Shapes}->[$sindex];
+ next unless $shape->{SelectedVertices} and @{$shape->{SelectedVertices}};
+
+ my $v = $shape->{Vertices};
+ for my $vindex (@{$shape->{SelectedVertices}}) {
+ $v->[$vindex]->[0] += $dx;
+ $v->[$vindex]->[1] += $dy;
+ }
+
+ my @rect;
+ for my $vertex (@{$shape->{Vertices}}) {
+ $rect[0] = defined($rect[0]) ? min($vertex->[0],$rect[0]) : $vertex->[0];
+ $rect[1] = defined($rect[1]) ? min($vertex->[1],$rect[1]) : $vertex->[1];
+ $rect[2] = defined($rect[2]) ? max($vertex->[0],$rect[2]) : $vertex->[0];
+ $rect[3] = defined($rect[3]) ? max($vertex->[1],$rect[3]) : $vertex->[1];
+ }
+
+ @{$shape->{MinBounds}}[0..1] = @rect[0..1];
+ @{$shape->{MaxBounds}}[0..1] = @rect[2..3];
+ $count++;
+ }
+
+ if ($self->{Rtree}) {
+ if ($count < 10) {
+ for my $sindex (0..$self->{NShapes}-1) {
+ my $shape = $self->{Shapes}->[$sindex];
+ next unless $shape->{SelectedVertices} and @{$shape->{SelectedVertices}};
+
+ # update Rtree...
+
+ #delete $sindex from it
+ print STDERR "remove $sindex\n";
+ $self->{Rtree}->remove($sindex);
+ }
+ for my $sindex (0..$self->{NShapes}-1) {
+ my $shape = $self->{Shapes}->[$sindex];
+ next unless $shape->{SelectedVertices} and @{$shape->{SelectedVertices}};
+
+ my @rect = (@{$shape->{MinBounds}}[0..1],@{$shape->{MaxBounds}}[0..1]);
+
+ # update Rtree...
+
+ # add $sindex to it
+ print STDERR "add $sindex\n";
+ $self->{Rtree}->insert($sindex, at rect);
+ }
+ } else {
+ $self->Rtree;
+ }
+ }
+
+ $self->{MinBounds}->[0] = $self->{Shapes}->[0]->{MinBounds}->[0];
+ $self->{MinBounds}->[1] = $self->{Shapes}->[0]->{MinBounds}->[1];
+ $self->{MaxBounds}->[0] = $self->{Shapes}->[0]->{MaxBounds}->[0];
+ $self->{MaxBounds}->[1] = $self->{Shapes}->[0]->{MaxBounds}->[1];
+ for my $sindex (1..$self->{NShapes}-1) {
+ my $shape = $self->{Shapes}->[$sindex];
+ $self->{MinBounds}->[0] = min($self->{MinBounds}->[0],$shape->{MinBounds}->[0]);
+ $self->{MinBounds}->[1] = min($self->{MinBounds}->[1],$shape->{MinBounds}->[1]);
+ $self->{MaxBounds}->[0] = max($self->{MaxBounds}->[0],$shape->{MaxBounds}->[0]);
+ $self->{MaxBounds}->[1] = max($self->{MaxBounds}->[1],$shape->{MaxBounds}->[1]);
+ }
+}
+
+sub min {
+ $_[0] > $_[1] ? $_[1] : $_[0];
+}
+
+sub max {
+ $_[0] > $_[1] ? $_[0] : $_[1];
+}
+
+=pod
+
+=head2 Setting the bounds of the shapefile
+
+ $shapefile->set_bounds;
+
+Sets the MinBounds and MaxBounds of all shapes and of the shapefile.
+
+=cut
+
+sub set_bounds {
+ my($self) = @_;
+
+ return unless @{$self->{Shapes}};
+
+ my $first = 1;
+
+ for my $shape (@{$self->{Shapes}}) {
+
+ my @rect;
+ for my $vertex (@{$shape->{Vertices}}) {
+ $rect[0] = defined($rect[0]) ? min($vertex->[0],$rect[0]) : $vertex->[0];
+ $rect[1] = defined($rect[1]) ? min($vertex->[1],$rect[1]) : $vertex->[1];
+ $rect[2] = defined($rect[2]) ? max($vertex->[0],$rect[2]) : $vertex->[0];
+ $rect[3] = defined($rect[3]) ? max($vertex->[1],$rect[3]) : $vertex->[1];
+ }
+
+ @{$shape->{MinBounds}}[0..1] = @rect[0..1];
+ @{$shape->{MaxBounds}}[0..1] = @rect[2..3];
+
+ if ($first) {
+ $self->{MinBounds}->[0] = $shape->{MinBounds}->[0];
+ $self->{MinBounds}->[1] = $shape->{MinBounds}->[1];
+ $self->{MaxBounds}->[0] = $shape->{MaxBounds}->[0];
+ $self->{MaxBounds}->[1] = $shape->{MaxBounds}->[1];
+ $first = 0;
+ } else {
+ $self->{MinBounds}->[0] = min($self->{MinBounds}->[0],$shape->{MinBounds}->[0]);
+ $self->{MinBounds}->[1] = min($self->{MinBounds}->[1],$shape->{MinBounds}->[1]);
+ $self->{MaxBounds}->[0] = max($self->{MaxBounds}->[0],$shape->{MaxBounds}->[0]);
+ $self->{MaxBounds}->[1] = max($self->{MaxBounds}->[1],$shape->{MaxBounds}->[1]);
+ }
+
+ }
+
+}
+
+=pod
+
+=head2 Saving the shapefile
+
+ $shapefile->save($filename);
+
+The argument $shapefile is optional, the internal attribute
+$shapefile->{Name} is used if $filename is not specified. If $filename
+is specified it also becomes the new name.
+
+$filename may contain an extension, it is removed and .shp etc. are used instead.
+
+If you are not sure that the bounds of the shapefile are ok, then call
+$shapefile->set_bounds; before saving.
+
+=cut
+
+sub save {
+ my($self,$filename) = @_;
+
+ unless (defined $self->{NShapes}) {
+ croak "no shapes" unless $self->{Shapes} and ref $self->{Shapes} eq 'ARRAY' and @{$self->{Shapes}};
+ $self->{NShapes} = @{$self->{Shapes}};
+ }
+
+ $self->create($filename);
+
+ for my $i (0..$self->{NShapes}-1) {
+ my $s = get_shape($self, $i);
+ my $rec = get_record($self, $i);
+ $self->add($s, $rec);
+ }
+
+ $self->close();
+}
+
+=pod
+
+=head2 create, add, close
+
+$shapefile->create($filename);
+
+many times:
+ $shapefile->add($shape, $record);
+
+$shapefile->close();
+
+These methods make it easy to create large shapefiles. $filename is
+optional. These methods create some temporary variables (prefix: _) in
+internal data and thus calling of close method is required.
+
+=cut
+
+sub create {
+ my ($self, $filename) = @_;
+
+ $filename = $self->{Name} unless defined $filename;
+ $filename =~ s/\.\w+$//;
+ $self->{_filename} = $filename;
+
+ $self->{_SHPhandle} = SHPCreate($filename.'.shp', $self->{Shapetype});
+ croak "SHPCreate failed" unless $self->{_SHPhandle};
+
+ $self->{_DBFhandle} = DBFCreate($filename.'.dbf');
+ croak "DBFCreate failed" unless $self->{_DBFhandle};
+
+ $self->{_fn} = $self->{FieldNames};
+ my $ft = $self->{FieldTypes};
+ unless ($self->{_fn}) {
+ ($self->{_fn}, $ft) = data_model($self);
+ }
+ for my $f (0..$#{$self->{_fn}}) {
+ my $type = 0;
+ my $width;
+ my $decimals = 0;
+ my ($ftype, $fwidth, $fdeci) = split(/[:;,]/, $ft->[$f]);
+ SWITCH: {
+ if ($ftype eq 'String') {
+ $type = 1;
+ $width = defined($fwidth)?$fwidth:255;
+ last SWITCH;
+ }
+ if ($ftype eq 'Integer') {
+ $type = 2;
+ $width = defined($fwidth)?$fwidth:10;
+ last SWITCH;
+ }
+ if ($ftype eq 'Double') {
+ $type = 3;
+ $width = defined($fwidth)?$fwidth:10;
+ $decimals = defined($fdeci)?$fdeci:4;
+ last SWITCH;
+ }
+ }
+ $self->{_ftypes}->[$f] = $type;
+ next unless $type;
+ my $ret = _DBFAddField($self->{_DBFhandle}, $self->{_fn}->[$f], $type, $width, $decimals);
+ croak "DBFAddField failed for field $self->{_fn}->[$f] of type $ft->[$f]" if $ret == -1;
+ }
+
+ $self->{_SHP_id} = 0;
+}
+
+sub add {
+ my ($self, $shape, $record) = @_;
+
+ if (defined($shape->{SHPType})) {
+ if ($shape->{SHPType} != 0 and $shape->{SHPType} != $self->{Shapetype}) {
+ croak "non-null shapes with differing shape types";
+ }
+ } else {
+ $shape->{SHPType} = $self->{Shapetype};
+ }
+ my $nParts = exists $shape->{Parts} ? @{$shape->{Parts}} : 0;
+ if (defined $shape->{NParts}) {
+ if ($shape->{NParts} > $nParts) {
+ croak "NParts is larger than the actual number of Parts";
+ } else {
+ $nParts = $shape->{NParts};
+ }
+ }
+ my $nVertices = exists $shape->{Vertices} ? @{$shape->{Vertices}} : 0;
+ if (defined $shape->{NVertices}) {
+ if ($shape->{NVertices} > $nVertices) {
+ croak "NVertices is larger than the actual number of Vertices";
+ } else {
+ $nVertices = $shape->{NVertices};
+ }
+ }
+ my $id = defined $shape->{ShapeId} ? $shape->{ShapeId} : $self->{_SHP_id};
+
+ my $s = _SHPCreateObject($shape->{SHPType}, $id, $nParts, $shape->{Parts}, $nVertices, $shape->{Vertices});
+ croak "SHPCreateObject failed" unless $s;
+ SHPWriteObject($self->{_SHPhandle}, -1, $s);
+ SHPDestroyObject($s);
+
+ my $r = $record;
+ if (ref $r eq 'HASH') {
+ my @rec;
+ for (@{$self->{_fn}}) {
+ push @rec,$r->{$_};
+ }
+ $r = \@rec;
+ }
+
+ for my $f (0..$#{$self->{_fn}}) {
+ next unless $self->{_ftypes}->[$f];
+ my $ret;
+ SWITCH: {
+ if ($self->{_ftypes}->[$f] == 1) {
+ $ret = DBFWriteStringAttribute($self->{_DBFhandle}, $self->{_SHP_id}, $f, $r->[$f]) if exists $r->[$f];
+ last SWITCH;
+ }
+ if ($self->{_ftypes}->[$f] == 2) {
+ $ret = DBFWriteIntegerAttribute($self->{_DBFhandle}, $self->{_SHP_id}, $f, $r->[$f]) if exists $r->[$f];
+ last SWITCH;
+ }
+ if ($self->{_ftypes}->[$f] == 3) {
+ $ret = DBFWriteDoubleAttribute($self->{_DBFhandle}, $self->{_SHP_id}, $f, $r->[$f]) if exists $r->[$f];
+ last SWITCH;
+ }
+ }
+ croak "DBFWriteAttribute(field = $self->{_fn}->[$f], ftype = $self->{_ftypes}[$f], value = $r->[$f]) failed" unless $ret;
+ }
+
+ $self->{_SHP_id}++;
+}
+
+sub close {
+ my ($self) = @_;
+ SHPClose($self->{_SHPhandle});
+ DBFClose($self->{_DBFhandle});
+ $self->{Name} = $self->{_filename};
+ delete $self->{_SHPhandle};
+ delete $self->{_DBFhandle};
+ delete $self->{_fn};
+ delete $self->{_ftypes};
+ delete $self->{_SHP_id};
+ delete $self->{_filename};
+}
+
+=pod
+
+=head2 Dump
+
+$shapefile->dump($to);
+
+$to can be undef (then dump uses STDOUT), filename, or reference to a
+filehandle (e.g., \*DUMP).
+
+This method just dumps all data. If you have yourself created the
+shapefile then the reported bounds may be incorrect.
+
+=cut
+
+sub dump {
+ my ($self,$file) = @_;
+
+ unless (defined $self->{NShapes}) {
+ croak "no shapes" unless $self->{Shapes} and ref $self->{Shapes} eq 'ARRAY' and @{$self->{Shapes}};
+ $self->{NShapes} = @{$self->{Shapes}};
+ }
+
+ my $old_select;
+ if (defined $file) {
+ if (not ref $file) {
+ # $file is a name that we'll convert to a file handle
+ # ref. Passing open a scalar makes it close when the
+ # scaler is destroyed.
+ my $fh;
+ unless (open $fh, ">$file") {
+ carp("$file: $!"),
+ return undef;
+ }
+ $file = $fh;
+ }
+ return undef unless ref($file) eq 'GLOB';
+ $old_select = select($file);
+ }
+
+ printf "Name: %s\n", ($self->{Name} or '(none)');
+ print "Shape type: $self->{Shapetype} ($ShapeTypes{$self->{Shapetype}})\n";
+ printf "Min bounds: %11f %11f %11f %11f\n", @{$self->{MinBounds}} if $self->{MinBounds};
+ printf "Max bounds: %11f %11f %11f %11f\n", @{$self->{MaxBounds}} if $self->{MaxBounds};
+ my $fn = $self->{FieldNames};
+ my $ft = $self->{FieldTypes};
+ unless ($fn) {
+ ($fn, $ft) = data_model($self);
+ }
+ print "Field names: ", join(', ', @$fn), "\n";
+ print "Field types: ", join(', ', @$ft), "\n";
+
+ print "Number of shapes: $self->{NShapes}\n";
+
+ my $sindex = 0;
+ while($sindex < $self->{NShapes}) {
+ my $shape = get_shape($self, $sindex);
+ my $rec = get_record_arrayref($self, $sindex, $fn);
+
+ print "Begin shape ",$sindex+1," of $self->{NShapes}\n";
+ print "\tShape id: $shape->{ShapeId}\n";
+ print "\tShape type: $shape->{SHPType} ($ShapeTypes{$shape->{SHPType}})\n";
+ printf "\tMin bounds: %11f %11f %11f %11f\n", @{$shape->{MinBounds}} if $shape->{MinBounds};
+ printf "\tMax bounds: %11f %11f %11f %11f\n", @{$shape->{MaxBounds}} if $shape->{MaxBounds};
+
+ print "\tShape record: ", join(', ', @$rec), "\n";
+
+ if ($shape->{NParts}) {
+
+ my $pindex = 0;
+ my $pmax = $shape->{NParts};
+ while($pindex < $pmax) {
+ my $part = $shape->{Parts}[$pindex];
+ print "\tBegin part ",$pindex+1," of $pmax\n";
+
+ if($self->{CombineVertices}) {
+ print "\t\tPartType: $part->[1] ($part->[2])\n";
+ my $vindex = $part->[0];
+ my $vmax = $shape->{Parts}[$pindex+1][0];
+ $vmax = $shape->{NVertices} unless defined $vmax;
+ while($vindex < $vmax) {
+ printf "\t\tVertex: %11f %11f %11f %11f\n", @{$shape->{Vertices}[$vindex]};
+ $vindex++;
+ }
+ } else {
+ print "\t\tPart id: $part->{PartId}\n";
+ print "\t\tPart type: $part->{PartType} ($PartTypes{$part->{PartType}})\n";
+ for my $vertex (@{$part->{Vertices}}) {
+ printf "\t\tVertex: %11f %11f %11f %11f\n", @$vertex;
+ }
+ }
+
+ print "\tEnd part ",$pindex+1," of $pmax\n";
+ $pindex++;
+ }
+
+ } else {
+
+ for my $vertex (@{$shape->{Vertices}}) {
+ printf "\t\tVertex: %11f %11f %11f %11f\n", @$vertex;
+ }
+
+ }
+
+ print "End shape ",$sindex+1," of $self->{NShapes}\n";
+ $sindex++;
+ }
+
+ select $old_select if defined $old_select;
+ return 1;
+}
+
+sub DESTROY {
+ my $self = shift;
+ SHPClose($self->{SHPHandle}) if defined $self->{SHPHandle};
+}
+
+1;
+__END__
+
+
+=head1 AUTHOR
+
+Ari Jolma, https://github.com/ajolma
+
+=head1 REPOSITORY
+
+L<https://github.com/ajolma/Geo-Shapelib>
+
+=cut
diff --git a/t/00.t b/t/00.t
new file mode 100644
index 0000000..f9f8102
--- /dev/null
+++ b/t/00.t
@@ -0,0 +1,201 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; }
+END {print "not ok 1\n" unless $loaded;}
+
+use Geo::Shapelib qw /:all/;
+use Test::More tests => 12;
+
+$loaded = 1;
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+my $shape = new Geo::Shapelib {
+ Shapetype => POLYLINE,
+};
+
+for (0..0) {
+ push @{$shape->{Shapes}}, {
+ Vertices=>[[0,0],[1,1]]
+ };
+}
+for (0..0) {
+ $s = $shape->get_shape($_);
+ @l = $shape->lengths($s);
+ ok(abs($l[0] - sqrt(2)) < 0.00001,'lengths');
+}
+
+my $test;
+
+my $shapefile = 'test_shape';
+
+my $shape = new Geo::Shapelib {
+ Name => $shapefile,
+ Shapetype => POINT,
+ FieldNames => ['Name','Code','Founded'],
+ FieldTypes => ['String:50','String:10','Integer:8']
+ };
+
+while (<DATA>) {
+ chomp;
+ ($station,$code,$founded,$x,$y) = split /\|/;
+ push @{$shape->{Shapes}}, {
+ Vertices=>[[$x,$y]]
+ };
+ push @{$shape->{ShapeRecords}}, [$station,$code,$founded];
+}
+
+ok($shape, 'new from data');
+
+$rec = $shape->get_record_hashref(0);
+
+ok($rec->{Founded} == 19780202, "get_record_hashref, $rec->{Founded} == 19780202");
+
+$shape->dump("$shapefile.dump");
+
+ok(1, 'dump');
+
+$shape->save();
+
+ok(1, "save");
+
+{
+ my $shape2 = new Geo::Shapelib $shapefile, {Rtree=>1};
+
+ ok(ref($shape2->{Rtree}) eq 'Tree::R', "Rtree");
+
+ $test = $shape->{Shapes}->[2]->{Vertices}->[0]->[1] ==
+ $shape2->{Shapes}->[2]->{Vertices}->[0]->[1] and
+ $shape->{Shapes}->[2]->{Vertices}->[0]->[1] == 6722622;
+
+ ok($test, 'Rtree seems to work');
+
+ is_deeply ($shape2->query_within_rect(
+ [3382750, 6690570, 3394250, 6698260]), [0, 8], "Quadtree spatial query" );
+ ok ($shape2->create_spatial_index, "Create Quadtree index");
+}
+
+$example = "example/xyz";
+
+{
+ $shape = new Geo::Shapelib $example, {Load=>0};
+
+ my $rec = $shape->get_record_hashref(0);
+ my $y = sprintf("%.2f", $rec->{Y});
+
+ ok($y == 4235332.51, "get_record_hashref (unloaded rec) $rec->{Y} ~ 4235332.51");
+
+ $shape->save($shapefile);
+
+ #for ('.shp','.dbf') {
+ # @stat1 = stat $example.$_;
+ # @stat2 = stat $shapefile.$_;
+ # ok($stat1[7] == $stat2[7], "cmp $_ files, expected $stat1[7] got $stat2[7]");
+ #}
+}
+
+$shape = new Geo::Shapelib $example, {Load=>0};
+$shape2 = new Geo::Shapelib {
+ Name => $shapefile,
+ Like => $shape
+};
+$shape2->create();
+for (0..$shape->{NShapes}-1) {
+ $s = $shape->get_shape($_);
+ $r = $shape->get_record($_);
+ $shape2->add($s,$r);
+}
+$shape2->close();
+
+#for ('.shp','.dbf') {
+# @stat1 = stat $example.$_;
+# @stat2 = stat $shapefile.$_;
+# ok($stat1[7] == $stat2[7], "cmp $_ files, expected $stat1[7] got $stat2[7]");
+#}
+
+
+$shape = new Geo::Shapelib "example/xyz", {UnhashFields => 0};
+
+$shape->save($shapefile);
+
+#for ('.shp','.dbf') {
+# @stat1 = stat $example.$_;
+# @stat2 = stat $shapefile.$_;
+# ok($stat1[7] == $stat2[7], "cmp $_ files after unhash=0, expected $stat1[7] got $stat2[7]");
+#}
+
+$shape = new Geo::Shapelib "example/xyz", {LoadRecords => 0};
+
+$shape->save($shapefile);
+
+#for ('.shp','.dbf') {
+# @stat1 = stat $example.$_;
+# @stat2 = stat $shapefile.$_;
+# ok($stat1[7] == $stat2[7], "cmp $_ files after loadrecords=0, expected $stat1[7] got $stat2[7]");
+#}
+
+$shape = new Geo::Shapelib "example/xyz", {LoadRecords => 0, UnhashFields => 0};
+
+$shape->save($shapefile);
+
+#for ('.shp','.dbf') {
+# @stat1 = stat $example.$_;
+# @stat2 = stat $shapefile.$_;
+# ok($stat1[7] == $stat2[7], "cmp $_ files after loadrecords=0,unhash=0, expected $stat1[7] got $stat2[7]");
+#}
+
+# thanks to Ethan Alpert for this test
+$shape = new Geo::Shapelib;
+$shape->{Name};
+$shape->{Shapetype}=5;
+$shape->{FieldNames}=['ID','Name'];
+$shape->{FieldTypes}=['Integer','String'];
+push @{$shape->{ShapeRecords}},[0,$shapefile];
+push @{$shape->{Shapes}}, {
+ SHPType=>5,
+ ShapeId=>0,
+ NParts=>2,
+ Parts=>[[0,5,'Ring'],[5,5,'Ring']],
+ NVertices=>10,
+ Vertices=>[[-1,1,0,0],[1,1,0,0],[1,-1,0,0],[-1,-1,0,0],[-1,1,0,0],[-.1,.1,0,0],[-.1,-.1,0,0],[.1,-.1,0,0],[.1,.1,0,0],[-.1,.1,0,0]]
+ };
+$shape->set_bounds;
+$shape->save($shapefile);
+
+#$shape->dump;
+
+$shape = new Geo::Shapelib $shapefile;
+
+#$shape->dump;
+
+#use Data::Dumper;
+#print Dumper($shape->{Shapes}[0]);
+ok($shape->{Shapes}[0]->{Vertices}[4][0] == -1, 'save multipart, vertices');
+ok($shape->{Shapes}[0]->{Parts}[1][0] == 5, 'save multipart, parts');
+
+END {
+ foreach ( 'shp', 'shx', 'dbf', 'qix', 'dump' ) {
+ unlink "$shapefile.$_";
+ }
+}
+
+__DATA__
+Helsinki-Vantaan Lentoasema|HVL|19780202|3387419|6692222
+Helsinki Kaisaniemi |HK|19580201|3385926|6675529
+Hyvink�� Mutila |HM|19630302|3379813|6722622
+Nurmij�rvi Rajam�ki |HR|19340204|3376486|6715764
+Vihti Maasoja |VM|19230502|3356766|6703481
+Porvoo J�rnb�le |PJ|19450202|3426574|6703254
+Porvoon Mlk Bengtsby |PMB|19670202|3424354|6684723
+Orimattila K�kel� |OK|19560202|3432847|6743998
+Tuusula Ruotsinkyl� |TR|19750402|3388723|6696784
diff --git a/typemap b/typemap
new file mode 100644
index 0000000..11ea1a3
--- /dev/null
+++ b/typemap
@@ -0,0 +1,4 @@
+TYPEMAP
+ SHPHandle T_PTROBJ
+ DBFHandle T_PTROBJ
+ SHPObject * T_PTROBJ
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-grass/libgeo-shapelib-perl.git
More information about the Pkg-grass-devel
mailing list