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

#
# Author: Slaven Rezic
#
# Copyright (C) 1998,2009,2012,2015,2018 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 strict;
use FindBin;
use lib ("$FindBin::RealBin/..", "$FindBin::RealBin/../lib");
use Strassen;
use Getopt::Long;

my %known_specials = map{($_,1)} qw(strassen);

sub usage {
    my $msg = shift;
    warn $msg, "\n" if $msg;
    my $special_string = join(" | ", sort keys %known_specials);
    die <<EOF;
usage: $0 -names | -linesegs | -points | -consecutive [-special $special_string] [-directed] file ...
EOF
}

my %specials;
my $do_names;
my $do_linesegs;
my $do_points;
my $do_consecutive;
my $directed;
GetOptions("names" => \$do_names,
	   "linesegs" => \$do_linesegs,
	   "points" => \$do_points,
	   'consecutive' => \$do_consecutive,
	   "special=s" => sub {
	       my $special = $_[1];
	       if (!exists $known_specials{$special}) {
		   usage "Unknown special '$special'";
	       }
	       $specials{$special}++;
	   },
	   "directed!" => \$directed,
	  )
    or usage;

($do_names xor $do_linesegs xor $do_points xor $do_consecutive) or usage "Please specify one of -names, -points, -linesegs, or -consecutive";

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

my @files = @ARGV;
usage "File missing" if !@files;

my @obj;
foreach my $file (@files) {
    my $obj = Strassen->new($file);
    die "Can't create obj for $file" if !$obj;
    push @obj, $obj;
}

my $o = MultiStrassen->new(@obj);

my @found_consecutives;
my %h;
$o->init;
while(1) {
    my $r = $o->next;
    my $c = $r->[Strassen::COORDS];
    last if !@$c;
    if ($do_names) {
	push @{ $h{$r->[Strassen::NAME]} }, @$c;
    } elsif ($do_linesegs) {
	if (@$c) {
	    my $cat = $r->[Strassen::CAT];
	    if ($specials{'strassen'}) {
		next if $cat eq 'Pl'; # legally may be doubled
	    }
	    my $bothdirs = !$directed && $cat !~ m{;};
	    for my $i (1 .. $#$c) {
		push @{ $h{$c->[$i-1].' '.$c->[$i]} }, $r->[Strassen::NAME];
		if ($bothdirs) {
		    push @{ $h{$c->[$i].' '.$c->[$i-1]} }, $r->[Strassen::NAME];
		}
	    }
	}
    } elsif ($do_points) {
	for my $point (@$c) {
	    push @{ $h{$point} }, $r->[Strassen::NAME];
	}
    } elsif ($do_consecutive) {
	for my $i (1 .. $#$c) {
	    if ($c->[$i-1] eq $c->[$i]) {
		push @found_consecutives, "$r->[Strassen::NAME]: $c->[$i]: two times in a row";
	    }
	}
    }
}

my @doubles;
while(my($k,$v) = each %h) {
    if (@$v > 1) {
	push @doubles, $k;
    }
}

if (@doubles) {
    print STDERR "*** ERROR: Found duplicates in @files\n";
    for my $double_key (@doubles) {
	if ($do_names) {
	    print STDERR "* $double_key\tX ", join(" ", @{ $h{$double_key} }), "\n";
	} else {
	    print STDERR "* ", join("; ", @{ $h{$double_key} }), "\tX $double_key\n";
	}
    }
    exit 1;
}

if (@found_consecutives) {
    print STDERR "*** ERROR: Found consecutive same points in @files\n";
    for my $found_consecutive (@found_consecutives) {
	print STDERR "* $found_consecutive\n";
    }
    exit 1;
}

__END__

=head1 NAME

check_double - make sure that things are unique

=head1 SYNOPSIS

    check_double -names strfile ...
    check_double -linesegs strfile ...
    check_double -directed -linesegs strfile ...
    check_double -consecutive strfile ...

=head1 DESCRIPTION

Checks if all names or line segments are unique. Exits with a non-zero
value if not.

With option C<-consecutive>, check if there are no two same points in
a row.

With option C<-directed> it is assumed that the data file contains
uni-directed line segments; otherwise both directions are handled.

=cut
