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

#
# Author: Slaven Rezic
#
# Copyright (C) 2005,2013,2019 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://www.rezic.de/eserte/
#

package BBBike::check_station_category;

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

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

sub usage {
    die <<EOF;
$0 points_file streets_file
EOF
}

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

    my %opt;
    GetOptions(\%opt, "special=s") or usage();

    my $points_file  = shift @ARGV || usage();
    my $streets_file = shift @ARGV || usage();

    my $p = Strassen->new($points_file, UseLocalDirectives => 1);
    my $s = Strassen->new($streets_file, UseLocalDirectives => 1);

    {
	# Filter first:
	# "noinwork": handle the section "station only" for stations without lines (yet), usually in work
	# "disused": handle the section "disused" for disused stations with lines, otherwise would yield a check error
	# category ends with "Bau" and at the same time there's a XXX or add_fragezeichen directive (e.g. station in work, but line is already finished)
	my $new_p = $p->grepstreets(sub {
					my $dir = $p->get_directive_for_iterator("grepstreets");
					if (defined $dir->{section} && grep { $_ eq 'station only' || $_ eq 'disused' } @{ $dir->{section} }) {
					    0;
					} elsif (($dir->{XXX} || $dir->{add_fragezeichen}) && do { my $r = $p->get_for_iterator('grepstreets'); $r->[Strassen::CAT] =~ /Bau$/}) {
					    0;
					} else {
					    1;
					}
				    });
	$p = $new_p;
    }

    my %point_to_category;

    $s->init;
    while(1) {
	my $r = $s->next;
	my @c = @{ $r->[Strassen::COORDS()] };
	last if !@c;
	my $cat = $r->[Strassen::CAT()];
	$cat =~ s{::.*}{}; # remove additional information
	for my $c (@c) {
	    $point_to_category{$c}->{$cat}++;
	}
    }

    my $errors = 0;

    $p->init;
    while(1) {
	my $r = $p->next;
	my @c = @{ $r->[Strassen::COORDS()] };
	last if !@c;
	if (@c != 1) {
	    warn "Strange: $r->[Strassen::NAME()] has more than one coordinate\n";
	    $errors++;
	}
	my $cat = $r->[Strassen::CAT()];
	for my $c (@c) {
	    if (!$point_to_category{$c}) {
		warn "Coordinate $c for $r->[Strassen::NAME()] is not defined in $streets_file\n";
		$errors++;
	    } elsif (!$point_to_category{$c}->{$cat}) {
		my @expected = keys %{ $point_to_category{$c} };
		warn "Category mismatch in $r->[Strassen::NAME()]: got $cat, expected " .
		    (@expected == 1 ? $expected[0] : "one of " . join(", ", @expected)) .
			"\n";
		$errors++;
	    }
	}
    }

    $errors ? 1 : 0;
}

return 1 if caller;

exit doit(@ARGV);

__END__
