view release on metacpan or  search on metacpan

lib/Geo/Gpx.pm  view on Meta::CPAN

  $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<name>, C<desc>, …) matches I<$regex>. By default, the regex is case-sensitive; specify C<qr/(?i:search_string_here)/> 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<qr/(?i:...

Alternatively, an array of C<Geo::GXP::Points> can be provided. C<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 C<xclip> 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<name> field is an exact match for I<$name> (case sensitively). Returns true if successful, C<undef> 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<name> field is an exact match for I<$name> (case sensitively) to I<$new_name>. Returns the point's new name if successful, C<undef> otherwise.

=back

=cut

sub waypoint_rename {
    my $gpx = shift;