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

#
# Author: Slaven Rezic
#
# Copyright (C) 2007,2016,2025 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.
#
# WWW:  https://github.com/eserte/bbbike
#

# This will be the successor of convert2hafas, one day

use strict;

use FindBin;
use lib ("$FindBin::RealBin/..",
	 "$FindBin::RealBin/../lib",
	 "$FindBin::RealBin/../data");

use Getopt::Long;
use Tie::IxHash;
use Time::Local qw(timelocal);

use Strassen::Core;

my $do_strip_tendencies;
my $do_strip_future_categories;
my $un_utf8_ify = 0;
my @keep_directive;
my $keep_old_name;
my @special;
if (!GetOptions("strip-tendencies!"        => \$do_strip_tendencies,
		"strip-future-categories!" => \$do_strip_future_categories,
		"unutf8ify!"               => \$un_utf8_ify,
		'keep-directive=s@'	   => \@keep_directive,
		'keep-old-name=s'          => \$keep_old_name,
		'special=s@'		   => \@special,
	       )) {
    die <<EOF;
usage: $0 [-strip-tendencies] [-strip-future-categories] [-unutf8ify]
          [-keep-directive dir [-keep-directive ...]] [-keep-old-name -ny]
	  [-special ... [-special ...]]
	origbbd > bbd
EOF
}

my $keep_old_name_epoch;
if ($keep_old_name) {
    if ($keep_old_name !~ m{^-(\d+)y$}) {
	die "usage: wrong -keep-old-name value, please use (without spaces) - number_of_years y";
    }
    my $years = $1;
    $keep_old_name_epoch = time - $years * 365 * 86400; # approx.
}

my $f = shift || "-";
if ($f eq '-') {
    if (-t $f) {
	warn "Read from STDIN...\n";
    }
}

local $Strassen::STRICT = 1;

my $s = Strassen->new($f, UseLocalDirectives => 1);
my $new_s = Strassen->new;
$s->init;
while(1) {
    my $r = $s->next;
    last if !@{ $r->[Strassen::COORDS] };

    my($cat_hin, $cat_rueck);
    if ($r->[Strassen::CAT] =~ /^(.*);(.*)$/) {
	($cat_hin, $cat_rueck) = ($1, $2);
    } else {
	$cat_hin = $cat_rueck = $r->[Strassen::CAT];
    }

    if ($do_strip_tendencies) {
	for ($cat_hin, $cat_rueck) {
	    s{^([qQ]\d)[\+\-](::|$)}{$1$2};
	}
    }

## Scheint gut auszusehen...
#     if ($do_strip_future_categories) {
# 	for ($cat_hin, $cat_rueck) {
# 	    s{^([USR][ABC0])::_?Tu_?}{$1}; # see also $tunnel_qr in bbbike
# 	}
#     }

    if ($cat_hin ne $cat_rueck) {
	$r->[Strassen::CAT] = $cat_hin . ";" . $cat_rueck;
    } else {
	$r->[Strassen::CAT] = $cat_hin; # XXX unless both directions should be always preserved, see radwege
    }

    my $dir = $s->get_directive;
    if ($dir->{append_comment}) {
	$r->[Strassen::NAME] .= " ($dir->{append_comment}->[0])";
    }

    for my $special (@special) {
	no strict 'refs';
	&{"special_".$special."_handler"}($r, $dir);
    }

    unutf8ify($r->[Strassen::NAME]);

    $new_s->push($r);

    {
	tie my %copied_dir, 'Tie::IxHash';
	for my $_dir (@keep_directive) {
	    if ($dir->{$_dir}) {
		$copied_dir{$_dir} = $dir->{$_dir};
	    }
	}
	if ($keep_old_name_epoch && $dir->{'oldname'}) {
	    if ($dir->{ignore_oldname_file} && $dir->{ignore_oldname_file}->[0] eq 'yes') {
		# don't create oldname directive for this record
	    } else {
		# use only the last oldname if there are multiple
		if ($dir->{'oldname'}->[-1] =~ m{-(\d{4,8}):\s+(.*)}) {
		    my($rename_date, $old_name) = ($1, $2);
		    my($y,$m,$d) = $rename_date =~ m{^(\d{4})(\d{2})?(\d{2})?};
		    $m = 1 if !defined $m;
		    $d = 1 if !defined $d;
		    my $rename_epoch = timelocal(0, 0, 0, $d, $m-1, $y);
		    if ($rename_epoch >= $keep_old_name_epoch) {
			$copied_dir{'oldname'} = [ $dir->{'oldname'}->[-1] ];
		    }
		}
	    }
	}
	if (%copied_dir) {
	    $new_s->set_directive_for_current(\%copied_dir);
	}
    }

}

my $glob_dir = $s->get_global_directives;
if ($un_utf8_ify && $glob_dir->{encoding}) {
    $glob_dir->{encoding} = ['iso-8859-1'];
    for (@{ $glob_dir->{'#'} || [] }) {
	s{(-\*-\s*coding:\s*)utf-8(\s*-\*-)}{$1iso-8859-1$2};
    }
}
$new_s->set_global_directives($glob_dir);
print $new_s->as_string;

sub unutf8ify {
    return if !$un_utf8_ify;
    $_[0] = unidecode_any($_[0], "iso-8859-1");
}

sub special_as_of_handler {
    my($r, $dir) = @_;
    if ($dir->{as_of}) {
	my($y,$m,$d) = $dir->{as_of}->[0] =~ m{^(\d{4})(?:-(\d{2})(?:-(\d{2}))?)?$};
	if (defined $y) {
	    my $date = (defined $d ? "$d.$m.$y" :
			defined $m ? "$m/$y" : # with day using ".", without using "/", seems to be natural in German
			$y);
	    $r->[Strassen::NAME] .= " (Stand $date)"; # XXX other lang/english version?
	}
    }
}

{
    my $init_done;
    my %railway_stations;
    my $street_crossings;

    sub _init_special_exits_handler () {
	require File::Basename;
	require Strassen::Kreuzungen;
	require Strassen::MultiStrassen;

	my $datadir = File::Basename::dirname($f);

	if (eval { require Tie::IxHash; 1 }) {
	    tie %railway_stations, 'Tie::IxHash';
	};

	for my $def (
	    # rationale for order:
	    # S-Bahn first because it generates shorted names (just S instead of Bhf.)
	    # U-Bahn last because it's probably less useful in Berlin than S-Bahn/Regionalbahn
	    ["S",    "sbahnhof"],
	    ["Bhf.", "rbahnhof"],
	    ["U",    "ubahnhof"],
	) {
	    my($symbol, $basename) = @$def;
	    my $file = "$datadir/$basename";
	    next if !-f $file;
	    $railway_stations{$symbol} = Kreuzungen->new_from_strassen(Strassen => Strassen->new($file));
	}

	my $street_str = MultiStrassen->new(grep { -f $_ } map { "$datadir/$_" } qw(strassen landstrassen landstrassen2));
	$street_crossings = Kreuzungen->new(Strassen => $street_str, AllPoints => 1);

	$init_done = 1;
    }

    sub special_exits_handler {
	my($r, $dir) = @_;
	_init_special_exits_handler if !$init_done;
	my @p = ($r->[Strassen::COORDS][0], $r->[Strassen::COORDS][-1]);
	my @names;
	for my $p (@p) {
	    my $name;
	SEARCH_FOR_RAILWAY_STATION: for my $railway_symbol (keys %railway_stations) {
		my $railway_stations = $railway_stations{$railway_symbol};
		if ($railway_stations->crossing_exists($p)) {
		    $name = "$railway_symbol " . join("/", @{$railway_stations->get($p)});
		    last SEARCH_FOR_RAILWAY_STATION;
		}
	    }
	    if (!$name) {
		if ($street_crossings->crossing_exists($p)) {
		    $name = join("/", @{$street_crossings->get($p)});
		} else {
		    $name = '...';
		}
	    }
	    push @names, $name;
	}

	$r->[Strassen::NAME] = join(" - ", @names) . ($dir->{note} ? " (" . join("; ", @{ $dir->{note} }) . ")" : "");
    }
}

# REPO BEGIN
# REPO NAME unidecode_any /home/e/eserte/work/srezic-repository 
# REPO MD5 bd47157f30dee711682b6a173fb1cb02

=head2 unidecode_any($text, $encoding)

Similar to Text::Unidecode::unidecode, but convert to the given
$encoding.

=cut

sub unidecode_any {
    my($text, $encoding) = @_;

    require Text::Unidecode;
    require Encode;

    my $res = "";

    for (split //, $text) {
	my $conv = eval { Encode::encode($encoding, $_, Encode::FB_CROAK()) };
	if ($@) {
	    $res .= Text::Unidecode::unidecode($_);
	} else {
	    $res .= $conv;
	}
    }

    $res;
}
# REPO END

__END__
