#!/usr/bin/env perl
# -*- perl -*-

#
# Author: Slaven Rezic
#
# Copyright (C) 2022,2023,2024 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#

use strict;
use warnings;

use Getopt::Long;
use Text::ParseWords;
use XML::LibXML;

use constant XMLNS_SRT     => 'http://rezic.de/gpxext/1';
use constant XMLPREFIX_SRT => 'srt';

my $v;
my @opdefs;

my $geo_distance;
my $op_needs_argv;
my $need_xpath_context_functions;

Getopt::Long::Configure("pass_through");
GetOptions(
    'edits-file=s'           => sub { push @ARGV, load_edits_file($_[1], 1) },
    'edits-file-if-exists=s' => sub { push @ARGV, load_edits_file($_[1], 0) },
);
Getopt::Long::Configure("no_pass_through"); # Revert configuration

GetOptions
    (
     'verbose|v' => \$v,
     'edits-file=s' => sub {}, # handled before
     'edits-file-if-exists=s' => sub {}, # handled before
     'trkseg-split-by-time-gap|trkseg-split-by-time=f' => sub {
	 my $delta_time = $_[1];
	 require DateTime::Format::ISO8601;
	 push @opdefs, { op => 'trkseg_split', args => ['time-gap', $delta_time] };
     },
     'trkseg-split-by-dist-gap|trkseg-split-by-dist=f' => sub {
	 my $meters = $_[1];
	 require Geo::Distance;
	 $geo_distance = Geo::Distance->new;
	 $geo_distance->formula('hsin');
	 push @opdefs, { op => 'trkseg_split', args => ['dist-gap', $meters] };
     },
     'trkcat' => sub {
	 my $opdef = { op => 'trkcat' };
	 push @opdefs, $opdef;
	 $op_needs_argv = $opdef;
     },
     'trkpts-delete=s' => sub {
	 my $xpath = $_[1];
	 push @opdefs, { op => 'trkpts_delete', args => [$xpath] };
	 $need_xpath_context_functions = 1;
     },
     'trk-attrib=s' => sub {
	 my($key, $val) = split /=/, $_[1], 2;
	 push @opdefs, { op => 'trk_attrib', args => [$key, $val] };
     },
    )
    or die "usage?";
my $file = shift;
if ($op_needs_argv) {
    $op_needs_argv->{args} = [@ARGV];
    @ARGV = ();
}
@ARGV and die "usage?";

my @load_xml_opts;
if ($file && $file ne '-') {
    @load_xml_opts = (location => $file);
} else {
    @load_xml_opts = (IO => \*STDIN);
}

my $doc = XML::LibXML->load_xml(@load_xml_opts);

my $xc;
if ($need_xpath_context_functions) {
    require XML::LibXML::XPathContext;
    $xc = XML::LibXML::XPathContext->new($doc);
    $xc->registerNs('gpx', 'http://www.topografix.com/GPX/1/1');
    $xc->registerFunction('str-lt', sub { $_[0] lt $_[1] });
    $xc->registerFunction('str-le', sub { $_[0] le $_[1] });
    $xc->registerFunction('str-gt', sub { $_[0] gt $_[1] });
    $xc->registerFunction('str-ge', sub { $_[0] ge $_[1] });
}

for my $opdef (@opdefs) {
    no strict 'refs';
    &{$opdef->{op}}(@{ $opdef->{args} });
}

print $doc->toString;

sub trkseg_split {
    my($by, $delta) = @_;
    for my $trk ($doc->findnodes('/*[local-name(.)="gpx"]/*[local-name(.)="trk"]')) {
	for my $trkseg ($trk->findnodes('./*[local-name(.)="trkseg"]')) {
	    my($prev_trkpt) = $trkseg->findnodes('(./*[local-name(.)="trkpt"])[1]');
	    while ($prev_trkpt and my $next_trkpt = $prev_trkpt->nextNonBlankSibling) {
		# XXX do we need to check if $next_trkpt is really a trkpt?
		my $do_split;
		if ($by eq 'time-gap') {
		    my $this_delta_time = trkpt_delta_time($prev_trkpt, $next_trkpt);
		    $do_split = $this_delta_time >= $delta;
		} elsif ($by eq 'dist-gap') {
		    my $this_dist = trkpt_dist($prev_trkpt, $next_trkpt);
		    $do_split = $this_dist >= $delta;
		} else {
		    die "Unhandled by parameter '$by'";
		}
		if ($do_split) {
		    warn "Need to split between " . trkpt_label($prev_trkpt) . " and " . trkpt_label($next_trkpt) . " (by $by).\n" if $v;
		    my $new_trkseg = $doc->createElement('trkseg');
		    $trk->insertBefore($new_trkseg, $trkseg);
		    my($node_to_move) = $trkseg->findnodes('(./*[local-name(.)="trkpt"])[1]');
		    while($node_to_move != $next_trkpt) {
			my $next_node = $node_to_move->nextSibling;
			$new_trkseg->addChild($node_to_move);
			$node_to_move = $next_node;
		    }
		}
		$prev_trkpt = $next_trkpt;
	    }
	}
    }
}

sub trkpt_delta_time {
    my($prev_trkpt, $next_trkpt) = @_;
    my $prev_time = DateTime::Format::ISO8601->parse_datetime($prev_trkpt->findvalue('./*[local-name(.)="time"]'));
    my $next_time = DateTime::Format::ISO8601->parse_datetime($next_trkpt->findvalue('./*[local-name(.)="time"]'));
    $next_time->epoch - $prev_time->epoch;
}

sub trkpt_dist {
    my($prev_trkpt, $next_trkpt) = @_;
    my($prev_lat, $prev_lon) = ($prev_trkpt->getAttribute('lat'), $prev_trkpt->getAttribute('lon'));
    my($next_lat, $next_lon) = ($next_trkpt->getAttribute('lat'), $next_trkpt->getAttribute('lon'));
    $geo_distance->distance('meter', $prev_lon, $prev_lat, $next_lon, $next_lat);
}

sub trkpt_label {
    my($trkpt) = @_;
    $trkpt->findvalue('./*[local-name(.)="time"]');
}

sub trkcat {
    my(@more_files) = @_;
    return if !@more_files;

    # Find the trkseg node to which we will be appending
    my ($append_to) = $doc->findnodes('//*[local-name(.)="trkseg"]');
    unless ($append_to) {
	die "First GPX file does not have a trkseg element\n";
    }

    # Loop through the rest of the files and extract trkseg elements
    for my $file (@more_files) {
	if ($v) {
	    warn "Add $file to first gpx file...\n";
	}
	my $tree = XML::LibXML->load_xml(location => $file);
	my @trkseg_nodes = $tree->findnodes('//*[local-name(.)="trkseg"]');
    
	for my $trkseg (@trkseg_nodes) {
	    my $cloned = $trkseg->cloneNode(1);  # deep copy
	    $append_to->addSibling($cloned);    # Append to previous trkseg
	}
    }
}

sub trkpts_delete {
    my($xpath) = @_;

    my %prev_siblings;

    my $deletions = 0;
    for my $node ($xc->findnodes($xpath)) {
	my $prev_sibling = $node->previousNonBlankSibling;
	$node->unbindNode;
	$deletions++;
	$prev_siblings{$prev_sibling} = $prev_sibling if $prev_sibling;
    }
    warn "Deleted $deletions node" . ($deletions == 1 ? '' : 's') . "\n" if $v;

    # Split <trkseg> after each unique previous sibling
    foreach my $prev_sibling (values %prev_siblings) {
	my $trkseg = $prev_sibling->parentNode;

	if ($trkseg->nodeName eq 'trkseg') {
	    my @trkpts = $trkseg->findnodes('./*[local-name(.)="trkpt"]');

	    if (@trkpts == 0) {
		# If there are no <trkpt> nodes, remove the <trkseg>
		$trkseg->unbindNode;
	    } elsif ($prev_sibling->nextNonBlankSibling) {
		# If there's a previous sibling, split the <trkseg> after it
		my $new_trkseg = XML::LibXML::Element->new('trkseg');

		# Move trkpts after the previous sibling to the new trkseg
		my $next = $prev_sibling->nextSibling;
		while ($next) {
		    my $temp = $next;
		    $next = $next->nextSibling;
		    $temp->unbindNode;
		    $new_trkseg->appendChild($temp);
		}

		# Insert the new trkseg after the previous sibling
		$trkseg->parentNode->insertAfter($new_trkseg, $prev_sibling);
	    }
	}
    }
}

sub maybe_add_xmlns {
    my($doc, $ns_uri, $ns_prefix) = @_;
    my $root = $doc->documentElement;
    my $ns_attr = "xmlns:$ns_prefix";
    my $ns_attr_value = $root->getAttribute($ns_attr);
    if (!$ns_attr_value) {
	$root->setAttribute($ns_attr, $ns_uri);
    } elsif ($ns_attr_value ne $ns_uri) {
	die "xmlns:$ns_prefix already exists, but instead to $ns_uri it points to $ns_attr_value";
    }
}

sub trk_attrib {
    my($key, $val) = @_;
    if ($key =~ /^@{[ XMLPREFIX_SRT ]}:(.*)/) {
	maybe_add_xmlns($doc, XMLNS_SRT, XMLPREFIX_SRT);
	my($trk) = $doc->findnodes('/*[local-name(.)="gpx"]/*[local-name(.)="trk"]');
	if (!$trk) {
	    die "GPX file does not have a <trk> element.\n";
	}
	my($extensions) = $trk->findnodes('./*[local-name(.)="extensions"]');
	if (!$extensions) {
	    $extensions = XML::LibXML::Element->new('extensions');
	    my($trkseg) = $trk->findnodes('./*[local-name(.)="trkseg"]');
	    if (!$trkseg) {
		$trk->appendChild($extensions);
	    } else {
		$trk->insertBefore($extensions, $trkseg);
	    }
	}
	my $new_elem = XML::LibXML::Element->new($key);
	$new_elem->appendText($val);
	$extensions->appendChild($new_elem);
    } else {
	die "Key '$key' must be prefixed by " . XMLPREFIX_SRT . ", other prefixes or prefix-less track attributes are not allowed.\n";
    }
}

sub load_edits_file {
    my ($file, $mandatory) = @_;
    if (-e $file) {
        open my $fh, '<', $file or die "Cannot open file '$file': $!";
	my @parsed_args;
        while (my $line = <$fh>) {
            chomp $line;
            # Parse the line like a shell would
            push @parsed_args, shellwords($line);
        }
	return @parsed_args;
    } elsif ($mandatory) {
        die "File '$file' does not exist.";
    } else {
	return ();
    }
}

__END__

=head1 NAME

gpx2gpx - apply operations on GPX files

=head1 SYNOPSIS

    gpx2gpx [--trkseg-split-by-time-gap=...] [--trkseg-split-by-dist-gap=...] [--trkpts-delete=xpath] src.gpx [--trkcat src2.gpx ...] [--edits-file file | --edits-file-if-exists file] > dst.gpx

=head1 DESCRIPTION

C<gpx2gpx> takes a source GPX file as an argument (alternatively, if
omitted or C<-> is specified, then the GPX data is read from stdin),
applies the specified L</OPERATIONS> (multiple are OK), and writes the
modified GPX to stdout.

=head2 OPERATIONS

=head3 C<--trkseg-split-by-time-gap=I<seconds>>

Split a C<< <trkseg> >> element if the time difference between two
adjacent C<< <trkpt> >> elements is greater or equal the specified
number of seconds.

=head3 C<--trkseg-split-by-dist-gap=I<meters>>

Split a C<< <trkseg> >> element if the distance between two adjacent
C<< <trkpt> >> elements is greater or equal the specified number of
meters.

=head3 C<--trkpts-delete=I<xpath>>

Delete C<< <trkpt> >> elements which match the given I<xpath>.

The C<gpx> prefix is registered into the XPath engine.

Additional functions are registered into the XPath engine:

=over

=item str-lt(val1,val2): string comparison less

=item str-le(val1,val2): string comparison less-or-equal

=item str-gt(val1,val2): string comparison greater

=item str-ge(val1,val2): string comparison greater-or-equal

=back

=head3 C<--trk-attrib srt:I<attrib>=I<value>>

Add a custom element into an C<< <extensions> >> section below the
first C<< <trk> >>. Currently only elements with a C<srt> prefix are
allowed. Possible attributes are for example:

=over

=item C<--trk-attrib srt:vehicle=bike>

=item C<--trk-attrib "srt:brand=rental bike">

=back

=head3 C<--trkcat I<file2 file3 ...>>

Concat the primary gpx file and further files. Only trk files are
supported. Only the C<< <trkseg> >> elements of the further files are
appended to the first one.

=head3 GENERAL OPTIONS

=head3 C<--verbose> (alias C<-v>)

Be verbose i.e. log the effects of operations.

=head3 C<--edits-file I<file>>

Take list of operations from the named file. Fails if the file does not exist.

=head3 C<--edits-file-if-exists I<file>>

Like C<--edits-file>, but does not fail if the named file does not exist.

=head2 EXAMPLES

For removing trkpt elements within a time range, use something like

    gpx2gpx --trkpts-delete '//gpx:trkpt[str-ge(gpx:time,"2023-01-02T12:11:29Z") and str-le(gpx:time, "2023-01-02T12:11:31Z")]' src.gpx

=head2 BUGS AND LIMITATIONS

Even if there are no changes, the resulting GPX file may have
(non-structural) differences against the source file. Currently
observed is a different ordering of XML attributes. It is possible
that insignificant whitespace may change.

The registered functions str-XX seem to have bugs and do not always
work as expected.

=head1 AUTHOR

Slaven Rezic <srezic@cpan.org>

=cut
