Geo-LibProj-FFI-1.01/000755 000765 000024 00000000000 14755373664 013667 5ustar00ajstaff000000 000000 Geo-LibProj-FFI-1.01/LICENSE000644 000765 000024 00000021306 14755373664 014676 0ustar00ajstaff000000 000000 The Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. 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. Geo-LibProj-FFI-1.01/cpanfile000644 000765 000024 00000001565 14755373664 015402 0ustar00ajstaff000000 000000 # This file is generated by Dist::Zilla::Plugin::CPANFile v6.032 # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. requires "Alien::proj" => "1.07"; requires "Convert::Binary::C" => "0.04"; requires "Exporter::Easy" => "0"; requires "FFI::C" => "0.08"; requires "FFI::Platypus" => "1.50"; requires "perl" => "v5.14.0"; on 'test' => sub { requires "ExtUtils::MakeMaker" => "0"; requires "File::Spec" => "0"; requires "Test::Exception" => "0"; requires "Test::More" => "0"; requires "Test::Warnings" => "0.010"; }; on 'test' => sub { recommends "CPAN::Meta" => "2.120900"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; }; on 'configure' => sub { suggests "JSON::PP" => "2.27300"; }; on 'develop' => sub { requires "Test::MinimumVersion" => "0"; requires "Test::More" => "0"; requires "Test::Pod" => "1.41"; }; Geo-LibProj-FFI-1.01/Changes000644 000765 000024 00000003331 14755373664 015162 0ustar00ajstaff000000 000000 Revision history for Geo::LibProj::FFI 1.01 2025-02-19 - Fix segmentation fault on armel and armhf. (GH #4) (Andreas Vögele) 1.00 2024-05-12 - Documentation update: Future major changes are no longer expected for this module. The version number is incremented to reflect that the interface is now considered stable. - No functional changes. 0.06 2023-12-05 - Fix compatibility with Perl v5.26 and older. (GH #3) 0.05 2023-12-01 - Add new PJ_COORD struct member accessors. Instead of calling $c->xyz->x(), you can now simply call $c->xyz_x(), which is faster and more likely to remain stable with future updates. The old syntax is now discouraged, but there are currently no plans to remove it. - Deprecate creating PJ_COORD union member structs with new(). Unions are not well supported by FFI::Platypus. For best forward compatibility, creating new PJ_COORD values should only be done by using proj_coords(). - Internal change: The PJ_COORD implementation is now based on the vector union member. This means the fastest way to access coordinates is now via $c->v(...) instead of $c->xyzt->... 0.04 2021-05-24 - Add area of interest functions - Add distances functions - Add error-state manipulation functions - Add info functions - Add lists functions - Add logging functions 0.03 2021-05-21 - Address performance issues with PJ_COORD values - Add brief description of how to work with PJ_COORD values and other PROJ data types to the documentation 0.02 2021-03-04 - Resolve failures reported in CPAN Testers (GH#1 and others) 0.01 2021-03-03 - Release to CPAN - Only a few essential functions are available, just enough to support Geo::LibProj::cs2cs and a simple example Geo-LibProj-FFI-1.01/MANIFEST000644 000765 000024 00000000704 14755373664 015021 0ustar00ajstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.032. Changes LICENSE MANIFEST META.json META.yml Makefile.PL README cpanfile eg/pj_obs_api_mini_demo.pl lib/Geo/LibProj/FFI.pm t/00-report-prereqs.dd t/00-report-prereqs.t t/00-version.t t/constants.t t/context.t t/distance.t t/error.t t/info.t t/lists.t t/misc.t t/private.t t/setup.t t/transform.t t/types.t t/zz-cleanup.t xt/author/minimum-version.t xt/author/pod-syntax.t Geo-LibProj-FFI-1.01/t/000755 000765 000024 00000000000 14755373664 014132 5ustar00ajstaff000000 000000 Geo-LibProj-FFI-1.01/xt/000755 000765 000024 00000000000 14755373664 014322 5ustar00ajstaff000000 000000 Geo-LibProj-FFI-1.01/README000644 000765 000024 00000002433 14755373664 014551 0ustar00ajstaff000000 000000 Geo::LibProj::FFI 1.01 This module is a foreign function interface to the PROJ coordinate transformation / projection library. Please see the PROJ library's C function reference for further documentation. You should be able to use those C functions as if they were Perl. More information about this software: https://metacpan.org/dist/Geo-LibProj-FFI INSTALLATION The recommended way to install this Perl module distribution is directly from CPAN with whichever tool you use to manage your installation of Perl. For example: cpanm Geo::LibProj::FFI If you already have downloaded the distribution, you can alternatively point your tool directly at the archive file or the directory: cpanm Geo-LibProj-FFI-1.01.tar.gz You can also install the module manually by following these steps: perl Makefile.PL make make test make install See https://www.cpan.org/modules/INSTALL.html for general information on installing CPAN modules. COPYRIGHT AND LICENSE This software is Copyright (c) 2021-2025 by Arne Johannessen. This is free software; you can redistribute it and/or modify it under the terms of the Artistic License 2.0 or (at your option) the same terms as the Perl 5 programming language system itself. Geo-LibProj-FFI-1.01/META.yml000644 000765 000024 00000004724 14755373664 015147 0ustar00ajstaff000000 000000 --- abstract: 'Foreign function interface to PROJ coordinate transformation software' author: - 'Arne Johannessen ' build_requires: ExtUtils::MakeMaker: '0' File::Spec: '0' Test::Exception: '0' Test::More: '0' Test::Warnings: '0.010' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.032, CPAN::Meta::Converter version 2.150010' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Geo-LibProj-FFI provides: Geo::LibProj::FFI: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_COORD: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_ENU: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_GEOD: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_GRID_INFO: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_INFO: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_INIT_INFO: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_LP: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_LPZ: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_LPZT: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_OPK: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_PROJ_INFO: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_UV: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_UVW: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_UVWT: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_XY: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_XYZ: file: lib/Geo/LibProj/FFI.pm version: '1.01' Geo::LibProj::FFI::PJ_XYZT: file: lib/Geo/LibProj/FFI.pm version: '1.01' requires: Alien::proj: '1.07' Convert::Binary::C: '0.04' Exporter::Easy: '0' FFI::C: '0.08' FFI::Platypus: '1.50' perl: v5.14.0 resources: bugtracker: https://github.com/johannessen/proj-perl-ffi/issues repository: https://github.com/johannessen/proj-perl-ffi.git version: '1.01' x_contributors: - 'Andreas Vögele ' x_generated_by_perl: v5.40.0 x_serialization_backend: 'YAML::Tiny version 1.74' x_spdx_expression: Artistic-2.0 Geo-LibProj-FFI-1.01/lib/000755 000765 000024 00000000000 14755373664 014435 5ustar00ajstaff000000 000000 Geo-LibProj-FFI-1.01/Makefile.PL000644 000765 000024 00000003021 14755373664 015635 0ustar00ajstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.032. use strict; use warnings; use 5.014000; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Foreign function interface to PROJ coordinate transformation software", "AUTHOR" => "Arne Johannessen ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Geo-LibProj-FFI", "LICENSE" => "artistic_2", "MIN_PERL_VERSION" => "5.014000", "NAME" => "Geo::LibProj::FFI", "PREREQ_PM" => { "Alien::proj" => "1.07", "Convert::Binary::C" => "0.04", "Exporter::Easy" => 0, "FFI::C" => "0.08", "FFI::Platypus" => "1.50" }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "Test::Exception" => 0, "Test::More" => 0, "Test::Warnings" => "0.010" }, "VERSION" => "1.01", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Alien::proj" => "1.07", "Convert::Binary::C" => "0.04", "Exporter::Easy" => 0, "ExtUtils::MakeMaker" => 0, "FFI::C" => "0.08", "FFI::Platypus" => "1.50", "File::Spec" => 0, "Test::Exception" => 0, "Test::More" => 0, "Test::Warnings" => "0.010" ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); Geo-LibProj-FFI-1.01/eg/000755 000765 000024 00000000000 14755373664 014262 5ustar00ajstaff000000 000000 Geo-LibProj-FFI-1.01/META.json000644 000765 000024 00000010151 14755373664 015306 0ustar00ajstaff000000 000000 { "abstract" : "Foreign function interface to PROJ coordinate transformation software", "author" : [ "Arne Johannessen " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.032, CPAN::Meta::Converter version 2.150010", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Geo-LibProj-FFI", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" }, "suggests" : { "JSON::PP" : "2.27300" } }, "develop" : { "requires" : { "Test::MinimumVersion" : "0", "Test::More" : "0", "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "Alien::proj" : "1.07", "Convert::Binary::C" : "0.04", "Exporter::Easy" : "0", "FFI::C" : "0.08", "FFI::Platypus" : "1.50", "perl" : "v5.14.0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "Test::Exception" : "0", "Test::More" : "0", "Test::Warnings" : "0.010" } } }, "provides" : { "Geo::LibProj::FFI" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_COORD" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_ENU" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_GEOD" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_GRID_INFO" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_INFO" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_INIT_INFO" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_LP" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_LPZ" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_LPZT" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_OPK" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_PROJ_INFO" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_UV" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_UVW" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_UVWT" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_XY" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_XYZ" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" }, "Geo::LibProj::FFI::PJ_XYZT" : { "file" : "lib/Geo/LibProj/FFI.pm", "version" : "1.01" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/johannessen/proj-perl-ffi/issues" }, "repository" : { "type" : "git", "url" : "https://github.com/johannessen/proj-perl-ffi.git", "web" : "https://github.com/johannessen/proj-perl-ffi" } }, "version" : "1.01", "x_contributors" : [ "Andreas V\u00f6gele " ], "x_generated_by_perl" : "v5.40.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.38", "x_spdx_expression" : "Artistic-2.0" } Geo-LibProj-FFI-1.01/eg/pj_obs_api_mini_demo.pl000755 000765 000024 00000003150 14755373664 020746 0ustar00ajstaff000000 000000 #! /usr/bin/env perl use strict; use warnings; use Geo::LibProj::FFI 0.05 qw( :all ); # Please compare this example code with: # https://github.com/OSGeo/PROJ/blob/8.0/examples/pj_obs_api_mini_demo.c # See also: # https://proj.org/development/quickstart.html my $C; # PJ_CONTEXT* my $P; # PJ* my $P_for_GIS; # PJ* my ($a, $b); # PJ_COORD # or you may set $C=PJ_DEFAULT_CTX if you are sure you will # use PJ objects from only one thread $C = proj_context_create(); $P = proj_create_crs_to_crs( $C, "EPSG:4326", "+proj=utm +zone=32 +datum=WGS84", # or EPSG:32632 undef ); unless ($P) { printf STDERR "Oops\n"; exit 1; } # This will ensure that the order of coordinates for the input CRS # will be longitude, latitude, whereas EPSG:4326 mandates latitude, # longitude $P_for_GIS = proj_normalize_for_visualization($C, $P); unless ($P_for_GIS) { printf STDERR "Oops\n"; exit 1; } proj_destroy($P); $P = $P_for_GIS; # a coordinate union representing Copenhagen: 55d N, 12d E # Given that we have used proj_normalize_for_visualization(), the order of # coordinates is longitude, latitude, and values are expressed in degrees. $a = proj_coord( 12, 55, 0, 0 ); # transform to UTM zone 32, then back to geographical $b = proj_trans( $P, PJ_FWD, $a ); printf "easting: %.3f, northing: %.3f\n", $b->enu_e, $b->enu_n; $b = proj_trans( $P, PJ_INV, $b ); printf "longitude: %g, latitude: %g\n", $b->lp_lam, $b->lp_phi; # Clean up proj_destroy($P); proj_context_destroy($C); # may be omitted in the single threaded case exit 0; Geo-LibProj-FFI-1.01/lib/Geo/000755 000765 000024 00000000000 14755373664 015147 5ustar00ajstaff000000 000000 Geo-LibProj-FFI-1.01/lib/Geo/LibProj/000755 000765 000024 00000000000 14755373664 016510 5ustar00ajstaff000000 000000 Geo-LibProj-FFI-1.01/lib/Geo/LibProj/FFI.pm000644 000765 000024 00000066506 14755373664 017467 0ustar00ajstaff000000 000000 use v5.14; use warnings; # ABSTRACT: Foreign function interface to PROJ coordinate transformation software package Geo::LibProj::FFI 1.01; use Alien::proj 1.07; use FFI::Platypus 1.50; use FFI::C 0.08; use Convert::Binary::C 0.04; use Exporter::Easy (TAGS => [ context => [qw( proj_context_create proj_context_destroy proj_context_use_proj4_init_rules )], setup => [qw( proj_create proj_create_argv proj_create_crs_to_crs proj_create_crs_to_crs_from_pj proj_normalize_for_visualization proj_destroy )], area => [qw( proj_area_create proj_area_set_bbox proj_area_destroy )], transform => [qw( proj_trans )], error => [qw( proj_context_errno proj_errno proj_errno_set proj_errno_reset proj_errno_restore proj_errno_string proj_context_errno_string )], logging => [qw( proj_log_level proj_log_func )], info => [qw( proj_info proj_pj_info proj_grid_info proj_init_info )], lists => [qw( proj_list_operations proj_list_ellps proj_list_units proj_list_angular_units proj_list_prime_meridians )], distance => [qw( proj_lp_dist proj_lpz_dist proj_xy_dist proj_xyz_dist proj_geod )], misc => [qw( proj_coord )], const => [qw( PJ_DEFAULT_CTX PJ_LOG_NONE PJ_LOG_ERROR PJ_LOG_DEBUG PJ_LOG_TRACE PJ_LOG_TELL PJ_FWD PJ_IDENT PJ_INV )], all => [qw( :context :setup :area :transform :error :logging :info :lists :distance :misc :const proj_cleanup )], ]); my $ffi = FFI::Platypus->new( api => 2, lang => 'C', lib => [Alien::proj->dynamic_libs], ); FFI::C->ffi($ffi); my $c = Convert::Binary::C->new(Alignment => 0); $ffi->load_custom_type('::StringPointer' => 'string_pointer'); # string* should also work, but doesn't in $ffi->cast $ffi->load_custom_type('::StringArray' => 'string_array'); # string[] should also work, but causes strlen in proj_create_crs_to_crs_from_pj to segfault # based on proj.h version 8.0.0 # *************************************************************************** # Copyright (c) 2016, 2017, Thomas Knudsen / SDFE # Copyright (c) 2018, Even Rouault # # Permission is hereby granted, free of charge, to any person obtaining a # copy of this software and associated documentation files (the "Software"), # to deal in the Software without restriction, including without limitation # the rights to use, copy, modify, merge, publish, distribute, sublicense, # and/or sell copies of the Software, and to permit persons to whom the # Software is furnished to do so, subject to the following conditions: # # The above copyright notice and this permission notice shall be included # in all copies or substantial portions of the Software. # # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS # OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO COORD SHALL # THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER # DEALINGS IN THE SOFTWARE. # *************************************************************************** # C API new generation $ffi->type('opaque' => 'PJ_AREA'); # Data type for projection/transformation information $ffi->type('opaque' => 'PJ'); # the PJ object herself # Data types for list of operations, ellipsoids, datums and units used in PROJ.4 $c->parse(<custom_type( 'PJ_OPERATIONS' => { native_to_perl => sub { my ($ptr) = @_; my $size = $c->sizeof('PJ_LIST'); my @list; while () { $ptr += $size; my $item = $c->unpack('PJ_LIST', $ffi->cast( 'opaque' => "record($size)*", $ptr )); last unless $item->{id}; $item->{id} = $ffi->cast( 'opaque' => 'string', $item->{id} ); $item->{descr} = $ffi->cast( 'opaque' => 'string_pointer', $item->{descr} ); push @list, $item; } return \@list; }, }); sub _unpack_list { my ($type, $ptr) = @_; my $size = $c->sizeof($type); my @list; while () { my $item = $c->unpack($type, $ffi->cast( 'opaque' => "record($size)*", $ptr )); last unless $item->{id}; $item->{$_} = $ffi->cast( 'opaque' => 'string', $item->{$_} ) for grep { $c->typeof("$type.$_") eq 'char *' } keys %$item; push @list, $item; $ptr += $size; } return \@list; } $c->parse(<custom_type( 'PJ_ELLPS' => { native_to_perl => sub { _unpack_list(PJ_ELLPS => @_) }, }); $c->parse(<custom_type( 'PJ_UNITS' => { native_to_perl => sub { _unpack_list(PJ_UNITS => @_) }, }); $c->parse(<custom_type( 'PJ_PRIME_MERIDIANS' => { native_to_perl => sub { _unpack_list(PJ_PRIME_MERIDIANS => @_) }, }); # Geodetic, mostly spatiotemporal coordinate types { package Geo::LibProj::FFI::PJ_XYZT 1.01; sub new { Geo::LibProj::FFI::PJ_COORD->_new($_[1], qw{ x y z t }) } package Geo::LibProj::FFI::PJ_UVWT 1.01; sub new { Geo::LibProj::FFI::PJ_COORD->_new($_[1], qw{ u v w t })->uvwt } package Geo::LibProj::FFI::PJ_LPZT 1.01; sub new { Geo::LibProj::FFI::PJ_COORD->_new($_[1], qw{ lam phi z t }) } package Geo::LibProj::FFI::PJ_OPK 1.01; sub new { Geo::LibProj::FFI::PJ_COORD->_new($_[1], qw{ o p k 0 }) } # Rotations: omega, phi, kappa package Geo::LibProj::FFI::PJ_ENU 1.01; sub new { Geo::LibProj::FFI::PJ_COORD->_new($_[1], qw{ e n u 0 }) } # East, North, Up package Geo::LibProj::FFI::PJ_GEOD 1.01; sub new { Geo::LibProj::FFI::PJ_COORD->_new($_[1], qw{ s a1 a2 0 }) } # Geodesic length, fwd azi, rev azi } # Classic proj.4 pair/triplet types - moved into the PJ_ name space { package Geo::LibProj::FFI::PJ_UV 1.01; sub new { Geo::LibProj::FFI::PJ_COORD->_new($_[1], qw{ u v 0 0 })->uv } package Geo::LibProj::FFI::PJ_XY 1.01; sub new { Geo::LibProj::FFI::PJ_COORD->_new($_[1], qw{ x y 0 0 }) } package Geo::LibProj::FFI::PJ_LP 1.01; sub new { Geo::LibProj::FFI::PJ_COORD->_new($_[1], qw{ lam phi 0 0 }) } package Geo::LibProj::FFI::PJ_XYZ 1.01; sub new { Geo::LibProj::FFI::PJ_COORD->_new($_[1], qw{ x y z 0 }) } package Geo::LibProj::FFI::PJ_UVW 1.01; sub new { Geo::LibProj::FFI::PJ_COORD->_new($_[1], qw{ u v w 0 })->uvw } package Geo::LibProj::FFI::PJ_LPZ 1.01; sub new { Geo::LibProj::FFI::PJ_COORD->_new($_[1], qw{ lam phi z 0 }) } } # Data type for generic geodetic 3D data plus epoch information # Avoid preprocessor renaming and implicit type-punning: Use a union to make it explicit { # FFI::C::Union can't be passed by value due to limitations within # FFI::Platypus. Workaround: Use a Record with some additional Perl # glue. The performance may not be perfect, but seems satisfactory. package Geo::LibProj::FFI::PJ_COORD 1.01; use FFI::Platypus::Record; record_layout_1(qw{ double[4] v }); # First and foremost, it really is "just 4 numbers in a vector" # union members: sub xyzt_x { shift->v(0, @_) } sub xyzt_y { shift->v(1, @_) } sub xyzt_z { shift->v(2, @_) } sub xyzt_t { shift->v(3, @_) } sub uvwt_u { shift->v(0, @_) } sub uvwt_v { shift->v(1, @_) } sub uvwt_w { shift->v(2, @_) } sub uvwt_t { shift->v(3, @_) } sub lpzt_lam { shift->v(0, @_) } sub lpzt_phi { shift->v(1, @_) } sub lpzt_z { shift->v(2, @_) } sub lpzt_t { shift->v(3, @_) } sub geod_s { shift->v(0, @_) } sub geod_a1 { shift->v(1, @_) } sub geod_a2 { shift->v(2, @_) } sub opk_o { shift->v(0, @_) } sub opk_p { shift->v(1, @_) } sub opk_k { shift->v(2, @_) } sub enu_e { shift->v(0, @_) } sub enu_n { shift->v(1, @_) } sub enu_u { shift->v(2, @_) } sub xyz_x { shift->v(0, @_) } sub xyz_y { shift->v(1, @_) } sub xyz_z { shift->v(2, @_) } sub uvw_u { shift->v(0, @_) } sub uvw_v { shift->v(1, @_) } sub uvw_w { shift->v(2, @_) } sub lpz_lam { shift->v(0, @_) } sub lpz_phi { shift->v(1, @_) } sub lpz_z { shift->v(2, @_) } sub xy_x { shift->v(0, @_) } sub xy_y { shift->v(1, @_) } sub uv_u { shift->v(0, @_) } sub uv_v { shift->v(1, @_) } sub lp_lam { shift->v(0, @_) } sub lp_phi { shift->v(1, @_) } # legacy support: sub _new { my ($class, $values, @params) = @_; warnings::warnif_at_level( 'deprecated', 1, sprintf 'Creating %s values with new() is deprecated; use proj_coords() instead', caller =~ s/^.*://r ); $values //= {}; @params = map { $values->{$_} // 0 } @params; return $class->new({ 'v' => \@params }); } sub _set { my ($self, $values, @params) = @_; warnings::warnif_at_level( 'deprecated', 2, 'Setting PJ_COORD union members is deprecated; use proj_coords() instead' ); if (ref $values eq 'HASH') { @params = map { $values->{$_} } @params; } else { @params = map { eval "\$values->$_" } grep !/^0$/, @params; ## no critic (ProhibitStringyEval) } $self->v(\@params); } *warnings::warnif_at_level = sub { warnings::warnif(shift, pop) } if $^V lt v5.27; # union members: sub xyzt { $_[1] ? $_[0]->_set($_[1], qw{ x y z t }) : shift } sub uvwt { $_[1] ? $_[0]->_set($_[1], qw{ u v w t }) : Geo::LibProj::FFI::PJ_UVWT->_new(shift) } sub lpzt { $_[1] ? $_[0]->_set($_[1], qw{ lam phi z t }) : shift } sub geod { $_[1] ? $_[0]->_set($_[1], qw{ s a1 a2 0 }) : shift } sub opk { $_[1] ? $_[0]->_set($_[1], qw{ o p k 0 }) : shift } sub enu { $_[1] ? $_[0]->_set($_[1], qw{ e n u 0 }) : shift } sub xyz { $_[1] ? $_[0]->_set($_[1], qw{ x y z 0 }) : shift } sub uvw { $_[1] ? $_[0]->_set($_[1], qw{ u v w 0 }) : Geo::LibProj::FFI::PJ_UVWT->_new(shift) } sub lpz { $_[1] ? $_[0]->_set($_[1], qw{ lam phi z 0 }) : shift } sub xy { $_[1] ? $_[0]->_set($_[1], qw{ x y 0 0 }) : shift } sub uv { $_[1] ? $_[0]->_set($_[1], qw{ u v 0 0 }) : Geo::LibProj::FFI::PJ_UVWT->_new(shift) } sub lp { $_[1] ? $_[0]->_set($_[1], qw{ lam phi 0 0 }) : shift } # struct members: # PJ_UV* need their own package due to name collisions. # The other types are implemented by the PJ_COORD package. sub x { shift->v(0, @_) } sub lam { shift->v(0, @_) } sub o { shift->v(0, @_) } sub e { shift->v(0, @_) } sub s { shift->v(0, @_) } sub y { shift->v(1, @_) } sub phi { shift->v(1, @_) } sub p { shift->v(1, @_) } sub n { shift->v(1, @_) } sub a1 { shift->v(1, @_) } sub z { shift->v(2, @_) } sub k { shift->v(2, @_) } sub u { shift->v(2, @_) } sub a2 { shift->v(2, @_) } sub t { shift->v(3, @_) } package Geo::LibProj::FFI::PJ_UVWT; sub _new { bless \$_[1], $_[0] } sub u { ${shift()}->v( 0, @_ ) } sub v { ${shift()}->v( 1, @_ ) } sub w { ${shift()}->v( 2, @_ ) } sub t { ${shift()}->v( 3, @_ ) } } $ffi->type('record(Geo::LibProj::FFI::PJ_COORD)' => 'PJ_COORD'); { package Geo::LibProj::FFI::PJ_INFO 1.01; use FFI::Platypus::Record; record_layout_1( int => 'major', # Major release number int => 'minor', # Minor release number int => 'patch', # Patch level string => 'release', # Release info. Version + date string => 'version', # Full version number string => 'searchpath', # Paths where init and grid files are # looked for. Paths are separated by # semi-colons on Windows, and colons # on non-Windows platforms. opaque => 'paths', size_t => 'path_count', ); } $ffi->type('record(Geo::LibProj::FFI::PJ_INFO)' => 'PJ_INFO'); { package Geo::LibProj::FFI::PJ_PROJ_INFO 1.01; use FFI::Platypus::Record; record_layout_1( string => 'id', # Name of the projection in question string => 'description', # Description of the projection string => 'definition', # Projection definition int => 'has_inverse', # 1 if an inverse mapping exists, 0 otherwise double => 'accuracy', # Expected accuracy of the transformation. -1 if unknown. ); } $ffi->type('record(Geo::LibProj::FFI::PJ_PROJ_INFO)' => 'PJ_PROJ_INFO'); { package Geo::LibProj::FFI::PJ_GRID_INFO 1.01; use FFI::Platypus::Record; record_layout_1( 'string(32)' => 'gridname_NUL', # name of grid 'string(260)' => 'filename_NUL', # full path to grid 'string(8)' => 'format_NUL', # file format of grid double => 'left', double => 'lower', # Coordinates of lower left corner double => 'right', double => 'upper', # Coordinates of upper right corner int => 'n_lon', int => 'n_lat', # Grid size double => 'cs_lon', double => 'cs_lat', # Cell size of grid ); sub gridname { my $s = shift->gridname_NUL; $s =~ s/\0+$//; $s } sub filename { my $s = shift->filename_NUL; $s =~ s/\0+$//; $s } sub format { my $s = shift->format_NUL; $s =~ s/\0+$//; $s } sub lowerleft { Geo::LibProj::FFI::PJ_COORD->new({ v => [$_[0]->left, $_[0]->lower] }) } sub upperright { Geo::LibProj::FFI::PJ_COORD->new({ v => [$_[0]->right, $_[0]->upper] }) } } $ffi->type('record(Geo::LibProj::FFI::PJ_GRID_INFO)' => 'PJ_GRID_INFO'); { package Geo::LibProj::FFI::PJ_INIT_INFO 1.01; use FFI::Platypus::Record; record_layout_1( 'string(32)' => 'name_NUL', # name of init file 'string(260)' => 'filename_NUL', # full path to the init file. 'string(32)' => 'version_NUL', # version of the init file 'string(32)' => 'origin_NUL', # origin of the file, e.g. EPSG 'string(16)' => 'lastupdate_NUL', # Date of last update in YYYY-MM-DD format ); sub name { my $s = shift->name_NUL; $s =~ s/\0+$//; $s } sub filename { my $s = shift->filename_NUL; $s =~ s/\0+$//; $s } sub version { my $s = shift->version_NUL; $s =~ s/\0+$//; $s } sub origin { my $s = shift->origin_NUL; $s =~ s/\0+$//; $s } sub lastupdate { my $s = shift->lastupdate_NUL; $s =~ s/\0+$//; $s } } $ffi->type('record(Geo::LibProj::FFI::PJ_INIT_INFO)' => 'PJ_INIT_INFO'); FFI::C->enum('PJ_LOG_LEVEL', [ [PJ_LOG_NONE => 0], [PJ_LOG_ERROR => 1], [PJ_LOG_DEBUG => 2], [PJ_LOG_TRACE => 3], [PJ_LOG_TELL => 4], [PJ_LOG_DEBUG_MAJOR => 2], # for proj_api.h compatibility [PJ_LOG_DEBUG_MINOR => 3], # for proj_api.h compatibility ], {rev => 'int'}); # The context type - properly namespaced synonym for pj_ctx $ffi->type('opaque' => 'PJ_CONTEXT'); # A P I # The objects returned by the functions defined in this section have minimal # interaction with the functions of the # iso19111_functions section, and vice versa. See its introduction # paragraph for more details. # Functionality for handling thread contexts use constant PJ_DEFAULT_CTX => 0; $ffi->attach( proj_context_create => [] => 'PJ_CONTEXT'); $ffi->attach( proj_context_destroy => ['PJ_CONTEXT'] => 'void'); $ffi->attach( proj_context_use_proj4_init_rules => [qw( PJ_CONTEXT int )] => 'void' ); # Manage the transformation definition object PJ $ffi->attach( proj_create => [qw( PJ_CONTEXT string )] => 'PJ' ); $ffi->attach( proj_create_argv => [qw( PJ_CONTEXT int string_array )] => 'PJ'); $ffi->attach( proj_create_crs_to_crs => [qw( PJ_CONTEXT string string PJ_AREA )] => 'PJ'); $ffi->attach( proj_create_crs_to_crs_from_pj => [qw( PJ_CONTEXT PJ PJ PJ_AREA string_array )] => 'PJ', sub{ $_[0]->( @_[1..4], $_[5] || [] ); # StringArray won't accept NULL }); $ffi->attach( proj_normalize_for_visualization => ['PJ_CONTEXT', 'PJ'] => 'PJ'); $ffi->attach( proj_destroy => ['PJ'] => 'void'); $ffi->attach( proj_area_create => [] => 'PJ_AREA'); $ffi->attach( proj_area_set_bbox => [qw( PJ_AREA double double double double )] => 'void'); $ffi->attach( proj_area_destroy => [qw( PJ_AREA )] => 'void'); # Apply transformation to observation - in forward or inverse direction FFI::C->enum('PJ_DIRECTION', [ [PJ_FWD => 1], # Forward [PJ_IDENT => 0], # Do nothing [PJ_INV => -1], # Inverse ]); $ffi->attach( proj_trans => ['PJ', 'PJ_DIRECTION', 'PJ_COORD'] => 'PJ_COORD'); # non-standard method (now discouraged; originally used by Perl cs2cs) # (expects and returns a single point as array ref) $ffi->attach( [proj_trans => '_trans'] => ['PJ', 'PJ_DIRECTION', 'PJ_COORD'] => 'PJ_COORD', sub { my ($sub, $pj, $dir, $coord) = @_; $sub->( $pj, $dir, proj_coord($coord->[0] // 0, $coord->[1] // 0, $coord->[2] // 0, $coord->[3] // 0) )->v; }); # Initializers $ffi->attach( proj_coord => [qw( double double double double )] => 'PJ_COORD'); # Geodesic distance between two points with angular 2D coordinates $ffi->attach( proj_lp_dist => [qw( PJ PJ_COORD PJ_COORD )] => 'double'); # The geodesic distance AND the vertical offset $ffi->attach( proj_lpz_dist => [qw( PJ PJ_COORD PJ_COORD )] => 'double'); # Euclidean distance between two points with linear 2D coordinates $ffi->attach( proj_xy_dist => [qw( PJ_COORD PJ_COORD )] => 'double'); # Euclidean distance between two points with linear 3D coordinates $ffi->attach( proj_xyz_dist => [qw( PJ_COORD PJ_COORD )] => 'double'); # Geodesic distance (in meter) + fwd and rev azimuth between two points on the ellipsoid $ffi->attach( proj_geod => [qw( PJ PJ_COORD PJ_COORD )] => 'PJ_COORD'); # Set or read error level $ffi->attach( proj_context_errno => ['PJ_CONTEXT'] => 'int'); $ffi->attach( proj_errno => ['PJ_CONTEXT'] => 'int'); $ffi->attach( proj_errno_set => ['PJ_CONTEXT', 'int'] => 'int'); $ffi->attach( proj_errno_reset => ['PJ_CONTEXT'] => 'int'); $ffi->attach( proj_errno_restore => ['PJ_CONTEXT', 'int'] => 'int'); $ffi->attach( proj_errno_string => ['int'] => 'string'); # deprecated. use proj_context_errno_string() eval { $ffi->attach( proj_context_errno_string => ['PJ_CONTEXT', 'int'] => 'string'); 1 } or do { *proj_context_errno_string = sub { proj_errno_string($_[1]); } }; $ffi->attach( proj_log_level => ['PJ_CONTEXT', 'PJ_LOG_LEVEL'] => 'PJ_LOG_LEVEL'); $ffi->attach( proj_log_func => ['PJ_CONTEXT', 'opaque', '(opaque,int,string)->void'] => 'void', sub { my ($sub, $ctx, $app_data, $logf) = @_; my $closure = $ffi->closure( $app_data ? sub { my (undef, $level, $msg) = @_; $logf->($app_data, $level, $msg); } : $logf ); $closure->sticky; $sub->($ctx, 0, $closure); }); # Info functions - get information about various PROJ.4 entities $ffi->attach( proj_info => [] => 'PJ_INFO'); $ffi->attach( proj_pj_info => ['PJ'] => 'PJ_PROJ_INFO'); $ffi->attach( proj_grid_info => ['string'] => 'PJ_GRID_INFO'); $ffi->attach( proj_init_info => ['string'] => 'PJ_INIT_INFO'); # List functions: # Get lists of operations, ellipsoids, units and prime meridians. $ffi->attach( proj_list_operations => [] => 'PJ_OPERATIONS'); $ffi->attach( proj_list_ellps => [] => 'PJ_ELLPS'); $ffi->attach( proj_list_units => [] => 'PJ_UNITS'); $ffi->attach( proj_list_angular_units => [] => 'PJ_UNITS'); $ffi->attach( proj_list_prime_meridians => [] => 'PJ_PRIME_MERIDIANS'); $ffi->attach( proj_cleanup => [] => 'void'); 1; __END__ =pod =encoding UTF-8 =head1 NAME Geo::LibProj::FFI - Foreign function interface to PROJ coordinate transformation software =head1 VERSION version 1.01 =head1 SYNOPSIS use Geo::LibProj::FFI 0.05 qw(:all); use Feature::Compat::Defer; my $ctx = proj_context_create() or die "Cannot create threading context"; defer { proj_context_destroy($ctx); } my $pj = proj_create_crs_to_crs($ctx, "EPSG:25833", "EPSG:2198", undef) or die "Cannot create proj"; defer { proj_destroy($pj); } ($easting, $northing) = ( 500_000, 6094_800 ); $a = proj_coord( $easting, $northing, 0, 'Inf' ); $b = proj_trans( $pj, PJ_FWD, $a ); printf "Target: easting %.2f, northing %.2f\n", $b->enu_e, $b->enu_n; See also the example script F in this distribution. =head1 DESCRIPTION This module is a foreign function interface to the L coordinate transformation / projection library. Please see the PROJ library's L for further documentation. You should be able to use those S as if they were Perl. L offers a large portion of the most commonly used PROJ functions, but more could be added later. If you need a function that isn't yet available in this module, please open a GitHub issue with a description of your use case. This module was originally written for PROJ S. It works with PROJ versions as old as 6.2.0, and up to and including the most recent version. =head1 FUNCTIONS L currently offers the following functions. Import all functions and constants by using the tag C<:all>. =over =item L =over =item * C =item * C =item * C =back =item L =over =item * C =item * C =item * C =item * C =item * C =item * C =back =item L =over =item * C =item * C =item * C =back =item L =over =item * C =back =item L =over =item * C =item * C =item * C =item * C =item * C =item * C =item * C =back =item L =over =item * C =item * C =back =item L =over =item * C =item * C =item * C =item * C =back =item L =over =item * C =item * C =item * C =item * C =item * C =back =item L =over =item * C =item * C =item * C =item * C =item * C =back =item L =over =item * C =back =item L =over =item * C =back =back =head1 DATA TYPES The PROJ library uses numerous composite data types to represent coordinate tuples. The primary coordinate type, L|https://proj.org/en/9.3/development/reference/datatypes.html#c.PJ_COORD>, is a C union that gets passed by value. This construct is not well supported by L, which this module relies on to make the PROJ library API available in Perl. The workaround implemented here is to just use the array C internally and only model the union semantics using object methods, which is slightly slower than direct member access in C would be. The method names are the combination of the names of the C union member and the individual struct member, joined with an underscore. However, these methods will in turn access the coordinate array by calling the C method with the array index as argument. This extra method call may cost performance if called in a tight loop. So if speed is more important to you than readable code, you should consider just calling C directly rather than using the other named union/struct member methods. $pj_coord = proj_coord( @coords ); @coords = $pj_coord->v->@*; # Fast access to individual coordinate numbers: $x = $pj_coord->v(0); $y = $pj_coord->v(1); # Access generic coordinates by named member methods: ($u, $v) = ( $c->uv_u, $c->uv_v ); ($u, $v, $w) = ( $c->uvw_u, $c->uvw_v, $c->uvw_w ); ($u, $v, $w, $t) = ( $c->uvwt_u, $c->uvwt_v, $c->uvwt_w, $c->uvwt_t ); # Access cartesian coordinates by named member methods: ($x, $y) = ( $c->xy_x, $c->xy_y ); ($x, $y, $z) = ( $c->xyz_x, $c->xyz_y, $c->xyz_z ); ($x, $y, $z, $t) = ( $c->xyzt_x, $c->xyzt_y, $c->xyzt_z, $c->xyzt_t ); # Access geodetic coordinates by named member methods: ($lamda, $phi) = ( $c->lp_lam, $c->lp_phi ); ($lamda, $phi, $z) = ( $c->lpz_lam, $c->lpz_phi, $c->lpz_z ); ($lamda, $phi, $z, $t) = ( $c->lpzt_lam, $c->lpzt_phi, $c->lpzt_z, $c->lpzt_t ); # Access ancillary data by named member methods: ($s, $az_fwd, $az_rev) = ( $c->geod_s, $c->geod_a1, $c->geod_a2 ); ($omega, $phi, $kappa) = ( $c->opk_o, $c->opk_p, $c->opk_k ); ($east, $north, $up) = ( $c->enu_e, $c->enu_n, $c->enu_u ); Modifying C values is possible. All methods shown above act as mutators if a new value is passed as an argument. In the case of C, you can pass either an array reference or two arguments representing the array index and the new value, respectively. $c = proj_coord( 0, 0, 0, 0 ); $c->v( [12, 34, 56] ); $c->v(1, 78); $c->xy_x(99); say join ' ', $c->v->@*; # 99 78 56 0 Creating new C values should only be done with the C function. Other ways to construct such values may exist, but these must be considered implementation details that are subject to change. The C function is the only supported way to create C values. Before version 0.05 of L, C method names were joined with the arrow operator instead of an underscore (C<< $c->xyz->x >> etc.). The old syntax is now discouraged, but there are no immediate plans to remove it. Data types other than C are available as well. Please see the L for further documentation. =head1 SEE ALSO =over =item * L =item * L =item * L =item * PROJ C API Reference: L, L =back =head1 API LICENSE The API this module gives access to is the C API, which is available under the terms of the Expat MIT license. Copyright (c) 2016, 2017, Thomas Knudsen / SDFE Copyright (c) 2018, Even Rouault The API designers didn't write this Perl module, and the module author didn't design the API. =head1 AUTHOR Arne Johannessen (L) =head1 CONTRIBUTOR =for stopwords Andreas Vögele Andreas Vögele =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2021-2025 by Arne Johannessen. This is free software; you can redistribute it and/or modify it under the terms of the Artistic License 2.0 or (at your option) the same terms as the Perl 5 programming language system itself. =cut Geo-LibProj-FFI-1.01/xt/author/000755 000765 000024 00000000000 14755373664 015624 5ustar00ajstaff000000 000000 Geo-LibProj-FFI-1.01/xt/author/minimum-version.t000644 000765 000024 00000000152 14755373664 021145 0ustar00ajstaff000000 000000 use strict; use warnings; use Test::More; use Test::MinimumVersion; all_minimum_version_ok( qq{v5.16} ); Geo-LibProj-FFI-1.01/xt/author/pod-syntax.t000644 000765 000024 00000000252 14755373664 020116 0ustar00ajstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); Geo-LibProj-FFI-1.01/t/error.t000644 000765 000024 00000004251 14755373664 015452 0ustar00ajstaff000000 000000 #!perl use strict; use warnings; use lib 'lib'; use Test::More; use Test::Exception; use Test::Warnings 0.010 qw(warning :no_end_test); my $no_warnings; use if $no_warnings = $ENV{AUTHOR_TESTING} ? 1 : 0, 'Test::Warnings'; # Error reporting and logging # https://proj.org/development/reference/functions.html#error-reporting plan tests => 2 + 8 + 6 + 4 + $no_warnings; use Geo::LibProj::FFI qw( :all ); my ($p, $e, $w); # proj_log_level lives_ok { proj_log_level(0, PJ_LOG_NONE) } 'log_level none'; lives_and { is proj_log_level(0, PJ_LOG_TELL), PJ_LOG_NONE } 'log_level tell'; # proj_errno # proj_errno_set # proj_errno_reset # proj_errno_restore lives_and { ok $p = proj_create(0, "EPSG:4326") } 'proj_create'; lives_ok { proj_errno_set($p, 123) } 'errno_set 1'; lives_and { ok $e = proj_errno_reset($p) } 'errno_reset'; lives_ok { proj_errno_set($p, 234) } 'errno_set 2'; lives_and { is proj_errno($p), 234 } 'errno is set'; lives_ok { proj_errno_restore($p, $e) } 'errno_restore'; lives_and { is proj_errno($p), 123 } 'errno is restored'; lives_ok { proj_destroy($p) } 'proj_destroy'; # proj_log_func my $id = "v46JbYsQTGZfw"; # app_data (to confirm that the custom function is in fact being used) lives_ok { proj_log_func(0, $id, sub { my ($app_data, $log_level, $msg) = @_; warn "$app_data (lvl $log_level): $msg"; }) } 'log_func'; # testing expected failure lives_and { proj_log_level(0, PJ_LOG_ERROR); $w = ''; $w = warning { $e = proj_create(0, "+proj=tpers"); }; proj_log_level(0, PJ_LOG_NONE); ok ! $e; } 'proj_create fail'; like ($w, qr/^\Q$id\E/, 'proj_create log_func') or diag 'got warning(s): ', explain($w); like $w, qr/ \(lvl 1\): /, 'log_func PJ_LOG_ERROR'; like $w, qr/\b1027\b|-30\b/, 'log_func errno'; like $w, qr/\bInvalid value\b|\bh\b/, 'log_func errno_string'; # proj_context_errno lives_and { ok $e = proj_context_errno(0) } 'context_errno'; lives_and { ok $e == 1027 || $e == -30 } 'context_errno value'; # proj_errno_string lives_and { like proj_errno_string($e), qr/\bInvalid value\b|\bh\b/i } 'errno_string'; # proj_context_errno_string lives_and { like proj_context_errno_string(0, $e), qr/\bInvalid value\b|\bh\b/i } 'context_errno_string'; done_testing; Geo-LibProj-FFI-1.01/t/setup.t000644 000765 000024 00000003400 14755373664 015454 0ustar00ajstaff000000 000000 #!perl use strict; use warnings; use lib 'lib'; use Test::More; use Test::Exception; my $no_warnings; use if $no_warnings = $ENV{AUTHOR_TESTING} ? 1 : 0, 'Test::Warnings'; # Transformation setup # https://proj.org/development/reference/functions.html#transformation-setup plan tests => 8 + 4 + 3 + $no_warnings; use Geo::LibProj::FFI qw( :all ); my ($a, $p, $p1, $p2); # proj_create # proj_create_argv # proj_create_crs_to_crs_from_pj # proj_destroy lives_and { ok $p1 = proj_create(0, "WGS 84 / UTM zone 32N") } 'create 1'; lives_and { ok $p2 = proj_create_argv(0, 4, [qw(+proj=utm +zone=32 +datum=WGS84 +type=crs)]) } 'create 2'; lives_and { ok $p = proj_create_crs_to_crs_from_pj(0, $p1, $p2, undef, undef) } 'create_crs_to_crs_from_pj 0'; lives_ok { proj_destroy($p) } 'create_crs_to_crs_from_pj destroy 0'; lives_and { ok $p = proj_create_crs_to_crs_from_pj(0, $p1, $p2, 0, ["ALLOW_BALLPARK=YES"]) } 'create_crs_to_crs_from_pj 1'; lives_ok { proj_destroy($p) } 'create_crs_to_crs_from_pj destroy 1'; lives_ok { proj_destroy($p1) } 'create destroy 1'; lives_ok { proj_destroy($p2) } 'create destroy 2'; # proj_create_crs_to_crs # Area of interest # https://proj.org/development/reference/functions.html#area-of-interest lives_and { ok $a = proj_area_create() } 'area_create'; lives_ok { proj_area_set_bbox($a, -150, 64, -149, 65) } 'area_set_bbox'; lives_and { ok $p = proj_create_crs_to_crs(0, "EPSG:4267", "EPSG:4326", $a) } 'create_crs_to_crs'; lives_ok { proj_area_destroy($a) } 'area_destroy'; # proj_normalize_for_visualization lives_and { ok $p2 = proj_normalize_for_visualization(0, $p) } 'normalize_for_visualization'; lives_ok { proj_destroy($p) } 'create_crs_to_crs destroy'; lives_ok { proj_destroy($p2) } 'normalize_for_visualization destroy'; done_testing; Geo-LibProj-FFI-1.01/t/00-version.t000644 000765 000024 00000001177 14755373664 016227 0ustar00ajstaff000000 000000 #!perl use strict; use warnings; use Test::More; plan skip_all => "Version check not requested" unless $ENV{EXTENDED_TESTING} || $ENV{RELEASE_TESTING} || $ENV{AUTHOR_TESTING} || $ENV{AUTOMATED_TESTING}; plan tests => 1; use Alien::proj; use File::Spec; my $bin = File::Spec->catdir(Alien::proj->dist_dir, 'bin', 'cs2cs'); $bin = 'cs2cs' if Alien::proj->install_type eq 'system'; my $out = `$bin 2>&1` // ''; my ($version) = $out =~ m/\b(\d+\.\d+(?:\.\d\w*)?)\b/; diag sprintf "Alien::proj %s with %s PROJ %s", Alien::proj->VERSION, Alien::proj->install_type, $version // ""; # need to run at least one test pass; done_testing; Geo-LibProj-FFI-1.01/t/distance.t000644 000765 000024 00000002201 14755373664 016104 0ustar00ajstaff000000 000000 #!perl use strict; use warnings; use lib 'lib'; use Test::More; use Test::Exception; my $no_warnings; use if $no_warnings = $ENV{AUTHOR_TESTING} ? 1 : 0, 'Test::Warnings'; # Distances # https://proj.org/development/reference/functions.html#distances plan tests => 4 + 7 + 2 + $no_warnings; use Geo::LibProj::FFI qw( :all ); my ($c, $p, $a, $b, $d); lives_and { ok $c = proj_context_create() } 'context_create'; lives_and { ok $p = proj_create($c, "EPSG:4979") } 'create'; lives_and { ok $a = proj_coord( .21, 1.3, 0, 0 ) } 'coord a'; lives_and { ok $b = proj_coord( -1.3, .68, 5, 0 ) } 'coord b'; # proj_lp_dist lives_ok { proj_lp_dist($p, $a, $b) } 'lp_dist'; # proj_lpz_dist lives_ok { proj_lpz_dist($p, $a, $b) } 'lpz_dist'; # proj_xy_dist lives_ok { $d = -1; $d = proj_xy_dist($a, $b) } 'xy_dist'; like $d, qr/^1\.6/, 'xy_dist ballpark'; # proj_xyz_dist lives_ok { $d = -1; $d = proj_xyz_dist($a, $b) } 'xyz_dist'; like $d, qr/^5\.2/, 'xyz_dist ballpark'; # proj_geod lives_ok { proj_geod($p, $a, $b) } 'geod'; lives_ok { proj_destroy($p) } 'destroy'; lives_ok { proj_context_destroy($c) } 'context_destroy'; done_testing; Geo-LibProj-FFI-1.01/t/types.t000644 000765 000024 00000047274 14755373664 015501 0ustar00ajstaff000000 000000 #!perl use strict; use warnings; use lib 'lib'; use Test::More; use Test::Exception; my $no_warnings; use if $no_warnings = $ENV{AUTHOR_TESTING} ? 1 : 0, 'Test::Warnings'; # Data types (particularly PJ_COORD) # https://proj.org/development/reference/datatypes.html plan tests => 13 + 13*2 + $no_warnings; use Geo::LibProj::FFI qw( :all ); # warnings::warnif_at_level workaround $SIG{'__WARN__'} = sub { warn shift if (caller 3)[0] !~ /^Geo::LibProj::FFI\b/ } if $^V lt v5.28; my ($a, $b, $c, $d, $v, $union, $struct); # PJ_COORD: constructors ($a, $b, $c, $d) = (12.5, -34.5, 67.5, -89.5); subtest 'PJ_LP new' => sub { plan tests => 2*3 + 4; no warnings 'deprecated'; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_LP->new(); } 'empty'; lives_and { is $struct->lam(), 0 } 'lam empty'; lives_and { is $struct->phi(), 0 } 'phi empty'; my $lp = { lam => $a, phi => $b }; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_LP->new({ lam => $a, phi => $b }); } 'new'; lives_and { is $struct->lam(), $a } 'lam'; lives_and { is $struct->phi(), $b } 'phi'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ lp => $lp }) } 'new union'; lives_and { is_deeply $union->v(), [$a, $b, 0, 0] } 'union array'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ lp => $struct }) } 'new union struct'; lives_and { is_deeply $union->v(), [$a, $b, 0, 0] } 'union struct array'; }; subtest 'PJ_XY new' => sub { plan tests => 2*3 + 4; no warnings 'deprecated'; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_XY->new(); } 'new empty'; is eval '$struct->x', 0, 'x empty'; is eval '$struct->y', 0, 'y empty'; my $xy = { 'x' => $a, 'y' => $b }; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_XY->new( $xy ); } 'new'; is eval '$struct->x', $a, 'x'; is eval '$struct->y', $b, 'y'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ xy => $xy }) } 'new union'; lives_and { is_deeply $union->v(), [$a, $b, 0, 0] } 'union array'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ xy => $struct }) } 'new union struct'; lives_and { is_deeply $union->v(), [$a, $b, 0, 0] } 'union struct array'; }; subtest 'PJ_UV new' => sub { plan tests => 2*3 + 4; no warnings 'deprecated'; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_UV->new(); } 'new empty'; lives_and { is $struct->u(), 0 } 'u empty'; lives_and { is $struct->v(), 0 } 'v empty'; my $uv = { u => $a, v => $b }; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_UV->new( $uv ); } 'new'; lives_and { is $struct->u(), $a } 'u'; lives_and { is $struct->v(), $b } 'v'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ uv => $uv }) } 'new union'; lives_and { is_deeply $union->v(), [$a, $b, 0, 0] } 'union array'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ uv => $struct }) } 'new union struct'; lives_and { is_deeply $union->v(), [$a, $b, 0, 0] } 'union struct array'; }; subtest 'PJ_LPZ new' => sub { plan tests => 2*4 + 4; no warnings 'deprecated'; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_LPZ->new(); } 'new empty'; lives_and { is $struct->lam(), 0 } 'lam empty'; lives_and { is $struct->phi(), 0 } 'phi empty'; lives_and { is $struct->z(), 0 } 'z empty'; my $lpz = { lam => $a, phi => $b, z => $c }; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_LPZ->new( $lpz ); } 'new'; lives_and { is $struct->lam(), $a } 'lam'; lives_and { is $struct->phi(), $b } 'phi'; lives_and { is $struct->z(), $c } 'z'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ lpz => $lpz }) } 'new union'; lives_and { is_deeply $union->v(), [$a, $b, $c, 0] } 'union array'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ lpz => $struct }) } 'new union struct'; lives_and { is_deeply $union->v(), [$a, $b, $c, 0] } 'union struct array'; }; subtest 'PJ_XYZ new' => sub { plan tests => 2*4 + 4; no warnings 'deprecated'; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_XYZ->new(); } 'new empty'; is eval '$struct->x', 0, 'x empty'; is eval '$struct->y', 0, 'y empty'; is eval '$struct->z', 0, 'z empty'; my $xyz = { 'x' => $a, 'y' => $b, 'z' => $c }; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_XYZ->new( $xyz ); } 'new'; is eval '$struct->x', $a, 'x'; is eval '$struct->y', $b, 'y'; is eval '$struct->z', $c, 'z'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ xyz => $xyz }) } 'new union'; lives_and { is_deeply $union->v(), [$a, $b, $c, 0] } 'union array'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ xyz => $struct }) } 'new union struct'; lives_and { is_deeply $union->v(), [$a, $b, $c, 0] } 'union struct array'; }; subtest 'PJ_UVW new' => sub { plan tests => 2*4 + 4; no warnings 'deprecated'; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_UVW->new(); } 'new empty'; lives_and { is $struct->u(), 0 } 'u empty'; lives_and { is $struct->v(), 0 } 'v empty'; lives_and { is $struct->w(), 0 } 'w empty'; my $uvw = { u => $a, v => $b, w => $c }; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_UVW->new( $uvw ); } 'new'; lives_and { is $struct->u(), $a } 'u'; lives_and { is $struct->v(), $b } 'v'; lives_and { is $struct->w(), $c } 'w'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ uvw => $uvw }) } 'new union'; lives_and { is_deeply $union->v(), [$a, $b, $c, 0] } 'union array'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ uvw => $struct }) } 'new union struct'; lives_and { is_deeply $union->v(), [$a, $b, $c, 0] } 'union struct array'; }; subtest 'PJ_LPZT new' => sub { plan tests => 2*5 + 4; no warnings 'deprecated'; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_LPZT->new(); } 'new empty'; lives_and { is $struct->lam(), 0 } 'lam empty'; lives_and { is $struct->phi(), 0 } 'phi empty'; lives_and { is $struct->z(), 0 } 'z empty'; lives_and { is $struct->t(), 0 } 't empty'; my $lpzt = { lam => $a, phi => $b, z => $c, t => $d }; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_LPZT->new( $lpzt ); } 'new'; lives_and { is $struct->lam(), $a } 'lam'; lives_and { is $struct->phi(), $b } 'phi'; lives_and { is $struct->z(), $c } 'z'; lives_and { is $struct->t(), $d } 't'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ lpzt => $lpzt }) } 'new union'; lives_and { is_deeply $union->v(), [$a, $b, $c, $d] } 'union array'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ lpzt => $struct }) } 'new union struct'; lives_and { is_deeply $union->v(), [$a, $b, $c, $d] } 'union struct array'; }; subtest 'PJ_XYZT new' => sub { plan tests => 2*5 + 4; no warnings 'deprecated'; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_XYZT->new(); } 'new empty'; is eval '$struct->x', 0, 'x empty'; is eval '$struct->y', 0, 'y empty'; is eval '$struct->z', 0, 'z empty'; is eval '$struct->t', 0, 't empty'; my $xyzt = { 'x' => $a, 'y' => $b, 'z' => $c, 't' => $d }; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_XYZT->new( $xyzt ); } 'new'; is eval '$struct->x', $a, 'x'; is eval '$struct->y', $b, 'y'; is eval '$struct->z', $c, 'z'; is eval '$struct->t', $d, 't'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ xyzt => $xyzt }) } 'new union'; lives_and { is_deeply $union->v(), [$a, $b, $c, $d] } 'union array'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ xyzt => $struct }) } 'new union struct'; lives_and { is_deeply $union->v(), [$a, $b, $c, $d] } 'union struct array'; }; subtest 'PJ_UVWT new' => sub { plan tests => 2*5 + 4; no warnings 'deprecated'; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_UVWT->new(); } 'new empty'; lives_and { is $struct->u(), 0 } 'u empty'; lives_and { is $struct->v(), 0 } 'v empty'; lives_and { is $struct->w(), 0 } 'w empty'; lives_and { is $struct->t(), 0 } 't empty'; my $uvwt = { u => $a, v => $b, w => $c, t => $d }; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_UVWT->new( $uvwt ); } 'new'; lives_and { is $struct->u(), $a } 'u'; lives_and { is $struct->v(), $b } 'v'; lives_and { is $struct->w(), $c } 'w'; lives_and { is $struct->t(), $d } 't'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ uvwt => $uvwt }) } 'new union'; lives_and { is_deeply $union->v(), [$a, $b, $c, $d] } 'union array'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ uvwt => $struct }) } 'new union struct'; lives_and { is_deeply $union->v(), [$a, $b, $c, $d] } 'union struct array'; }; subtest 'PJ_OPK new' => sub { plan tests => 2*4 + 4; no warnings 'deprecated'; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_OPK->new(); } 'new empty'; lives_and { is $struct->o(), 0 } 'o empty'; lives_and { is $struct->p(), 0 } 'p empty'; lives_and { is $struct->k(), 0 } 'k empty'; my $opk = { o => $a, p => $b, k => $c }; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_OPK->new( $opk ); } 'new'; lives_and { is $struct->o(), $a } 'o'; lives_and { is $struct->p(), $b } 'p'; lives_and { is $struct->k(), $c } 'k'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ opk => $opk }) } 'new union'; lives_and { is_deeply $union->v(), [$a, $b, $c, 0] } 'union array'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ opk => $struct }) } 'new union struct'; lives_and { is_deeply $union->v(), [$a, $b, $c, 0] } 'union struct array'; }; subtest 'PJ_ENU new' => sub { plan tests => 2*4 + 4; no warnings 'deprecated'; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_ENU->new(); } 'new empty'; lives_and { is $struct->e(), 0 } 'e empty'; lives_and { is $struct->n(), 0 } 'n empty'; lives_and { is $struct->u(), 0 } 'u empty'; my $enu = { e => $a, n => $b, u => $c }; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_ENU->new( $enu ); } 'new'; lives_and { is $struct->e(), $a } 'e'; lives_and { is $struct->n(), $b } 'n'; lives_and { is $struct->u(), $c } 'u'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ enu => $enu }) } 'new union'; lives_and { is_deeply $union->v(), [$a, $b, $c, 0] } 'union array'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ enu => $struct }) } 'new union struct'; lives_and { is_deeply $union->v(), [$a, $b, $c, 0] } 'union struct array'; }; subtest 'PJ_GEOD new' => sub { plan tests => 2*4 + 4; no warnings 'deprecated'; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_GEOD->new(); } 'new empty'; is eval '$struct->s', 0, 's empty'; is eval '$struct->a1', 0, 'a1 empty'; is eval '$struct->a2', 0, 'a2 empty'; my $geod = { 's' => $a, 'a1' => $b, 'a2' => $c }; lives_and { $struct = 0; ok $struct = Geo::LibProj::FFI::PJ_GEOD->new( $geod ); } 'new'; is eval '$struct->s', $a, 's'; is eval '$struct->a1', $b, 'a1'; is eval '$struct->a2', $c, 'a2'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ geod => $geod }) } 'new union'; lives_and { is_deeply $union->v(), [$a, $b, $c, 0] } 'union array'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ geod => $struct }) } 'new union struct'; lives_and { is_deeply $union->v(), [$a, $b, $c, 0] } 'union struct array'; }; subtest 'PJ_COORD new v' => sub { plan tests => 6; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new() } 'new empty'; is_deeply $union->v(), [0, 0, 0, 0], 'v empty'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ v => [] }) } 'new empty array'; is_deeply $union->v(), [0, 0, 0, 0], 'v empty array'; lives_ok { $union = 0; $union = Geo::LibProj::FFI::PJ_COORD->new({ v => [$a, $b, $c, $d] }) } 'new'; lives_and { is_deeply $union->v(), [$a, $b, $c, $d] } 'v array'; $union = proj_coord($a, $b, $c, $d) if ! $union; }; # PJ_COORD: read and write values lives_and { $struct = 0; ok $struct = $union->xyzt } 'xyzt'; subtest 'PJ_XYZT' => sub { plan skip_all => "(xyzt failed)" unless $struct; plan tests => 4*4; is $union->xyzt_x, $a, 'xyzt_x'; is $union->xyzt_y, $b, 'xyzt_y'; is $union->xyzt_z, $c, 'xyzt_z'; is $union->xyzt_t, $d, 'xyzt_t'; lives_ok { $union->xyzt_x(++$a) } 'inc xyzt_x'; lives_ok { $union->xyzt_y(++$b) } 'inc xyzt_y'; lives_ok { $union->xyzt_z(++$c) } 'inc xyzt_z'; lives_ok { $union->xyzt_t(++$d) } 'inc xyzt_t'; is eval '$struct->x', $a, 'x'; is eval '$struct->y', $b, 'y'; is eval '$struct->z', $c, 'z'; is eval '$struct->t', $d, 't'; lives_ok { eval '$struct->x('.++$a.')' } 'inc x'; lives_ok { eval '$struct->y('.++$b.')' } 'inc y'; lives_ok { eval '$struct->z('.++$c.')' } 'inc z'; lives_ok { eval '$struct->t('.++$d.')' } 'inc t'; }; lives_and { $struct = 0; ok $struct = $union->uvwt } 'uvwt'; subtest 'PJ_UVWT' => sub { plan skip_all => "(uvwt failed)" unless $struct; plan tests => 4*4; is $union->uvwt_u, $a, 'uvwt_u'; is $union->uvwt_v, $b, 'uvwt_v'; is $union->uvwt_w, $c, 'uvwt_w'; is $union->uvwt_t, $d, 'uvwt_t'; lives_ok { $union->uvwt_u(++$a) } 'inc uvwt_u'; lives_ok { $union->uvwt_v(++$b) } 'inc uvwt_v'; lives_ok { $union->uvwt_w(++$c) } 'inc uvwt_w'; lives_ok { $union->uvwt_t(++$d) } 'inc uvwt_t'; lives_and { is $struct->u(), $a } 'u'; lives_and { is $struct->v(), $b } 'v'; lives_and { is $struct->w(), $c } 'w'; lives_and { is $struct->t(), $d } 't'; lives_ok { $struct->u(++$a) } 'inc u'; lives_ok { $struct->v(++$b) } 'inc v'; lives_ok { $struct->w(++$c) } 'inc w'; lives_ok { $struct->t(++$d) } 'inc t'; }; lives_and { $struct = 0; ok $struct = $union->lpzt } 'lpzt'; subtest 'PJ_LPZT' => sub { plan skip_all => "(lpzt failed)" unless $struct; plan tests => 4*4; is $union->lpzt_lam, $a, 'lpzt_lam'; is $union->lpzt_phi, $b, 'lpzt_phi'; is $union->lpzt_z, $c, 'lpzt_z'; is $union->lpzt_t, $d, 'lpzt_t'; lives_ok { $union->lpzt_lam(++$a) } 'inc lpzt_lam'; lives_ok { $union->lpzt_phi(++$b) } 'inc lpzt_phi'; lives_ok { $union->lpzt_z(++$c) } 'inc lpzt_z'; lives_ok { $union->lpzt_t(++$d) } 'inc lpzt_t'; lives_and { is $struct->lam(), $a } 'lam'; lives_and { is $struct->phi(), $b } 'phi'; lives_and { is $struct->z(), $c } 'z'; lives_and { is $struct->t(), $d } 't'; lives_ok { $struct->lam(++$a) } 'inc lam'; lives_ok { $struct->phi(++$b) } 'inc phi'; lives_ok { $struct->z(++$c) } 'inc z'; lives_ok { $struct->t(++$d) } 'inc t'; }; lives_and { $struct = 0; ok $struct = $union->geod } 'geod'; subtest 'PJ_GEOD' => sub { plan skip_all => "(geod failed)" unless $struct; plan tests => 4*3; is $union->geod_s, $a, 'geod_s'; is $union->geod_a1, $b, 'geod_a1'; is $union->geod_a2, $c, 'geod_a2'; lives_ok { $union->geod_s(++$a) } 'inc geod_s'; lives_ok { $union->geod_a1(++$b) } 'inc geod_a1'; lives_ok { $union->geod_a2(++$c) } 'inc geod_a2'; is eval '$struct->s', $a, 's'; is eval '$struct->a1', $b, 'a1'; is eval '$struct->a2', $c, 'a2'; lives_ok { eval '$struct->s('.++$a.')' } 'inc s'; lives_ok { eval '$struct->a1('.++$b.')' } 'inc a1'; lives_ok { eval '$struct->a2('.++$c.')' } 'inc a2'; }; lives_and { $struct = 0; ok $struct = $union->opk } 'opk'; subtest 'PJ_OPK' => sub { plan skip_all => "(opk failed)" unless $struct; plan tests => 4*3; is $union->opk_o, $a, 'opk_o'; is $union->opk_p, $b, 'opk_p'; is $union->opk_k, $c, 'opk_k'; lives_ok { $union->opk_o(++$a) } 'inc opk_o'; lives_ok { $union->opk_p(++$b) } 'inc opk_p'; lives_ok { $union->opk_k(++$c) } 'inc opk_k'; lives_and { is $struct->o(), $a } 'o'; lives_and { is $struct->p(), $b } 'p'; lives_and { is $struct->k(), $c } 'k'; lives_ok { $struct->o(++$a) } 'inc o'; lives_ok { $struct->p(++$b) } 'inc p'; lives_ok { $struct->k(++$c) } 'inc k'; }; lives_and { $struct = 0; ok $struct = $union->enu } 'enu'; subtest 'PJ_ENU' => sub { plan skip_all => "(enu failed)" unless $struct; plan tests => 4*3; is $union->enu_e, $a, 'enu_e'; is $union->enu_n, $b, 'enu_n'; is $union->enu_u, $c, 'enu_u'; lives_ok { $union->enu_e(++$a) } 'inc enu_e'; lives_ok { $union->enu_n(++$b) } 'inc enu_n'; lives_ok { $union->enu_u(++$c) } 'inc enu_u'; lives_and { is $struct->e(), $a } 'e'; lives_and { is $struct->n(), $b } 'n'; lives_and { is $struct->u(), $c } 'u'; lives_ok { $struct->e(++$a) } 'inc e'; lives_ok { $struct->n(++$b) } 'inc n'; lives_ok { $struct->u(++$c) } 'inc u'; }; lives_and { $struct = 0; ok $struct = $union->xyz } 'xyz'; subtest 'PJ_XYZ' => sub { plan skip_all => "(xyz failed)" unless $struct; plan tests => 4*3; is $union->xyz_x, $a, 'xyz_x'; is $union->xyz_y, $b, 'xyz_y'; is $union->xyz_z, $c, 'xyz_z'; lives_ok { $union->xyz_x(++$a) } 'inc xyz_x'; lives_ok { $union->xyz_y(++$b) } 'inc xyz_y'; lives_ok { $union->xyz_z(++$c) } 'inc xyz_z'; is eval '$struct->x', $a, 'x'; is eval '$struct->y', $b, 'y'; is eval '$struct->z', $c, 'z'; lives_ok { eval '$struct->x('.++$a.')' } 'inc x'; lives_ok { eval '$struct->y('.++$b.')' } 'inc y'; lives_ok { eval '$struct->z('.++$c.')' } 'inc z'; }; lives_and { $struct = 0; ok $struct = $union->uvw } 'uvw'; subtest 'PJ_UVW' => sub { plan skip_all => "(uvw failed)" unless $struct; plan tests => 4*3; is $union->uvw_u, $a, 'uvw_u'; is $union->uvw_v, $b, 'uvw_v'; is $union->uvw_w, $c, 'uvw_w'; lives_ok { $union->uvw_u(++$a) } 'inc uvw_u'; lives_ok { $union->uvw_v(++$b) } 'inc uvw_v'; lives_ok { $union->uvw_w(++$c) } 'inc uvw_w'; lives_and { is $struct->u(), $a } 'u'; lives_and { is $struct->v(), $b } 'v'; lives_and { is $struct->w(), $c } 'w'; lives_ok { $struct->u(++$a) } 'inc u'; lives_ok { $struct->v(++$b) } 'inc v'; lives_ok { $struct->w(++$c) } 'inc w'; }; lives_and { $struct = 0; ok $struct = $union->lpz } 'lpz'; subtest 'PJ_LPZ' => sub { plan skip_all => "(lpz failed)" unless $struct; plan tests => 4*3; is $union->lpz_lam, $a, 'lpz_lam'; is $union->lpz_phi, $b, 'lpz_phi'; is $union->lpz_z, $c, 'lpz_z'; lives_ok { $union->lpz_lam(++$a) } 'inc lpz_lam'; lives_ok { $union->lpz_phi(++$b) } 'inc lpz_phi'; lives_ok { $union->lpz_z(++$c) } 'inc lpz_z'; lives_and { is $struct->lam(), $a } 'lam'; lives_and { is $struct->phi(), $b } 'phi'; lives_and { is $struct->z(), $c } 'z'; lives_ok { $struct->lam(++$a) } 'inc lam'; lives_ok { $struct->phi(++$b) } 'inc phi'; lives_ok { $struct->z(++$c) } 'inc z'; }; lives_and { $struct = 0; ok $struct = $union->xy } 'xy'; subtest 'PJ_XY' => sub { plan skip_all => "(xy failed)" unless $struct; plan tests => 4*2; is $union->xy_x, $a, 'xy_x'; is $union->xy_y, $b, 'xy_y'; lives_ok { $union->xy_x(++$a) } 'inc xy_x'; lives_ok { $union->xy_y(++$b) } 'inc xy_y'; is eval '$struct->x', $a, 'x'; is eval '$struct->y', $b, 'y'; lives_ok { eval '$struct->x('.++$a.')' } 'inc x'; lives_ok { eval '$struct->y('.++$b.')' } 'inc y'; }; lives_and { $struct = 0; ok $struct = $union->uv } 'uv'; subtest 'PJ_UV' => sub { plan skip_all => "(uv failed)" unless $struct; plan tests => 4*2; is $union->uv_u, $a, 'uv_u'; is $union->uv_v, $b, 'uv_v'; lives_ok { $union->uv_u(++$a) } 'inc uv_u'; lives_ok { $union->uv_v(++$b) } 'inc uv_v'; lives_and { is $struct->u(), $a } 'u'; lives_and { is $struct->v(), $b } 'v'; lives_ok { $struct->u(++$a) } 'inc u'; lives_ok { $struct->v(++$b) } 'inc v'; }; lives_and { $struct = 0; ok $struct = $union->lp } 'lp'; subtest 'PJ_LP' => sub { plan skip_all => "(lp failed)" unless $struct; plan tests => 4*2; is $union->lp_lam, $a, 'lp_lam'; is $union->lp_phi, $b, 'lp_phi'; lives_ok { $union->lp_lam(++$a) } 'inc lp_lam'; lives_ok { $union->lp_phi(++$b) } 'inc lp_phi'; lives_and { is $struct->lam(), $a } 'lam'; lives_and { is $struct->phi(), $b } 'phi'; lives_ok { $struct->lam(++$a) } 'inc lam'; lives_ok { $struct->phi(++$b) } 'inc phi'; }; lives_and { $v = 0; ok $v = $union->v } 'v'; subtest 'vector' => sub { plan skip_all => "(v failed)" unless $v; plan tests => 3; is_deeply $v, [$a, $b, $c, $d], 'v array'; lives_ok { $union->v([ ++$a, ++$b, ++$c, ++$d ]) } 'inc v'; is_deeply $union->v(), [37.5, -9.5, 86.5, -82.5], 'v array'; }; done_testing; Geo-LibProj-FFI-1.01/t/misc.t000644 000765 000024 00000001443 14755373664 015254 0ustar00ajstaff000000 000000 #!perl use strict; use warnings; use lib 'lib'; use Test::More; use Test::Exception; my $no_warnings; use if $no_warnings = $ENV{AUTHOR_TESTING} ? 1 : 0, 'Test::Warnings'; # Various # https://proj.org/development/reference/functions.html#various plan tests => 3 + $no_warnings; use Geo::LibProj::FFI qw( :all ); my ($a, $b, $c, $d, $v, $union); # proj_coord ($a, $b, $c, $d) = (12.5, -34.5, 67.5, -89.5); lives_and { ok $union = proj_coord($a, $b, $c, $d) } 'coord'; lives_and { $v = 0; ok $v = $union->v } 'v'; SKIP: { skip "(v failed)", 1 unless $v; is_deeply $v, [$a, $b, $c, $d], 'v array'; } # proj_roundtrip # proj_factors # proj_torad # proj_todeg # proj_dmstor # proj_rtodms # proj_angular_input # proj_angular_output # proj_degree_input # proj_degree_output done_testing; Geo-LibProj-FFI-1.01/t/context.t000644 000765 000024 00000001252 14755373664 016003 0ustar00ajstaff000000 000000 #!perl use strict; use warnings; use lib 'lib'; use Test::More; use Test::Exception; my $no_warnings; use if $no_warnings = $ENV{AUTHOR_TESTING} ? 1 : 0, 'Test::Warnings'; # Threading contexts # https://proj.org/development/reference/functions.html#threading-contexts plan tests => 3 + $no_warnings; use Geo::LibProj::FFI qw( :all ); my ($c); # proj_context_create lives_and { ok $c = proj_context_create() } 'context_create'; # proj_context_clone # proj_context_use_proj4_init_rules lives_ok { proj_context_use_proj4_init_rules($c, 1) } 'context_use_proj4_init_rules'; # proj_context_destroy lives_ok { proj_context_destroy($c) } 'context_destroy'; done_testing; Geo-LibProj-FFI-1.01/t/private.t000644 000765 000024 00000001350 14755373664 015770 0ustar00ajstaff000000 000000 #!perl use strict; use warnings; use lib 'lib'; use Test::More; use Test::Exception; my $no_warnings; use if $no_warnings = $ENV{AUTHOR_TESTING} ? 1 : 0, 'Test::Warnings'; # non-API functions # (not exported through :all) plan tests => 6 + $no_warnings; use Geo::LibProj::FFI qw( :all ); my ($p, $a); # _trans lives_and { ok $p = proj_create_crs_to_crs(0, "EPSG:4326", "EPSG:25833", 0) } 'create_crs_to_crs'; $a = [ 79, 12, 0, 0 ]; dies_ok { _trans( $p, PJ_FWD(), $a ) } 'trans not exported'; lives_and { ok $a = Geo::LibProj::FFI::_trans( $p, PJ_FWD(), $a ) } 'trans'; lives_and { like $a->[0], qr/^43612.\./ } 'easting'; lives_and { like $a->[1], qr/^877161.\./ } 'northing'; lives_ok { proj_destroy($p) } 'destroy'; done_testing; Geo-LibProj-FFI-1.01/t/lists.t000644 000765 000024 00000004103 14755373664 015453 0ustar00ajstaff000000 000000 #!perl use strict; use warnings; use lib 'lib'; use Test::More; use Test::Exception; my $no_warnings; use if $no_warnings = $ENV{AUTHOR_TESTING} ? 1 : 0, 'Test::Warnings'; # Lists # https://proj.org/development/reference/functions.html#lists plan tests => 4 + 6 + 6 + 6 + 4 + $no_warnings; use Geo::LibProj::FFI qw( :all ); my ($list, @e); # proj_list_operations lives_ok { $list = proj_list_operations() } 'list_operations'; ok scalar @$list > 1, 'list_operations multiple'; @e = grep {$_->{id} eq 'noop'} @$list; ok @e, 'list_operations id noop'; like ${$e[0]->{descr}}, qr/\bNo operation\b/i, 'list_operations descr'; # proj_list_ellps lives_ok { $list = proj_list_ellps() } 'list_ellps'; ok scalar @$list > 1, 'list_ellps multiple'; @e = grep {$_->{id} eq 'intl'} @$list; ok @e, 'list_ellps id intl'; like $e[0]->{name}, qr/\bHayford\b/i, 'list_ellps name'; like $e[0]->{major}, qr/\b6378388\b/, 'list_ellps major'; like $e[0]->{ell}, qr/\b297\b/, 'list_ellps major'; # proj_list_units lives_ok { $list = proj_list_units() } 'list_units'; ok scalar @$list > 1, 'list_units multiple'; @e = grep {$_->{id} eq 'm'} @$list; ok @e, 'list_units id m'; like $e[0]->{name}, qr/\bMeter\b/i, 'list_units name'; is $e[0]->{to_meter}, "1", 'list_units to_meter'; is $e[0]->{factor}, 1, 'list_units factor'; # proj_list_angular_units lives_ok { $list = proj_list_angular_units() } 'list_angular_units'; ok scalar @$list > 1, 'list_angular_units multiple'; @e = grep {$_->{id} eq 'deg'} @$list; ok @e, 'list_angular_units id deg'; like $e[0]->{name}, qr/\bDegree\b/i, 'list_angular_units name'; like $e[0]->{to_meter}, qr/^0\.0174/, 'list_angular_units to_meter ballpark'; like $e[0]->{factor}, qr/^0\.0174/, 'list_angular_units factor ballpark'; # proj_list_prime_meridians lives_ok { $list = proj_list_prime_meridians() } 'list_prime_meridians'; ok scalar @$list > 1, 'list_prime_meridians multiple'; @e = grep {$_->{id} eq 'greenwich'} @$list; ok @e, 'list_prime_meridians id lonlat'; is $e[0]->{defn}, "0dE", 'list_prime_meridians defn'; # the PROJ docs actually say it's .def, not .defn done_testing; Geo-LibProj-FFI-1.01/t/constants.t000644 000765 000024 00000001441 14755373664 016333 0ustar00ajstaff000000 000000 #!perl use strict; use warnings; use lib 'lib'; use Test::More; use Test::Exception; my $no_warnings; use if $no_warnings = $ENV{AUTHOR_TESTING} ? 1 : 0, 'Test::Warnings'; # Constants plan tests => 1 + 5 + 3 + $no_warnings; use Geo::LibProj::FFI qw( :all ); my ($a); lives_and { is eval "PJ_DEFAULT_CTX", 0 } 'PJ_DEFAULT_CTX'; # PJ_LOG_LEVEL lives_and { is eval "PJ_LOG_NONE", 0 } 'PJ_LOG_NONE'; lives_and { is eval "PJ_LOG_ERROR", 1 } 'PJ_LOG_ERROR'; lives_and { is eval "PJ_LOG_DEBUG", 2 } 'PJ_LOG_DEBUG'; lives_and { is eval "PJ_LOG_TRACE", 3 } 'PJ_LOG_TRACE'; lives_and { is eval "PJ_LOG_TELL", 4 } 'PJ_LOG_TELL'; # PJ_DIRECTION lives_and { is eval "PJ_FWD", 1 } 'PJ_FWD'; lives_and { is eval "PJ_IDENT", 0 } 'PJ_IDENT'; lives_and { is eval "PJ_INV", -1 } 'PJ_INV'; done_testing; Geo-LibProj-FFI-1.01/t/transform.t000644 000765 000024 00000001671 14755373664 016337 0ustar00ajstaff000000 000000 #!perl use strict; use warnings; use lib 'lib'; use Test::More; use Test::Exception; my $no_warnings; use if $no_warnings = $ENV{AUTHOR_TESTING} ? 1 : 0, 'Test::Warnings'; # Coordinate transformation # https://proj.org/development/reference/functions.html#coordinate-transformation plan tests => 2 + 4 + 2 + $no_warnings; use Geo::LibProj::FFI qw( :all ); my ($c, $p, $a); lives_and { ok $c = proj_context_create() } 'context_create'; lives_and { ok $p = proj_create_crs_to_crs($c, "EPSG:4326", "EPSG:25833", 0) } 'create_crs_to_crs'; # proj_trans lives_and { ok $a = proj_coord( 79, 12, 0, 0 ) } 'coord'; lives_and { ok $a = proj_trans( $p, PJ_FWD(), $a ) } 'trans'; lives_and { like $a->enu_e(), qr/^43612.\./ } 'easting'; lives_and { like $a->enu_n(), qr/^877161.\./ } 'northing'; # proj_trans_generic # proj_trans_array lives_ok { proj_destroy($p) } 'destroy'; lives_ok { proj_context_destroy($c) } 'context_destroy'; done_testing; Geo-LibProj-FFI-1.01/t/zz-cleanup.t000644 000765 000024 00000001146 14755373664 016411 0ustar00ajstaff000000 000000 #!perl use strict; use warnings; use lib 'lib'; use Test::More; use Test::Exception; my $no_warnings; use if $no_warnings = $ENV{AUTHOR_TESTING} ? 1 : 0, 'Test::Warnings'; # Cleanup # https://proj.org/development/reference/functions.html#cleanup plan tests => 1 + $no_warnings; use Geo::LibProj::FFI qw( :all ); my ($c, $p); eval { $c = proj_context_create(); proj_context_use_proj4_init_rules($c, 1); $p = proj_create_crs_to_crs($c, "+init=epsg:25832", "+init=epsg:25833", 0); proj_destroy($p) if $p; }; eval { proj_context_destroy($c) } if $c; lives_ok { proj_cleanup() } 'cleanup'; done_testing; Geo-LibProj-FFI-1.01/t/00-report-prereqs.t000644 000765 000024 00000013601 14755373664 017527 0ustar00ajstaff000000 000000 #!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.029 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec; # from $version::LAX my $lax_version_re = qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? | (?:\.[0-9]+) (?:_[0-9]+)? ) | (?: v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? | (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? ) )/x; # hide optional CPAN::Meta modules from prereq scanner # and check if they are available my $cpan_meta = "CPAN::Meta"; my $cpan_meta_pre = "CPAN::Meta::Prereqs"; my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic # Verify requirements? my $DO_VERIFY_PREREQS = 1; sub _max { my $max = shift; $max = ( $_ > $max ) ? $_ : $max for @_; return $max; } sub _merge_prereqs { my ($collector, $prereqs) = @_; # CPAN::Meta::Prereqs object if (ref $collector eq $cpan_meta_pre) { return $collector->with_merged_prereqs( CPAN::Meta::Prereqs->new( $prereqs ) ); } # Raw hashrefs for my $phase ( keys %$prereqs ) { for my $type ( keys %{ $prereqs->{$phase} } ) { for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; } } } return $collector; } my @include = qw( ); my @exclude = qw( ); # Add static prereqs to the included modules list my $static_prereqs = do './t/00-report-prereqs.dd'; # Merge all prereqs (either with ::Prereqs or a hashref) my $full_prereqs = _merge_prereqs( ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), $static_prereqs ); # Add dynamic prereqs to the included modules list (if we can) my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; my $cpan_meta_error; if ( $source && $HAS_CPAN_META && (my $meta = eval { CPAN::Meta->load_file($source) } ) ) { $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); } else { $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source) $source = 'static metadata'; } my @full_reports; my @dep_errors; my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; # Add static includes into a fake section for my $mod (@include) { $req_hash->{other}{modules}{$mod} = 0; } for my $phase ( qw(configure build test runtime develop other) ) { next unless $req_hash->{$phase}; next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); for my $type ( qw(requires recommends suggests conflicts modules) ) { next unless $req_hash->{$phase}{$type}; my $title = ucfirst($phase).' '.ucfirst($type); my @reports = [qw/Module Want Have/]; for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { next if grep { $_ eq $mod } @exclude; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; if ($mod eq 'perl') { push @reports, ['perl', $want, $]]; next; } my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; if ($prefix) { my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); $have = "undef" unless defined $have; push @reports, [$mod, $want, $have]; if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { if ( $have !~ /\A$lax_version_re\z/ ) { push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; } elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { push @dep_errors, "$mod version '$have' is not in required range '$want'"; } } } else { push @reports, [$mod, $want, "missing"]; if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { push @dep_errors, "$mod is not installed ($req_string)"; } } } if ( @reports ) { push @full_reports, "=== $title ===\n\n"; my $ml = _max( map { length $_->[0] } @reports ); my $wl = _max( map { length $_->[1] } @reports ); my $hl = _max( map { length $_->[2] } @reports ); if ($type eq 'modules') { splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; } else { splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; } push @full_reports, "\n"; } } } if ( @full_reports ) { diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; } if ( $cpan_meta_error || @dep_errors ) { diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n"; } if ( $cpan_meta_error ) { my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n"; } if ( @dep_errors ) { diag join("\n", "\nThe following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass('Reported prereqs'); # vim: ts=4 sts=4 sw=4 et: Geo-LibProj-FFI-1.01/t/00-report-prereqs.dd000644 000765 000024 00000003301 14755373664 017647 0ustar00ajstaff000000 000000 do { my $x = { 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '0' }, 'suggests' => { 'JSON::PP' => '2.27300' } }, 'develop' => { 'requires' => { 'Test::MinimumVersion' => '0', 'Test::More' => '0', 'Test::Pod' => '1.41' } }, 'runtime' => { 'requires' => { 'Alien::proj' => '1.07', 'Convert::Binary::C' => '0.04', 'Exporter::Easy' => '0', 'FFI::C' => '0.08', 'FFI::Platypus' => '1.50', 'perl' => 'v5.14.0' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900' }, 'requires' => { 'ExtUtils::MakeMaker' => '0', 'File::Spec' => '0', 'Test::Exception' => '0', 'Test::More' => '0', 'Test::Warnings' => '0.010' } } }; $x; }Geo-LibProj-FFI-1.01/t/info.t000644 000765 000024 00000005146 14755373664 015260 0ustar00ajstaff000000 000000 #!perl use strict; use warnings; use lib 'lib'; use Test::More; use Test::Exception; my $no_warnings; use if $no_warnings = $ENV{AUTHOR_TESTING} ? 1 : 0, 'Test::Warnings'; # Info functions # https://proj.org/development/reference/functions.html#info-functions plan tests => 9 + 8 + 10 + 6 + $no_warnings; use Geo::LibProj::FFI qw( :all ); my ($s, $p, $i); # proj_info lives_and { ok $i = proj_info() } 'info'; lives_and { ok $i->major > 4 } 'info major'; lives_and { ok $i->minor >= 0 } 'info minor'; lives_and { ok $i->patch >= 0 } 'info patch'; my $version = ''; eval { $version = $i->major . '.' . $i->minor . '.' . $i->patch }; diag "PROJ $version" if $ENV{AUTHOR_TESTING} || $ENV{AUTOMATED_TESTING}; lives_and { like $i->release, qr/\b\Q$version\E\b/ } 'info release'; lives_and { like $i->version, qr/^\Q$version\E\b/ } 'info version'; lives_and { like $i->searchpath, qr#\bAlien-proj\b|/proj\b# } 'info searchpath'; # These two are not publicly documented and always seem to return 0: lives_ok { $i->paths } 'info paths'; lives_ok { $i->path_count } 'info path_count'; # proj_pj_info $s = "proj=merc ellps=WGS84"; lives_and { ok $p = proj_create(0, $s) } 'proj_create'; SKIP: { skip "(proj_create failed)", 2 unless $p; lives_and { ok $i = proj_pj_info($p) } 'info'; lives_and { is $i->id(), "merc" } 'pj_info id'; lives_and { like $i->description(), qr/\bcoordinate op/ } 'pj_info description'; lives_and { is $i->definition(), $s } 'pj_info definition'; lives_and { is $i->has_inverse(), 1 } 'pj_info has_inverse'; lives_and { is $i->accuracy(), -1 } 'pj_info accuracy'; } lives_ok { proj_destroy($p) } 'proj_destroy'; # proj_grid_info $s = ""; lives_and { ok $i = proj_grid_info($s) } 'grid_info'; lives_and { is $i->gridname(), $s } 'grid_info gridname'; lives_and { like $i->filename(), qr/\Q$s\E$/ } 'grid_info filename'; lives_and { is $i->format(), "missing" } 'grid_info format'; lives_and { like ref($i->lowerleft), qr/\bPJ_COORD$/ } 'grid_info lowerleft'; lives_and { like ref($i->upperright), qr/\bPJ_COORD$/ } 'grid_info upperright'; lives_ok { $i->n_lon } 'grid_info n_lon'; lives_ok { $i->n_lat } 'grid_info n_lat'; lives_ok { $i->cs_lon } 'grid_info cs_lon'; lives_ok { $i->cs_lat } 'grid_info cs_lat'; # proj_init_info $s = "ITRF2014"; lives_and { ok $i = proj_init_info($s) } 'init_info'; lives_and { is $i->name(), $s } 'init_info name'; lives_and { like $i->filename(), qr/\Q$s\E$/ } 'init_info filename'; lives_ok { $i->version() } 'init_info version'; lives_ok { $i->origin() } 'init_info origin'; lives_and { like $i->lastupdate(), qr/^[0-9]{4}-[0-9]{2}-[0-9]{2}$/ } 'init_info lastupdate'; done_testing;