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

#
# Author: Slaven Rezic
#
# Copyright (C) 2009,2011,2013,2016,2017,2020,2022,2023,2024,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
#

use strict;
use warnings;
use 5.010; # //
use List::Util qw(first);

sub usage (;$) {
    my $msg = shift;
    warn $msg, "\n" if $msg;
    die <<EOF;
usage: $0 task
EOF
}

my $task = shift
    or usage("Task is missing");

{
    my @available_tasks;
    sub check_task (@) {
        if (first { $task eq $_ } @_) { # List::Util::any would be more correct, but requires a relatively new List::Util
            1;
        } else {
            push @available_tasks, @_;
            0;
        }
    }
    sub get_available_tasks () { @available_tasks }
}

if ($task eq 'yml_to_permanent_bbd') {
    warn "WARNING: Please rename 'yml_to_permanent_bbd' to 'yml_to_recurring_bbd'.\n";
    $task = 'yml_to_recurring_bbd';
} elsif ($task eq 'yml_to_nonpermanent_bbd') {
    warn "WARNING: Please rename 'yml_to_nonpermanent_bbd' to 'yml_to_nonrecurring_bbd'.\n";
    $task = 'yml_to_nonrecurring_bbd';
}

if (check_task 'pl_to_yml') {
    my $in_file = shift
	or usage("in file is missing");
    my $out_file = shift
	or usage("out file is missing");
    @ARGV and usage("extra args");

    _add_bbbike_inc();
    require BBBikeYAML;

    my $temp_blocking_records = _load_records($in_file);
    BBBikeYAML::DumpFile($out_file, $temp_blocking_records);

} elsif (check_task 'cmp_pl_and_yml') {
    my $file_pl = shift
	or usage("pl file is missing");
    my $file_yml = shift
	or usage("yml file is missing");
    @ARGV and usage("extra args");

    require Data::Compare;
    require Data::Dumper;
    require File::Temp;

    _add_bbbike_inc();
    require BBBikeYAML;

    $file_pl = _make_abs_path($file_pl);

    use vars qw(@temp_blocking);
    local @temp_blocking;
    do $file_pl;
    die "Can't find \@temp_blocking array in $file_pl" if not @temp_blocking;
    my $y = BBBikeYAML::LoadFile($file_yml);

    no warnings 'once';
    local $Data::Dumper::Sortkeys = 1;
    if (not Data::Compare::Compare(\@temp_blocking, $y)) {
	my($tmp1fh,$tmp1file) = File::Temp::tempfile(SUFFIX => "_temp_blockings.pl") or die;
	my($tmp2fh,$tmp2file) = File::Temp::tempfile(SUFFIX => "_temp_blockings.yml") or die;
	print $tmp1fh Data::Dumper->new([\@temp_blocking],[])->Dump;
	print $tmp2fh Data::Dumper->new([$$y],[])->Dump;
	close $tmp1fh or die;
	close $tmp2fh or die;
	system("diff", "-u", $tmp1file, $tmp2file);
	exit 1;
    }

} elsif (check_task('yml_to_bbd') || check_task('yml_to_recurring_bbd') || check_task('yml_to_nonrecurring_bbd')) {
    require Getopt::Long;
    my $basedir;
    if (!Getopt::Long::GetOptions("basedir=s" => \$basedir)) {
	die "usage: $0 $task [--basedir=...] bbbike_temp_blockings.yml\n";
    }
    my $infile = shift
	or usage "yml file is missing";
    @ARGV and usage "Extra args";

    my @options;
    if ($basedir) {
	push @options, basedir => $basedir;
    }
    if ($task eq 'yml_to_recurring_bbd') {
	push @options, filter => 'recurring';
    } elsif ($task eq 'yml_to_nonrecurring_bbd') {
	push @options, filter => 'nonrecurring';
    }

    yml_to_bbd($infile, @options);

} elsif (check_task('bbd_to_pl_snippet')) {
    require Getopt::Long;
    if (!Getopt::Long::GetOptions()) {
	die "usage: $0 $task file.bbd\n";
    }
    my $infile = shift
	or die usage "bbd file is missing";
    @ARGV and usage "Extra args";

    my @options;
    bbd_to_pl_snippet($infile, @options);

} elsif (check_task 'check_recurrences') {
    require Getopt::Long;
    my $prewarn_days = 7;
    my $now;
    if (!Getopt::Long::GetOptions(
				  "prewarn-days=f" => \$prewarn_days,
				  "now=s" => \$now,
				 )) {
	die "usage: $0 $task [--prewarn-days=...] [--now=YYYY-MM-DDTHH:MM:SS] bbbike_temp_blockings.pl\n";
    }
    my $pl_file = shift
	or usage "pl file is missing";
    my $temp_blocking_records = _load_records($pl_file);
    check_recurrences($temp_blocking_records, prewarn_days => $prewarn_days, now => $now);
} elsif (check_task 'check_data_islands') {
    require Getopt::Long;
    my $acceptable_distance = 1000; # visible area on my monitor at 1:6000 is approx. 2800x1300 meters, so 1000 is hopefully enough
    if (!Getopt::Long::GetOptions(
				  'acceptable-distance=i' => \$acceptable_distance,
				 )) {
	die "usage: $0 $task [--acceptable_distance=...] bbbike_temp_blockings.pl\n";
    }
    my $pl_file = shift
	or usage 'pl file is missing';
    my $temp_blocking_records = _load_records($pl_file);
    check_data_islands($temp_blocking_records, acceptable_distance => $acceptable_distance);
} else {
    usage("Task '$task' is unknown, known tasks are:\n" . join("", map { "- $_\n" } get_available_tasks()));
}

sub yml_to_bbd {
    my($infile, %args) = @_;
    my $filter_recurring    = $args{'filter'} && $args{'filter'} eq 'recurring';
    my $filter_nonrecurring = $args{'filter'} && $args{'filter'} eq 'nonrecurring';
    my $basedir             = $args{'basedir'} || do { require File::Basename; File::Basename::dirname($infile) };

    _add_bbbike_inc();
    require BBBikeYAML;

    my $x = BBBikeYAML::LoadFile($infile);
    my $done_header;
    my $id = -1;
    for my $rec (@$x) {
	$id++;
	my $d = $rec->{data};
	if (!$d) {
	    my $f = $rec->{file};
	    if ($f) {
		require File::Spec;
		my $abs_f = File::Spec->rel2abs($f, $basedir);
		open my $fh, $abs_f or die "Can't open file '$abs_f': $!";
		local $/;
		$d = <$fh>;
	    }
	}
	next if not $d;
	my $d_is_multiline = $d =~ /\n.*\n/;
	next if $filter_recurring    && !($rec->{permanent} || $rec->{recurring});
	next if $filter_nonrecurring &&  ($rec->{permanent} || $rec->{recurring});
	if (!$done_header) {
	    print "#: source_file: $infile\n#:\n";
	    $done_header = 1;
	}
	print "# \n";
	print "#: id: $id vvv\n";
	print "#: x-from: "  . (defined $rec->{from}  ? $rec->{from}  : "undef") . " vvv\n";
	print "#: x-until: " . (defined $rec->{until} ? $rec->{until} : "undef") . " vvv\n";
	print "#: x-recurring: $rec->{recurring} vvv\n" if $rec->{recurring};
	my @source_ids;
	if ($rec->{source_id}) {
	    for my $source_id (ref $rec->{source_id} eq 'ARRAY' ? @{ $rec->{source_id} } : $rec->{source_id}) {
		if ($source_id =~ m{^https?}) {
		    print "#: by: $source_id\n";
		} else {
		    push @source_ids, $source_id;
		}
	    }
	}
	for my $source_id (@source_ids) {
	    print "#: source_id: $source_id" . ($d_is_multiline ? " vvv" : "") . "\n";
	}
	my $t = $rec->{text};
	$t =~ s{[\n\t]}{ }g;
	$d =~ s{^(?!\#)(.*)(\t.*)}{
	    $t . (length $1 ? " [$1]" : "") . $2;
	}gme;
	print $d;
	if ($d_is_multiline) {
	    for (0 .. $#source_ids) {
		print "#: source_id ^^^\n";
	    }
	}
	print "#: x-recurring ^^^\n" if $rec->{recurring};
	print "#: x-until ^^^\n";
	print "#: x-from ^^^\n";
	print "#: id ^^^\n";
    }
}

sub bbd_to_pl_snippet {
    my($infile, %args) = @_;
    die "Unhandled arguments: " . join(", ", %args) if %args;

    require Time::Local;
    _add_bbbike_inc();
    require Strassen::Core;
    my $s = Strassen->new_stream($infile);
    my $name;
    my $max_epoch;
    $s->read_stream
	(sub {
	     my($r,$dir) = @_;
	     if (!defined $name && $r->[Strassen::NAME()]) {
		 $name = $r->[Strassen::NAME()];
	     }
	     if (($dir->{source_id} || [])->[0] =~ /.*bis\s+(\d{1,2})\.(\d{1,2})\.(\d{4})/) {
		 my $epoch = Time::Local::timelocal(59,59,23,$1,$2-1,$3);
		 $max_epoch = $epoch if !defined $max_epoch || $max_epoch < $epoch;
	     }
	 });
    my $max_epoch_string = $max_epoch // 'undef';
    $name //= '';
    chomp(my $bbd_string = Strassen->new($infile, UseLocalDirectives => 1)->as_string);
    print <<OUTEREOF;
     { from  => undef, #
       until => $max_epoch_string, #
       text  => '$name',
       type  => 'gesperrt', # handicap
       data  => <<'EOF',
$bbd_string
EOF
     },
OUTEREOF
}

sub check_recurrences {
    my($temp_blocking_records, %args) = @_;

    my $prewarn_days = delete $args{prewarn_days};
    my $now = delete $args{now};
    die "Unhandled args: " . join(" ", %args) if %args;

    require DateTime;
    require DateTime::Event::Easter;
    require DateTime::Event::Recurrence;

    require Encode::Locale;

    my $set_start = sub {
	my($set, $start) = @_;
	require DateTime::Span;
	require DateTime::Format::ISO8601;
	$start = DateTime::Format::ISO8601->parse_datetime($start);
	return $set->intersection(DateTime::Span->from_datetimes(start => $start));
    };

    my $now_dt;
    if ($now) {
	require DateTime::Format::ISO8601;
	$now_dt = DateTime::Format::ISO8601->parse_datetime($now);
    } else {
	$now_dt = DateTime->now;
    }

    my @candidates;
    my $id = -1;
    for my $record (@$temp_blocking_records) {
	$id++;
	my $set;
	for my $recurrence (@{ $record->{recurrences} || [] }) {
	    my($method, @method_args) = @$recurrence;
	    my $set;
	    if ($method eq 'easter') {
		my $day = shift @method_args;
		my %method_args = @method_args;
		my $start = delete $method_args{start};
		$set = DateTime::Event::Easter->new(
						    day => $day,
						   );
		if ($start) {
		    $set = $set->as_set;
		    $set = $set_start->($set, $start);
		}
	    } else {
		# There is a start parameter in DateTime::Event::Recurrence,
		# but it only works in conjunction with interval. See
		# https://rt.cpan.org/Ticket/Display.html?id=79375
		# So handle start manually, using DateTime::Span and an intersection.
		my %method_args = @method_args;
		my $start = delete $method_args{start};
		$set = DateTime::Event::Recurrence->$method(%method_args);
		if ($start) {
		    $set = $set_start->($set, $start);
		}
	    }
	    if ($set) {
		my $dt_last = DateTime->from_epoch(epoch => $record->{until});
		my $dt_next = $set->can('next') ? $set->next($dt_last) : $set->following($dt_last); # next for ::Recurrence, ->following for ::Easter
		if (!$dt_next) {
		    die "Cannot find next recurrence day for record '" . $record->{text} . "', id $id...";
		}
		my $this_prewarn_days = (
					 defined $record->{recurrence_prewarn_days} && $record->{recurrence_prewarn_days} < $prewarn_days
					 ? $record->{recurrence_prewarn_days}
					 : $prewarn_days
					);
		$dt_next = $dt_next->subtract(days => $this_prewarn_days);
		if ($dt_next <= $now_dt) {
		    push @candidates, { record => $record, id => $id, date => $dt_next };
		}
	    }
	}
    }

    if (@candidates) {
	require Text::Wrap;
	binmode STDOUT, ':encoding(console_out)';
	for my $candidate (sort { $a->{date} cmp $b->{date} } @candidates) {
	    my $text = $candidate->{record}->{text};
	    my $initial = sprintf("%6d: ", $candidate->{id});
	    print Text::Wrap::wrap($initial, " " x length($initial), "$candidate->{date} $text\n");
	}
	exit 1;
    } else {
	exit 0;
    }
}

sub check_data_islands {
    my($temp_blocking_records, %args) = @_;
    my $acceptable_distance = delete $args{acceptable_distance};
    die "Unhandled args: " . join(" ", %args) if %args;

    _add_bbbike_inc();
    require Strassen::Core;
    require Strassen::StrassenNetz;
    require Strassen::Check;
    require Strassen::Util;

    my $possible_errors = 0;
    for my $record (@$temp_blocking_records) {
	next if !$record->{data}; # XXX what about file?
	my $s = Strassen->new_from_data_string($record->{data});
	my $net = StrassenNetz->new($s);
	$net->make_net;
	my $islands = Strassen::Check::get_islands($net, shortcut => 0);
	next if (@$islands <= 1);
	@$islands = sort { scalar(keys %$b) <=> scalar(keys %$a) } @$islands;

	my $this_acceptable_distance = $record->{accept_multi_feature_distance} || $acceptable_distance;

    CHECK_ISLAND:
	for my $island_i (1 .. $#$islands) {
	    my $min_dist;
	    my @nearest_points;
	    for my $island1_point (keys %{ $islands->[0] }) {
		for my $island2_point (keys %{ $islands->[$island_i] }) {
		    my $dist = Strassen::Util::strecke_s($island1_point, $island2_point);
		    if ($dist <= $this_acceptable_distance) {
			next CHECK_ISLAND;
		    } elsif (!$min_dist || $dist < $min_dist) {
			$min_dist = $dist;
			@nearest_points = ($island1_point, $island2_point);
		    }
		}
	    }
	    my $int_min_dist = int($min_dist)+1;
	    warn "Found far-away data islands in record (distance $int_min_dist from largest island, acceptable is $this_acceptable_distance, nearest points are: @nearest_points; set 'accept_multi_feature_distance => $int_min_dist' if this is OK)";
	    require Data::Dumper; print STDERR "Line " . __LINE__ . ", File: " . __FILE__ . "\n" . Data::Dumper->new([$record, $islands],[qw(need_to_check)])->Indent(1)->Useqq(1)->Sortkeys(1)->Terse(1)->Dump;
	    $possible_errors++;
	}
    }

    die "$possible_errors error(s) found" if $possible_errors;
}

sub _add_bbbike_inc {
    require lib;
    require FindBin;
    lib->import("$FindBin::RealBin/..", "$FindBin::RealBin/../lib");
}

sub _load_records {
    my $in_file = shift;
    $in_file = _make_abs_path($in_file);

    no warnings 'once';
    use vars qw(@temp_blocking);
    local @temp_blocking;
    do $in_file;
    die "Can't find \@temp_blocking array in $in_file" if not @temp_blocking;

    \@temp_blocking;
}

sub _make_abs_path {
    my $path = shift;
    require File::Spec;
    if (!File::Spec->file_name_is_absolute($path)) {
	$path = File::Spec->rel2abs($path);
    }
    $path;
}

__END__
