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 <fran...@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 <qjh...@ucdavis.edu>, see README.Debian + - included the debian files into MANIFEST +0.04 released Mar 4 2003 + - changes from Leif Pedersen <peder...@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 <wood...@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.baba...@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'; + +@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} } ]; + +@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); + +@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,@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,@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,@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 _______________________________________________ Pkg-grass-devel mailing list Pkg-grass-devel@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-grass-devel