Geo-Gpx-1.11/0000775000175000017500000000000014636644166011056 5ustar patpatGeo-Gpx-1.11/Install0000644000175000017500000000156114636644166012410 0ustar patpatINSTALLATION Recommended Installation Method: The easiest way to install this distribution is from the Perl cpan shell. cpan[1]> install Geo::Gpx To install from the source files in the module's directory, run the following commands: perl Makefile.PL make make test make install Alternatively, to install with Module::Build, you can use the following commands: perl Build.PL ./Build ./Build test ./Build install Installing from the Github Repository: If you cloned or downloaded a release from the Github repository, please install using the Makefile.PL provided. The Build.PL file is not maintained on Github, it is automatically generated by the Dist::Zilla distribution management tool when releasing a new version on CPAN. Installation using Dist::Zilla is for code maitainers and is not supported. DEPENDENCIES See the README.md Geo-Gpx-1.11/Changes0000644000175000017500000001034514636644166012352 0ustar patpatRevision history for Geo-Gpx 1.11 [2024-06-25] The encoding of entities in xml() and save() has a new default: - only the <, >, &, and " characters are now encoded by default with HTML::Entities - key implication is that most multi-byte unicode characters are left as-is and no longer encoded as entities - users can revert to the previous default (which is equivalent to that of HTML::Entities) by explicitly setting unsafe_chars => undef Version argument in xml() is now implemented as key/value pair instead of a positional parameter 1.10 [2023-11-25] New methods for waypoints: - waypoint_rename(), waypoints_print(), - waypoints_clip() -- only supported on systems with the xclip utility New methods for tracks: - track_rename(), track_delete(), tracks_delete_all(), tracks_print() New method for routes: - routes_delete_all Fixed error when a filehandle is used as input 1.09 [2022-12-06] Fixed bug in parsing absolute and relative paths in MSWin32 1.08 [2022-12-03] Removed Geo::Calc from dependencies and added Math::Trig 1.07 [2022-10-26] Removed > 15 year old legacy bits likely to conflict with newly added support for tracks and routes 1.06 [2022-10-25] Added method Geo::Gpx::Point->time_datetime() returning a DateTime object corresponding to the time of a point Removed use_datetime option in Geo::Gpx->new() in favour of the new Geo::Gpx::Point method above 1.05 [2022-10-23] Various new methods for waypoints: - waypoints_search(), waypoints_merge(), waypoints_count(), waypoints_delete_all(), waypoint_delete(), waypoint_closest_to() Other new methods: routes_count(), tracks_count(), 1.04 [2022-10-20] The waypoints() method now gets but no longer sets: - call waypoints_add() to set instead - users would need to replace calls to waypoints with waypoints_add but only if they were setting Renamed method waypoints_add(), was add_waypoint(): - this change was necessary for consistency in method naming - users should replace all calls to add_waypoint with waypoints_add New methods to replace current accessors: routes(), tracks() New methods: routes_add(), tracks_add(), clone() 1.03 [2022-10-16] new()'s 'input' key now accepts a filename as argument and a work_dir key can be specified to set the instance's working directory. Has no effect on the caller's current working directory. Added methods set_filename(), set_wd() and save(). 1.02 [2022-10-10] Switched to Dist::Zilla to manage and release the module 1.01 [2022-10-08] fixed missing dependencies in Makefile.PL and Build.PL: - Geo::Calc - Geo::Coordinates::Transform 1.00 [2022-10-07] Added Geo/Gpx/Point.pm: a new class to store and edit GPX points Initialize points with Geo::Gpx::Point->new() objects 0.26 2009-05-26 Move to GitHub 0.25 2009-05-05 Implement time zone support. Refs #28532. 0.24 2009-03-10 Avoid clock skew in JSON tests. 0.23 2009-03-08 Skip JSON tests if installed JSON is too old. 0.22 2009-03-08 Always use UTC for timestamps. Refs #34463. Make bounds work as documented. Add TO_JSON support for JSON encoding. Refs #34458. Thanks to Steve Purkis. 0.21 2007-10-13 0.20 2007-10-11 Release to (hopefully) fix bizarre test failures. 0.19 2007-10-11 Fixed wpt element ordering per #29909 0.18 2007-08-07 Replaced AUTOLOAD with generated accessors. Added bd foy's suggested add_waypoint method. 0.17 2007-02-23 Added machine readable licence. 0.16 2007-02-11 Fixed idiotic dependency on rand producing the same values given the same seed on all platforms. 0.15 2006-12-14 Minor documentation typos fixed. Fixed problems due to differing numeric precision on different platforms in t/03.gen-parse.t and t/04.legacy.t 0.14 2006-12-12 Added support for 'input' option that is passed through unchanged to XML::Descent. The old 'xml' option is still supported for legacy use. 0.13 2006-11-26 Implement complete support for parsing and generating GPX 1.0 and 1.1 documents Geo-Gpx-1.11/t/0000775000175000017500000000000014636644166011321 5ustar patpatGeo-Gpx-1.11/t/set.t0000644000175000017500000000614114636644166012301 0ustar patpat# t/set.t - set_* methods (for Gpx.pm) use strict; use warnings; use Test::More tests => 22; use Geo::Gpx; use File::Temp qw/ tempfile tempdir /; use Cwd qw(cwd abs_path); my $cwd = abs_path( cwd() ); my $tmp_dir = tempdir( CLEANUP => 1 ); my $o = Geo::Gpx->new( input => 't/larose_wpt.gpx'); isa_ok ($o, 'Geo::Gpx'); # # set_filename() mkdir 't/test_set_filename'; my $fname_initial = $o->set_filename(); my $wd_initial = $o->set_wd(); my $tmp_dir_str = $tmp_dir; $tmp_dir_str =~ s,\\,/,g if $^O eq 'MSWin32'; is($o->set_filename('foo.txt'), $cwd . '/t/foo.txt', " set_filename(): should be in same folder"); is($o->set_filename('test_set_filename/foo.txt'), $cwd . '/t/test_set_filename/foo.txt'," set_filename(): should be in folder one level up"); is($o->set_filename('./foo.txt'), $cwd . '/t/foo.txt', " set_filename(): should be in same folder"); is($o->set_filename('../foo.txt'), $cwd . '/foo.txt', " set_filename(): should be up one folder levels"); if ($^O eq 'darwin') { is($o->set_filename($tmp_dir . '/foo.txt'), '/private' . $tmp_dir . '/foo.txt', " set_filename(): with an absolute path"); } else { is($o->set_filename($tmp_dir . '/foo.txt'), $tmp_dir_str . '/foo.txt', " set_filename(): with an absolute path"); } is($o->set_wd(), $cwd . '/t/', " set_wd(): work_dir should not have changed throughout"); is($o->set_wd('test_set_filename'), $cwd . '/t/test_set_filename/', " set_wd(): going down 2-levels so we can then test saving a file up 2-levels"); is($o->set_filename('../../foo.txt'), $cwd . '/foo.txt', " set_filename(): should be up two folder levels"); is($o->set_filename($fname_initial), $cwd . '/t/larose_wpt.gpx', " set_filename(): back to original name"); # # set_wd() is($o->set_wd($wd_initial), $cwd . '/t/', " set_wd(): back to initial working directory"); is($o->set_wd(), $cwd . '/t/', " set_wd(): get the working directory"); is($o->set_wd($tmp_dir), $tmp_dir . '/', " set_wd(): set the working directory"); is($o->set_wd(' - '), $cwd . '/t/', " set_wd(): and _set_wd_old(): return to the previous working directory"); is($o->set_wd('..'), $cwd . '/', " set_wd(): up a level"); is($o->set_wd(' - '), $cwd . '/t/', " set_wd(): and _set_wd_old(): return to the previous working directory"); is($o->set_wd('test_set_filename'), $cwd . '/t/test_set_filename/', " set_wd(): down 2 levels"); is($o->set_wd('../..'), $cwd . '/', " set_wd(): up 2 levels"); is($o->set_wd('t'), $cwd . '/t/', " set_wd(): relative path to set the working directory"); is($o->set_wd('-'), $cwd . '/', " set_wd(): and _set_wd_old(): return to the previous working directory"); is($o->set_wd('./'), $cwd . '/', " set_wd(): same working directory"); is($o->set_wd($wd_initial), $cwd . '/t/', " set_wd(): back to initial working directory"); rmdir 't/test_set_filename'; print "so debugger doesn't exit\n"; Geo-Gpx-1.11/t/pod.t0000644000175000017500000000021414636644166012263 0ustar patpat#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Geo-Gpx-1.11/t/misc.t0000644000175000017500000000521314636644166012440 0ustar patpatuse strict; use warnings; use Test::More tests => 9; use Geo::Gpx; my $time = time(); my @wpt = ( Geo::Gpx::Point->new ( ( # All standard GPX fields lat => 54.786989, lon => -2.344214, ele => 512, time => $time, magvar => 0, geoidheight => 0, name => 'My house & home', cmt => 'Where I live', desc => '<>', src => 'Testing', link => { href => 'http://hexten.net/', text => 'Hexten', type => 'Blah' }, sym => 'pin', type => 'unknown', fix => 'dgps', sat => 3, hdop => 10, vdop => 10, pdop => 10, ageofdgpsdata => 45, dgpsid => 247 )), Geo::Gpx::Point->new ( ( # Fewer fields lat => -38.870059, lon => -151.210030, name => 'Sydney, AU' )), ); { my $gpx = new Geo::Gpx; $gpx->waypoints_add( @wpt ); is_deeply $gpx->waypoints, \@wpt, "waypoints_add adds waypoints"; } { my $gpx = new Geo::Gpx; eval { $gpx->waypoints_add( [] ) }; like $@, qr/waypoint argument must be a hash reference/, "type check OK"; } { for my $wpt ( {}, { lat => 1 }, { lon => 1 } ) { my $gpx = new Geo::Gpx; eval { $gpx->waypoints_add( $wpt ) }; like $@, qr/mandatory in waypoint/, "mandatory lat, lon OK"; } } { my $gpx = Geo::Gpx->new; $gpx->waypoints_add( @wpt ); my $bounds = { 'maxlat' => 54.786989, 'maxlon' => -2.344214, 'minlat' => -38.870059, 'minlon' => -151.21003, }; is_deeply $gpx->bounds, $bounds, "gpx->bounds doesn't require an iterator"; } { my $gpx = Geo::Gpx->new; # Violate encapsulation, avoid clock skew. $gpx->{time} = $time; $gpx->waypoints_add( @wpt ); my $expect = { waypoints => \@wpt, bounds => { 'maxlat' => 54.786989, 'maxlon' => -2.344214, 'minlat' => -38.870059, 'minlon' => -151.21003, }, time => $time, }; is_deeply $gpx->TO_JSON, $expect, "TO_JSON"; $gpx->name( 'spurkis' ); $expect->{name} = 'spurkis'; is_deeply $gpx->TO_JSON, $expect, "TO_JSON now has a name"; SKIP: { eval "use JSON"; skip 'JSON not installed', 1 if $@; my $coder = JSON->new; my @need = qw( encode decode allow_blessed convert_blessed ); for my $method ( @need ) { skip "JSON doesn't support $method", 1 unless $coder->can( $method ); } $coder->allow_blessed->convert_blessed; my $json = $coder->decode( $coder->encode( $gpx ) ); my $json2 = $coder->decode( $coder->encode( $expect ) ); is_deeply $json, $json2, "works with JSON module"; } } Geo-Gpx-1.11/t/time.t0000644000175000017500000001451314636644166012446 0ustar patpat# t/time.t use DateTime; use DateTime::Format::ISO8601; use Geo::Gpx; use Geo::Gpx::Point; use Test::More tests => 18; my ($dt_t, $dt_u); $dt_t = DateTime->new( year => 2022, month => 10, day => 25, hour => 9, minute => 45, second => 0, time_zone => 'America/Toronto', ); $dt_u = DateTime->new( year => 2022, month => 10, day => 25, hour => 9, minute => 45, second => 0, time_zone => 'UTC', ); # # Show that epoch time is "unique" and always reflects UTC time my $epoch_diff_t_vs_u = ($dt_t->epoch - $dt_u->epoch) / 3600; is($epoch_diff_t_vs_u, 4, " time(): same hour and minute b/w EST (in DST) and UTC should be 4 hours appart, epoch wise"); is($dt_t->stringify, '2022-10-25T09:45:00', " stringify(): produce time as a string in local timezone (unless time_zone specified in DT object)"); is($dt_u->stringify, '2022-10-25T09:45:00', " stringify(): produce time as a string in local timezone (unless time_zone specified in DT object)"); my ($dt_min4, $dt_min4_z); $dt_min4 = DateTime::Format::ISO8601->parse_datetime('2022-10-25T09:45:00-04:00'); $dt_min4_z = DateTime::Format::ISO8601->parse_datetime('2022-10-25T13:45:00Z'); my $epoch_diff_min4_vs_z = ($dt_min4->epoch - $dt_min4_z->epoch) / 3600; is($epoch_diff_min4_vs_z, 0, " time(): should produce same value for epoch in Gpx and Gpx::Point constructors"); is($dt_min4->stringify, '2022-10-25T09:45:00', " stringify(): produce time as a string in local timezone"); is($dt_min4_z->stringify, '2022-10-25T13:45:00', " stringify(): produce time as a string in local timezone (Z as same effect it seems as specifying time_zone => 'UTC'"); # # Test that Geo::Gpx->new() and Geo::Gpx::Point-new() parse date strings the same way # First, NB that within tags in the xml, the date is *always* a string, never epoch i.e. # my $xml_fail = ''; # my $gpx_fail = Geo::Gpx->new( xml => $xml_fail ); # would return Invalid date format: 1666705500 (as expected) # ... but Point's new() constructor is more flexibile, also accepts an epoch (see below) my $xml = do { local $/; }; my $gpx = Geo::Gpx->new( xml => $xml ); # creating these same 4 points individually with Point->new(), should yield the same results my $pt1 = Geo::Gpx::Point->new( lat => '54.786989', lon => '-2.344214', time => '2022-10-25T09:45-04:00' ); my $pt2 = Geo::Gpx::Point->new( lat => '54.786989', lon => '-2.344214', time => '2022-10-25T13:45' ); my $pt3 = Geo::Gpx::Point->new( lat => '54.786989', lon => '-2.344214', time => '2022-10-25T13:45Z' ); my $pt4 = Geo::Gpx::Point->new( lat => '54.786989', lon => '-2.344214', time => 1666705500 ); # NB: can specify time as epoch in ::Point constructor but epoch cannot appear in xml mark-up is($gpx->waypoints(1)->time, $pt1->time, " time(): should produce same value for epoch in Gpx and Gpx::Point constructors"); is($gpx->waypoints(2)->time, $pt2->time, " time(): should produce same value for epoch in Gpx and Gpx::Point constructors"); is($gpx->waypoints(3)->time, $pt3->time, " time(): should produce same value for epoch in Gpx and Gpx::Point constructors"); is($gpx->waypoints(4)->time, $pt4->time, " time(): should produce same value for epoch in Gpx and Gpx::Point constructors"); # stringification of the points is done in perspective of the local time (**unless** time_zone is specified in DT object). The # DateTime manpage states the from_epoch() method creates a DT object **with** a time_zone, which is time_zone => 'UTC' as the default, # so the stringification of the DT object returned by Point->time_datetime() will represent UTC time and not local time (for the same epoch). # If a a differe time_zone is specified upon construction, the string will represent the time of that time_zone my $str1 = $pt1->time_datetime->stringify; my $str2 = $pt2->time_datetime->stringify; my $str3 = $pt3->time_datetime->stringify; my $str4 = $pt4->time_datetime->stringify; is($str1, '2022-10-25T13:45:00', " stringify(): produce time as a string in local timezone (unless time_zone specified in DT object)"); is($str2, '2022-10-25T13:45:00', " stringify(): produce time as a string in local timezone (unless time_zone specified in DT object)"); is($str3, '2022-10-25T13:45:00', " stringify(): produce time as a string in local timezone (unless time_zone specified in DT object)"); is($str4, '2022-10-25T13:45:00', " stringify(): produce time as a string in local timezone (unless time_zone specified in DT object)"); my $str5 = $pt1->time_datetime( time_zone => 'America/Toronto' )->stringify; my $str6 = $pt2->time_datetime( time_zone => 'America/Toronto' )->stringify; my $str7 = $pt3->time_datetime( time_zone => 'America/Toronto' )->stringify; my $str8 = $pt4->time_datetime( time_zone => 'America/Toronto' )->stringify; is($str5, '2022-10-25T09:45:00', " stringify(): produce time as a string in local timezone (unless time_zone specified in DT object)"); is($str6, '2022-10-25T09:45:00', " stringify(): produce time as a string in local timezone (unless time_zone specified in DT object)"); is($str7, '2022-10-25T09:45:00', " stringify(): produce time as a string in local timezone (unless time_zone specified in DT object)"); is($str8, '2022-10-25T09:45:00', " stringify(): produce time as a string in local timezone (unless time_zone specified in DT object)"); # Add a lot of check, questions, etc. # # TODO: then document that Gpx has _parse_time becaseu need to parse time for other things than points, tracks, routes, etc. print "so debug doesn't exit\n"; __DATA__ Test Geo-Gpx-1.11/t/_xml.t0000644000175000017500000001014214636644166012441 0ustar patpat# t/_xml.t - test _xml(), _tag(), _enc(), all methods called by xml() use strict; use warnings; use Test::More tests => 7; use Geo::Gpx; use File::Temp qw/ tempfile tempdir /; use Cwd qw(cwd abs_path); my $cwd = abs_path( cwd() ); my $tmp_dir = tempdir( CLEANUP => 1 ); my $o = Geo::Gpx->new( input => 't/larose_wpt.gpx'); isa_ok ($o, 'Geo::Gpx'); # a waypoint we can use for tests, but let's add some unicode to it my $pt = $o->waypoints( name => 'LP1' ); $pt->desc( 'Larose P1 - Limoges - Stationnement & début des trails' ); # just a temporary call to xml() -- so we can put breakpoint in *.pm and see what the argument are where for calls we want to test # $o->xml(); # # _tag() -- as called by _xml() # . with a non-empty href my $uc = '<>&"'; # same as the default ($unsafe_chars_default), could test with other values for $uc my $tag = 'wpt'; my $attr = { 'lat' => $pt->lat, 'lon' => $pt->lon }; my @cont = ( "\n", "" . $pt->ele . "\n", "" . $pt->name . "\n", "" . $pt->cmt . "\n", "" . $pt->desc . "\n", "" . $pt->sym . "\n", "" . $pt->extensions . "\n" ); my $expect_tag = '" . join( '', @cont ) . "\n"; my $return_tag = Geo::Gpx::_tag( $uc, $tag, $attr, @cont ); is($return_tag, $expect_tag, " _tag(): as called by _xml() with a non-empty href"); # . with an empty href $tag = 'desc'; @cont = 'Larose P1 - Limoges'; $expect_tag = "Larose P1 - Limoges\n"; $return_tag = Geo::Gpx::_tag( $uc, $tag, {}, @cont ); is($return_tag, $expect_tag, " _tag(): as called by _xml() with an empty href"); # # _tag() -- as called by itself # . with an empty href $tag = 'name'; my $value = 'α β\' è γ'; $expect_tag = "α β' è γ\n"; $return_tag = Geo::Gpx::_tag( $uc, $tag, {}, Geo::Gpx::_enc( $value, $uc ) ); is($return_tag, $expect_tag, " _tag(): as called by itself with an empty href"); # # _xml() -- as called by xml() # . with a href (e.g. a Geo::Gpx::Point) my $name = 'wpt'; # we expect same output as a call to _tag() above: @cont = ( "\n", "" . $pt->ele . "\n", "" . $pt->name . "\n", "" . $pt->cmt . "\n", "" . $pt->desc . "\n", "" . $pt->sym . "\n", "" . $pt->extensions . "\n" ); my $expect__xml = '" . join( '', @cont ) . "\n"; $expect__xml =~ s/\&/&/; my $return__xml = $o->_xml( $uc, $name, $pt ); is($return__xml, $expect__xml, " _xml(): as called by xml() with a href as \$value"); # . with an aref $name = 'wpt'; $value = [ $o->waypoints_search( desc => qr/Limoges/ ) ]; my $name_map = { 'waypoints' => 'wpt' }; my @cont0 = ( "\n", "" . $value->[0]->ele . "\n", "" . $value->[0]->name . "\n", "" . $value->[0]->cmt . "\n", "" . $value->[0]->desc . "\n", "" . $value->[0]->sym . "\n", "" . $value->[0]->extensions . "\n" ); my @cont1 = ( "\n", "" . $value->[1]->ele . "\n", "" . $value->[1]->name . "\n", "" . $value->[1]->cmt . "\n", "" . $value->[1]->desc . "\n", "" . $value->[1]->sym . "\n", "" . $value->[1]->extensions . "\n" ); $expect__xml = '" . join( '', @cont0 ) . "\n" . '" . join( '', @cont1 ) . "\n"; $expect__xml =~ s/\&/&/; $return__xml = $o->_xml( $uc, $name, $value, $name_map ); is($return__xml, $expect__xml, " _xml(): as called by xml() with an aref as \$value"); # . with a scalar $name = 'desc'; $value = 'Larose P1 - Limoges'; $expect__xml= "Larose P1 - Limoges\n"; $return__xml = $o->_xml( $uc, $name, $value ); is($return__xml, $expect__xml, " _xml(): as called by _xml() with a scalar as \$value"); print "so debugger doesn't exit\n"; Geo-Gpx-1.11/t/iter.t0000644000175000017500000000134314636644166012450 0ustar patpat# Test private iterator primitives use Test::More tests => 4; BEGIN { use_ok( 'Geo::Gpx' ); } my @ar1 = ( 1, 2, 3 ); my @ar2 = ( 4, 5, 6 ); my @ar3 = ( @ar1, @ar2 ); sub drain_iter { my $iter = shift; my @ar = (); while ( my $el = $iter->() ) { push @ar, $el; } return @ar; } my @r1 = drain_iter( Geo::Gpx::_iterate_points( \@ar1 ) ); is_deeply( \@r1, \@ar1, '_iterate_points' ); my $i1 = Geo::Gpx::_iterate_points( \@ar1 ); my $i2 = Geo::Gpx::_iterate_points( \@ar2 ); my @r2 = drain_iter( Geo::Gpx::_iterate_iterators( $i1, $i2 ) ); is_deeply( \@r2, \@ar3, '_iterate_iterators' ); my $gpx = Geo::Gpx->new(); # Empty my @r3 = drain_iter( $gpx->iterate_points() ); is( scalar( @r3 ), 0, 'empty iterator' ); Geo-Gpx-1.11/t/point.t0000644000175000017500000000425414636644166012642 0ustar patpat# t/05_point.t - test file for Geo::Gpx::Point use strict; use warnings; use Test::More tests => 11; use Geo::Gpx::Point; my %point_fields = ( lat => 45.483419, lon => 75.848268, ele => 260.91, name => 'MacKing', desc => "Mackenzie King Estate"); my $pt = Geo::Gpx::Point->new( %point_fields ); isa_ok ($pt, 'Geo::Gpx::Point'); # # clone() my $cl = $pt->clone; isa_ok ($cl, 'Geo::Gpx::Point'); # the following change would make desc test below fail if clone() did not work properly $cl->desc('clone now is amnesiac, where was this?'); is ($cl->desc, 'clone now is amnesiac, where was this?', " test clone() and desc field"); # # to_geocalc() # enable this test but skip if Geo::Calc is not available # my $gc = $pt->to_geocalc(); # isa_ok ($gc, 'Geo::Calc'); # # to_geocalc() # enable this test but skip if Geo::TCX is not available # my $tcx = $pt->to_tcx(); # isa_ok ($tcx, 'Geo::TCX::Trackpoint'); # # test other fields is ($pt->desc, 'Mackenzie King Estate', " test desc field"); # # flex_coordinates() my @lusk_cave = qw/ 45.5832 75.9816 /; my $msa = \'47.0871 -70.9318'; my $pt_lc = Geo::Gpx::Point->flex_coordinates(@lusk_cave, ele => 503 ); my $pt_msa = Geo::Gpx::Point->flex_coordinates($msa, desc => 'Mont Ste-Anne' ); isa_ok ($pt_lc, 'Geo::Gpx::Point'); isa_ok ($pt_msa, 'Geo::Gpx::Point'); is ($pt_lc->ele, '503', " test for ele field"); is ($pt_msa->desc, 'Mont Ste-Anne', " test for desc field"); my $lat = q/ N45 32.298 /; my $lon = q/ W75 52.066 /; my @ruins = ( $lat, $lon); my $pt_ruins = Geo::Gpx::Point->flex_coordinates(@ruins); isa_ok ($pt_ruins, 'Geo::Gpx::Point'); # # distance_to() my ($some_pt, $p4, $dist); $some_pt = Geo::Gpx::Point->new( lat => 45.405441, lon => -75.137497 ); $p4 = Geo::Gpx::Point->new( lat => 45.404692031443119, lon=> -75.140401963144541 ); $dist = $some_pt->distance_to( $p4 ); is($dist, 241.593745, " distance_to(): we get the expected distance"); $dist = $some_pt->distance_to( $p4, dec => 2 ); is($dist, 241.59, " distance_to(): we get the expected no of decimal points"); # # Parking lot and other methods I could develop print "so debugger doesn't exit\n"; Geo-Gpx-1.11/t/00_load.t0000644000175000017500000000015614636644166012724 0ustar patpatuse Test::More tests => 1; BEGIN { use_ok( 'Geo::Gpx' ); } diag( "Testing Geo::Gpx $Geo::Gpx::VERSION" ); Geo-Gpx-1.11/t/cmp_ver.t0000644000175000017500000000054114636644166013137 0ustar patpat# Test version comparison use Test::More tests => 2; BEGIN { use_ok( 'Geo::Gpx' ); } my @ok = qw( 0.0.0.0.0.1 0.0.0.0.0.2 1 1.0 1.0.1 1.1 2 2.1 2.99 2.100 3 10.1 ); # Mix them up my @m = sort { $b cmp $a } @ok; # Sort them according to _cmp_ver my @got = sort { Geo::Gpx::_cmp_ver( $a, $b ) } @m; is_deeply( \@got, \@ok, 'version ordering' ); Geo-Gpx-1.11/t/01_main.t0000644000175000017500000002372514636644166012741 0ustar patpat# t/01_main.t - main testing file (for Gpx.pm) use strict; use warnings; use Test::More tests => 38; use Geo::Gpx; use File::Temp qw/ tempfile tempdir /; use Cwd qw(cwd abs_path); my $cwd = abs_path( cwd() ); my $tmp_dir = tempdir( CLEANUP => 1 ); my $href_chez_andy = { lat => 54.786989, lon => -2.344214, ele => 512, time => 1164488503, magvar => 0, geoidheight => 0, name => 'My house & home', cmt => 'Where I live', desc => '<>', src => 'Testing', link => { href => 'http://hexten.net/', text => 'Hexten', type => 'Blah' }, sym => 'Flag, Green', type => 'unknown', fix => 'dgps', sat => 3, hdop => 10, vdop => 10, pdop => 10, ageofdgpsdata => 45, dgpsid => 247 }; my $href_chez_pat = { lat => 45.93789, lon => -75.85077, lon => -2.344214, ele => 550, time => 1167813923, magvar => 0, geoidheight => 0, name => 'Atop Radar Road', cmt => 'This key is cmt', desc => '<>', src => 'Testing', sym => 'pin', type => 'unknown', fix => 'dgps', sat => 3, hdop => 10, vdop => 10, pdop => 10, ageofdgpsdata => 54, dgpsid => 247 }; my $href_chez_kaz = { lat => 45.94636, lon => -76.01154, 'sym' => 'Parking Area' }; my $o = Geo::Gpx->new(); isa_ok ($o, 'Geo::Gpx'); $o->waypoints_add( $href_chez_andy, $href_chez_pat ); $o->waypoints_add( $href_chez_kaz ); # # Section A - Constructor # new(): from filename (file with only waypoints) my $fname_wpt1 = 't/larose_wpt.gpx'; my $o_wpt_only1 = Geo::Gpx->new( input => "$fname_wpt1" ); isa_ok ($o_wpt_only1, 'Geo::Gpx'); # new(): from filename (file with only trackpoints) my $fname_trk1 = 't/larose_trk1.gpx'; my $o_trk_only1 = Geo::Gpx->new( input => "$fname_trk1" ); isa_ok ($o_trk_only1, 'Geo::Gpx'); my $fname_trk2 = 't/larose_trk2.gpx'; my $o_trk_only2 = Geo::Gpx->new( input => "$fname_trk2" ); isa_ok ($o_trk_only2, 'Geo::Gpx'); # new(): from filehandle open( my $fh , '<', $fname_wpt1 ) or die "can't open file $fname_wpt1 $!"; my $o_from_fh = Geo::Gpx->new( input => $fh ); isa_ok ($o_from_fh, 'Geo::Gpx'); # NextSteps: create a new empty gpx file, add the waypoints, add a track, then add another track (do we have a method to add another track like waypoints_add() # # Section B - Object Methods # *_count() accessors: is($o_trk_only1->waypoints_count, 0, " waypoints_count(): test the number of waypoints found"); is($o->routes_count, 0, " routes_count(): test the number of routes found"); is($o->tracks_count, 0, " tracks_count(): test the number of tracks found"); # waypoints_add(): will likely rename waypoints_add() my %point = ( lat => 54.786989, lon => -2.344214, ele => 512, time => 1164488503, name => 'My house', desc => 'There\'s no place like home' ); my $pt = Geo::Gpx::Point->new( %point ); $pt->sym('Triangle, Blue'); $o->waypoints_add( $pt ); is($o->waypoints_count, 4, " waypoints_add(): test the number of waypoints found"); # waypoints(): my $gotten1 = $o->waypoints( name => 'My house' ); my $gotten2 = $o->waypoints( 4 ); is_deeply ($gotten1, $gotten2, " waypoints(): compare waypoints obtained with name => \$name and integer index"); my $waypoints_ret_val; $waypoints_ret_val = $o->waypoints( name => 'There are none with that name' ); is($waypoints_ret_val, undef, " waypoints(): no exception raised if name is not found, return undef"); $waypoints_ret_val = $o->waypoints( 5 ); is($waypoints_ret_val, undef, " waypoints(): no exception raised if index is not found, return undef"); # tracks_add(): my $track1 = $o_trk_only1->tracks( 1 ); my $track2 = $o_trk_only2->tracks( 1 ); $o_wpt_only1->tracks_add( $track1, name => 'My first track' ); $o_wpt_only1->tracks_add( $track2 ); my $get_track = $o_wpt_only1->tracks( name => '2020-10-25T20:36:07Z' ); is($o_wpt_only1->tracks_count, 2, " tracks_add(): test the number of tracks found"); # tracks_add(): test also with aref's my $aref1 = [ { lat => 45.405441, lon => -75.137497, ele => -0.301, time => '2020-10-25T21:34:31Z' }, { lat => 45.405291, lon => -75.137528, ele => -0.098, time => '2020-10-25T21:34:35Z' }, { lat => 45.405147, lon => -75.137508, ele => -0.233, time => '2020-10-25T21:34:38Z' }, { lat => 45.405050, lon => -75.137655, ele => -0.512, time => '2020-10-25T21:34:41Z' }, { lat => 45.404993, lon => -75.137781, ele => -0.108, time => '2020-10-25T21:34:43Z' }, ]; my $aref2 = [ { lat => 45.404952, lon => -75.137896, ele => 0.057, time => '2020-10-25T21:34:45Z' }, { lat => 45.405009, lon => -75.138072, ele => -0.518, time => '2020-10-25T21:34:48Z' }, { lat => 45.405023, lon => -75.138386, ele => -0.613, time => '2020-10-25T21:34:53Z' }, { lat => 45.405017, lon => -75.138450, ele => -0.442, time => '2020-10-25T21:34:54Z' }, { lat => 45.405042, lon => -75.138751, ele => -0.704, time => '2020-10-25T21:34:59Z' }, ]; my $aref3 = [ { lat => 45.405051, lon => -75.138798, ele => -0.656, time => '2020-10-25T21:35:00Z' }, { lat => 45.405025, lon => -75.139096, ele => -0.164, time => '2020-10-25T21:35:05Z' }, { lat => 45.405061, lon => -75.139310, ele => -0.205, time => '2020-10-25T21:35:10Z' }, { lat => 45.405020, lon => -75.139528, ele => -0.242, time => '2020-10-25T21:35:15Z' }, { lat => 45.404974, lon => -75.139638, ele => -0.047, time => '2020-10-25T21:35:19Z' }, ]; my $o_ta = Geo::Gpx->new(); $o_ta->tracks_add( $aref1, name => 'A track with one segment' ); is($o_ta->tracks_count, 1, " tracks_add(): test the number of tracks found"); $o_ta->tracks_add( $aref2, $aref3, name => 'Two segments near the end of the trail' ); is($o_ta->tracks_count, 2, " tracks_add(): test the number of tracks found"); # routes_add(): $o_ta->routes_add( $aref2, name => 'My first route' ); is($o_ta->routes_count, 1, " routes_add(): test the number of routes found"); $o_wpt_only1->routes_add( $aref2 ); is($o_wpt_only1->routes_count, 1, " routes_add(): test the number of routes found"); # waypoints_search(): my @search; @search = $o_wpt_only1->waypoints_search( name => qr/(?i:p[0-4])/); @search = $o_wpt_only1->waypoints_search( desc => qr/(?i:limoges)/); # waypoints_merge(): my $n_merged = $o->waypoints_merge( $o_wpt_only1, qr/LP[4-9]/ ); is($n_merged, 2, " waypoints_merge(): number of waypoints merged"); is($o->waypoints_count, 6, " waypoints_merge(): number of waypoints found"); # waypoint_rename(): is( $o_wpt_only1->waypoint_rename('LP1', 'LP1_renamed'), 'LP1_renamed', " waypoint_rename(): check if rename is successful"); is( $o_wpt_only1->waypoint_rename('LP1', 'Another name'), undef, " waypoint_rename(): check return value if unsuccessful"); # waypoint_delete(): is( $o_wpt_only1->waypoint_delete('LP1'), undef, " waypoint_delete(): check return value if waypoint name is not found"); $o_wpt_only1->waypoint_rename('LP1_renamed', 'LP1'); is( $o_wpt_only1->waypoint_delete('LP1'), 1, " waypoint_delete(): check if waypoint deletion is successful"); is( $o_wpt_only1->waypoints_count, 2, " waypoint_delete(): had 3 points, should now have 2"); # test the various *_closest_to() methods: # . point_closest_to(); my $pt1 = Geo::Gpx::Point->new( lat => 45.405120, lon => -75.139360 ); my ($closest_pt1, $dist1) = $o_wpt_only1->point_closest_to( $pt1 ); isa_ok ($closest_pt1, 'Geo::Gpx::Point'); is($dist1, 2.010698, " point_closest_to(): check the distance to the closest point"); # . waypoint_closest_to(); my $pt2 = Geo::Gpx::Point->new( lat => 45.405441, lon => -75.137497 ); my ($closest_pt2, $dist2) = $o_wpt_only1->waypoint_closest_to( $pt2 ); isa_ok ($closest_pt2, 'Geo::Gpx::Point'); is($dist2, 241.593745, " waypoint_closest_to(): check the distance to the closest waypoint"); # . trackpoint_closest_to(); my $pt3 = Geo::Gpx::Point->new( lat => 45.405120, lon => -75.139360 ); my ($closest_pt3, $dist3) = $o_wpt_only1->trackpoint_closest_to( $pt3 ); isa_ok ($closest_pt3, 'Geo::Gpx::Point'); is($dist3, 2.010698, " trackpoint_closest_to(): check the distance to the closest trackpoint"); # . routepoint_closest_to(); my $pt4 = Geo::Gpx::Point->new( lat => 45.405120, lon => -75.139360 ); my ($closest_pt4, $dist4) = $o_wpt_only1->routepoint_closest_to( $pt4 ); isa_ok ($closest_pt4, 'Geo::Gpx::Point'); is($dist4, 48.328519, " routepoint_closest_to(): check the distance to the closest routepoint"); # track_rename(): is( $o_ta->track_rename('A track with one segment', 'Single segment track'), 'Single segment track', " track_rename(): check if rename is successful"); # is( $o_ta->track_rename( -0, 'Really just one'), 'Really just one', " track_rename(): check if rename is successful"); # ... counting from the end is undocumented and will change in the future i.e. -1 will refer to last not -0 # is( $o_ta->track_rename('A track with one segment', 'LP1_renamed'), undef, " track_rename(): check return value if unsuccessful"); # ... this one croaks instead of returing undef, I think waypoint_rename() should behave the same way and croak # track_delete(): $o_ta->track_delete( 'Single segment track' ); is($o_ta->tracks_count, 1, " tracks_delete(): test the number of tracks remaining"); # save(): a few saves $o->set_wd( $tmp_dir ); $o->save( filename => 'test_save.gpx', force => 1); $o->set_wd( '-' ); $o_wpt_only1->set_wd( $tmp_dir ); $o_wpt_only1->save( filename => 'test_save_wpt_and_track.gpx', force => 1); $o_wpt_only1->set_wd( '-' ); # save() - new instance based on saved file my $saved_then_read = Geo::Gpx->new( input => $tmp_dir . '/test_save.gpx' ); isa_ok ($saved_then_read, 'Geo::Gpx'); # delete_all's $o->waypoints_delete_all; is( $o->waypoints_count, 0, " waypoints_delete_all(): count should now be 0"); $o_ta->tracks_delete_all; is( $o_ta->tracks_count, 0, " waypoints_delete_all(): count should now be 0"); $o_ta->routes_delete_all; is( $o_ta->routes_count, 0, " waypoints_delete_all(): count should now be 0"); print "so debugger doesn't exit\n"; Geo-Gpx-1.11/t/sample.gpx0000644000175000017500000000521514636644166013323 0ustar patpat Run 2009-06-19 52.048584 164 99 52.529175 161 95 52.048584 164 99 52.529175 161 96 1 2009-06-19T10:13:04Z 4.6700000 1 0.5881348 163 active 2 2009-06-19T10:13:15Z 4.6700000 1 0.5881348 163 active Geo-Gpx-1.11/t/key-order.t0000644000175000017500000000235114636644166013406 0ustar patpatuse strict; use warnings; use Test::More tests => 2; use Geo::Gpx; # See: # http://rt.cpan.org/Public/Bug/Display.html?id=29909 my $gpx = Geo::Gpx->new; my @correct_order = qw( ele time magvar geoidheight name cmt desc src link sym type fix sat hdop vdop pdop ageofdgpsdata dgpsid ); $gpx->waypoints_add( { # All standard GPX fields lat => 54.786989, lon => -2.344214, ele => 512, time => 1164488503, magvar => 0, geoidheight => 0, name => 'My house & home', cmt => 'Where I live', desc => '<>', src => 'Testing', link => { href => 'http://hexten.net/', text => 'Hexten', type => 'Blah' }, sym => 'pin', type => 'unknown', fix => 'dgps', sat => 3, hdop => 10, vdop => 10, pdop => 10, ageofdgpsdata => 45, dgpsid => 247 } ); my $xml = $gpx->xml( version => '1.1' ); ok $xml =~ m{ ]*> (.*?) }xms, "has wpt"; my $wpt = $1; my @ord = ( $wpt =~ m{ <(\w+).*? }xmsg ); is_deeply \@ord, \@correct_order, 'order ok'; Geo-Gpx-1.11/t/encodings.t0000644000175000017500000000721514636644166013462 0ustar patpat# t/encodings.t - test encodings use strict; use warnings; use Test::More tests => 12; use Encode; use Geo::Gpx; use File::Temp qw/ tempfile tempdir /; use Cwd qw(cwd abs_path); my $cwd = abs_path( cwd() ); my $tmp_dir = tempdir( CLEANUP => 1 ); my $wpt1 = { lat => 45.93789, lon => -75.85077, ele => 550, time => 1167813923, name => 'é è à ï', desc => 'Un waypoint nommé é è à ï', sym => 'pin', }; my $wpt2 = { lat => 45.93678, lon => -75.85093, ele => 548, time => 1167814115, name => 'α β\' è γ', desc => 'Un waypoint nommé alpha, beta prime, e accent grave & gamma', sym => 'Flag, Blue', }; my $wpt3 = { lat => 45.94636, lon => -76.01154, time => 1167810723, sym => 'Parking Area' }; # # Test waypoints with unicode my $o = Geo::Gpx->new(); isa_ok ($o, 'Geo::Gpx'); $o->set_wd( $tmp_dir ); $o->waypoints_add( $wpt1, $wpt2, $wpt3 ); is($o->waypoints_count, 3, " waypoints_add(): waypoints with unicode added"); # save and reload $o->save( filename => 'test_unicode.gpx', force => 1); my $o_copy = Geo::Gpx->new( input => $tmp_dir . '/test_unicode.gpx' ); isa_ok ($o_copy, 'Geo::Gpx'); $o->save( filename => 'test_unicode_explicit_unsafe_chars.gpx', unsafe_chars => "<>&\"'", force => 1); my $o_copy2 = Geo::Gpx->new( input => $tmp_dir . '/test_unicode_explicit_unsafe_chars.gpx' ); isa_ok ($o_copy2, 'Geo::Gpx'); # TODO: should be compare the 2 objects, like a deep compare? Look into it. # # test .gpx file with mix of unicode and ascii/latin1 codes entities # here we test a file that has a mix of entities based on unicode and ascii/latin1 codes can be read properly into an object my $mixed1 = Geo::Gpx->new( input => 't/mix_of_latin1_utf8_chars.xml' ); $mixed1->waypoints_add( $wpt1 ); # ... we added a waypoint so we have a combination of points read from a file and at least one added from a script my $str1_expect = 'CC & URj'; my $str2_expect = 'βelvé (name hard-coded, added a beta too)'; my $str3_expect = 'βé (hard-coded)'; my $str4_expect = 'RRtop'; my $str5_expect = 'α, é, & γ (hard-coded except the ampersand)'; my $str1 = $mixed1->waypoints(1)->name; my $str2 = $mixed1->waypoints(2)->name; my $str3 = $mixed1->waypoints(3)->name; my $str4 = $mixed1->waypoints(4)->name; my $str5 = $mixed1->waypoints(5)->name; is($str1, $str1_expect, " Encode::encode() call in _trim(): ensure string is unicode"); is($str2, $str2_expect, " Encode::encode() call in _trim(): ensure string is unicode"); is($str3, $str3_expect, " Encode::encode() call in _trim(): ensure string is unicode"); is($str4, $str4_expect, " Encode::encode() call in _trim(): ensure string is unicode"); is($str5, $str5_expect, " Encode::encode() call in _trim(): ensure string is unicode"); my $desc4 = $mixed1->waypoints( name => 'RRtop' )->desc; my $expect_not = 'Belvédère en haut de la montagne (2-bytes codes based on binary values)'; isnt($desc4, $expect_not, " new(): read xml with accented characters wrongly encoded with the binary values of a char instead of unicode code"); # waypoints_search() with unicode characters in their name my @search; @search = $o->waypoints_search( name => qr/(?i:[è])/); is( @search, 2, " waypoints_search(): search waypoints based on unicode character"); # waypoints_search() with unicode characters in their name -- example with greek letter my $mixed2 = $mixed1->clone(); $mixed2->waypoints_add( $wpt2 ); @search = $mixed2->waypoints_search( name => qr/β/); is( @search, 3, " waypoints_search(): search waypoints based on unicode character"); # $DB::single=1; print "so debugger doesn't exit\n"; Geo-Gpx-1.11/t/gen-parse.t0000644000175000017500000002422214636644166013367 0ustar patpatuse strict; use warnings; use Geo::Gpx; use Test::More; BEGIN { eval "use Test::XML"; plan skip_all => "Test::XML unavailable" if $@; } use Test::More tests => 4; my %refxml = (); my $k = undef; while ( ) { if ( /^==\s+(\S+)\s+==$/ ) { $k = $1; } elsif ( defined( $k ) ) { $refxml{$k} .= $_; } } my $gpx = Geo::Gpx->new(); my @wpt = ( { # All standard GPX fields lat => 54.786989, lon => -2.344214, ele => 512, time => time(), magvar => 0, geoidheight => 0, name => 'My house & home', cmt => 'Where I live', desc => '<>', src => 'Testing', link => { href => 'http://hexten.net/', text => 'Hexten', type => 'Blah' }, sym => 'pin', type => 'unknown', fix => 'dgps', sat => 3, hdop => 10, vdop => 10, pdop => 10, ageofdgpsdata => 45, dgpsid => 247 }, { # Fewer fields lat => -38.870059, lon => -151.210030, name => 'Sydney, AU' } ); $gpx->waypoints_add( @wpt ); # Quick fix for dumbass dependency on RNG being the same everywhere my $rp = 0; my @rn = ( 0.03984, 0.08913, 0.12012, 0.84698, 0.35285, 0.00580, 0.37354, 0.33931, 0.88578, 0.78503, 0.69597, 0.19332, 0.76844, 0.08150, 0.47062, 0.64957, 0.00072, 0.57271, 0.73318, 0.80986, 0.96169, 0.96567, 0.52550, 0.57476, 0.21792, 0.07187, 0.95170, 0.19820, 0.07930, 0.86521, 0.37511, 0.52225, 0.48271, 0.23808, 0.70230, 0.23426, 0.05024, 0.44965, 0.96768, 0.17396, 0.11877, 0.65996, 0.89178, 0.67894, 0.30362, 0.11972, 0.87709, 0.70132, 0.69666, 0.46293, 0.11827, 0.35612, 0.14679, 0.56480, 0.43109, 0.21226, 0.59054, 0.78612, 0.79592, 0.94235, 0.03657, 0.34607, 0.91482, 0.47672, 0.32947, 0.53454, 0.70178, 0.02437, 0.07496, 0.49284, 0.16772, 0.82976, 0.27625, 0.12485, 0.68737, 0.32405, 0.06580, 0.13189, 0.90450, 0.03470, 0.00016, 0.24118, 0.26281, 0.76458, 0.37970, 0.98307, 0.25990, 0.80449, 0.94870, 0.19664, 0.38404, 0.35733, 0.69219, 0.14925, 0.38206, 0.62497, 0.66942, 0.35608, 0.05149, 0.72594, ); sub not_rand { $rp = 0 if $rp == @rn; return $rn[ $rp++ ]; } my $lat = 54.786989; my $lon = -2.344214; my $next = 1; sub get_point { my $fmt = shift; my $dlat = not_rand( 1 ) - 0.5; my $dlon = not_rand( 1 ) - 0.5; $lat += $dlat; $lon += $dlon; if ( $fmt ) { return { lat => $lat, lon => $lon, name => sprintf( $fmt, $next++ ) }; } else { return { lat => $lat, lon => $lon }; } } my @rte = ( { name => 'Route 1', points => [ map { get_point( 'WPT%d' ) } ( 1 .. 3 ) ] }, { name => 'Route 2', points => [ map { get_point( 'WPT%d' ) } ( 1 .. 2 ) ] } ); # $gpx->routes( \@trk ); # ... routes no longer sets $gpx->{routes} = \@rte ; my @trk = ( { name => 'Track 1', segments => [ { points => [ map { get_point() } ( 1 .. 3 ) ] }, { points => [ map { get_point() } ( 1 .. 1 ) ] } ] }, { name => 'Track 2', segments => [ { points => [ map { get_point() } ( 1 .. 5 ) ] } ] } ); # $gpx->tracks( \@trk ); # ... tracks no longer sets $gpx->{tracks} = \@trk; $gpx->name( 'Test' ); $gpx->desc( 'Test data' ); $gpx->author( { name => 'Andy Armstrong', email => { id => 'andy', domain => 'hexten.net' }, link => { href => 'http://hexten.net/', text => 'Hexten' } } ); $gpx->copyright( '(c) Anyone' ); $gpx->link( { href => 'http://www.topografix.com/GPX', text => 'GPX Spec', type => 'unknown' } ); $gpx->time( time() ); $gpx->keywords( [ 'this', 'that', 'the other' ] ); for my $version ( keys %refxml ) { my $xml = normalise( $refxml{$version} ); my $gen = normalise( $gpx->xml( version => $version ) ); is_xml( $gen, $xml, 'generated version ' . $version ); # Parse reference XMLs my $ngpx = Geo::Gpx->new( xml => $refxml{$version} ); my $ngen = normalise( $ngpx->xml( version => $version ) ); is_xml( $ngen, $xml, 'reparsed version ' . $version ); } sub save_if_diff { my ( $base, $gen, $orig ) = @_; if ( $gen ne $orig ) { save( "$base-orig.gpx", $orig ); save( "$base-gen.gpx", $gen ); } } sub save { my ( $name, $xml ) = @_; open( my $fh, '>', $name ) or die "Can't write $name ($!)\n"; print $fh $xml; close( $fh ); } sub normalise { my $xml = shift; # Remove leading spaces in case we decide to indent the output $xml =~ s{^\s+}{}msg; my $fix_time = sub { my $tm = shift; $tm =~ s{\d}{9}g; $tm =~ s{[+-]}{-}g; return $tm; }; $xml =~ s{()}{$1 . $fix_time->($2) . $3}eg; my $fix_coord = sub { my $co = shift; return sprintf( "%.6f", $co ); }; $xml =~ s{((?:lat|lon)=\")([^\"]+)(\")}{$1 . $fix_coord->($2) . $3}eg; return $xml; } __END__ == 1.0 == Test Test data Andy Armstrong andy@hexten.net this, that, the other (c) Anyone http://www.topografix.com/GPX GPX Spec Route 1 WPT1 WPT2 WPT3 Route 2 WPT4 WPT5 Track 1 Track 2 45 Where I live <<Chez moi>> 247 512 dgps 0 10 http://hexten.net/ Hexten 0 My house & home 10 3 Testing pin unknown 10 Sydney, AU == 1.1 == Test Test data Hexten Andy Armstrong this, that, the other (c) Anyone GPX Spec unknown Route 1 WPT1 WPT2 WPT3 Route 2 WPT4 WPT5 Track 1 Track 2 45 Where I live <<Chez moi>> 247 512 dgps 0 10 Hexten Blah 0 My house & home 10 3 Testing pin unknown 10 Sydney, AU Geo-Gpx-1.11/t/larose_wpt.gpx0000644000175000017500000000360314636644166014220 0ustar patpat Garmin International 73 LP1 Larose P1 - Limoges Larose P1 - Limoges Flag, Green SymbolAndName -105 LP4 Larose P4 - Bourget Larose P4 - Bourget Flag, Green SymbolAndName 99 LP7 Larose P7 - Limoges Larose P7 - Limoges Flag, Green SymbolAndName Geo-Gpx-1.11/t/pod-coverage.t0000644000175000017500000000025614636644166014062 0ustar patpat#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); Geo-Gpx-1.11/t/larose_trk1.gpx0000644000175000017500000000172314636644166014270 0ustar patpat Biking2020-10-25 0.000 0.000 0.508 0.379 0.123 Geo-Gpx-1.11/t/larose_trk2.gpx0000644000175000017500000000172314636644166014271 0ustar patpat Biking2020-10-25 0.446 0.842 0.677 0.537 0.744 Geo-Gpx-1.11/t/00-report-prereqs.t0000644000175000017500000001360114636644166014714 0ustar patpat#!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-Gpx-1.11/t/00-report-prereqs.dd0000644000175000017500000000315314636644166015041 0ustar patpatdo { my $x = { 'build' => { 'requires' => { 'Module::Build' => '0.28' } }, 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '0', 'Module::Build' => '0.28' } }, 'runtime' => { 'requires' => { 'DateTime' => '1.44', 'DateTime::Format::ISO8601' => '0.16', 'Geo::Coordinates::Transform' => '0', 'HTML::Entities' => '0', 'Math::Trig' => '0', 'Scalar::Util' => '0', 'Test::More' => '0', 'XML::Descent' => '0', 'perl' => '5.008', 'version' => '0' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900' }, 'requires' => { 'ExtUtils::MakeMaker' => '0', 'File::Spec' => '0', 'Test::More' => '0' } } }; $x; }Geo-Gpx-1.11/t/mix_of_latin1_utf8_chars.xml0000644000175000017500000000307614636644166016726 0ustar patpat Garmin International 202.96 CC & URj Cookie's Climb & Upper Ridgeback junction (ampersand and single-quote are the same ascii, latin1 and unicode codes) Flag, Green 548.00 βelvé (name hard-coded, added a beta too) Belvédère en haut de la montagne (1-byte codes based on ASCII/latin-1 codes Flag, Green 548.00 βé (hard-coded) Flag, Green 537.74 RRtop Belvédère en haut de la montagne (2-bytes codes based on binary values) Flag, Green 535.00 α, é, & γ (hard-coded except the ampersand) près du début de Family Jewel (2-bytes codes based on unicode character code) Flag, Green Geo-Gpx-1.11/LICENSE0000644000175000017500000004374714636644166012100 0ustar patpatThis software is copyright (c) 2004-2022 by Andy Armstrong, Patrick Joly. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2004-2022 by Andy Armstrong, Patrick Joly. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2004-2022 by Andy Armstrong, Patrick Joly. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Geo-Gpx-1.11/dist.ini0000644000175000017500000000076614636644166012531 0ustar patpatname = Geo-Gpx author = Patrick Joly license = Perl_5 copyright_holder = Andy Armstrong, Patrick Joly copyright_year = 2004-2022 [@Basic] [ModuleBuild] [VersionFromModule] [GithubMeta] [MetaJSON] [Test::ReportPrereqs] [Prereqs / RuntimeRequires] perl = 5.008 DateTime = 1.44 DateTime::Format::ISO8601 = 0.16 Geo::Coordinates::Transform = 0 HTML::Entities = 0 Math::Trig = 0 Scalar::Util = 0 Test::More = 0 XML::Descent = 0 version = 0 [Prereqs / TestRequires] Test::More = 0 Geo-Gpx-1.11/META.yml0000644000175000017500000000172014636644166012325 0ustar patpat--- abstract: 'Create and parse GPX files' author: - 'Patrick Joly ' build_requires: ExtUtils::MakeMaker: '0' File::Spec: '0' Module::Build: '0.28' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' Module::Build: '0.28' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.030, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Geo-Gpx requires: DateTime: '1.44' DateTime::Format::ISO8601: '0.16' Geo::Coordinates::Transform: '0' HTML::Entities: '0' Math::Trig: '0' Scalar::Util: '0' Test::More: '0' XML::Descent: '0' perl: '5.008' version: '0' resources: homepage: https://github.com/patjoly/geo-gpx repository: https://github.com/patjoly/geo-gpx.git version: '1.11' x_generated_by_perl: v5.36.0 x_serialization_backend: 'YAML::Tiny version 1.74' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' Geo-Gpx-1.11/MANIFEST0000644000175000017500000000077414636644166012215 0ustar patpat# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.030. Build.PL Changes Install LICENSE MANIFEST META.json META.yml Makefile.PL README.md dist.ini lib/Geo/Gpx.pm lib/Geo/Gpx/Point.pm t/00-report-prereqs.dd t/00-report-prereqs.t t/00_load.t t/01_main.t t/_xml.t t/cmp_ver.t t/encodings.t t/gen-parse.t t/iter.t t/key-order.t t/larose_trk1.gpx t/larose_trk2.gpx t/larose_wpt.gpx t/misc.t t/mix_of_latin1_utf8_chars.xml t/pod-coverage.t t/pod.t t/point.t t/sample.gpx t/set.t t/time.t Geo-Gpx-1.11/Build.PL0000644000175000017500000000252614636644166012355 0ustar patpat # This file was automatically generated by Dist::Zilla::Plugin::ModuleBuild v6.030. use strict; use warnings; use Module::Build 0.28; my %module_build_args = ( "build_requires" => { "Module::Build" => "0.28" }, "configure_requires" => { "ExtUtils::MakeMaker" => 0, "Module::Build" => "0.28" }, "dist_abstract" => "Create and parse GPX files", "dist_author" => [ "Patrick Joly " ], "dist_name" => "Geo-Gpx", "dist_version" => "1.11", "license" => "perl", "module_name" => "Geo::Gpx", "recursive_test_files" => 1, "requires" => { "DateTime" => "1.44", "DateTime::Format::ISO8601" => "0.16", "Geo::Coordinates::Transform" => 0, "HTML::Entities" => 0, "Math::Trig" => 0, "Scalar::Util" => 0, "Test::More" => 0, "XML::Descent" => 0, "perl" => "5.008", "version" => 0 }, "test_requires" => { "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "Test::More" => 0 } ); my %fallback_build_requires = ( "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "Module::Build" => "0.28", "Test::More" => 0 ); unless ( eval { Module::Build->VERSION(0.4004) } ) { delete $module_build_args{test_requires}; $module_build_args{build_requires} = \%fallback_build_requires; } my $build = Module::Build->new(%module_build_args); $build->create_build_script; Geo-Gpx-1.11/README.md0000644000175000017500000004032314636644166012335 0ustar patpat# NAME Geo::Gpx - Create and parse GPX files # SYNOPSIS my ($gpx, $waypoints, $tracks); # From a filename, an open file, or an XML string: $gpx = Geo::Gpx->new( input => $fname ); $gpx = Geo::Gpx->new( input => $fh ); $gpx = Geo::Gpx->new( xml => $xml ); my $waypoints = $gpx->waypoints(); my $tracks = $gpx->tracks(); # DESCRIPTION `Geo::Gpx` supports the parsing and generation of GPX data. ## Constructor - new( input => ($fname | $fh) or xml => $xml \[, work\_dir => $working\_directory \] ) Create and return a new `Geo::Gpx` instance based on a \*.gpx file (_$fname_), an open filehandle (_$fh_), or an XML string (_$xml_). GPX 1.0 and 1.1 are supported. The optional `work_dir` (or `wd` for short) specifies where to save any working files, such as with the save() method. It can be supplied as a relative path or as an absolute path. If `work_dir` is omitted, it is set based on the path of the _$fname_ supplied or the current working directory if the constructor is called with an XML string or a filehandle (see `set_wd()` for more info). - clone() Returns a deep copy of a `Geo::Gpx` instance. $clone = $self->clone; ## Methods - waypoints( $int or name => $name ) Without arguments, returns the array reference of waypoints. With an argument, returns a reference to the waypoint whose `name` field is an exact match with _$name_. If an integer is specified instead of the `name` key/value pair, returns the waypoint at position _$int_ in the array reference (1-indexed with negative integers also counting from the end of the array). Returns `undef` if no corresponding waypoints are found such that this method can be used to check if a specific point exists (i.e. no exception is raised if _$name_ or _$int_ do not exist) . - waypoints\_add( $point or \\%point \[, $point or \\%point, … \] ) Add one or more waypoints. Each waypoint must be either a [Geo::Gpx::Point](https://metacpan.org/pod/Geo%3A%3AGpx%3A%3APoint) or a hash reference with fields that can be parsed by [Geo::Gpx::Point](https://metacpan.org/pod/Geo%3A%3AGpx%3A%3APoint)'s `new()` constructor. See the later for the possible fields. %point = ( lat => 54.786989, lon => -2.344214, ele => 512, name => 'My house' ); $gpx->waypoints_add( \%point ); or $pt = Geo::Gpx::Point->new( %point ); $gpx->waypoints_add( $pt ); - waypoints\_search( $field => $regex ) returns an array of waypoints whose _$field_ (e.g. `name`, `desc`, …) matches _$regex_. By default, the regex is case-sensitive; specify `qr/(?i:search_string_here)/` to ignore case. - waypoints\_clip( $name | $regex | LIST ) - way\_clip( ) Sends the coordinates of the waypoint(s) whose name is either `$name` or matches `$regex` to the clipboard (all points found are sent to the clipboard) and returns an array of points found. By default, the regex is case-sensitive; specify `qr/(?i:...)/` to ignore case. Alternatively, an array of `Geo::GXP::Points` can be provided. `way_clip()` is a short-hand for this method (convenient when used interactively in the debugger). This method is only supported on unix-based systems that have the `xclip` utility installed (see DEPENDENCIES). - waypoints\_delete\_all() delete all waypoints. Returns true. - waypoint\_delete( $name ) delete the waypoint whose `name` field is an exact match for _$name_ (case sensitively). Returns true if successful, `undef` if the name cannot be found. - waypoint\_rename( $name, $new\_name ) rename the waypoint whose `name` field is an exact match for _$name_ (case sensitively) to _$new\_name_. Returns the point's new name if successful, `undef` otherwise. - waypoints\_merge( $gpx, $regex ) Merge waypoints with those contained in the [Geo::Gpx](https://metacpan.org/pod/Geo%3A%3AGpx) instance provide as argument. Waypoints are compared based on their respective `name` fields, which must exist in _$gpx_ (if names are missing in the current instance, all points will be merged). A _$regex_ may be provided to limit the merge to a subset of waypoints from _$gpx_. Returns the number of points successfully merged (i.e. the difference in `$gps->waypoints_count` before and after the merge). - waypoint\_closest\_to( $point or $tcx\_trackpoint ) - trackpoint\_closest\_to( … ) - routepoint\_closest\_to( … ) - point\_closest\_to( … ) From any [Geo::Gpx::Point](https://metacpan.org/pod/Geo%3A%3AGpx%3A%3APoint) or [Geo::TCX::Trackpoint](https://metacpan.org/pod/Geo%3A%3ATCX%3A%3ATrackpoint) object, return the [Geo::Gpx::Point](https://metacpan.org/pod/Geo%3A%3AGpx%3A%3APoint) that is closest to it. If called in list context, returns a two-element array consisting of that point, and the distance from the coordinate (in meters). - waypoints\_print() print the list of waypoints to screen, along with their names and descriptions if defined. Returns true. - waypoints\_count() returns the number of waypoints in the object. - routes( integer or name => 'name' ) Returns the array reference of routes when called without argument. Optionally accepts a single integer referring to the route number from routes aref (1-indexed with negative integers also counting from the end of the array) or a key value pair with the name of the route to be returned. - routes\_add( $route or $points\_aref \[, name => $route\_name ) Add a route to a `Geo::Gpx` object. The _$route_ is expected to be an existing route (i.e. a hash ref). Returns true. A new route can also be created based an array reference(s) of [Geo::Gpx::Point](https://metacpan.org/pod/Geo%3A%3AGpx%3A%3APoint) objects and added to the `Geo::Gpx` instance. `name` and all other meta fields supported by routes can be provided and will overwrite any existing fields in _$route_. - routes\_delete\_all() delete all routes. Returns true. - routes\_count() returns the number of routes in the object. - tracks( integer or name => 'name' ) Returns the array reference of tracks when called without argument. Optionally accepts a single integer referring to the track number from the tracks aref (1-indexed with negative integers also counting from the end of the array) or a key value pair with the name of the track to be returned. - tracks\_add( $track or $points\_aref \[, $points\_aref, … \] \[, name => $track\_name \] ) Add a track to a `Geo::Gpx` object. The _$track_ is expected to be an existing track (i.e. a hash ref). Returns true. If _$track_ has no `name` field and none is provided, the timestamp of the first point of the track will be used (this is experimental and may change in the future). All other fields supported by tracks can be provided and will overwrite any existing fields in _$track_. A new track can also be created based an array reference(s) of [Geo::Gpx::Point](https://metacpan.org/pod/Geo%3A%3AGpx%3A%3APoint) objects and added to the `Geo::Gpx` instance. If more than one array reference is supplied, the resulting track will contain as many segments as the number of aref's provided. - tracks\_delete\_all() delete all tracks. Returns true. - track\_delete( $name ) delete the track whose `name` field is an exact match for _$name_ (case sensitively). Returns true if successful, `undef` if the name cannot be found. - track\_rename( $name, $new\_name ) rename the track whose `name` field is an exact match for _$name_ (case sensitively) to _$new\_name_. Returns the track's new name if successful, `undef` otherwise. Alternatively, an integer may be specified as the first argument, referring to the track number from tracks aref (1-indexed). This is a convenience as it is quite common for tracks to be named with the timestamp fo the first point. - tracks\_print() print the list of tracks to screen, by their `name` field. Returns true. - tracks\_count() returns the number of tracks in the object. - iterate\_waypoints() - iterate\_trackpoints() - iterate\_routepoints() Get an iterator for all of the waypoints, trackpoints, or routepoints in a `Geo::Gpx` instance, as per the iterator chosen. - iterate\_points() Get an iterator for all of the points in a `Geo::Gpx` instance, including waypoints, trackpoints, and routepoints. my $iter = $gpx->iterate_points(); while ( my $pt = $iter->() ) { print "Point: ", join( ', ', $pt->{lat}, $pt->{lon} ), "\n"; } - bounds( $iterator ) Compute the bounding box of all the points in a `Geo::Gpx` returning the result as a hash reference. my $gpx = Geo::Gpx->new( xml => $some_xml ); my $bounds = $gpx->bounds(); returns a structure like this: $bounds = { minlat => 57.120939, minlon => -2.9839832, maxlat => 57.781729, maxlon => -1.230902 }; `$iterator` defaults to `$self->iterate_points` if not specified. - xml( key/values ) Generate and return an XML string representation of the instance. _key/values_ are (all optional): `version`: specifies the GPX XML version scheme to use (defaults to 1.0). `unsafe_chars`: the set of characters to be considered unsafe for the XML mark-up and encoded as an entity. If `version` is omitted, it defaults to the value of the `version` attribute. Parsing a GPX document sets the version. If the `version` attribute is unset defaults to 1.0. `unsafe_chars` can be provided to specify which characters to consider unsafe in generating the XML mark-up. This field is then passed through to [HTML::Entities](https://metacpan.org/pod/HTML%3A%3AEntities) function calls whose documentation describes that this field is "specified using the regular expression character class syntax (what you find within brackets in regular expressions)". As of version _1.11_ of `Geo::Gpx`, the default set of characters are the `'<'`, `'&'`, `'>'`, `'"'` characters. To revert to the pre-version _1.11_ default, which is equivalent to that in <`HTML::Entities`, explicitely specify `unsafe_chars => undef`. This will encode as the latter module describes the "control chars, high-bit chars, and the `'<'`, `'&'`, `'>'`, `"'"`, `'"'` characters". - TO\_JSON For compatibility with [JSON](https://metacpan.org/pod/JSON) modules. Convert this object to a hash with keys that correspond to the above methods. Generated ala: my %json = map { $_ => $self->$_ } qw( name desc author keywords copyright time link waypoints tracks routes version ); $json{bounds} = $self->bounds( $iter ); With one difference: the keys will only be set if they are defined. - save( filename => $fname, key/values ) Saves the `Geo::Gpx` instance as a file. The filename field is optional unless the instance was created without a filename (i.e with an XML string or a filehandle) and `set_filename()` has not been called yet. If the filename is a relative path, the file will be saved in the instance's working directory (not the caller's, `Cwd`). _key/values_ are (all optional): `force`: overwrites existing files if true, otherwise it won't. `extensions`: save `…` tags if true (defaults to false). `meta_time`: save the `` tag in the file's meta information tags if true (defaults to false). Some applications like MapSource return an error if this tags is present. (All other time tags elsewhere are kept.) `unsafe_chars`: see the documentation for `xml()` above. - set\_filename( $filename ) Sets/gets the filename. Returns the name of the file with the complete path. - set\_wd( $folder ) Sets/gets the working directory for any eventual saving of the \*.gpx file and checks the validity of that path. It can be set as a relative path (i.e. relative to the actual [Cwd](https://metacpan.org/pod/Cwd)) or as an absolute path, but is always returned as a full path. This working directory is always defined. The previous one is also stored in memory, such that `set_wd('-')` switches back and forth between two directories. The module never actually `chdir`'s, it just keeps track of where the user wishes to save files. ## Accessors - name( $str ) - desc( $str ) - copyright( $str ) - keywords( $aref ) Accessors to get or set the `name`, `desc`, `copyright`, or `keywords` fields of the `Geo::Gpx` instance. - author( $href ) The author information is stored in a hash that reflects the structure of a GPX 1.1 document. To set it, supply a hash reference as (`link` and `email` are optional): { link => { text => 'Hexten', href => 'http://hexten.net/' }, email => { domain => 'hexten.net', id => 'andy' }, name => 'Andy Armstrong' }, - link( $href ) The link is stored similarly to the author information, it can be set by supplying a hash reference as: { link => { text => 'Hexten', href => 'http://hexten.net/' } } - time( $epoch ) Accessor for the <time> element of a GPX. The time is converted to a Unix epoch time when a GPX document is parsed, therefore only epoch time is supported for setting. - version() Returns the schema version of a GPX document. Versions 1.0 and 1.1 are supported. # DEPENDENCIES [DateTime](https://metacpan.org/pod/DateTime), [DateTime::Format::ISO8601](https://metacpan.org/pod/DateTime%3A%3AFormat%3A%3AISO8601), [Geo::Coordinates::Transform](https://metacpan.org/pod/Geo%3A%3ACoordinates%3A%3ATransform), [HTML::Entities](https://metacpan.org/pod/HTML%3A%3AEntities), [Math::Trig](https://metacpan.org/pod/Math%3A%3ATrig), [Scalar::Util](https://metacpan.org/pod/Scalar%3A%3AUtil), [XML::Descent](https://metacpan.org/pod/XML%3A%3ADescent) The `waypoints_clip()` method is only supported on unix-based systems that have the `xclip` utility installed. # SEE ALSO [JSON](https://metacpan.org/pod/JSON) # BUGS AND LIMITATIONS Prior to version 1.11, `xml()` and `save()` encoded "unsafe characters" as per the default in [HTML::Entities](https://metacpan.org/pod/HTML%3A%3AEntities) which resulted in erroneous codes for some multi-byte unicode characters. The current default is to only encode a short list of characters -- see `xml()` above. This change is motivated by the now prevalent use of unicode as the default encoding in many applications that read XML markup and \*.gpx files. Please report any bugs or feature requests on the github project page. Alternatively, you may submit them to `bug-geo-gpx@rt.cpan.org` or through the web interface at [http://rt.cpan.org](http://rt.cpan.org). # AUTHOR Originally by Rich Bowen `` and Andy Armstrong ``. This version by Patrick Joly ``. Please visit the project page at: [https://github.com/patjoly/geo-gpx](https://github.com/patjoly/geo-gpx). # VERSION 1.11 # LICENSE AND COPYRIGHT Copyright (c) 2004-2022, Andy Armstrong ``, Patrick Joly `patjol@cpan.org`. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See [perlartistic](https://metacpan.org/pod/perlartistic). # DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. Geo-Gpx-1.11/META.json0000644000175000017500000000340614636644166012500 0ustar patpat{ "abstract" : "Create and parse GPX files", "author" : [ "Patrick Joly " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.030, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Geo-Gpx", "prereqs" : { "build" : { "requires" : { "Module::Build" : "0.28" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "Module::Build" : "0.28" } }, "runtime" : { "requires" : { "DateTime" : "1.44", "DateTime::Format::ISO8601" : "0.16", "Geo::Coordinates::Transform" : "0", "HTML::Entities" : "0", "Math::Trig" : "0", "Scalar::Util" : "0", "Test::More" : "0", "XML::Descent" : "0", "perl" : "5.008", "version" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "homepage" : "https://github.com/patjoly/geo-gpx", "repository" : { "type" : "git", "url" : "https://github.com/patjoly/geo-gpx.git", "web" : "https://github.com/patjoly/geo-gpx" } }, "version" : "1.11", "x_generated_by_perl" : "v5.36.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.36", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" } Geo-Gpx-1.11/Makefile.PL0000644000175000017500000000317514636644166013034 0ustar patpat# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.030. use strict; use warnings; use 5.008; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Create and parse GPX files", "AUTHOR" => "Patrick Joly ", "BUILD_REQUIRES" => { "Module::Build" => "0.28" }, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "Module::Build" => "0.28" }, "DISTNAME" => "Geo-Gpx", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.008", "NAME" => "Geo::Gpx", "PREREQ_PM" => { "DateTime" => "1.44", "DateTime::Format::ISO8601" => "0.16", "Geo::Coordinates::Transform" => 0, "HTML::Entities" => 0, "Math::Trig" => 0, "Scalar::Util" => 0, "Test::More" => 0, "XML::Descent" => 0, "version" => 0 }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "Test::More" => 0 }, "VERSION" => "1.11", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "DateTime" => "1.44", "DateTime::Format::ISO8601" => "0.16", "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "Geo::Coordinates::Transform" => 0, "HTML::Entities" => 0, "Math::Trig" => 0, "Module::Build" => "0.28", "Scalar::Util" => 0, "Test::More" => 0, "XML::Descent" => 0, "version" => 0 ); 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-Gpx-1.11/lib/0000775000175000017500000000000014636644166011624 5ustar patpatGeo-Gpx-1.11/lib/Geo/0000775000175000017500000000000014636644166012336 5ustar patpatGeo-Gpx-1.11/lib/Geo/Gpx.pm0000644000175000017500000013637114636644166013443 0ustar patpatpackage Geo::Gpx; use warnings; use strict; our $VERSION = '1.11'; use Carp; use DateTime::Format::ISO8601; use DateTime; use Encode; use HTML::Entities qw( encode_entities encode_entities_numeric ); use Scalar::Util qw( blessed looks_like_number ); use XML::Descent; use File::Basename; use Cwd qw(cwd abs_path); use Geo::Gpx::Point; =encoding utf8 =head1 NAME Geo::Gpx - Create and parse GPX files =head1 SYNOPSIS my ($gpx, $waypoints, $tracks); # From a filename, an open file, or an XML string: $gpx = Geo::Gpx->new( input => $fname ); $gpx = Geo::Gpx->new( input => $fh ); $gpx = Geo::Gpx->new( xml => $xml ); my $waypoints = $gpx->waypoints(); my $tracks = $gpx->tracks(); =head1 DESCRIPTION C supports the parsing and generation of GPX data. =cut my %AS_ATTR = ( # values that are encoded as attributes wpt => qr{^lat|lon$}, rtept => qr{^lat|lon$}, trkpt => qr{^lat|lon$}, email => qr{^id|domain$}, link => qr{^href$} ); my %KEY_ORDER = ( wpt => [ qw( ele time magvar geoidheight name cmt desc src link sym type fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions ) ], ); my %XMLMAP = ( # map hash keys to GPX names waypoints => { waypoints => 'wpt' }, routes => { routes => 'rte', points => 'rtept' }, tracks => { tracks => 'trk', segments => 'trkseg', points => 'trkpt' } ); # my $unsafe_chars_default = '<>&\'"'; my $unsafe_chars_default = '<>&"'; # single-quote character is not problematic my (@META, @ATTR); BEGIN { @META = qw( name desc author time keywords copyright link ); @ATTR = qw( version ); # Generate accessors for my $attr ( @META, @ATTR ) { no strict 'refs'; *{ __PACKAGE__ . '::' . $attr } = sub { my $self = shift; $self->{$attr} = shift if @_; return $self->{$attr}; } } } sub _time_string_to_epoch { my $dt = DateTime::Format::ISO8601->parse_datetime( shift ); return $dt->epoch } sub _time_epoch_to_string { my $dt = DateTime->from_epoch( epoch => shift, time_zone => 'UTC' ); my $str = $dt->strftime( '%Y-%m-%dT%H:%M:%S%z' ); $str =~ s/(\d{2})$/:$1/; $str =~ s/\+00:00$/Z/; return $str } sub _init_shiny_new { my ( $self, $args ) = @_; $self->{schema} = []; $self->{waypoints} = []; $self->{routes} = []; $self->{tracks} = []; $self->{handler} = { create => sub { return {@_}; }, time => sub { return _time_epoch_to_string( $_[0] ); } } } =head2 Constructor =over 4 =item new( input => ($fname | $fh) or xml => $xml [, work_dir => $working_directory ] ) Create and return a new C instance based on a *.gpx file (I<$fname>), an open filehandle (I<$fh>), or an XML string (I<$xml>). GPX 1.0 and 1.1 are supported. The optional C (or C for short) specifies where to save any working files, such as with the save() method. It can be supplied as a relative path or as an absolute path. If C is omitted, it is set based on the path of the I<$fname> supplied or the current working directory if the constructor is called with an XML string or a filehandle (see C<< set_wd() >> for more info). =back =cut sub new { my ( $class, @args ) = @_; my $self = bless( {}, $class ); # CORE::time because we have our own time method. $self->{time} = CORE::time(); if ( @args % 2 == 0 ) { my %args = @args; $self->_init_shiny_new( \%args ); if ( exists $args{input} ) { my ($fh, $arg); $arg = $args{input}; $arg =~ s/~/$ENV{'HOME'}/ if $arg =~ /^~/; if (-f $arg and $arg !~ /^GLOB/) { open( $fh , '<', $arg ) or die "can't open file $arg $!"; $self->_parse( $fh ); $self->set_filename($arg) } else { $self->_parse( $args{input} ) } } elsif ( exists $args{xml} ) { $self->_parse( \$args{xml} ) } $self->set_wd( $args{work_dir} || $args{wd} ) } else { croak( "Invalid arguments" ) } return $self } sub _trim { my $str = shift; $str =~ s/^\s+//; $str =~ s/\s+$//; $str =~ s/\s+/ /g; $str = encode( 'utf-8', $str ); # ... because XML::TokeParser (called by the XML::Descent instance) encodes all entities indiscriminately and there is no way to turn that off return $str } sub _parse { my $self = shift; my $source = shift; my $p = XML::Descent->new( { Input => $source } ); $p->on( gpx => sub { my ( $elem, $attr ) = @_; $p->context( $self ); my $version = $self->{version} = ( $attr->{version} || '1.0' ); my $parse_deep = sub { my ( $elem, $attr ) = @_; my $ob = $attr; # Get attributes $p->context( $ob ); $p->walk(); return $ob }; # Parse a point my $parse_point = sub { my ( $elem, $attr ) = @_; my $pt = $parse_deep->( $elem, $attr ); return Geo::Gpx::Point->new( %{$pt} ) }; $p->on( '*' => sub { my ( $elem, $attr, $ctx ) = @_; $ctx->{$elem} = _trim( $p->text() ) }, time => sub { my ( $elem, $attr, $ctx ) = @_; my $tm = _time_string_to_epoch( _trim( $p->text() ) ); $ctx->{$elem} = $tm if defined $tm } ); if ( _cmp_ver( $version, '1.1' ) >= 0 ) { # Handle 1.1 metadata $p->on( metadata => sub { $p->walk(); }, [ 'link', 'email', 'author' ] => sub { my ( $elem, $attr, $ctx ) = @_; $ctx->{$elem} = $parse_deep->( $elem, $attr ) } ); } else { # Handle 1.0 metadata $p->on( url => sub { my ( $elem, $attr, $ctx ) = @_; $ctx->{link}->{href} = _trim( $p->text() ) }, urlname => sub { my ( $elem, $attr, $ctx ) = @_; $ctx->{link}->{text} = _trim( $p->text() ) }, author => sub { my ( $elem, $attr, $ctx ) = @_; $ctx->{author}->{name} = _trim( $p->text() ) }, email => sub { my ( $elem, $attr, $ctx ) = @_; my $em = _trim( $p->text() ); if ( $em =~ m{^(.+)\@(.+)$} ) { $ctx->{author}->{email} = { id => $1, domain => $2 }; } } ); } $p->on( bounds => sub { my ( $elem, $attr, $ctx ) = @_; $ctx->{$elem} = $parse_deep->( $elem, $attr ) }, keywords => sub { my ( $elem, $attr ) = @_; $self->{keywords} = [ map { _trim( $_ ) } split( /,/, $p->text() ) ] }, wpt => sub { my ( $elem, $attr ) = @_; push @{ $self->{waypoints} }, $parse_point->( $elem, $attr ) }, [ 'trkpt', 'rtept' ] => sub { my ( $elem, $attr, $ctx ) = @_; push @{ $ctx->{points} }, $parse_point->( $elem, $attr ) }, rte => sub { my ( $elem, $attr ) = @_; my $rt = $parse_deep->( $elem, $attr ); push @{ $self->{routes} }, $rt }, trk => sub { my ( $elem, $attr ) = @_; my $tk = {}; $p->context( $tk ); $p->on( trkseg => sub { my ( $elem, $attr ) = @_; my $seg = $parse_deep->( $elem, $attr ); push @{ $tk->{segments} }, $seg; } ); $p->walk(); push @{ $self->{tracks} }, $tk } ); $p->walk() } ); $p->walk() } =over 4 =item clone() Returns a deep copy of a C instance. $clone = $self->clone; =back =cut sub clone { # actually it can clone anything my $clone; eval(Data::Dumper->Dump([ shift ], ['$clone'])); confess $@ if $@; return $clone } =head2 Methods =over 4 =item waypoints( $int or name => $name ) Without arguments, returns the array reference of waypoints. With an argument, returns a reference to the waypoint whose C field is an exact match with I<$name>. If an integer is specified instead of the C key/value pair, returns the waypoint at position I<$int> in the array reference (1-indexed with negative integers also counting from the end of the array). Returns C if no corresponding waypoints are found such that this method can be used to check if a specific point exists (i.e. no exception is raised if I<$name> or I<$int> do not exist) . =back =cut sub waypoints { my $aref = shift->{waypoints}; return $aref unless @_; my $waypoint; if (@_ == 2) { croak "$_[0] key is not supported in waypoints()" unless $_[0] eq 'name'; for my $pt ( @{$aref} ) { next unless defined $pt->name; $waypoint = $pt if $pt->name eq $_[1] } } else { my $index = $_[0]; croak 'waypoints are 1-indexed, please specify a non-zero integer' if $index==0; $index -= 1 if $index > 0; # such that -1, -2, still count from end $waypoint = $aref->[ $index ] } return $waypoint } =over 4 =item waypoints_add( $point or \%point [, $point or \%point, … ] ) Add one or more waypoints. Each waypoint must be either a L or a hash reference with fields that can be parsed by L's C constructor. See the later for the possible fields. %point = ( lat => 54.786989, lon => -2.344214, ele => 512, name => 'My house' ); $gpx->waypoints_add( \%point ); or $pt = Geo::Gpx::Point->new( %point ); $gpx->waypoints_add( $pt ); =back =cut sub waypoints_add { my $self = shift; for my $wpt ( @_ ) { eval { keys %$wpt }; croak "waypoint argument must be a hash reference" if $@; croak "'lat' and 'lon' keys are mandatory in waypoint hash" unless exists $wpt->{lon} && exists $wpt->{lat}; my $pt = Geo::Gpx::Point->new( %$wpt ); if (defined $pt->name ) { my $new_name = $pt->name; croak "there already is a waypoint named $new_name, please select another name" if $self->waypoints( 'name' => $new_name ); } push @{ $self->{waypoints} }, $pt } #TODO: Should return 1 } =over 4 =item waypoints_search( $field => $regex ) returns an array of waypoints whose I<$field> (e.g. C, C, …) matches I<$regex>. By default, the regex is case-sensitive; specify C to ignore case. =back =cut sub waypoints_search { my ($gpx, $field, $regex) = @_; my @matches; my $iter = $gpx->iterate_waypoints(); while ( my $pt = $iter->() ) { if (defined $pt->$field) { push @matches, $pt if ($pt->$field =~ $regex) } } return @matches } =over 4 =item waypoints_clip( $name | $regex | LIST ) =item way_clip( ) Sends the coordinates of the waypoint(s) whose name is either C<$name> or matches C<$regex> to the clipboard (all points found are sent to the clipboard) and returns an array of points found. By default, the regex is case-sensitive; specify C to ignore case. Alternatively, an array of C can be provided. C is a short-hand for this method (convenient when used interactively in the debugger). This method is only supported on unix-based systems that have the C utility installed (see DEPENDENCIES). =back =cut sub way_clip { waypoints_clip( @_ ) } sub waypoints_clip { my $gpx = shift; my @points; if ( blessed $_[0] and $_[0]->isa('Geo::Gpx::Point' )) { @points = @_ } else { my $first_arg = shift; if ( ref( $first_arg ) eq 'Regexp' ) { @points = $gpx->waypoints_search( name => $first_arg ) } else { my $match = $gpx->waypoints( name => $first_arg ); push @points, $match if $match } croak 'no point matches the supplied regex' unless @points } my @points_reversed = reverse @points; for my $pt (@points_reversed) { croak 'way_clip() expects list of Geo::Gpx::Point objects' unless $pt->isa('Geo::Gpx::Point'); my $coords = $pt->lat . ', '; $coords .= $pt->lon; system("echo $coords | xclip -selection clipboard") } return @points } =over 4 =item waypoints_delete_all() delete all waypoints. Returns true. =back =cut sub waypoints_delete_all { my $gpx = shift; croak 'waypoints_delete_all() expects no arguments' if @_; $gpx->{waypoints} = []; return 1 } =over 4 =item waypoint_delete( $name ) delete the waypoint whose C field is an exact match for I<$name> (case sensitively). Returns true if successful, C if the name cannot be found. =back =cut sub waypoint_delete { my ($gpx, $name) = @_; my ($index, $found_match) = (0, undef); my $iter = $gpx->iterate_waypoints(); while ( my $pt = $iter->() ) { if (defined $pt->name) { if ($pt->name eq $name) { $found_match = 1; last } } ++$index } splice @{$gpx->{waypoints}}, $index, 1 if $found_match; return $found_match } =over 4 =item waypoint_rename( $name, $new_name ) rename the waypoint whose C field is an exact match for I<$name> (case sensitively) to I<$new_name>. Returns the point's new name if successful, C otherwise. =back =cut sub waypoint_rename { my $gpx = shift; croak 'waypoint_rename() expects $name and $new_name as arguments' unless @_ == 2; my ($name, $new_name) = @_; my $ret_val; croak "there already is a waypoint named $new_name, please select another name" if $gpx->waypoints( 'name' => $new_name ); my $iter = $gpx->iterate_waypoints(); while ( my $pt = $iter->() ) { if (defined $pt->name) { if ($pt->name eq $name) { $ret_val = $pt->name( $new_name ); last } } } return $ret_val } =over 4 =item waypoints_merge( $gpx, $regex ) Merge waypoints with those contained in the L instance provide as argument. Waypoints are compared based on their respective C fields, which must exist in I<$gpx> (if names are missing in the current instance, all points will be merged). A I<$regex> may be provided to limit the merge to a subset of waypoints from I<$gpx>. Returns the number of points successfully merged (i.e. the difference in C<< $gps->waypoints_count >> before and after the merge). =back =cut sub waypoints_merge { my ($gpx1, $gpx2) = (shift, shift); my ($regex, @to_merge); $regex = shift if ref $_[0] eq 'Regexp'; croak "waypoints_merge() expects a Geo::Gpx object (and optionally a regex) as arguments" if @_; if ($regex) { @to_merge = $gpx2->waypoints_search( name => $regex ) } else { @to_merge = @{ $gpx2->waypoints } } croak "no waypoints to merge found" unless @to_merge; my $before_count = $gpx1->waypoints_count; for (0 .. $#to_merge) { my $pt = $to_merge[$_]; croak "points to merge must contain a name field" unless defined $pt->name; next if $gpx1->waypoints( name => $pt->name ); # i.e. don't add if exists, could later give option force => 1 $gpx1->waypoints_add( $pt ) } return $gpx1->waypoints_count - $before_count } =over 4 =item waypoint_closest_to( $point or $tcx_trackpoint ) =item trackpoint_closest_to( … ) =item routepoint_closest_to( … ) =item point_closest_to( … ) From any L or L object, return the L that is closest to it. If called in list context, returns a two-element array consisting of that point, and the distance from the coordinate (in meters). =back =cut sub waypoint_closest_to { my $gpx = shift; my ($closest_pt, $min_dist) = _iterate_and_find_closest_to( $gpx->iterate_waypoints, @_ ); return ($closest_pt, $min_dist) if wantarray; return $closest_pt } sub trackpoint_closest_to { my $gpx = shift; my ($closest_pt, $min_dist) = _iterate_and_find_closest_to( $gpx->iterate_trackpoints, @_ ); return ($closest_pt, $min_dist) if wantarray; return $closest_pt } sub routepoint_closest_to { my $gpx = shift; my ($closest_pt, $min_dist) = _iterate_and_find_closest_to( $gpx->iterate_routepoints, @_ ); return ($closest_pt, $min_dist) if wantarray; return $closest_pt } sub point_closest_to { my $gpx = shift; my ($closest_pt, $min_dist) = _iterate_and_find_closest_to( $gpx->iterate_points, @_ ); return ($closest_pt, $min_dist) if wantarray; return $closest_pt } sub _iterate_and_find_closest_to { my ($iterator, $to_pt) = (shift, shift); my ($method_name, @caller); @caller = caller(1); ($method_name = $caller[3]) =~ s/.*::(.*)/$1()/; my $croak_msg = $method_name . ' expects a single argument in the form of a Geo::Gpx::Point or Geo::TCX::Trackpoint'; if (ref $to_pt) { croak $croak_msg unless $to_pt->isa('Geo::Gpx::Point') or $to_pt->isa('Geo::TCX::Trackpoint') } else { croak $croak_msg } croak $croak_msg if @_; my ($closest_pt, $min_dist); while ( my $pt = $iterator->() ) { my $distance = $to_pt->distance_to( $pt ); $min_dist = $distance if ! defined $min_dist; # $min_dist can be 0 $closest_pt ||= $pt; if ($distance < $min_dist) { $closest_pt = $pt; $min_dist = $distance } } return ($closest_pt, $min_dist) } =over 4 =item waypoints_print() print the list of waypoints to screen, along with their names and descriptions if defined. Returns true. =back =cut sub waypoints_print { my $gpx = shift; croak 'waypoints_print() expects no arguments' if @_; my $iter = $gpx->iterate_waypoints(); while ( my $pt = $iter->() ) { my ($name, $desc); $name = defined $pt->name ? $pt->name : 'Unnamed'; $desc = defined $pt->desc ? $pt->desc : 'No description'; print $name, ': ', $desc, "\n\t", $pt->lat, " ", $pt->lon, "\n" } return 1 } =over 4 =item waypoints_count() returns the number of waypoints in the object. =back =cut sub waypoints_count { return scalar @{ shift->{waypoints} } } =over 4 =item routes( integer or name => 'name' ) Returns the array reference of routes when called without argument. Optionally accepts a single integer referring to the route number from routes aref (1-indexed with negative integers also counting from the end of the array) or a key value pair with the name of the route to be returned. =back =cut sub routes { my $o= shift; return $o->{routes} unless @_; my $route; if (@_ == 2) { for my $t ( @{ $o->{routes} } ) { $route = $t if $t->{$_[0]} eq $_[1] } croak "no route named $_[1] in route list" unless $route } else { my $index = $_[0]; croak 'routes are 1-indexed, please specify a non-zero integer' if $index==0; $index -= 1 if $index > 0; # such that -1, -2, still count from end $route = $o->{routes}[ $index ]; croak "route $_[0] not found" unless $route } return $route } =over 4 =item routes_add( $route or $points_aref [, name => $route_name ) Add a route to a C object. The I<$route> is expected to be an existing route (i.e. a hash ref). Returns true. A new route can also be created based an array reference(s) of L objects and added to the C instance. C and all other meta fields supported by routes can be provided and will overwrite any existing fields in I<$route>. =back =cut sub routes_add { my $o = shift; my ($route, $aref); my @args = @_; for (@args) { if ( ref($_) eq 'HASH' ) { $route = shift } elsif ( ref($_) eq 'ARRAY' ) { $aref = shift } } my %opts = @_; my $c; if ($aref) { croak 'arguments to routes_add() contain both an existing route and an array reference of points, please specify only one kind of reference' if $route; $route = { 'name' => 'Track' }; for my $pt (@$aref) { my $is_geo_gpx_point = blessed $pt and $pt->isa('Geo::Gpx::Point'); $pt = Geo::Gpx::Point->new( %$pt ) unless $is_geo_gpx_point } $route->{points} = $aref } croak 'routes_add() expects an existing route or an array reference as argument' unless $route; $c = clone( $route ); for (keys %opts) { $c->{$_} = $opts{$_} # need to check the $_ are legal } push @{ $o->{routes} }, $c; return 1 } =over 4 =item routes_delete_all() delete all routes. Returns true. =back =cut sub routes_delete_all { my $gpx = shift; croak 'routes_delete_all() expects no arguments' if @_; $gpx->{routes} = []; return 1 } =over 4 =item routes_count() returns the number of routes in the object. =back =cut sub routes_count { return scalar @{ shift->{routes} } } =over 4 =item tracks( integer or name => 'name' ) Returns the array reference of tracks when called without argument. Optionally accepts a single integer referring to the track number from the tracks aref (1-indexed with negative integers also counting from the end of the array) or a key value pair with the name of the track to be returned. =back =cut sub tracks { my $o= shift; return $o->{tracks} unless @_; my $track; if (@_ == 2) { for my $t ( @{ $o->{tracks} } ) { $track = $t if $t->{$_[0]} eq $_[1] } croak "no track named $_[1] in track list" unless $track } else { my $index = $_[0]; croak 'tracks are 1-indexed, please specify a non-zero integer' if $index==0; $index -= 1 if $index > 0; # such that -1, -2, still count from end $track = $o->{tracks}[ $index ]; croak "track $_[0] not found" unless $track } return $track } =over 4 =item tracks_add( $track or $points_aref [, $points_aref, … ] [, name => $track_name ] ) Add a track to a C object. The I<$track> is expected to be an existing track (i.e. a hash ref). Returns true. If I<$track> has no C field and none is provided, the timestamp of the first point of the track will be used (this is experimental and may change in the future). All other fields supported by tracks can be provided and will overwrite any existing fields in I<$track>. A new track can also be created based an array reference(s) of L objects and added to the C instance. If more than one array reference is supplied, the resulting track will contain as many segments as the number of aref's provided. =back =cut sub tracks_add { my $o = shift; my ($track, @arefs); my @args = @_; for (@args) { if ( ref($_) eq 'HASH' ) { $track = shift } elsif ( ref($_) eq 'ARRAY' ) { push @arefs, shift } } my %opts = @_; # Q: do we need to check that $o->{tracks} does not already contain a track of the same name? # - if so we would do here (unless not yet possible) but it's relevant to method way of adding a track # Q: is the name key mandatory? check the schema my $c; if (@arefs) { croak 'arguments to tracks_add() contain both an existing track and an array reference of points, please specify only one kind of reference' if $track; # $track = { 'name' => 'Track', 'segments' => [] }; $track = { 'segments' => [] }; # commented line was just to show the structure of the aref, the name is not required for my $i (0 .. $#arefs) { my $points = $arefs[$i]; for my $pt (@{$points}) { my $is_geo_gpx_point = blessed $pt and $pt->isa('Geo::Gpx::Point'); $pt = Geo::Gpx::Point->new( %$pt ) unless $is_geo_gpx_point } $track->{segments}[$i]{points} = $points } } else { croak 'tracks_add() expects an existing track or an array reference as argument' unless $track } $c = clone( $track ); for (keys %opts) { $c->{$_} = $opts{$_} # need to check the $_ are legal } # let's try a default behaviour of adding time of first point if name is not defined (could provide option to turn this off) if ( ! defined $c->{name} ) { my $first_pt_time = $c->{segments}[0]{points}[0]->time; $c->{name} = _time_epoch_to_string( $first_pt_time ) if $first_pt_time } push @{ $o->{tracks} }, $c; return 1 } =over 4 =item tracks_delete_all() delete all tracks. Returns true. =back =cut sub tracks_delete_all { my $gpx = shift; croak 'tracks_delete_all() expects no arguments' if @_; $gpx->{tracks} = []; return 1 } =over 4 =item track_delete( $name ) delete the track whose C field is an exact match for I<$name> (case sensitively). Returns true if successful, C if the name cannot be found. =back =cut sub track_delete { my ($gpx, $name) = @_; my ($index, $found_match) = (0, undef); for my $t ( @{ $gpx->{tracks} } ) { if ($t->{name} eq $name) { $found_match = 1; last } ++$index } splice @{$gpx->{tracks}}, $index, 1 if $found_match; return $found_match } =over 4 =item track_rename( $name, $new_name ) rename the track whose C field is an exact match for I<$name> (case sensitively) to I<$new_name>. Returns the track's new name if successful, C otherwise. Alternatively, an integer may be specified as the first argument, referring to the track number from tracks aref (1-indexed). This is a convenience as it is quite common for tracks to be named with the timestamp fo the first point. =back =cut sub track_rename { my $gpx = shift; croak 'track_rename() expects $name (or an integer) and $new_name as arguments' unless @_ == 2; my ($first_arg, $new_name) = @_; for my $t ( @{ $gpx->{tracks} } ) { croak "there already is a track named $new_name, please select another name" if $t->{name} eq $new_name } my $track; my $is_index = looks_like_number( $first_arg ); $track = $is_index ? $gpx->tracks( $first_arg ) : $gpx->tracks( name => $first_arg ); if (defined $track) { return $track->{name} = $new_name } return undef } =over 4 =item tracks_print() print the list of tracks to screen, by their C field. Returns true. =back =cut sub tracks_print { my $gpx = shift; croak 'tracks_print() expects no arguments' if @_; for my $t ( @{ $gpx->{tracks} } ) { print $t->{name}, "\n" } return 1 } =over 4 =item tracks_count() returns the number of tracks in the object. =back =cut sub tracks_count { return scalar @{ shift->{tracks} } } sub _iterate_points { my $pts = shift || []; # array ref unless ( defined $pts ) { return sub { return } } my $max = scalar( @{$pts} ); my $pos = 0; return sub { return if $pos >= $max; return $pts->[ $pos++ ] } } sub _iterate_iterators { my @its = @_; return sub { for ( ;; ) { return undef unless @its; my $next = $its[0]->(); return $next if defined $next; shift @its } } } =over 4 =item iterate_waypoints() =item iterate_trackpoints() =item iterate_routepoints() Get an iterator for all of the waypoints, trackpoints, or routepoints in a C instance, as per the iterator chosen. =cut sub iterate_waypoints { my $self = shift; return _iterate_points( $self->{waypoints} ) } sub iterate_routepoints { my $self = shift; my @iter = (); if ( exists( $self->{routes} ) ) { for my $rte ( @{ $self->{routes} } ) { push @iter, _iterate_points( $rte->{points} ) } } return _iterate_iterators( @iter ) } sub iterate_trackpoints { my $self = shift; my @iter = (); if ( exists( $self->{tracks} ) ) { for my $trk ( @{ $self->{tracks} } ) { if ( exists( $trk->{segments} ) ) { for my $seg ( @{ $trk->{segments} } ) { push @iter, _iterate_points( $seg->{points} ) } } } } return _iterate_iterators( @iter ) } =item iterate_points() Get an iterator for all of the points in a C instance, including waypoints, trackpoints, and routepoints. my $iter = $gpx->iterate_points(); while ( my $pt = $iter->() ) { print "Point: ", join( ', ', $pt->{lat}, $pt->{lon} ), "\n"; } =back =cut sub iterate_points { my $self = shift; return _iterate_iterators( $self->iterate_waypoints(), $self->iterate_routepoints(), $self->iterate_trackpoints() ) } =over 4 =item bounds( $iterator ) Compute the bounding box of all the points in a C returning the result as a hash reference. my $gpx = Geo::Gpx->new( xml => $some_xml ); my $bounds = $gpx->bounds(); returns a structure like this: $bounds = { minlat => 57.120939, minlon => -2.9839832, maxlat => 57.781729, maxlon => -1.230902 }; C<$iterator> defaults to C<$self-Eiterate_points> if not specified. =cut sub bounds { my ( $self, $iter ) = @_; $iter ||= $self->iterate_points; my $bounds = {}; while ( my $pt = $iter->() ) { $bounds->{minlat} = $pt->{lat} if !defined $bounds->{minlat} || $pt->{lat} < $bounds->{minlat}; $bounds->{maxlat} = $pt->{lat} if !defined $bounds->{maxlat} || $pt->{lat} > $bounds->{maxlat}; $bounds->{minlon} = $pt->{lon} if !defined $bounds->{minlon} || $pt->{lon} < $bounds->{minlon}; $bounds->{maxlon} = $pt->{lon} if !defined $bounds->{maxlon} || $pt->{lon} > $bounds->{maxlon}; } return $bounds } sub _enc { return encode_entities_numeric( @_ ) # 2nd positional arg can either be undef or the string of unsafe chars to encode } sub _tag { my $uc = shift; # unsafe_characters my $name = shift; my $attr = shift || {}; my @tag = ( '<', $name ); # Sort keys so the tests can depend on hash output order for my $n ( sort keys %{$attr} ) { my $v = $attr->{$n}; push @tag, ' ', $n, '="', _enc( $v, $uc ), '"' } if ( @_ ) { push @tag, '>', @_, '\n" } else { push @tag, " />\n" } return join( '', @tag ) } sub _xml { my $self = shift; my $uc = shift; # unsafe_characters my $name = shift; my $value = shift; my $name_map = shift || {}; my $tag = $name_map->{$name} || $name; my $is_geo_gpx_point = blessed $value and $value->isa('Geo::Gpx::Point'); if ( defined( my $enc = $self->{encoder}->{$name} ) ) { return $enc->( $name, $value ) } elsif ( ref $value eq 'HASH' or $is_geo_gpx_point ) { my $attr = {}; my @cont = ( "\n" ); my $as_attr = $AS_ATTR{$name}; # Shallow copy so we can delete keys as we output them my %v = %{$value}; for my $k ( @{ $KEY_ORDER{$name} || [] }, sort keys %v ) { if ( defined( my $vv = delete $v{$k} ) ) { if ( defined $as_attr && $k =~ $as_attr ) { $attr->{$k} = $vv } else { push @cont, $self->_xml( $uc, $k, $vv, $name_map ) } } } return _tag( $uc, $tag, $attr, @cont ) } elsif ( ref $value eq 'ARRAY' ) { return join '', map { $self->_xml( $uc, $tag, $_, $name_map ) } @{$value} } else { return _tag( $uc, $tag, {}, _enc( $value, $uc ) ) } } sub _cmp_ver { my ( $v1, $v2 ) = @_; my @v1 = split( /[.]/, $v1 ); my @v2 = split( /[.]/, $v2 ); while ( @v1 && @v2 ) { my $cmp = ( shift @v1 <=> shift @v2 ); return $cmp if $cmp } return @v1 <=> @v2 } =item xml( key/values ) Generate and return an XML string representation of the instance. I are (all optional): Z<> C: specifies the GPX XML version scheme to use (defaults to 1.0). Z<> C: the set of characters to be considered unsafe for the XML mark-up and encoded as an entity. If C is omitted, it defaults to the value of the C attribute. Parsing a GPX document sets the version. If the C attribute is unset defaults to 1.0. C can be provided to specify which characters to consider unsafe in generating the XML mark-up. This field is then passed through to L function calls whose documentation describes that this field is "specified using the regular expression character class syntax (what you find within brackets in regular expressions)". As of version I<1.11> of C, the default set of characters are the C<< '<' >>, C<'&'>, C<< '>' >>, C<'"'> characters. To revert to the pre-version I<1.11> default, which is equivalent to that in , explicitely specify C<< unsafe_chars => undef >>. This will encode as the latter module describes the "control chars, high-bit chars, and the C<< '<' >>, C<'&'>, C<< '>' >>, C<< "'" >>, C<'"'> characters". =cut sub xml { my ($self, %opts) = @_; my $version = $opts{version} || '1.0'; my $uc; # can exist and set as undef to encode everything if ( exists $opts{unsafe_chars} ) { $uc = $opts{unsafe_chars} } else { $uc = $unsafe_chars_default } my @ret = (); push @ret, qq{\n}; $self->{encoder} = { time => sub { my ( $n, $v ) = @_; return _tag( $uc, $n, {}, _enc( $self->{handler}->{time}->( $v ), $uc ) ) }, keywords => sub { my ( $n, $v ) = @_; return _tag( $uc, $n, {}, _enc( join( ', ', @{$v} ), $uc ) ) } }; # Limit to the latest version we know about if ( _cmp_ver( $version, '1.1' ) >= 0 ) { $version = '1.1'; } else { # Modify encoder $self->{encoder}->{link} = sub { my ( $n, $v ) = @_; my @v = (); push @v, $self->_xml( $uc, 'url', $v->{href} ) if exists( $v->{href} ); push @v, $self->_xml( $uc, 'urlname', $v->{text} ) if exists( $v->{text} ); return join( '', @v ) }; $self->{encoder}->{email} = sub { my ( $n, $v ) = @_; if ( exists( $v->{id} ) && exists( $v->{domain} ) ) { return _tag( $uc, 'email', {}, _enc( join( '@', $v->{id}, $v->{domain} ), $uc ) ) } else { return '' } }; $self->{encoder}->{author} = sub { my ( $n, $v ) = @_; my @v = (); push @v, _tag( $uc, 'author', {}, _enc( $v->{name}, $uc ) ) if exists( $v->{name} ); push @v, $self->_xml( $uc, 'email', $v->{email} ) if exists( $v->{email} ); return join( '', @v ) }; } # Turn version into path element ( my $vpath = $version ) =~ s{[.]}{/}g; my $ns = "http://www.topografix.com/GPX/$vpath"; my $schema = join( ' ', $ns, "$ns/gpx.xsd", @{ $self->{schema} } ); push @ret, qq{\n}; my @meta = (); for my $fld ( @META ) { if ( exists( $self->{$fld} ) ) { push @meta, $self->_xml( $uc, $fld, $self->{$fld} ) } } my $bounds = $self->bounds( $self->iterate_points() ); if ( %{$bounds} ) { push @meta, _tag( $uc, 'bounds', $bounds ) } # Version 1.1 nests metadata in a metadata tag if ( _cmp_ver( $version, '1.1' ) >= 0 ) { push @ret, _tag( $uc, 'metadata', {}, "\n", @meta ) } else { push @ret, @meta } my @existing_keys; # waypoints should be generated first, applications like MapSource croak if not for my $k ( sort keys %XMLMAP ) { if ( exists( $self->{$k} ) ) { if ($k eq 'waypoints') { unshift @existing_keys, $k } else { push @existing_keys, $k } } } for my $k ( @existing_keys ) { push @ret, $self->_xml( $uc, $k, $self->{$k}, $XMLMAP{$k} ) } push @ret, qq{\n}; return join( '', @ret ) } =item TO_JSON For compatibility with L modules. Convert this object to a hash with keys that correspond to the above methods. Generated ala: my %json = map { $_ => $self->$_ } qw( name desc author keywords copyright time link waypoints tracks routes version ); $json{bounds} = $self->bounds( $iter ); With one difference: the keys will only be set if they are defined. =back =cut sub TO_JSON { my $self = shift; my %json; #= map {$_ => $self->$_} ... my @keys = (@META, @ATTR); push @keys, 'waypoints' if $self->waypoints_count; push @keys, 'routes' if $self->routes_count; push @keys, 'tracks' if $self->tracks_count; for my $key ( @keys ) { my $val = $self->$key; $json{$key} = $val if defined $val } if ( my $bounds = $self->bounds ) { $json{bounds} = $self->bounds } return \%json } =over 4 =item save( filename => $fname, key/values ) Saves the C instance as a file. The filename field is optional unless the instance was created without a filename (i.e with an XML string or a filehandle) and C has not been called yet. If the filename is a relative path, the file will be saved in the instance's working directory (not the caller's, C). I are (all optional): Z<> C: overwrites existing files if true, otherwise it won't. Z<> C: save C<< … >> tags if true (defaults to false). Z<> C: save the C<< >> tag in the file's meta information tags if true (defaults to false). Some applications like MapSource return an error if this tags is present. (All other time tags elsewhere are kept.) Z<> C: see the documentation for C above. =back =cut sub save { my ($o, %opts) = @_; my ($fh, $fname, $xml_string); if ( $opts{filename} ) { $fname = $o->set_filename( $opts{filename} ) } else { $fname = $o->set_filename() } croak "$fname already exists" if -f $fname and !$opts{force}; my $uc; # can exist and set as undef to encode everything if ( exists $opts{unsafe_chars} ) { $uc = $opts{unsafe_chars} } else { $uc = $unsafe_chars_default } $xml_string = $o->xml( unsafe_chars => $uc ); if ( ! $opts{extensions} ) { $xml_string =~ s/\n*\w*[^<]*<\/extensions>//gs } if ( ! $opts{meta_time} ) { $xml_string =~ s/\n*\w*