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

#
# Author: Slaven Rezic
#
# Copyright (C) 1998,2004,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
#

use FindBin;
use lib ("$FindBin::RealBin/..", "$FindBin::RealBin/../lib");
use Strassen;
use Getopt::Long;
use strict;
use File::Basename;

eval 'use BBBikeXS 0.02';

my $verbose = 0;
my $maxdist;
my @strfile;
my $map;
my $use_orig_map;
my $as_bbd;
my $ignore_file;
my $show_outdated_ignore;
my $remove_outdated_ignore;
GetOptions("v!" => \$verbose,
	   "datadir=s" => sub {
	       my $dir = $_[1];
	       @Strassen::datadirs = ($dir);
	       $dir =~ s|/+$||;
	       ($Strassen::Util::cacheprefix = basename($dir)) =~ s/\W/_/g;
	   },
	   'strfile=s@' => \@strfile,
	   "maxdist=i" => \$maxdist,
	   "map=s" => \$map,
	   "useorigmap!" => \$use_orig_map,
	   "asbbd" => \$as_bbd,
	   "ignore=s" => \$ignore_file,
	   "show-outdated-ignore" => \$show_outdated_ignore,
	   "remove-outdated-ignore" => \$remove_outdated_ignore,
	  ) or usage();

usage() if (@ARGV);

sub usage {
    require Pod::Usage;
    Pod::Usage::pod2usage(2);
}

if (!@strfile) {
    @strfile = "strassen";
}

warn "new Strassen...\n" if $verbose;
my $str = @strfile == 1 ? Strassen->new(@strfile) : MultiStrassen->new(@strfile);

if (defined $map) {
    $str->{GlobalDirectives}{map} = $map;
}
my $conv = $str->get_conversion;
my $anti_conv;
if ($use_orig_map) {
    $anti_conv = $str->get_anti_conversion;
}
if ($conv) {
    warn "Conversion needed...\n" if $verbose;
    my $new_str = Strassen->new;
    $new_str->{DependentFiles} = [ $str->dependent_files ];
    $str->init;
    while(1) {
	my $ret = $str->next;
	last if !@{ $ret->[Strassen::COORDS] };
	for my $c (@{ $ret->[Strassen::COORDS] }) {
	    $c = join ",", map { int } split(/,/, $conv->($c));
	}
	$new_str->push($ret);
    }
    $str = $new_str;
}

warn "make_net...\n" if $verbose;
my $net = new StrassenNetz $str;
$net->make_net;
warn "all_crossings...\n" if $verbose;
my $crossings = $str->all_crossings(RetType => 'hash',
				    UseCache => 1,
				    Kurvenpunkte => 1);
warn "make_grid...\n" if $verbose;
my $kr = new Kreuzungen Hash => $crossings;
$kr->make_grid;

my $ignore = {};
if (defined $ignore_file) {
    print STDERR "reading ignore file...\r" if $verbose;
    my $ignore_s = Strassen->new($ignore_file);
    $ignore_s->init;
    while(1) {
	my $r = $ignore_s->next;
	last if !@{ $r->[Strassen::COORDS()] };
	my($c1,$c2) = @{ $r->[Strassen::COORDS()] };
	$ignore->{$c1}{$c2} = 1;
	$ignore->{$c2}{$c1} = 1;
    }
    print STDERR "\n" if $verbose;
}

print STDERR "searching...\r" if $verbose;
my @nearest_glob;
my $i = 0;
my $keys_crossings = keys %$crossings;
while(my($k,$v) = each %$crossings) {
    if ($verbose) {
	$i++;
	if ($i%100==0) {
	    printf STDERR "searching %d%%\r", ($i/$keys_crossings)*100;
	}
    }
    my($x, $y) = Strassen::Util::string_to_coord($k);
    my(@nearest) = $kr->nearest($x, $y, IncludeDistance => 1);
    shift @nearest; # first is point itself
    if (@nearest) {
	my $nearest = $nearest[0];
	if (!exists $net->{Net}{$k}{$nearest->[0]} &&
	    (!defined $maxdist || $maxdist >= $nearest->[1])
	   ) {
	    push @nearest_glob, [$nearest->[0], $k, $nearest->[1]];
	}
    }
}
print STDERR "\n" if $verbose;

print STDERR "sorting...\r" if $verbose;
my %seen;
$i = 0;
foreach my $c (sort { $a->[2] <=> $b->[2] } @nearest_glob) {
    if ($verbose) {
	if ($i%100==0) {
	    printf STDERR "sorting %d%%\r", ($i/@nearest_glob)*100;
	}
    }
    next if ($seen{$c->[0]} || $seen{$c->[1]});
    my @outc;
    if ($anti_conv) {
	@outc = (map { $anti_conv->($_) } @{$c}[0, 1]);
    } else {
	@outc = @{$c}[0, 1];
    }
    if ($ignore->{$outc[0]}{$outc[1]}) {
	next;
    }
    my $dist = $c->[2];
    if ($as_bbd) {
	my $d = $dist > 100 ? 100 : $dist;
	my $gv = (128/100)*$d;
	my $color = sprintf "#%02x%02x%02x", ($gv)x3;
	printf "%05d %dm\t%s %s %s\n", $i, $dist, $color, @outc;
    } else {
	printf "%s %s (%dm)\n", @outc, $dist;
    }
    $seen{$c->[0]}++;
    $seen{$c->[1]}++;
    $i++;
}
print STDERR "\n" if $verbose;

{
    my %outdated_ignore;
    if ($show_outdated_ignore || $remove_outdated_ignore) {
	while(my($k,$v) = each %$ignore) {
	    while(my($k2,$v2) = each %$v) {
		if (!$net->{Net}{$k} || !$net->{Net}{$k2} || exists $net->{Net}{$k}{$k2} || exists $net->{Net}{$k2}{$k}) {
		    print STDERR "OUTDATED: $k $k2\n";
		    $outdated_ignore{$k}{$k2} = 1;
		}
	    }
	}
    }
    if ($remove_outdated_ignore && keys %outdated_ignore) {
	if (!defined $ignore_file) {
	    die "-remove-outdated-ignore must operate on an 'ignore' file";
	}
	open my $fh, "<", $ignore_file
	    or die "Can't open $ignore_file: $!";
	open my $ofh, ">", "$ignore_file~"
	    or die "Can't write to $ignore_file~: $!";
	while(<$fh>) {
	    if (/^#/ || /^$/) {
		# pass
	    } else {
		my $r = Strassen::parse($_);
		if (!$r) {
		    # pass
		} else {
		    my @c = @{ $r->[Strassen::COORDS] };
		    if (
			$outdated_ignore{$c[0]}{$c[1]}
		       ) {
			# remove
			next;
		    } else {
			# pass
		    }
		}
	    }
	    print $ofh $_;
	}
	close $ofh
	    or die "Error while writing to $ignore_file~: $!";
	rename "$ignore_file~", $ignore_file
	    or die "Can't rename $ignore_file~ to $ignore_file: $!";
    }
}

__END__

=head1 NAME

check_nearest - return list of nearest non-connected neighbors

=head1 SYNOPSIS

    perl check_nearest [-useorigmap] [-map mapname] [-maxdist distance]
                       [-datadir directory] [-strfile bbdfile [-strfile ...]]
		       [-asbbd] [-ignore ignorefile] [-v]
		       [-show-outdated-ignore] [-remove-outdated-ignore]

=head1 DESCRIPTION

Return for a given bbd file (or "strassen" by default) a list of near
non-connected neighbors. This script is used for detecting potential
errors in the data file.

The output is a list which is sorted by distance. The output format of
the list ist: coordinates of the first point, coordinates of the
second point, distance between these points in meters.

=head2 OPTIONS

=over

=item -v

Be verbose

=item -datadir directory

The directory where to look for the given bbd file.

=item -strfile bbdfile

The bbd file to work on. If not given, use "strassen" (optionally in a
directory given by -datadir). You can also use absolute paths. This
option may be used multiple times.

=item -maxdist distance

Maximum distance for the output list. Otherwise the maximum distance
is approximately the standard width of the grid (1000 m).

=item -map mapname

Set the coordinate system of the bbd file.

=item -useorigmap

If set, then output the coordinates in the original format of the bbd
file, otherwise use standard coordinates.

=item -asbbd

Output as a bbd stream.

=item -ignore bbdfile

Ignore the coordinate pairs listet in bbdfile.

=item -show-outdated-ignore

Show list of outdated coordinate pairs in the given C<-ignore> file.

A coordinate pair is considered outdated if

=over

=item one or both coordinates are not in the net anymore

=item there's a direct connection between both coordinates

=back

Formerly an option C<-show-unconsumed-ignore> existed, but it was
removed because of unclear semantics.

=item -remove-outdated-ignore

Show and remove outdated coordinate pairs in the given C<-ignore>
file.

Formerly an option C<-remove-unconsumed-ignore> existed, but it was
removed because of unclear semantics.

=back

=head1 EXAMPLES

Show a list of nearest neighbors for a MapInfo file which is using
WGS84 coordinates:

    perl check_nearest -useorigmap -map polar -maxdist 50 -strfile /tmp/BRB_strassen_IS.mif

=head1 AUTHOR

Slaven Rezic

=cut
