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

#
# $Id: check_neighbour,v 1.17 2005/03/28 22:53:48 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 1998,2004 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
#

package BBBike::check_neighbour;

use strict;
use Getopt::Long;
use FindBin;
use lib ("$FindBin::RealBin/..", "$FindBin::RealBin/../lib");
use Strassen::Core;
use Strassen::MultiStrassen;
use Strassen::StrassenNetz;
eval 'use BBBikeXS';
use Karte;
use vars qw(%net);


sub doit {
    local(@ARGV) = @_;

    my $datatype = "standard";
    my @datafile;
    my @against = ();
    my $origmap = "Standard";
    my $keep_net = 0;
    my $q;
    my $net;
    my $v;

    GetOptions('data=s@'    => \@datafile,
	       "type=s"     => \$datatype,
	       "against=s@" => \@against,
	       "origmap=s"  => \$origmap,
	       "keepnet!"   => \$keep_net,
	       "q|quiet!"   => \$q,
	       "v|verbose"  => \$v,
	      )
	or die <<EOF;
usage: $0 [-data datafile [-data datafile ...]]
          [-against file [-against file ...]]
          [-type datatype] [-origmap map] [-[no]keepnet] [-[no]quiet | -q] [-v]
EOF


    if (!@against) {
	@against = "strassen";
    }
    my $cachename = join "_", sort @against;

    local @Strassen::datadirs = @Strassen::datadirs;
    unshift @Strassen::datadirs, "$FindBin::RealBin/../data";

    Karte::preload($origmap);
    my $to   = $Karte::map_by_modname{$origmap};

    if (!$net{$cachename} || !$keep_net) {
	my $str;
	if (@against == 1) {
	    $str = new Strassen $against[0];
	} else {
	    $str = new MultiStrassen @against;
	}

	$net = new StrassenNetz $str;
	$net->make_net(UseCache => 1,
		       PreferCache => 0, # 0 oder 1, macht keinen groen Unterschied
		      );

	$net{$cachename} = $net;
    } else {
	warn "Use cached file $cachename...\n" if $v;
	$net = $net{$cachename};
    }

    my $err;

    for my $datafile (@datafile) {
	if ($datatype =~ /radweg/i) { # this type is obsolete...
	    open(D, $datafile) or die $!;
	    while(<D>) {
		next if /^\s*\#/;
		chomp;
		my(@l) = split(/\s+/);
		if (!exists $net->{Net}{$l[0]}{$l[1]} and
		    !exists $net->{Net}{$l[1]}{$l[0]}) {
		    print STDERR "Not neighbours in $datafile: $l[0] and $l[1]"
			unless $q;
		    if ($origmap ne "Standard") {
			my $orig0 = join(",", map {int} $to->standard2map(split /,/, $l[0]));
			my $orig1 = join(",", map {int} $to->standard2map(split /,/, $l[1]));
			print STDERR " (orig coords: $orig0 and $orig1)"
			    unless $q;
		    }
		    print STDERR "\n" unless $q;
		    $err++;
		}
	    }
	    close D;
	} else {
	    my $d = new Strassen $datafile;
	    die if !$d;
	    $d->init;
	    while(1) {
		my $ret = $d->next;
		my @coord = @{$ret->[1]};
		last if !@coord;
		next if @coord < 2;
		for(my $i = 0; $i < $#coord; $i++) {
		    next if ($coord[$i]   !~ /^[-+\d]/ ||
			     $coord[$i+1] !~ /^[-+\d]/); # XXX andere Coord-Systeme NYI
		    if (!exists $net->{Net}{$coord[$i]}{$coord[$i+1]} and
			!exists $net->{Net}{$coord[$i+1]}{$coord[$i]}) {
			print STDERR "Not neighbours in $datafile: $coord[$i] $coord[$i+1] (line @{[ $d->pos+1]})" unless $q;
			if ($origmap ne "Standard") {
			    my $orig0 = join(",", map {int} $to->standard2map(split /,/, $coord[$i]));
			    my $orig1 = join(",", map {int} $to->standard2map(split /,/, $coord[$i+1]));
			    print STDERR " (orig: $orig0;$orig1)" unless $q;
			}
			print STDERR "\n" unless $q;
			$err++;
		    }
		}
	    }
	}
    }

    die if $err;

    1;
}

return 1 if caller;

doit(@ARGV);

__END__
