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

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

use Getopt::Long;
use JSON::XS;
use LWP::UserAgent;
use File::Temp;
use BBBikeUtil;

my $ca_temp_file;

sub _get_ua {
    if (!$ca_temp_file) {
	my $cert = <<'CERT';
-----BEGIN CERTIFICATE-----
MIIFszCCA5ugAwIBAgIQIZxULej27HF3+k7ow3BXlzANBgkqhkiG9w0BAQwFADBj
MQswCQYDVQQGEwJERTEnMCUGA1UECgweRGV1dHNjaGUgVGVsZWtvbSBTZWN1cml0
eSBHbWJIMSswKQYDVQQDDCJUZWxla29tIFNlY3VyaXR5IFRMUyBSU0EgUm9vdCAy
MDIzMB4XDTIzMDMyODEyMTY0NVoXDTQ4MDMyNzIzNTk1OVowYzELMAkGA1UEBhMC
REUxJzAlBgNVBAoMHkRldXRzY2hlIFRlbGVrb20gU2VjdXJpdHkgR21iSDErMCkG
A1UEAwwiVGVsZWtvbSBTZWN1cml0eSBUTFMgUlNBIFJvb3QgMjAyMzCCAiIwDQYJ
KoZIhvcNAQEBBQADggIPADCCAgoCggIBAO01oYGA88tKaVvC+1GDrib94W7zgRJ9
cUD/h3VCKSHtgVIs3xLBGYSJwb3FKNXVS2xE1kzbB5ZKVXrKNoIENqil/Cf2SfHV
cp6R+SPWcHu79ZvB7JPPGeplfohwoHP89v+1VmLhc2o0mD6CuKyVU/QBoCcHcqMA
U6DksquDOFczJZSfvkgdmOGjup5czQRxUX11eKvzWarE4GC+j4NSuHUaQTXtvPM6
Y+mpFEXX5lLRbtLevOP1Czvm4MS9Q2QTps70mDdsipWol8hHD/BeEIvnHRz+sTug
BTNoBUGCwQMrAcjnj02r6LX2zWtEtefdi+zqJbQAIldNsLGyMcEWzv/9FIS3R/qy
8XDe24tsNlikfLMR0cN3f1+2JeANxdKz+bi4d9s3cXFH42AYTyS2dTd4uaNir73J
co4vzLuu2+QVUhkHM/tqty1LkCiCc/4YizWN26cEar7qwU02OxY2kTLvtkCJkUPg
8qKrBC7m8kwOFjQgrIfBLX7JZkcXFBGk8/ehJImr2BrIoVyxo/eMbcgByU/J7MT8
rFEz0ciD0cmfHdRHNCk+y7AO+oMLKFjlKdw/fKifybYKu6boRhYPluV75Gp6SG12
mAWl3G0eQh5C2hrgUve1g8Aae3g1LDj1H/1Joy7SWWO/gLCMk3PLNaaZlSJhZQNg
+y+TS/qanIA7AgMBAAGjYzBhMA4GA1UdDwEB/wQEAwIBBjAdBgNVHQ4EFgQUtqeX
gj10hZv3PJ+TmpV5dVKMbUcwDwYDVR0TAQH/BAUwAwEB/zAfBgNVHSMEGDAWgBS2
p5eCPXSFm/c8n5OalXl1UoxtRzANBgkqhkiG9w0BAQwFAAOCAgEAqMxhpr51nhVQ
pGv7qHBFfLp+sVr8WyP6Cnf4mHGCDG3gXkaqk/QeoMPhk9tLrbKmXauw1GLLXrtm
9S3ul0A8Yute1hTWjOKWi0FpkzXmuZlrYrShF2Y0pmtjxrlO8iLpWA1WQdH6DErw
M807u20hOq6OcrXDSvvpfeWxm4bu4uB9tPcy/SKE8YXJN3nptT+/XOR0so8RYgDd
GGah2XsjX/GO1WfoVNpbOms2b/mBsTNHM3dA+VKq3dSDz4V4mZqTuXNnQkYRIer+
CqkbGmVps4+uFrb2S1ayLfmlyOw7YqPta9BO1UAJpB+Y1zqlklkg5LB9zVtzaL1t
xKITDmcZuI1CfmwMmm6gJC3VRRvcxAIU/oVbZZfKTpBQCHpCNfnqwmbU+AGuHrS+
w6jv/naaoqYfRvaE7fzbzsQCzndILIyy7MMAo+wsVRjBfhnu4S/yrYObnqsZ38aK
L4x35bcF7DvB7L6Gs4a8wPfc5+pbrrLMtTWGS9DiP7bY+A4A7l3j941Y/8+LN+lj
X273CXE2whJdV/LItM3z7gLfEdxquVeEHVlNjM7IDiPCtyaaEBRx/pOyiriA8A4Q
ntOoUAw3gi/q4Iqd4Sw5/7W0cwDk90imc6y/st53BIe0o82bNSQ3+pCTE4FCxpgm
dTdmQRCsu/WU48IxK63nI1bMNSWSs1A=
-----END CERTIFICATE-----
CERT
	my ($fh, $filename) = File::Temp::tempfile(UNLINK => 1);
	print $fh $cert;
	close $fh;
	$ca_temp_file = $filename;
    }
    my $ua = LWP::UserAgent->new(
	ssl_opts => {
	    SSL_ca_file	    => $ca_temp_file,
	    verify_hostname => 1,
	}
    );
    $ua->agent("curl/8.5.0");
    $ua->send_te(0);
    return $ua;
}

sub get_bbbikeid {
    my ($feature) = @_;
    my $geom = $feature->{geometry};
    my $props = $feature->{properties} || {};

    if (!defined $geom || ref($geom) ne 'HASH') {
	die "Error: geometry block is missing or not a HASH.\n";
    }

    my $coords = $geom->{coordinates};
    if (!defined $coords || ref($coords) ne 'ARRAY') {
	die "Error: coordinates array is missing in feature geometry.\n";
    }

    # Drill down to find the first coord pair [lon, lat]
    while (ref($coords) eq 'ARRAY' && ref($coords->[0]) eq 'ARRAY') {
	$coords = $coords->[0];
    }

    if (ref($coords) ne 'ARRAY' || @$coords < 2) {
	die "Error: Could not determine valid coordinate pair from geometry.\n";
    }

    my $lon = $coords->[0];
    my $lat = $coords->[1];
    if (!defined $lon || !defined $lat) {
	die "Error: Coordinate pair contains undefined values.\n";
    }

    my $dat_beginn = $props->{dat_beginn};
    $dat_beginn = "" if !defined $dat_beginn;

    my $uhr_beginn = $props->{uhr_beginn};
    $uhr_beginn = "" if !defined $uhr_beginn;
    $uhr_beginn =~ s/:[0-9]{2}$//;

    my @parts = ($lon, $lat, $dat_beginn, $uhr_beginn);
    return "planb2026:" . join(",", @parts);
}

sub usage {
    print <<EOF;
usage: $0 <subcommand> [options]

Subcommands:
  fetch-one | fetch-single | fetch-by-importid <importid> ...
      Fetch details for a specific importid (or multiple).

  fetch
      Fetch the daily GeoJSON and generate the adjusted BBD files.

  check
      Check active/inactive planb2026 IDs.

  diff [--fancy] [file1|date1] [file2|date2]
      Perform a BBD diff between two dates or custom BBD files.
EOF
    exit 1;
}

my $help = 0;
Getopt::Long::Configure("pass_through");
GetOptions("help|h" => \$help) or usage();

if ($help || !@ARGV) {
    usage();
}

my $subcmd = shift @ARGV;
Getopt::Long::Configure("no_pass_through");

if ($subcmd eq 'fetch-one' || $subcmd eq 'fetch-single' || $subcmd eq 'fetch-by-importid') {
    cmd_fetch_one(\@ARGV);
} elsif ($subcmd eq 'fetch') {
    cmd_fetch(\@ARGV);
} elsif ($subcmd eq 'check') {
    cmd_check(\@ARGV);
} elsif ($subcmd eq 'diff') {
    cmd_diff(\@ARGV);
} else {
    warn "Unknown subcommand: $subcmd\n";
    usage();
}

sub cmd_fetch_one {
    my ($args) = @_;
    if (!@$args) {
	die "Error: Please specify at least one importid.\n";
    }

    my $ua = _get_ua();
    my $json_coder = JSON::XS->new->canonical->pretty;

    binmode STDOUT, ':utf8';

    for my $importid (@$args) {
	my $url = "https://gdi.berlin.de/services/wfs/planb_ereignisse?service=WFS&version=2.0.0&request=GetFeature&srsName=EPSG:4326&typeNames=planb_ereignisse:ereignisse&CQL_FILTER=importid=$importid&outputFormat=application/json";
	my $resp = $ua->get($url);
	if (!$resp->is_success) {
	    die "Error fetching importid $importid: " . $resp->status_line . "\n";
	}
	my $data = eval { JSON::XS::decode_json($resp->content) };
	if ($@) {
	    die "Error parsing JSON response for importid $importid: $@\n";
	}
	my $features = $data->{features};
	if (!$features || !@$features) {
	    die "Error: No feature found for importid $importid.\n";
	}
	my $feature = $features->[0];
	my $props = $feature->{properties} || {};

	# Print properties JSON block
	print $json_coder->encode($props);

	# Calculate artificial ID
	my $id = get_bbbikeid($feature);

	# Format einschr and dat_ende
	my $einschr = $props->{einschr};
	$einschr = "" if !defined $einschr;
	my $dat_ende = $props->{dat_ende};
	$dat_ende = "" if !defined $dat_ende;

	print "#: source_id: $id (\"$einschr\", bis $dat_ende)\n";
    }
}

sub cmd_fetch {
    my ($args) = @_;
    require POSIX;

    my $today = POSIX::strftime("%F", localtime()); # YYYY-MM-DD
    my $dest_base = "$ENV{HOME}/src/bbbike-planb";
    if (!-d $dest_base) {
	die "Error: Directory '$dest_base' does not exist.\n" .
	    "Please create it manually before running this command, e.g.:\n" .
	    "  mkdir -p $dest_base\n";
    }

    my $destdir = "$dest_base/$today";
    if (!-d $destdir) {
	mkdir($destdir, 0755) or die "Can't create directory '$destdir': $!\n";
    }

    my $geojson_gz = "$destdir/all_planb.geojson.gz";
    my $geojson_raw = "$destdir/all_planb.geojson";
    my $bbd_raw = "$destdir/all_planb.bbd";

    my $bbbike_root = BBBikeUtil::bbbike_root();
    my $any2bbd_path = "$bbbike_root/miscsrc/any2bbd";

    if (!-s $geojson_gz) {
	print "Fetch geojson...\n";
	my $ua = _get_ua();
	my $url = "https://gdi.berlin.de/services/wfs/planb_ereignisse?service=WFS&version=2.0.0&srsName=EPSG:4326&request=GetFeature&typeNames=planb_ereignisse:ereignisse&outputFormat=application/json";
	my $resp = $ua->get($url, ':content_file' => $geojson_raw);
	if (!$resp->is_success) {
	    unlink $geojson_raw;
	    die "Error fetching complete geojson: " . $resp->status_line . "\n";
	}

	print "Convert to bbd...\n";
	my @cmd1 = (
	    $^X, $any2bbd_path,
	    '-geojson-name', '.properties.strasse .properties.einschr id=.properties.importid rating=.properties.bewertung .properties.dat_beginn .properties.dat_ende',
	    $geojson_raw,
	    '-o', $bbd_raw
	);
	system(@cmd1) == 0 or die "any2bbd failed: $?\n";

	print "Compress geojson...\n";
	system("gzip", "-f", $geojson_raw) == 0 or die "gzip failed: $?\n";
    }

    print "Create bbd variant with bbbikeid...\n";
    open my $gzip_fh, "-|", "gzip", "-dc", $geojson_gz or die "Can't decompress $geojson_gz: $!\n";
    local $/;
    my $geojson_content = <$gzip_fh>;
    close $gzip_fh;

    my $geojson_data = eval { JSON::XS::decode_json($geojson_content) };
    if ($@) {
	die "Error parsing downloaded GeoJSON: $@\n";
    }

    my $features = $geojson_data->{features} || [];
    for my $feature (@$features) {
	my $bbbikeid = get_bbbikeid($feature);
	$feature->{properties}->{bbbikeid} = $bbbikeid;
    }

    my $temp_geojson = "/tmp/all_planb_${today}_bbbikeid.geojson";
    open my $out_fh, ">", $temp_geojson or die "Can't write temporary geojson: $!\n";
    print $out_fh JSON::XS::encode_json($geojson_data);
    close $out_fh;

    my @cmd2 = (
	$^X, $any2bbd_path,
	'-geojson-name', '.properties.strasse .properties.einschr bbbikeid=.properties.bbbikeid rating=.properties.bewertung .properties.dat_beginn .properties.dat_ende',
	$temp_geojson,
	'-o', '/tmp/all_planb_bbbikeid.bbd'
    );
    system(@cmd2) == 0 or die "any2bbd bbbikeid failed: $?\n";

    print "Adjust categories...\n";
    my $replacestrassen_path = "$bbbike_root/miscsrc/replacestrassen";
    my @cmd3 = (
	$^X, $replacestrassen_path,
	'-addglobdir', 'category_color.PB3p=#d73027',
	'-addglobdir', 'category_color.PB3s=#d73027',
	'-addglobdir', 'category_color.PB3f=#d73027',
	'-addglobdir', 'category_color.PB2p=#fdae61',
	'-addglobdir', 'category_color.PB2s=#fdae61',
	'-addglobdir', 'category_color.PB2f=#fdae61',
	'-addglobdir', 'category_color.PB1p=#4575b4',
	'-addglobdir', 'category_color.PB1s=#4575b4',
	'-addglobdir', 'category_color.PB1f=#4575b4',
	'-addglobdir', 'line_dash.PB3s=1,4',
	'-addglobdir', 'line_dash.PB3f=2,4',
	'-addglobdir', 'line_dash.PB2s=1,4',
	'-addglobdir', 'line_dash.PB2f=2,4',
	'-addglobdir', 'line_dash.PB1s=1,4',
	'-addglobdir', 'line_dash.PB1f=2,4',
	'-recexpr', q{
use Time::Local qw(timelocal);
my $tense = q{f};
if (my($d1,$m1,$y1, $d2,$m2,$y2) = $_->[Strassen::NAME] =~ /(\d{2})\.(\d{2})\.(\d{4})\s+(\d{2})\.(\d{2})\.(\d{4})$/) {
    my $from  = timelocal(0,0,0,$d1,$m1-1,$y1);
    my $until = timelocal(0,0,0,$d2,$m2-1,$y2);
    if ($from > time) {
	$tense = q{f}; # future
    } elsif (($until - $from)/86400 <= 7) { # rough calculation, inaccuracies on DST switches are accepted
	$tense = q{s}; # short
    } else {
	$tense = q{p}; # present
    }
}
my $prio = 2;
if ($_->[Strassen::NAME] =~ m{(Vollsperrung|Sperrung einer Fahrtrichtung)}) {
    $prio = 3;
} elsif ($_->[Strassen::NAME] =~ m{(Haltverbote|keine Fahrbahn-Einschr.*nkung)}) {
    $prio = 1;
}
my $cat = qq{PB$prio$tense};
$_->[Strassen::CAT] = ($_->[Strassen::CAT] =~ /^F:/ ? "F:" : "") . $cat;
},
	$bbd_raw
    );

    open my $cat_fh, ">", "/tmp/all_planb_cat.bbd" or die "Can't write /tmp/all_planb_cat.bbd: $!\n";
    my $pid = open(my $pipe, "-|", @cmd3);
    if (defined $pid) {
	while (<$pipe>) {
	    print $cat_fh $_;
	}
	close $pipe;
    } else {
	die "Can't run replacestrassen: $!\n";
    }
    close $cat_fh;
    print "fetch complete!\n";
}

sub cmd_check {
    my ($args) = @_;
    require POSIX;

    my $today = POSIX::strftime("%F", localtime()); # YYYY-MM-DD
    my $temp_geojson = "/tmp/all_planb_${today}_bbbikeid.geojson";
    if (!-e $temp_geojson) {
	die "Error: Temporary GeoJSON file '$temp_geojson' does not exist. Please run 'fetch' first.\n";
    }

    open my $fh, "<", $temp_geojson or die "Can't read $temp_geojson: $!\n";
    local $/;
    my $geojson_content = <$fh>;
    close $fh;

    my $geojson_data = eval { JSON::XS::decode_json($geojson_content) };
    if ($@) {
	die "Error parsing $temp_geojson: $@\n";
    }

    my %existing_planb_bbbikeids;
    my $features = $geojson_data->{features} || [];
    for my $feature (@$features) {
	my $bbbikeid = $feature->{properties}->{bbbikeid};
	if (defined $bbbikeid) {
	    $existing_planb_bbbikeids{$bbbikeid} = 1;
	}
    }

    my $bbbike_root = BBBikeUtil::bbbike_root();
    my $current_yml = "$bbbike_root/tmp/sourceid-current.yml";
    my $inactive_yml = "$bbbike_root/tmp/sourceid-inactive.yml";

    require BBBikeYAML;
    my $current_sourceids = -f $current_yml ? eval { BBBikeYAML::LoadFile($current_yml) } : {};
    my $inactive_sourceids = -f $inactive_yml ? eval { BBBikeYAML::LoadFile($inactive_yml) } : {};

    my @removed_planb_ids;
    my @reactivated_planb_ids;

    if ($current_sourceids) {
	while (my ($id, $v) = each %$current_sourceids) {
	    next if $inactive_sourceids && $inactive_sourceids->{$id};
	    next if $id !~ /^planb2026:(.*)/;
	    next if $1 =~ /^(-|\d+)$/; # none or unstable importid
	    if (!$existing_planb_bbbikeids{$id}) {
		push @removed_planb_ids, $id;
	    }
	}
    }

    if ($inactive_sourceids) {
	while (my ($id, $v) = each %$inactive_sourceids) {
	    next if $id !~ /^planb2026:(.*)/;
	    next if $1 =~ /^(-|\d+)$/; # none or unstable importid
	    if ($existing_planb_bbbikeids{$id}) {
		push @reactivated_planb_ids, $id;
	    }
	}
    }

    my $error = 0;
    if (@removed_planb_ids) {
	warn "The following planb ids were removed:\n" . join("\n", map { "  $_" } sort @removed_planb_ids) . "\n";
	$error++;
    }
    if (@reactivated_planb_ids) {
	warn "The following planb ids were reactivated:\n" . join("\n", map { "	 $_" } sort @reactivated_planb_ids) . "\n";
	# $error++; # XXX currently do not count as an error
    }

    if ($error) {
	exit 1;
    }
}

sub cmd_diff {
    my ($args) = @_;
    my $fancy = 0;

    local @ARGV = @$args;
    GetOptions(
	"fancy" => \$fancy,
    ) or die "Usage: $0 diff [--fancy] [file1|date1] [file2|date2]\n";

    my $arg1 = shift @ARGV;
    my $arg2 = shift @ARGV;

    my $dest_base = "$ENV{HOME}/src/bbbike-planb";

    my $file1;
    if (defined $arg1) {
	if ($arg1 =~ /^\d{4}-\d{2}-\d{2}$/) {
	    $file1 = "$dest_base/$arg1/all_planb.bbd";
	} else {
	    $file1 = $arg1;
	}
    } else {
	require POSIX;
	my $yesterday = POSIX::strftime("%F", localtime(time() - 86400));
	$file1 = "$dest_base/$yesterday/all_planb.bbd";
    }

    my $file2;
    if (defined $arg2) {
	if ($arg2 =~ /^\d{4}-\d{2}-\d{2}$/) {
	    $file2 = "$dest_base/$arg2/all_planb.bbd";
	} else {
	    $file2 = $arg2;
	}
    } else {
	require POSIX;
	my $today = POSIX::strftime("%F", localtime());
	$file2 = "$dest_base/$today/all_planb.bbd";
    }

    if (!-f $file1) {
	die "Error: File1 '$file1' does not exist.\n";
    }
    if (!-f $file2) {
	die "Error: File2 '$file2' does not exist.\n";
    }

    if (!$fancy) {
	# Standard mode
	my ($fh1, $tmp1) = File::Temp::tempfile(UNLINK => 1);
	my ($fh2, $tmp2) = File::Temp::tempfile(UNLINK => 1);

	binmode $fh1, ':utf8';
	binmode $fh2, ':utf8';

	open my $in1, "<:utf8", $file1 or die "Can't read $file1: $!\n";
	while (<$in1>) {
	    s/\s+id=\d+//;
	    print $fh1 $_;
	}
	close $in1;
	close $fh1;

	open my $in2, "<:utf8", $file2 or die "Can't read $file2: $!\n";
	while (<$in2>) {
	    s/\s+id=\d+//;
	    print $fh2 $_;
	}
	close $in2;
	close $fh2;

	my $diff_cmd = "diff -u0 " . quotemeta($tmp1) . " " . quotemeta($tmp2);
	if (-t STDOUT) {
	    system("$diff_cmd | less -S \"+/(Vollsperrung|Fahrtrichtung)\"");
	} else {
	    system($diff_cmd);
	}
    } else {
	# Fancy mode
	binmode STDOUT, ':utf8';

	my $bbbike_root = BBBikeUtil::bbbike_root();
	my $current_yml = "$bbbike_root/tmp/sourceid-current.yml";
	my $inactive_yml = "$bbbike_root/tmp/sourceid-inactive.yml";

	require BBBikeYAML;
	my $current_sourceids = -f $current_yml ? eval { BBBikeYAML::LoadFile($current_yml) } : {};
	my $inactive_sourceids = -f $inactive_yml ? eval { BBBikeYAML::LoadFile($inactive_yml) } : {};

	open my $in1, "<:utf8", $file1 or die "Can't read $file1: $!\n";
	my %old_records;
	while (my $line = <$in1>) {
	    my $rec = parse_bbd_line($line);
	    if ($rec) {
		$old_records{$rec->{stable_key}} = $rec;
	    }
	}
	close $in1;

	open my $in2, "<:utf8", $file2 or die "Can't read $file2: $!\n";
	my %new_records;
	while (my $line = <$in2>) {
	    my $rec = parse_bbd_line($line);
	    if ($rec) {
		$new_records{$rec->{stable_key}} = $rec;
	    }
	}
	close $in2;

	my @additions;
	my @changes;
	my $deleted_count = 0;
	my %seen_ids;

	for my $key (keys %new_records) {
	    my $new_rec = $new_records{$key};
	    next if $seen_ids{$new_rec->{id}}++;
	    if (!exists $old_records{$key}) {
		push @additions, $new_rec;
	    } else {
		my $old_rec = $old_records{$key};
		if ($old_rec->{end_date} ne $new_rec->{end_date} ||
		    $old_rec->{rating} ne $new_rec->{rating}) {
		    push @changes, {
			old  => $old_rec,
			new  => $new_rec,
			prio => calculate_prio($new_rec),
		    };
		}
	    }
	}

	for my $key (keys %old_records) {
	    if (!exists $new_records{$key}) {
		$deleted_count++;
	    }
	}

	for my $rec (@additions) {
	    $rec->{prio} = calculate_prio($rec);
	}
	@additions = sort { $b->{prio} <=> $a->{prio} } @additions;
	@changes   = sort { $b->{prio} <=> $a->{prio} } @changes;

	print "--- Fancy BBD Diff ---\n";
	print "File 1 (Old): $file1\n";
	print "File 2 (New): $file2\n\n";

	if (@additions) {
	    print "=== NEW EVENTS (" . scalar(@additions) . ") ===\n";
	    for my $rec (@additions) {
		my $stable_info = get_stable_id_info($rec, $current_sourceids, $inactive_sourceids);
		printf "[NEW] Prio: %2d | %s | %s - %s | ID: %s %s | %s\n",
		    $rec->{prio},
		    $rec->{desc},
		    $rec->{begin_date},
		    $rec->{end_date},
		    $rec->{id} || 'N/A',
		    $stable_info,
		    $rec->{coords}->[0] || 'N/A';
	    }
	    print "\n";
	}

	if (@changes) {
	    print "=== CHANGED EVENTS (" . scalar(@changes) . ") ===\n";
	    for my $chg (@changes) {
		my $old = $chg->{old};
		my $new = $chg->{new};
		my $stable_info = get_stable_id_info($new, $current_sourceids, $inactive_sourceids);
		printf "[CHANGED] Prio: %2d | %s | ID: %s %s\n",
		    $chg->{prio},
		    $new->{desc},
		    $new->{id} || 'N/A',
		    $stable_info;
		if ($old->{end_date} ne $new->{end_date}) {
		    print "    - End Date: $old->{end_date} -> $new->{end_date}\n";
		}
		if ($old->{rating} ne $new->{rating}) {
		    print "    - Rating: $old->{rating} -> $new->{rating}\n";
		}
	    }
	    print "\n";
	}

	print "Info: $deleted_count deleted/removed events were dropped from the display.\n";
    }
}

sub parse_date_to_epoch {
    my ($date_str) = @_;
    if ($date_str && $date_str =~ /^(\d{2})\.(\d{2})\.(\d{4})$/) {
	require Time::Local;
	return eval { Time::Local::timelocal(0, 0, 0, $1, $2 - 1, $3) };
    }
    return undef;
}

sub calculate_prio {
    my ($record) = @_;
    my $prio = 50;

    my $desc = $record->{desc} || "";

    if ($desc =~ /Vollsperrung.*Fahrbahn|Sperrung einer Fahrtrichtung/i) {
	$prio += 30;
    } elsif ($desc =~ /Sicherung gem.* Vz.-plan/i) {
	$prio += 20;
    } elsif ($desc =~ /Gehwegvollsperrung/i) {
	$prio -= 10;
    } elsif ($desc =~ /keine Fahrbahn-Einschr|Haltverbot/i) {
	$prio -= 25;
    }

    my $begin_epoch = parse_date_to_epoch($record->{begin_date});
    my $end_epoch = parse_date_to_epoch($record->{end_date});
    if (defined $begin_epoch && defined $end_epoch) {
	my $duration_days = ($end_epoch - $begin_epoch) / 86400;
	if ($duration_days > 30) {
	    $prio += 15;
	}
	if ($duration_days <= 3) {
	    $prio -= 20;
	}
    }

    return $prio;
}

sub get_stable_id_info {
    my ($rec, $current_sourceids, $inactive_sourceids) = @_;

    my $stable_id = $rec->{bbbikeid} || "";
    my $first_coord = $rec->{coords}->[0] || "";
    my $begin_date = $rec->{begin_date} || "";

    my $matched_inuse = 0;
    my $matched_was_inuse = 0;

    if ($stable_id) {
	if ($current_sourceids->{$stable_id}) {
	    $matched_inuse = 1;
	}
	if ($inactive_sourceids->{$stable_id}) {
	    $matched_was_inuse = 1;
	}
    }

    if (!$matched_inuse && !$matched_was_inuse) {
	my $prefix = "planb2026:$first_coord,$begin_date";
	for my $k (keys %$current_sourceids) {
	    if ($k eq $prefix || $k =~ /^\Q$prefix\E,/) {
		$matched_inuse = 1;
		$stable_id = $k;
		last;
	    }
	}
	for my $k (keys %$inactive_sourceids) {
	    if ($k eq $prefix || $k =~ /^\Q$prefix\E,/) {
		$matched_was_inuse = 1;
		$stable_id = $k;
		last;
	    }
	}
    }

    if (!$stable_id) {
	$stable_id = "planb2026:$first_coord,$begin_date,";
    }

    my $status_str = "";
    if ($matched_inuse) {
	$status_str .= "INUSE ";
    }
    if ($matched_was_inuse) {
	$status_str .= "WAS_INUSE ";
    }

    return "$status_str$stable_id";
}

sub parse_bbd_line {
    my ($line) = @_;
    chomp $line;
    return undef if $line =~ /^#/ || $line =~ /^\s*$/;

    my ($text_part, $coords_part) = split /\t/, $line, 2;
    return undef if !$coords_part;

    my ($cat, @coords) = split /\s+/, $coords_part;
    my $first_coord = $coords[0] || "";

    my $begin_date = "";
    my $end_date = "";
    if ($text_part =~ s/\s+(\d{2}\.\d{2}\.\d{4})\s+(\d{2}\.\d{2}\.\d{4})$//) {
	$begin_date = $1;
	$end_date = $2;
    }

    my $bbbikeid = "";
    if ($text_part =~ s/\s+bbbikeid=(\S+)//) {
	$bbbikeid = $1;
    }
    my $id = "";
    if ($text_part =~ s/\s+id=(\S+)//) {
	$id = $1;
    }
    my $rating = "";
    if ($text_part =~ s/\s+rating=(\d+)//) {
	$rating = $1;
    }

    my $desc = $text_part;
    my $stable_key = join("|", $first_coord, $begin_date, $desc);

    return {
	line	   => $line,
	desc	   => $desc,
	id	   => $id,
	bbbikeid   => $bbbikeid,
	rating	   => $rating,
	begin_date => $begin_date,
	end_date   => $end_date,
	cat	   => $cat,
	coords	   => \@coords,
	stable_key => $stable_key,
    };
}
