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

#
# Author: Slaven Rezic
#
# Copyright (C) 1998,2004,2005,2010,2014 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.
#
# Mail: slaven@rezic.de
# WWW:  http://bbbike.de
#

=head1 NAME

check_str_plz - check street names against zip file (PLZ-Datei)

=cut

use Getopt::Long;
use FindBin;
use lib ("$FindBin::RealBin/..", "$FindBin::RealBin/../lib");
use File::Basename qw(basename);
use Strassen;
use PLZ;
use Symbol;

use strict;

unshift(@Strassen::datadirs, "$FindBin::RealBin/../data");

my @datafile;
my $ignore_in_parens = 1;
my $ignore_bracket_part = 1;
my $plzfield = PLZ::FILE_ZIP();
my $plzdata;
my $addstr;
my $do_check_coords;
my $check_coords_limit;
my $do_reverse_check;
my $ignore_plz_warnings;

GetOptions("plzdata=s"  => \$plzdata,
	   "plzfield=i" => \$plzfield,
	   "addstr=s"   => \$addstr,
	   'data=s@'     => \@datafile,
	   "ignoreparens!" => \$ignore_in_parens,
	   "ignorebracketpart!" => \$ignore_bracket_part, # ignore [...]
	   "ignoreplzwarnings!" => \$ignore_plz_warnings,
	   "checkcoords!" => \$do_check_coords,
	   "checkcoordslimit=i" => \$check_coords_limit,
	   "reversecheck" => \$do_reverse_check,
	  ) or die <<EOF;
usage: $0 [-plzdata plzdatafile] [-plzfield fieldindex]
	  [-addstr bbdfile]
	  [-[no]checkcoords [-checkcoordslimit ...]] [-reversecheck]
	  [-[no]ignoreparens] [-[no]ignorebracketpart] [-ignoreplzwarnings]
	  -data bbdfile
EOF

@datafile = "strassen" if !@datafile;
my $plz;
if (!defined $plzdata) {
    $plz = PLZ->new();
    $plzdata = $plz->{File};
}

my %str_in_plz;
my %str_in_plz2;
my %str_coord;
my %str_coord_without_bezirk;
my %seen_str;
my @plz_errors;
my $fh = gensym;
open($fh, $plzdata) or die "$plzdata: $!";
while(<$fh>) {
    chomp;
    my(@l) = split(/\|/, $_);
    $str_in_plz{$l[0]}->{$l[1]}++;
    $l[$plzfield]="" if $ignore_plz_warnings && !defined $l[$plzfield]; # may happen for example in Potsdam.coords.data
    if ($l[$plzfield] ne '' && $l[$plzfield] !~ m{^\d{5}$}) {
	push @plz_errors, "$l[0] $l[1]: $l[$plzfield]";
    }
    $str_in_plz2{$l[0]}->{$l[$plzfield]}++;
    $seen_str{$l[0]}->{$l[PLZ::FILE_CITYPART()]} = $l[PLZ::FILE_COORD()] if $do_reverse_check;
    $str_coord{$l[PLZ::FILE_NAME()]}->{$l[PLZ::FILE_CITYPART()]}
	= $l[PLZ::FILE_COORD()];
    $str_coord_without_bezirk{$l[PLZ::FILE_NAME()]}
	= $l[PLZ::FILE_COORD()];
}
close $fh;

if (@plz_errors) {
    die "PLZ errors found in $plzdata:\n" . join("\n", map { "  $_" } @plz_errors) . "\n";
}

if (!defined $addstr) {
    foreach (@Strassen::datadirs) {
	$addstr = "$_/add_str";
	if (-f $addstr && -r $addstr) {
	    last;
	} else {
	    undef $addstr;
	}
    }
}

open(D, $addstr) or die "$addstr: $!";
while(<D>) {
    chomp;
    my($str, $bez) = split(/\t/, $_);
    $bez = "XXX[FROM $addstr]XXX" if !$bez;
    $str_in_plz{$str}->{$bez}++;
    $str_coord{$str}->{$bez} = "XXX";
    $str_coord_without_bezirk{$str} = "XXX";
}
close D;

my @lastbezirk;
my $lastname;
my @coords;
my $check_coords = sub {
    return unless $do_check_coords;
    my $check_against;
    if (exists $str_coord{$lastname}) {
	if (keys %{ $str_coord{$lastname} } == 1) {
	    while(my($k,$v) = each %{ $str_coord{$lastname} }) {
		$check_against = $v;
		last;
	    }
	} else {
	    for my $bezirk (@lastbezirk) {
		if (exists $str_coord{$lastname}->{$bezirk}) {
		    $check_against = $str_coord{$lastname}->{$bezirk};
		    last;
		}
	    }
	    if (!defined $check_against) {
		# else use first
		while(my($k,$v) = each %{ $str_coord{$lastname} }) {
		    $check_against = $v;
		    last;
		}
	    }
	}
    }
    if (!$check_against) {
	warn "Can't find any coordinate for $lastname @lastbezirk\n";
    } elsif (!grep { $_ eq $check_against } @coords) {
	my $min_dist;
	if ($check_against ne 'XXX') {
	    for my $i (1 .. $#coords) {
		require VectorUtil;
		my $dist = VectorUtil::distance_point_line((split /,/, $check_against),
							   (split /,/, $coords[$i-1]),
							   (split /,/, $coords[$i]),
							  );
		if (!defined $min_dist || $dist < $min_dist) {
		    $min_dist = $dist;
		}
	    }
	}
	if (!$check_coords_limit || (defined $min_dist && $min_dist > $check_coords_limit)) {
	    warn "Can't find coordinate $check_against for $lastname @lastbezirk" .
		(defined $min_dist ? ", distance is " . int($min_dist) . "m" : '') .
		    "\n";
	}
    }
};

my @ambiguous;
my @unknown;
my @unknown2;
my @no_coord;

my $s = @datafile == 1 ? Strassen->new($datafile[0]) : MultiStrassen->new(@datafile);
$s->init;
while(1) {
    my $ret = $s->next;
    last if !@{$ret->[1]};
    my $name = $ret->[0];

    if ($ignore_in_parens && $name =~ /^\(.*\)$/) {
	next;
    }

    if ($ignore_bracket_part) {
	$name =~ s{\s+\[.*?\]\s*}{ }g;
	$name =~ s{ +$}{};
    }

    my @bezirk;
    if ($name =~ s/\s+\(([^\(]+)\)$//) {
	foreach (split(/,\s*/, $1)) {
	    push(@bezirk, $_) unless /\?/ || /^(?:F|R)\s*\d+$/;
	}
    }

    if ($do_reverse_check) {
	if (!@bezirk) {
	    delete $seen_str{$name};
	} else {
	    for my $bezirk (@bezirk) {
		delete $seen_str{$name}->{$bezirk};
	    }
	    if (!keys %{ $seen_str{$name} }) {
		delete $seen_str{$name};
	    }
	}
    }

    if (defined $lastname && $name eq $lastname) {
	push @coords, @{$ret->[Strassen::COORDS()]};
	next;
    } else {
	if (defined $lastname && @coords) {
	    $check_coords->();
	}
	@coords = @{$ret->[Strassen::COORDS()]};
    }

    if (!@bezirk) {
	if (exists $str_in_plz{$name} &&
	    exists $str_in_plz2{$name}) {
	    my $k1 = keys %{$str_in_plz{$name}};
	    my $k2 = keys %{$str_in_plz2{$name}};
	    if ($k1 > 1 && $k2 > 1) {
		my $ambiguous_coord = 1;
		# check if all coords are the same
		if (exists $str_coord{$name}) {
		    $ambiguous_coord = 0;
		    my $last_coord;
		    for my $citypart (keys %{ $str_coord{$name} }) {
			my $this_coord = $str_coord{$name}->{$citypart};
			if (defined $last_coord && $last_coord ne $this_coord) {
			    $ambiguous_coord = 1;
			    last;
			}
			$last_coord = $this_coord;
		    }
		}
		# Coords are ambigous
		if ($ambiguous_coord) {
		    push @ambiguous, $name;
		}
	    }
	}
    }
    if (!exists $str_in_plz{$name}) {
	push(@unknown, $name);
    } elsif (@bezirk && $name !~ /^\(/) {
	foreach my $bezirk (@bezirk) {
	    if (!exists $str_in_plz{$name}->{$bezirk}) {
		push(@unknown2, $name);
	    }
	}
    }
    if (exists $str_in_plz{$name}) {
	if (@bezirk) {
	    for my $bezirk (@bezirk) {
		if (!$str_coord{$name}->{$bezirk}) {
		    push(@no_coord, $name);
		}
	    }
	} else {
	    if (!$str_coord_without_bezirk{$name}) {
		push(@no_coord, $name);
	    }
	}
    }

    $lastname = $name;
    @lastbezirk = @bezirk;
}
$check_coords->();

if ($do_reverse_check) {
    if (keys %seen_str) {
	for my $name (sort keys %seen_str) {
	    my @bezirke = sort keys %{ $seen_str{$name} };
	    my $coord = $seen_str{$name}->{$bezirke[0]};
	    if ($coord) {
		print "$name @bezirke\tX $coord\n";
	    } else {
		print "# $name @bezirke\n";
	    }
	}
	exit 1;
    } else {
	exit 0;
    }
}

if (@unknown || @unknown2 || @ambiguous || @no_coord) {
    print "="x70,"\n", join("\n", sort @unknown), "\n";
    print "="x70,"\n", join("\n", sort @unknown2), "\n";
    print "="x70,"\n";
    if (@no_coord) {
	print "= No coordinate in " . basename($plzdata) . " for:\n";
	print join("\n", sort @no_coord), "\n";
    }
    print "="x70,"\n";
    if (@ambiguous) {
	print "= Add citypart name to street:\n";
	foreach (sort @ambiguous) {
	    print "$_<TAB>", join(",", keys %{$str_in_plz{$_}}), "\n";
	}
    }
    exit 1;
} else {
    exit 0;
}

__END__

=head1 EXAMPLES

C<-checkcoords> may be used also to find significant mismatches
between Berlin.coords.data and strassen data by sorting by distance.
For this, my C<psort> script (sort with a custom perl sub) may be
used:

    ./check_str_plz -checkcoords -data .strassen.tmp |& psort -r -n -e 'm{distance is (\d+)m} ? $1 : 0' | less

(Note: F<.strassen.tmp> is used here instead of the default
F<strassen>, because the latter also contains entries from
F<routing_helper-orig>, which are typically not mentioned in
F<Berlin.coords.data>)

=head1 SEE ALSO

L<PLZ>.

=cut
