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

#
# Author: Slaven Rezic
#
# Copyright (C) 2005,2006,2013,2015,2026 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.
#

# WWW: https://github.com/eserte/bbbike

use strict;
use FindBin;
use lib ("$FindBin::RealBin/..",
	 "$FindBin::RealBin/../lib",
	);
use Hash::Util qw(lock_keys);

use Archive::Zip qw(:ERROR_CODES);
use Encode qw(decode);
use File::Temp qw(tempfile);
use File::Basename qw(basename dirname);
use Getopt::Long;
use I18N::Langinfo qw(langinfo CODESET);

use Strassen::Gpsman;
use Strassen::Core;
use Strassen::MultiStrassen;

# XXX problematisch: die .g7t-Waypoints-Dateien, die Zeilen ohne Koordinaten erzeugen!

# Note: if using any2bbd with -info ... and -append, then make sure that the
# first file wrote a global directive preamble. The easiest is to call any2bbd
# first without any files in non-append mode.

my $codeset = langinfo(CODESET());
$codeset = lc $codeset; # 'UTF-8' is not recognized by emacs, but 'utf-8' is

@ARGV = map { decode $codeset, $_ } @ARGV;

my %opt;

GetOptions(\%opt,
	   'dir=s@',
	   'exclude=s@',
	   'excluderx=s@',
	   "o=s",
	   "append|a!",
	   "inputformat|i=s",
	   "routenamefmt=s",
	   "infotobbd!",
	   "info=s",
	   "noempty",
	   "geojson-name=s",
	   "name-sep=s",
	   "v+",
	  )
    or die <<EOF;
usage: $0 [-i inputformat] -o outfile [-a|-append]
    [-routenamefmt ...] [-dir download-dir | files ...]
    [-exclude basename [-exclude ...]]
    [-excluderx rx [-excluderx ...]]
    [-info file]
    [-infotobbd]
    [-noempty]
    [-geojson-name ...] [-name-sep ...]
    [-v [-v ...]]
EOF

use vars qw($verbose);
if ($opt{v}) {
    $verbose = $opt{v};
}

my $namecb;
if ($opt{'geojson-name'}) {
    my @defs;
    my @paths = split /\s+/, $opt{'geojson-name'};
    for my $path (@paths) {
	my %def;
	if (my($label,$path_rest) = $path =~ /^([a-zA-Z]+=)?\.(.+)/) {
	    %def = (
		label          => $label,
		splitted_path  => [ split /\./, $path_rest ],
	    );
	} else {
	    die "All -geojson-name values have to be paths (e.g. .properties.street), optionally prefixed with a label (e.g. id=.properties.id)\n";
	}
	push @defs, \%def;
    }

    my $name_sep = defined $opt{'name-sep'} ? $opt{'name-sep'} : ' ';

    my %warn_once;
    $namecb = sub {
	my $start_cursor = shift;
	my @names;
	for my $def (@defs) {
	    my $cursor = $start_cursor;
	    my $splitted_path = $def->{splitted_path};
	    for my $i (0 .. $#$splitted_path) {
		if (ref $cursor ne 'HASH') {
		    if (!$warn_once{nohash}++) {
			warn "geojson-name: path @$splitted_path cannot be resolved, feature " . (defined $cursor ? "'$cursor'" : '<undef>') . " is not a HASH\n";
			last;
		    }
		}
		$cursor = $cursor->{$splitted_path->[$i]};
	    }
	    if (defined $cursor) {
		my $label = $def->{label};
		push @names, (defined $label ? $label : '') . $cursor;
	    }
	}
	if (@names) {
	    join($name_sep, @names);
	} else {
	    '';
	}
    };
}

my @download_dirs; @download_dirs = @{ $opt{dir} } if $opt{dir};
my $outfile = $opt{o} || die "Missing option -o for output file, use -o - for stdout";
my $routenamefmt = $opt{routenamefmt} || "%b";
my %exclude = map {($_,1)} @{ $opt{exclude} || [] };
my $excludebyrx = sub {
    return if !$opt{excluderx};
    for (@{ $opt{excluderx} }) {
	return 1 if ($_[0] =~ m{$_}i);
    }
    0;
};
my $do_infotobbd = $opt{infotobbd} || 0;
my $file_info = $opt{info};
my %file_info;
if ($file_info) {
    require BBBikeYAML;
    %file_info = %{ BBBikeYAML::LoadFile($file_info) };
}

my @files = @ARGV;
for my $download_dir (@download_dirs) {
    push @files, glob("$download_dir/*");
}

my $has_acc_cat;
my @s;
for my $file (@files) {
    my $basename = basename($file);
    next if $exclude{$basename};
    next if $excludebyrx->($file);
    print STDERR "$file... ";
    my %info = (handled_by => "?", file => $file, subfile => undef);
    lock_keys %info;
    my %this_file_info = %{ $file_info{$basename} || {} };
    # do not lock %this_file_info

    my $check_s = sub {
	my $s = shift;
	if ($s && $s->data && @{ $s->data }) {
	    print STDERR "OK ($info{handled_by})\n";
	    1;
	} else {
	    print STDERR "no (usable) GPS data\n";
	    0;
	}
    };

    eval {
	if ($file =~ /\.zip$/i) {
	    my $zip = Archive::Zip->new;
	    $zip->read($file) == AZ_OK or die;
	    print STDERR "\n";
	    for my $member ($zip->members) {
		next if $exclude{ basename($member->fileName) };
		next if $excludebyrx->($member->fileName);
		print STDERR "  " . $member->fileName . "... ";
		$info{subfile} = $member->fileName;
		my($suffix) = $member->fileName =~ /(\.[^\.]+)$/;
		my($tmpfh,$tmpfile) = tempfile(UNLINK => 1,
					       SUFFIX => $suffix,
					      );
		print $tmpfh ($member->contents)[0];
		close $tmpfh;
		my %this_result_info;
		my $s = run_gpsbabel($tmpfile,
				     title => routenamefmt($file . "/" . basename($member->fileName)),
				     info => \%info,
				     file_info => \%this_file_info,
				     result_info => \%this_result_info,
				    );
		if ($check_s->($s)) {
		    prepend_info($s, \%info);
		    push @s, $s;
		    $has_acc_cat = 1 if $this_result_info{has_acc_cat};
		}
	    }
	} else {
	    my $work_file = $file;

	    if ($file =~ m{\.bz2$}) {
		my($suffix) = $file =~ m{\.([^.]+)\.bz2$};
		my($tmpfh,$tmpfile) = tempfile(UNLINK => 1,
					       (defined $suffix ? (SUFFIX => $suffix) : ()),
					      );
		open my $fh, "-|", "bzcat", $file
		    or die "Can't run bzcat $file: $!";
		local $/ = \8192;
		while(<$fh>) {
		    print $tmpfh $_;
		}
		close $tmpfh
		    or die "Error while writing to temporary file $tmpfile: $!";
		$work_file = $tmpfile;
	    }
	    if (-f $work_file) {
		my %this_result_info;
		my $s = run_gpsbabel($work_file,
				     title => routenamefmt($file),
				     info => \%info,
				     file_info => \%this_file_info,
				     result_info => \%this_result_info,
				    );
		if ($check_s->($s)) {
		    prepend_info($s, \%info);
		    push @s, $s;
		    $has_acc_cat = 1 if $this_result_info{has_acc_cat};
		}
	    } elsif (-d $work_file) {
		print STDERR "skipping directory\n";
	    } else {
		print STDERR "skipping non-existent file '$work_file'\n";
	    }
	}
    };
    warn $@ if $@;
}

if (!@s && $opt{noempty}) {
    warn "No usable input files (tried @files), do not write anything...\n";
    exit 0;
}

my $ms = MultiStrassen->new(@s);
if ($opt{append}) {
    $ms->append($outfile);
} else {
    if ($has_acc_cat) {
	$ms->set_global_directive("category_dash.AccManually"  => "3,8");
	$ms->set_global_directive("category_color.AccManually" => "#8080c0");
	$ms->set_global_directive("category_dash.AccLow"       => "2,4");
	$ms->set_global_directive("category_color.AccLow"      => "#4040a0");
    }
    $ms->write($outfile);
}

# XXX use GPS::Gpsbabel::run_gpsbabel instead, once that one
# has all the features of this function (accuracy cat handling etc.)
sub run_gpsbabel {
    my($file, %args) = @_;
    my $title = $args{title} || $file;
    my $info = $args{info} || {};
    my $file_info = $args{file_info} || {};
    my $result_info = $args{result_info} || {};
    my $cat = "#000080";
    if ($file_info->{accuracy}) {
	if ($file_info->{accuracy} eq 'manually') {
	    $cat = "AccManually";
	    $result_info->{has_acc_cat} = 1;
	} elsif ($file_info->{accuracy} eq 'low') {
	    $cat = "AccLow";
	    $result_info->{has_acc_cat} = 1;
	} elsif ($file_info->{accuracy} eq 'unusable') {
	    return undef;
	}
    }
    if ($file_info->{maptitle}) {
	$title = $file_info->{maptitle};
    }
    if ($opt{inputformat}) {
	my $s = eval {
	    require Strassen::FromRoute;
	    Strassen::FromRoute->new($file, name => $title);
	};
	if ($s) {
	    $info->{handled_by} = "Strassen::FromRoute";
	    return $s;
	}
    }
    if ($file =~ m{( \.(dbf|sbn|sbx|shp|shx)$
		   | \.(mif|mid)$
		   | \.e00$
		   | \.mps$
		   | \.g7t$
		   | \.gpx$
		   | \.kml$
		   | \.kmz$
		   | \.ovl$
		   | \.gpx$
		   | \.geojson$
		   )
	          }xi) {
	my $s = eval { Strassen->new($file, ($namecb ? (namecb => $namecb) : (name => $title)), cat => $cat) };
	if ($s) {
	    $info->{handled_by} = ref $s;
	    return $s;
	} else {
	    warn $@;
	}
    }

    my $magic_line;
    if (open(my $fh, $file)) {
	$magic_line = <$fh>;
	if ($magic_line =~ /^%.*(gpsmanager|gps::gpsmanconn|gps::gpsmandata)/i) {
	    close $fh;
	    my $s = Strassen::Gpsman->new($file,
					  cat => $cat,
					  fallbackname => $title);
	    if ($s) {
		$info->{handled_by} = "Strassen::Gpsman";
		return $s;
	    }
	}
    }

    if ((defined $magic_line && $magic_line =~ m{<\?xml.*?><workout>}) # do a real match
	|| $file =~ m{\.xml\.gz$} # and this is just lazyness
       ) {
	require GPS::GpsmanData::SportsTracker;
	my $gpsman = GPS::GpsmanData::SportsTracker->load($file);
	my($tmpfh,$tmpfile) = tempfile(SUFFIX => ".trk", UNLINK => 1);
	print $tmpfh $gpsman->as_string;
	close $tmpfh
	    or die "While writing temporary file: $!";
	my $s = Strassen::Gpsman->new($tmpfile,
				      cat => $cat,
				      fallbackname => $title);
	if ($s) {
	    $info->{handled_by} = "GPS::GpsmanData::SportsTracker and Strassen::Gpsman";
	    return $s;
	}
    }

    # XXX should really check magic before trying, i.e. 2nd line should match
    # /^I\s+PCX5/
    my $in_fmt = "pcx";
    my $out_fmt;
    if (eval { require Strassen::GPX; 1 }) {
	# Prefer gpx output, because gpsbabel's pcx->gpx conversion is
	# better than pcx->gpsman.
	#
	# Downside: handling GPX is *MUCH* slower
	$out_fmt = "gpx";
    } else {
	$out_fmt = "gpsman";
    }
    if ($file =~ /\.gpx$/) {
	$in_fmt = "gpx";
	$out_fmt = "gpsman";
    }
    my($ofh,$ofilename) = tempfile(UNLINK => 1,
				   SUFFIX => "_any2bbd.$out_fmt");
    system("gpsbabel", "-t",
	   "-i", $in_fmt, "-f", $file,
	   "-o", $out_fmt, -F, $ofilename);
    $info->{handled_by} = "gpsbabel";

    if ($out_fmt eq 'gpsman') {
	# Hack: set track name
	my($o2fh,$o2filename) = tempfile(UNLINK => 1);
	open(F, $ofilename) or die $!;
	while(<F>) {
	    s/(^!T:)/$1\t$title/;
	    print $o2fh $_;
	}
	close F;
	close $o2fh;
	$ofilename = $o2filename;
    }

    my $s;
    if ($out_fmt eq 'gpsman') {
	$s = Strassen::Gpsman->new($ofilename,
				   cat => $cat,
				   fallbackname => $title);
	$info->{handled_by} .= " and Strassen::Gpsman";
    } elsif ($out_fmt eq 'gpx') {
	$s = eval { Strassen->new($ofilename,
				  cat => $cat,
				  name => $title)
		};
	$info->{handled_by} .= " and " . ref($s);
    } else {
	die "Shouldn't happen: out_fmt=<$out_fmt>";
    }
    $s;
}

sub routenamefmt {
    my($file) = @_;
    my $rv = $routenamefmt;
    $rv =~ s{%b}{ basename($file) }ge;
    $rv =~ s{%f}{ $file }g;
    $rv =~ s{%d}{ basename(dirname($file)) }ge;
    $rv =~ s{%D}{ dirname($file) }ge;
    $rv;
}

# XXX Should go to Strassen::?
sub prepend_info {
    return if !$do_infotobbd;
    my($s, $info) = @_;
    unshift @{ $s->data },
	"# source file: $info->{file}" . ($info->{subfile} ? "#$info->{subfile}" : "") . "\n",
	    "# handled_by: $info->{handled_by}\n";
}

__END__
