Geo-Gpx-0.26000755000765000120 011210046507 12104 5ustar00andyadmin000000000000Build.PL000444000765000120 127011210046507 13456 0ustar00andyadmin000000000000Geo-Gpx-0.26use strict; use warnings; use Module::Build; use 5.005; use lib 'inc'; use MyBuilder; my $builder = MyBuilder->new( module_name => 'Geo::Gpx', license => 'perl', dist_author => 'Andy Armstrong ', dist_version_from => 'lib/Geo/Gpx.pm', requires => { 'DateTime' => 0, 'DateTime::Format::ISO8601' => 0, 'HTML::Entities' => 0, 'Scalar::Util' => 0, 'Test::More' => 0, 'Time::Local' => 0, 'XML::Descent' => '1.01', 'version' => 0, }, add_to_cleanup => ['Geo-Gpx-*'], ); $builder->create_build_script(); Changes000444000765000120 265311210046507 13463 0ustar00andyadmin000000000000Geo-Gpx-0.26Revision history for Geo-Gpx 0.13 2006-11-26 Implement complete support for parsing and generating GPX 1.0 and 1.1 documents 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.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.16 2007-02-11 Fixed idiotic dependency on rand producing the same values given the same seed on all platforms. 0.17 2007-02-23 Added machine readable licence. 0.18 2007-08-07 Replaced AUTOLOAD with generated accessors. Added bd foy's suggested add_waypoint method. 0.19 2007-10-11 Fixed wpt element ordering per #29909 0.20 2007-10-11 Release to (hopefully) fix bizarre test failures. 0.21 2007-10-13 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.23 2009-03-08 Skip JSON tests if installed JSON is too old. 0.24 2009-03-10 Avoid clock skew in JSON tests. 0.25 2009-05-05 Implement time zone support. Refs #28532. 0.26 2009-05-26 Move to GitHub MANIFEST000444000765000120 31311210046507 13270 0ustar00andyadmin000000000000Geo-Gpx-0.26Build.PL Changes inc/MyBuilder.pm lib/Geo/Gpx.pm Makefile.PL MANIFEST README t/0load.t t/cmp_ver.t t/datetime.t t/gen-parse.t t/iter.t t/key-order.t t/legacy.t t/misc.t t/pod-coverage.t t/pod.t META.yml META.yml000444000765000120 121311210046507 13430 0ustar00andyadmin000000000000Geo-Gpx-0.26--- name: Geo-Gpx version: 0.26 author: - 'Andy Armstrong ' abstract: Create and parse GPX files. license: perl resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Geo-Gpx license: http://dev.perl.org/licenses/ repository: git://github.com/AndyA/Geo--Gpx.git requires: DateTime: 0 DateTime::Format::ISO8601: 0 HTML::Entities: 0 Scalar::Util: 0 Test::More: 0 Time::Local: 0 XML::Descent: 1.01 version: 0 provides: Geo::Gpx: file: lib/Geo/Gpx.pm version: 0.26 generated_by: Module::Build version 0.33 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Makefile.PL000444000765000120 205211210046507 14133 0ustar00andyadmin000000000000Geo-Gpx-0.26use strict; use warnings; use ExtUtils::MakeMaker; eval 'use ExtUtils::MakeMaker::Coverage'; warn "Optional ExtUtils::MakeMaker::Coverage not available\n" if $@; WriteMakefile( ( MM->can( 'signature_target' ) ? ( SIGN => 1 ) : () ), license( 'perl' ), NAME => 'Geo::Gpx', AUTHOR => 'Andy Armstrong ', VERSION_FROM => 'lib/Geo/Gpx.pm', ABSTRACT_FROM => 'lib/Geo/Gpx.pm', PL_FILES => {}, PREREQ_PM => { 'DateTime' => 0, 'DateTime::Format::ISO8601' => 0, 'HTML::Entities' => 0, 'Scalar::Util' => 0, 'Test::More' => 0, 'Time::Local' => 0, 'XML::Descent' => '1.01', 'version' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Geo-Gpx-*' }, ); sub license { my $lic = shift; local $^W = 0; # Silence warning about non-numeric version return unless $ExtUtils::MakeMaker::VERSION >= '6.31'; return ( LICENSE => $lic ); } README000444000765000120 100411210046507 13035 0ustar00andyadmin000000000000Geo-Gpx-0.26Geo-Gpx version 0.26 INSTALLATION To install this module, 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 DEPENDENCIES None. COPYRIGHT AND LICENCE Copyright (C) Rich Bowen Copyright (C) 2006, Andy Armstrong This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. inc000755000765000120 011210046507 12576 5ustar00andyadmin000000000000Geo-Gpx-0.26MyBuilder.pm000444000765000120 353111210046507 15167 0ustar00andyadmin000000000000Geo-Gpx-0.26/incpackage MyBuilder; use base qw( Module::Build ); sub create_build_script { my ( $self, @args ) = @_; $self->_auto_mm; return $self->SUPER::create_build_script( @args ); } sub _auto_mm { my $self = shift; my $mm = $self->meta_merge; my @meta = qw( homepage bugtracker MailingList repository ); for my $meta ( @meta ) { next if exists $mm->{resources}{$meta}; my $auto = "_auto_$meta"; next unless $self->can( $auto ); my $av = $self->$auto(); $mm->{resources}{$meta} = $av if defined $av; } $self->meta_merge( $mm ); } sub _auto_repository { my $self = shift; if ( -d '.svn' ) { my $info = `svn info .`; return $1 if $info =~ /^URL:\s+(.+)$/m; } elsif ( -d '.git' ) { my $info = `git remote -v`; return unless $info =~ /^origin\s+(.+)$/m; my $url = $1; # Special case: patch up github URLs $url =~ s!^git\@github\.com:!git://github.com/!; return $url; } return; } sub _auto_bugtracker { 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=' . shift->dist_name; } sub ACTION_testauthor { my $self = shift; $self->test_files( 'xt/author' ); $self->ACTION_test; } sub ACTION_critic { exec qw( perlcritic -1 -q -profile perlcriticrc lib/ ), glob 't/*.t'; } sub ACTION_tags { exec( qw( ctags -f tags --recurse --totals --exclude=blib --exclude=.svn --exclude='*~' --languages=Perl t/ lib/ ) ); } sub ACTION_tidy { my $self = shift; my @extra = qw( Build.PL ); my %found_files = map { %$_ } $self->find_pm_files, $self->_find_file_by_type( 'pm', 't' ), $self->_find_file_by_type( 'pm', 'inc' ), $self->_find_file_by_type( 't', 't' ); my @files = ( keys %found_files, map { $self->localize_file_path( $_ ) } @extra ); for my $file ( @files ) { system 'perltidy', '-b', $file; unlink "$file.bak" if $? == 0; } } 1; lib000755000765000120 011210046507 12573 5ustar00andyadmin000000000000Geo-Gpx-0.26Geo000755000765000120 011210046507 13305 5ustar00andyadmin000000000000Geo-Gpx-0.26/libGpx.pm000444000765000120 6651111210046507 14567 0ustar00andyadmin000000000000Geo-Gpx-0.26/lib/Geopackage Geo::Gpx; use warnings; use strict; use Carp; use DateTime::Format::ISO8601; use DateTime; use HTML::Entities qw( encode_entities encode_entities_numeric ); use Scalar::Util qw( blessed ); use Time::Local; use XML::Descent; =head1 NAME Geo::Gpx - Create and parse GPX files. =head1 VERSION This document describes Geo::Gpx version 0.26 =head1 SYNOPSIS # Version 0.10 compatibility use Geo::Gpx; my $gpx = Geo::Gpx->new( @waypoints ); my $xml = $gpx->xml; # New API, generate GPX my $gpx = Geo::Gpx->new(); $gpx->waypoints( \@wpt ); my $xml = $gpx->xml( '1.0' ); # Parse GPX my $gpx = Geo::Gpx->new( xml => $xml ); my $waypoints = $gpx->waypoints(); my $tracks = $gpx->tracks(); # Parse GPX from open file my $gpx = Geo::Gpx->new( input => $fh ); my $waypoints = $gpx->waypoints(); my $tracks = $gpx->tracks(); =head1 DESCRIPTION The original goal of this module was to produce GPX/XML files which were parseable by both GPX Spinner and EasyGPS. As of version 0.13 it has been extended to support general parsing and generation of GPX data. GPX 1.0 and 1.1 are supported. =cut use vars qw ($VERSION); $VERSION = '0.26'; # Values that are encoded as attributes my %AS_ATTR = ( 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 ) ], ); # Map hash keys to GPX names my %XMLMAP = ( waypoints => { waypoints => 'wpt' }, routes => { routes => 'rte', points => 'rtept' }, tracks => { tracks => 'trk', segments => 'trkseg', points => 'trkpt' } ); my @META; my @ATTR; BEGIN { @META = qw( name desc author time keywords copyright link ); @ATTR = qw( waypoints tracks routes 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 _parse_time { my ( $self, $str ) = @_; my $dt = DateTime::Format::ISO8601->parse_datetime( $str ); return $self->{use_datetime} ? $dt : $dt->epoch; } sub _format_time { my ( $self, $tm, $legacy ) = @_; unless ( blessed $tm && $tm->can( 'strftime' ) ) { return $self->_format_time( DateTime->from_epoch( epoch => $tm, time_zone => 'UTC' ), $legacy ); } my $ts = $tm->strftime( $legacy ? '%Y-%m-%dT%H:%M:%S.%7N%z' : '%Y-%m-%dT%H:%M:%S%z' ); $ts =~ s/(\d{2})$/:$1/; return $ts; } # For backwards compatibility sub _init_legacy { my $self = shift; $self->{keywords} = [qw(cache geocache groundspeak)]; $self->{author} = { name => 'Groundspeak', email => { id => 'contact', domain => 'groundspeak.com' } }; $self->{desc} = 'GPX file generated by Geo::Gpx'; $self->{schema} = [ qw( http://www.groundspeak.com/cache/1/0 http://www.groundspeak.com/cache/1/0/cache.xsd ) ]; require Geo::Cache; $self->{handler} = { create => sub { return Geo::Cache->new( @_ ); }, time => sub { return $self->_format_time( $_[0], 1 ); }, }; } sub _init_shiny_new { my ( $self, $args ) = @_; $self->{use_datetime} = $args->{use_datetime} || 0; $self->{schema} = []; $self->{handler} = { create => sub { return {@_}; }, time => sub { return $self->_format_time( $_[0], 0 ); }, }; } =head1 INTERFACE =head2 C The original purpose of C was to allow an array of L objects to be converted into a GPX file. This behaviour is maintained by this release: use Geo::Gpx; my $gpx = Geo::Gpx->new( @waypoints ); my $xml = $gpx->xml; New applications can use C to parse a GPX file : my $gpx = Geo::Gpx->new( xml => $gpx_document ); or from an open filehandle : my $gpx = Geo::Gpx->new( input => $fh ); or can create an empty container to which waypoints, routes and tracks can then be added: my $gpx = Geo::Gpx->new(); $gpx->waypoints( \@wpt ); The following additional options can be specified: =over =item C< use_datetime > If true time values in parsed GPX will be L objects rather than epoch times. =back =cut sub new { my ( $class, @args ) = @_; my $self = bless( {}, $class ); # CORE::time because we have our own time method. $self->{time} = CORE::time(); # Has to handle same calling convention as previous # version. if ( blessed $args[0] && $args[0]->isa( 'Geo::Cache' ) ) { $self->_init_legacy(); $self->{waypoints} = \@args; } elsif ( @args % 2 == 0 ) { my %args = @args; $self->_init_shiny_new( \%args ); if ( exists $args{input} ) { $self->_parse( $args{input} ); } elsif ( exists $args{xml} ) { $self->_parse( \$args{xml} ); } } else { croak( "Invalid arguments" ); } return $self; } # Not a method sub _trim { my $str = shift; $str =~ s/^\s+//; $str =~ s/\s+$//; $str =~ s/\s+/ /g; 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 $self->{handler}->{create}->( %{$pt} ); }; $p->on( '*' => sub { my ( $elem, $attr, $ctx ) = @_; $ctx->{$elem} = _trim( $p->text() ); }, time => sub { my ( $elem, $attr, $ctx ) = @_; my $tm = $self->_parse_time( _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(); } =head2 C Add one or more waypoints. Each waypoint must be a reference to a hash. Each waypoint must include the keys C and C and may include others: my $wpt = { 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 }; $gpx->add_waypoint( $wpt ); Time values may either be an epoch offset or a L. If you wish to specify the timezone use a L. =cut sub add_waypoint { 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}; push @{ $self->{waypoints} }, $wpt; } } # Not a method 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++ ]; }; } # Not a method sub _iterate_iterators { my @its = @_; return sub { for ( ;; ) { return undef unless @its; my $next = $its[0]->(); return $next if defined $next; shift @its; } } } =head2 C Get an iterator that visits all the waypoints in a C. =cut sub iterate_waypoints { my $self = shift; return _iterate_points( $self->{waypoints} ); } =head2 C Get an iterator that visits all the routepoints in a C. =cut 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 ); } =head2 C Get an iterator that visits all the trackpoints in a C. =cut 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 ); } =head2 C Get an iterator that visits all the points in a C. For example my $iter = $gpx->iterate_points(); while ( my $pt = $iter->() ) { print "Point: ", join( ', ', $pt->{lat}, $pt->{lon} ), "\n"; } =cut sub iterate_points { my $self = shift; return _iterate_iterators( $self->iterate_waypoints(), $self->iterate_routepoints(), $self->iterate_trackpoints() ); } =head2 C Compute the bounding box of all the points in a C returning the result as a hash reference. For example: 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>. =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( $_[0] ); } sub _tag { 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 ), '"'; } if ( @_ ) { push @tag, '>', @_, '\n"; } else { push @tag, " />\n"; } return join( '', @tag ); } sub _xml { my $self = shift; my $name = shift; my $value = shift; my $name_map = shift || {}; my $tag = $name_map->{$name} || $name; if ( blessed $value && $value->can( 'xml' ) ) { # Handles legacy Gpx::Cache objects that can # render themselves. Note that Gpx::Cache->xml # adds the wrapper - so this won't # work correctly for trkpt and rtept return $value->xml( $name ); } elsif ( defined( my $enc = $self->{encoder}->{$name} ) ) { return $enc->( $name, $value ); } elsif ( ref $value eq 'HASH' ) { 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( $k, $vv, $name_map ); } } } return _tag( $tag, $attr, @cont ); } elsif ( ref $value eq 'ARRAY' ) { return join '', map { $self->_xml( $tag, $_, $name_map ) } @{$value}; } else { return _tag( $tag, {}, _enc( $value ) ); } } 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; } =head2 C Generate GPX XML. my $gpx10 = $gpx->xml( '1.0' ); my $gpx11 = $gpx->xml( '1.1' ); If the version is omitted it defaults to the value of the C attibute. Parsing a GPX document sets the version. If the C attribute is unset defaults to 1.0. C version 0.10 used L to render each of the points. L generates a number of hardwired values to suit the original application of that module which aren't appropriate for general purpose GPX manipulation. Legacy mode is triggered by passing a list of L points to the constructor; this should probably be avoided for new applications. =cut sub xml { my $self = shift; my $version = shift || $self->{version} || '1.0'; my @ret = (); push @ret, qq{\n}; $self->{encoder} = { time => sub { my ( $n, $v ) = @_; return _tag( $n, {}, _enc( $self->{handler}->{time}->( $v ) ) ); }, keywords => sub { my ( $n, $v ) = @_; return _tag( $n, {}, _enc( join( ', ', @{$v} ) ) ); } }; # 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( 'url', $v->{href} ) if exists( $v->{href} ); push @v, $self->_xml( '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( 'email', {}, _enc( join( '@', $v->{id}, $v->{domain} ) ) ); } else { return ''; } }; $self->{encoder}->{author} = sub { my ( $n, $v ) = @_; my @v = (); push @v, _tag( 'author', {}, _enc( $v->{name} ) ) if exists( $v->{name} ); push @v, $self->_xml( '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( $fld, $self->{$fld} ); } } my $bounds = $self->bounds( $self->iterate_points() ); if ( %{$bounds} ) { push @meta, _tag( 'bounds', $bounds ); } # Version 1.1 nests metadata in a metadata tag if ( _cmp_ver( $version, '1.1' ) >= 0 ) { push @ret, _tag( 'metadata', {}, "\n", @meta ); } else { push @ret, @meta; } for my $k ( sort keys %XMLMAP ) { if ( exists( $self->{$k} ) ) { push @ret, $self->_xml( $k, $self->{$k}, $XMLMAP{$k} ); } } push @ret, qq{\n}; return join( '', @ret ); } =head2 C For compatability with L modules. Converts 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. =cut sub TO_JSON { my $self = shift; my %json; #= map {$_ => $self->$_} ... for my $key ( @META, @ATTR ) { my $val = $self->$key; $json{$key} = $val if defined $val; } if ( my $bounds = $self->bounds ) { $json{bounds} = $self->bounds; } return \%json; } #### Legacy methods from 0.10 =head2 C Synonym for C. Provided for compatibility with version 0.10. =cut sub gpx { my $self = shift; return $self->xml( @_ ); } =head2 C Provided for compatibility with version 0.10. =cut sub loc { my $self = shift; my @ret = (); push @ret, qq{\n}; push @ret, qq{\n}; if ( exists( $self->{waypoints} ) ) { for my $wpt ( @{ $self->{waypoints} } ) { push @ret, $wpt->loc(); } } push @ret, qq{\n}; return join( '', @ret ); } =head2 C Provided for compatibility with version 0.10. =cut sub gpsdrive { my $self = shift; my @ret = (); if ( exists( $self->{waypoints} ) ) { for my $wpt ( @{ $self->{waypoints} } ) { push @ret, $wpt->gpsdrive(); } } return join( '', @ret ); } 1; __END__ =head2 C Accessor for the element of a GPX. To get the name: my $name = $gpx->name(); and to set it: $gpx->name( 'My big adventure' ); =head2 C Accessor for the element of a GPX. To get the the description: my $desc = $gpx->desc(); and to set it: $gpx->desc('Got lost, wandered around for ages, got cold, got hungry.'); =head2 C Accessor for the author structure of a GPX. The author information is stored in a hash that reflects the structure of a GPX 1.1 document: my $author = $gpx->author(); $author = { link => { text => 'Hexten', href => 'http://hexten.net/' }, email => { domain => 'hexten.net', id => 'andy' }, name => 'Andy Armstrong' }, When setting the author data a similar structure must be supplied: $gpx->author({ name => 'Me!' }); The bizarre encoding of email addresses as id and domain is a feature of GPX. =head2 C Accessor for the