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

#
# Author: Slaven Rezic
#
# Copyright (C) 1998,2003,2004,2012,2013,2017,2018,2023 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
#

# insert_points:
# Als Eingabe werden drei Punkte erwartet. Der mittlere Punkt ist neu
# und wird zwischen den ersten und dritten Punkt eingefgt. Bei Radwegen
# _gab_ es eine Sonderbehandlung.
# Da diese Funktion gefhrlich ist, wird zuerst angezeigt, welche
# Dateien gendert werden.

# -operation insertmulti:
# Like -operation insert, but allow more than one point to be inserted.

# change_points:
# Als Eingabe werden zwei Punkte erwartet. Der erste Punkt wird in allen
# Dateien in den zweiten Punkt umgewandelt.

# change_line:
# Als Eingabe werden drei Punkte erwartet. Die ersten beiden Punkte
# geben die Strecke an, von der der zweite Punkt zum dritten Punkt
# der Eingabe verschoben werden soll. Also:
# Strecke A --- B; B wird nach C verschoben
# grep_point:
# show files containing the point

# XXX deletemulti implementieren XXX was soll das machen? Mehrere Punkte lschen?

# XXX deletelines implementieren: Loeschen von Streckenzuegen

# Mit -tk wird das Programm mit Tk-Interface aufgerufen. Dann werden die
# Argumente in der X11-Selection erwartet (Fr Win32: Clipboard).

package BBBikeModify;

# Types
# 0: normal (Strassen.pm)
# 2: ampelschaltung.txt
# 3: comments
use constant T_NORMAL => 0;
use constant T_AMPELSCHALTUNG => 2; # ampelschaltung only, ampeln is T_NORMAL
use constant T_COMMENTS => 3; # XXX never implemented
use constant T_TEMPBLOCK => 5;
use constant T_TEMPBLOCKMAIN => 6;
use constant T_VORFAHRT => 7;
use constant T_MAX => 7;

use constant RET_ERROR    => 0;
use constant RET_NOMOD    => 1;
use constant RET_MODIFIED => 2;

use strict;
use Getopt::Long;

use FindBin;
use lib ("$FindBin::RealBin/..", "$FindBin::RealBin/../lib",
	 $FindBin::RealBin,
	 "$FindBin::RealBin/miscsrc", # in the case it's required from bbbike
	);
use BBBikeUtil;
use BBBikeUtil qw(save_pwd first);
use BBBikeProcUtil qw(double_fork);
use File::Basename;
use Strassen::Dataset;
use Strassen::Core;
use File::Copy qw(cp);

if (eval { require DB_File::Lock; 1 }) {
    eval { require Strassen::Index }; warn $@ if $@;
}

use vars qw($datadir);

my $use_tk = 0;
my $report;
my $bbbikerootdir = "..";
my $tempblockingdir;
my $verbose = 0;
my $n;
my @custom_check_files;
my @add_custom_check_files;
my $custom_file_list;
my $add_custom_file_list;
my @add_check_files_noorig;
my %noorig_files;
my $useint; # XXX never used?
my $orig = 1;
my $logfile;
my $ask = 1;
my @special_post_handling_files;
my $topref;
my $top;
my $my_top;
my @infiles;
my $use_indexer = 1;

my $operation;

sub process {
    my(@argv) = @_;
    my $ret;
    save_pwd {
	$ret = _process(@argv);
    };
    $ret;
}

sub _process {
    my(@argv) = @_;

    local @ARGV = @argv;

    # reset all array options:
    @custom_check_files     = ();
    @add_custom_check_files = ();
    @infiles                = ();

    if (!GetOptions('tk!'        => \$use_tk,
		    'bbbikerootdir=s' => \$bbbikerootdir,
		    'datadir=s'  => \$datadir,
		    'logfile=s'  => \$logfile,
		    'tempblockingdir=s' => \$tempblockingdir,
		    'v!'         => \$verbose,
		    'n'          => \$n,
		    'operation=s' => \$operation,
		    'file=s@'    => \@custom_check_files,
		    'addfile=s@' => \@add_custom_check_files,
		    'fl|filelist=s' => \$custom_file_list,
		    'addfl|addfilelist=s' => \$add_custom_file_list,
		    'useint!'    => \$useint,
		    'orig!'      => \$orig,
		    "report!"    => \$report,
		    "ask!"       => \$ask,
		    'infiles=s@' => \@infiles,
		    'indexer!'   => \$use_indexer,
		   )) {
	die "Usage!";
    }

    $top = $main::top = $main::top; # unfortunately I cannot use Getopt::Long to provide $top
    $datadir = "$bbbikerootdir/data" if !defined $datadir;
    $tempblockingdir = "$datadir/temp_blockings" if !defined $tempblockingdir;

    for my $def ([$custom_file_list, \@custom_check_files],
		 [$add_custom_file_list, \@add_custom_check_files],
		) {
	my($file_list, $check_files) = @$def;
	if ($file_list) {
	    open(F, $file_list) or die "Can't open $file_list: $!";
	    while(<F>) {
		chomp;
		my $f = $_;
		if (!-r $f) {
		    if (-r "$datadir/$f") {
			$f = "$datadir/$f";
		    } else {
			warn "Cannot handle $f, skipping...\n";
			next;
		    }
		}
		push @$check_files, $f;
	    }
	    close F;
	}
    }

    @add_check_files_noorig = glob("$tempblockingdir/*.bbd");

    if (@add_custom_check_files) {
	push @add_check_files_noorig, @add_custom_check_files;
    }

    warn "Custom check files are @custom_check_files\n" if $verbose and @custom_check_files;
    warn "Additional files to check are @add_check_files_noorig\n" if $verbose and @add_check_files_noorig;

    if ($use_tk) {
	require Tk;
	require Tk::ErrorDialog;
	require Tk::Dialog;
	if (!Tk::Exists($top)) {
	    $my_top = MainWindow->new;
	    $top = $my_top;
	    $top->withdraw;
	}
    }

    my($from, @middle, $to, $new_to);
    my $extra;
    my @coords = @ARGV;
    if (!@coords && defined &Tk::Exists && Tk::Exists($top)) {
	my $sel_str = ($^O eq 'MSWin32'
		       ? do { require Tk::Clipboard;
			      $top->Tk::Clipboard::clipboardGet;
			  }
		       : $top->SelectionGet);
	$sel_str =~ s/^\s+//; # my clipboard content is something faulty
	@coords = map { s/\.\d+//g; $_ } split(/\s+/, $sel_str);
    }

    if ($operation eq 'insert') {
	($from, $middle[0], $to, $extra) = @coords;
    } elsif ($operation eq 'insertmulti') {
	$from = $coords[0];
	$to = $coords[-1];
	@middle = @coords[1 .. $#coords-1];
    } elsif ($operation eq 'changeline') {
	($from, $to, $new_to, $extra) = @coords;
    } elsif ($operation eq 'change') {
	($from, $to, $extra) = @coords;
    } elsif ($operation =~ /^(grep|delete)$/) {
	($from, $extra) = @coords;
    } elsif ($operation eq 'grepline') {
	($from, $to, $extra) = @coords;
    } elsif ($operation eq 'deletemulti') {
	$from = undef;
	$to = undef;
	@middle = @coords;
    }

    my @cmd_args = ($operation, @coords);
    {
	local $^W = undef;
	warn "from=<$from> middle=<@middle> to=<$to> new_to=<$new_to>\n" if $verbose;
    }

    if (defined $extra) {
	if ($use_tk) {
	    my $d = $top->Dialog(-title => $0,
				 -text => 'Zu viele Punkte markiert!',
				 -bitmap => 'error',
				 -buttons => ['OK']);
	    $d->Show;
	    $d->destroy;
	    $my_top->destroy if Tk::Exists($my_top);
	}
	warn "Too many points ($extra)";
	return RET_ERROR;
    }

    if ($operation eq 'change' && $from eq $to) {
	if ($use_tk) {
	    common_message('Gleicher Punkt, keine Aktion notwendig!', 'infodlg');
	    $my_top->destroy if Tk::Exists($my_top);
	}
	warn "Same point $from eq $to";
	return RET_NOMOD;
    }

    my $coord_rx = qr/\d+,.*\d+$/;

    if (!defined $from or $from   !~ $coord_rx
	or
	($operation eq 'insert' and (!defined $middle[0] or $middle[0] !~ $coord_rx))
	or
	($operation eq 'insertmulti' and (!@middle or grep { !/$coord_rx/ } @middle))
	or
	($operation eq 'deletemulti' and (!@middle or grep { !/$coord_rx/ } @middle))
	or
	($operation eq 'changeline' and (!defined $new_to or $new_to !~ $coord_rx))
	or
	((!defined $to or $to     !~ $coord_rx) && $operation !~ /^(delete|grep)$/)
       ) {
	if ($use_tk) {
	    my $var_text = ($operation =~ /^(insert|changeline)$/
			    ? "mssen genau drei Punkte"
			    : ($operation eq 'grep'
			       ? "muss genau ein Punkt"
			       : ($operation eq 'insertmulti'
				  ? "mindestens drei Punkte"
				  : ($operation eq 'deletemulti'
				     ? "mindestens ein Punkt"
				     : "mssen genau zwei Punkte"
				    )
				 )
			      )
			   );
	    common_message('In der Auswahl ' . $var_text . ' sein!', 'err');
	    warn "Found operation=$operation from=$from middle=@middle to=$to";
	    $my_top->destroy if Tk::Exists($my_top);
	    return RET_ERROR;
	} else {
	    if ($operation eq 'insert') {
		die "Usage: $0 from middle to";
	    } elsif ($operation eq 'changeline') {
		die "Usage: $0 from to newto";
	    } elsif ($operation eq 'change') {
		die "Usage: $0 from to";
	    } elsif ($operation eq 'grepline') {
		die "Usage: $0 from to";
	    } elsif ($operation =~ /^(grep|delete)$/) {
		die "Usage: $0 point";
	    }
	}
    }

    my @check_files;
    my @comments_part_files = map { "comments_$_" } @Strassen::Dataset::comments_types;

    if (!@custom_check_files) {
	chdir $datadir or die "chdir to $datadir failed: $!";

	if ($operation =~ /^(insert|insertmulti|changeline|change|grepline|grep|delete|deletemulti)$/) {
	    # folgende Dateien werden bei insert_points berprft:
	    # normales Format
	    # XXX gesperrt/gesperrt_car: Die Kategorie 3 msste
	    # eigentlich gesondert betrachtet werden (wie die Drei-Punkte-Form
	    # von comments). Aber es sollte so auch funktionieren.
	    @{$check_files[T_NORMAL]} =
		qw(gesperrt gesperrt_u gesperrt_s gesperrt_r gesperrt_car
		   landstrassen landstrassen2
		   strassen_bab
		   qualitaet_l qualitaet_s
		   handicap_directed
		   handicap_l handicap_s
		   strassen plaetze faehren
		   rbahn rbahnhof
		   sbahn sbahnhof
		   ubahn ubahnhof
		   nolighting
		   flaechen wasserstrassen wasserumland
		   wasserumland2 ampeln hoehe
		   housenumbers green brunnels
		   deutschland
		   fragezeichen
		   exits
		   orte orte2
		   ortsschilder
		   sehenswuerdigkeit
		   potsdam plz
		   grenzuebergaenge
		   culdesac
		   ../misc/abdeckung.bbd
		   mudways
		  );
	    # Specify files here which are only available as -orig or
	    # non-orig version:
	    if ($orig) {
		push @{$check_files[T_NORMAL]}, "radwege", "routing_helper";
	    } else {
		push @{$check_files[T_NORMAL]}, "radwege_exact";
	    }
	    # relation_gps herausgenommen (CVS 2004-07-26, RCS ...)
	    # XXX gehrt housenumbers hier rein???

	    # Besonderer Code fr die Drei-Punkte-Form von comments bei
	    # insert_points.
	    # ist fr vorfahrt und ampelschaltung_rules.bbd implementiert, XXX fr andere auch notwendig?
	    # XXX for now use the normal insert ... the additional points have to
	    # be put out manually (but this is easier than do nothing)
	    push @{$check_files[T_NORMAL]}, @comments_part_files;

	    @{$check_files[T_VORFAHRT]} = qw(vorfahrt ../misc/ampelschaltung_rules.bbd);

	    @{$check_files[T_TEMPBLOCK]} =
		@add_check_files_noorig if @add_check_files_noorig;

	    if (1) {
		# Hopefully this is not too dangerous enough: treating
		# bbbike-temp-blockings.pl as it was a normal bbd file:
		for my $orig_src ("$tempblockingdir/bbbike-temp-blockings.pl",
				  "$tempblockingdir/old-bbbike-temp-blockings.pl",
				 ) {
		    if (-r $orig_src) {
			push @{$check_files[T_NORMAL]}, $orig_src;
			push @add_check_files_noorig, $orig_src;
		    }
		}
	    } else {		      
		# The old code, which needs some postprocessing by the
		# user (incorporerating changes in the temp files into
		# the real bbbike-temp-blockings.pl)
		for my $orig_src ("$tempblockingdir/bbbike-temp-blockings.pl",
				  "$tempblockingdir/old-bbbike-temp-blockings.pl",
				 ) {
		    my $f = "/tmp/" . basename($orig_src, qr{\.pl$}) . ".bbd";
		    if (-r $orig_src) {
			if (!-e $f || -M $orig_src < -M $f) {
			    use vars qw(@temp_blocking);
			    @temp_blocking = ();
			    do $orig_src;
			    my $data = "";
			    for (@temp_blocking) {
				$data .= $_->{data} if $_->{data};
			    }
			    if ($data ne "") {
				open TEMP, ">$f"
				    or die "Can't write to $f: $!";
				print TEMP $data;
				close TEMP;
				push @{$check_files[T_TEMPBLOCKMAIN]}, $f;
			    }
			} else {
			    push @{$check_files[T_TEMPBLOCKMAIN]}, $f;
			}
			cp $f, "$f~";
			push @special_post_handling_files, {Original        => $orig_src,
							    BBDFile         => $f,
							    BBDFileOriginal => "$f~",
							   };
		    }
		}
	    }
	}

	# user defined files
	%noorig_files = ();
	$noorig_files{'../misc/ampelschaltung_rules.bbd'} = 1;
	$noorig_files{'mudways'} = 1;

	if ($operation =~ /^(change|grep)$/) {
	    @{$check_files[T_AMPELSCHALTUNG]} = ('../misc/ampelschaltung.txt', 'ampelschaltung');
	}

	for (@add_check_files_noorig) {
	    $noorig_files{$_} = 1;
	}

    } else { # custom_check_files
	@{$check_files[T_NORMAL]} = @custom_check_files;
	$noorig_files{$_} = 1 for (@custom_check_files);
	for (T_NORMAL+1 .. T_MAX) {
	    @{$check_files[$_]} = ();
	}
    }

    # uhm... how hackish :-(
    if ($orig) {
#	if ($operation ne 'change') {
	    for my $cf_i (0 .. $#check_files) {
		next if $cf_i == T_TEMPBLOCK || $cf_i == T_TEMPBLOCKMAIN;
		my $cf = $check_files[$cf_i];
		for my $f (@$cf) {
		    next if $noorig_files{$f};
		    if ($f !~ s/\.txt/-orig.txt/) {
			$f .= "-orig";
		    }
		}
	    }
#	}
    } else {
#	if ($operation eq 'change') {
	    for my $cf_i (0 .. $#check_files) {
		next if $cf_i == T_TEMPBLOCK || $cf_i == T_TEMPBLOCKMAIN;
		my $cf = $check_files[$cf_i];
		for my $f (@$cf) {
		    next if $noorig_files{$f};
		    if ($f !~ s/-orig\.txt$/.txt/) {
			$f =~ s/-orig//;
		    }
		}
	    }
#	}
    }

    my @change_files;
    my %change_names;
    my %change_special_flags;

    my @warnings;

    for(my $type = 0; $type <= $#check_files; $type++) {
	foreach my $file (@{$check_files[$type]}) {

	    my $indexer = get_indexer(file => $file, type => $type);
	    if ($indexer) {
		if (!$indexer->point_exists($from) &&
		    (!defined $to || !$indexer->point_exists($to))) {
		    warn "Shortcut check for $file positive, skipping...\n" if $verbose;
		    next;
		}
	    }

	    my $map_from = $from;
	    my $map_to; $map_to = $to if defined $to;
	    open(F, $file) or do {
		my $msg = "Can't open file <$file>";
		warn "$msg.\n";
		push @warnings, "$msg.\n";
		next;
	    };
	    warn "Read $file...\n" if $verbose;
	    my(@data) = <F>;
	    close F;

	    if ($operation =~ /^(insert|insertmulti|changeline|grepline)$/) {
		if ($type == T_NORMAL || $type == T_TEMPBLOCK || $type == T_TEMPBLOCKMAIN || $type == T_VORFAHRT) {
		    if ($verbose) {
			warn "Check for ($map_from $map_to|$map_to $map_from)\n";
		    }
		    my @changed = grep(/(?:(?<=\s)|^)(?:$map_from $map_to|$map_to $map_from)\b/, @data);
		    if (@changed) {
			push @{$change_files[$type]}, $file;
			push @{$change_names{$file}}, extract_bbd_names(@changed);
			if ($operation eq 'changeline' && first { /(?:\t\S+\s(?:$map_from $map_to|$map_to $map_from)\b|\b(?:$map_from $map_to|$map_to $map_from)$)/ } @data) {
			    push @{$change_special_flags{$file}}, "endpoint";
			}
		    }
		} elsif ($type == T_COMMENTS) {
		    # XXX implement!
		    #my $rx = "P\d.*
		    #if ($verbose) {
		    #warn "Check for ($map_from\t$map_to|$map_to\t$map_from)\n";
		    #}
		}
	    } elsif ($operation =~ /^(change|grep|delete)$/) {
		# XXX verbose fehlt
		if ($type == T_NORMAL || $type == T_TEMPBLOCK || $type == T_TEMPBLOCKMAIN || $type == T_COMMENTS || $type == T_VORFAHRT) {
		    my @changed = grep(/(?:(?<=\s)|^)$map_from(\b|$)/, @data);
		    if (@changed) {
			push @{$change_files[$type]}, $file;
			push @{$change_names{$file}}, extract_bbd_names(@changed);
			if (first { /\t\S+\s$map_from$/ } @changed) {
			    push @{$change_special_flags{$file}}, "single-point";
			} elsif (first { /(?:\t\S+\s$map_from\b|\b$map_from$)/ } @changed) {
			    push @{$change_special_flags{$file}}, "endpoint";
			}
		    }
		} elsif ($type == T_AMPELSCHALTUNG) {
		    #warn "XXX NYI $operation for $file";
                    if (grep(/^$map_from\b/, @data)) {
			push @{$change_files[$type]}, $file;
		    }
		}
	    }
	}
    }

    if (@warnings) {
	if ($use_tk) {
	    $top->messageBox(-message => join "", @warnings);
	}
    }

    my $dialog_text = "Keine Umwandlung ntig.";
    if ($operation eq 'grep') {
	$dialog_text = "Punkt nicht gefunden.";
    } elsif ($operation eq 'grepline') {
	$dialog_text = "Strecke nicht gefunden.";
    }
    if (!_interpolate(@change_files)) {
	if ($use_tk) {
	    common_message($dialog_text, 'infodlg');
	    $my_top->destroy if Tk::Exists($my_top);
	} else {
	    print STDERR "$dialog_text.\n";
	}
	return RET_NOMOD;
    }

    if ($report) {
	print join("\n", _interpolate(@change_files)), "\n";
	return RET_NOMOD;
    }

    # %change_names values are octets currently, make it into
    # perl characters (if necessary)
    if (%change_names) {
	for my $file (keys %change_names) {
	    for my $val (@{ $change_names{$file} }) {
		$val = decode_for_file($val, $file);
	    }
	}
    }

    $dialog_text = "Betroffene Dateien:\n";
    for my $changed_file (_interpolate(@change_files)) {
	$dialog_text .= "\t" . $changed_file;
	if (exists $change_names{$changed_file} &&
		@{ $change_names{$changed_file} }) {
	    $dialog_text .= " (" . join(", ", @{ $change_names{$changed_file} }) . ")";
	}
	if (exists $change_special_flags{$changed_file} &&
		@{ $change_special_flags{$changed_file} }) {
	    $dialog_text .= " (" . join(", ", @{ $change_special_flags{$changed_file} }) . ")";
	}
	$dialog_text .= "\n";
    }
    $dialog_text .= "\nSoll die Umwandlung ($operation) vorgenommen werden?";
    if ($n) {
	$dialog_text .= " (no-clobber mode)";
    }

    if (@infiles) {
	my %infiles = map {($_,1)} @infiles;
	my @change_files =  _interpolate(@change_files);
	my %change_files = map {($_,1)} @change_files;
	for my $infile (keys %infiles) {
	    if (!exists $change_files{$infile}) {
		die "Unexpected: $infile exists in datachange.log, but not in files actually to change: @change_files ($operation on @coords)\n";
	    }
	}
	for my $change_file (keys %change_files) {
	    if (!exists $infiles{$change_file}) {
		die "Unexpected: $change_file should be actually changed, but does not exist in datachange.log: @infiles ($operation on @coords)\n";
	    }
	}
    }

    my $editable_operation = $operation !~ /^(grep|grepline)$/;

    my $ans;
    if (!$ask) {
	print STDERR "Doing $operation...\n" if $verbose;
	$ans = 'j';
    } elsif ($use_tk) {
	my @check;
	my @orig_change_files;
	my @checkbutton_info;
	my @lock_warnings;
	for (my $type = 0; $type <= $#change_files; $type++) {
	    next if !defined $change_files[$type];
	    @{$orig_change_files[$type]} = @{$change_files[$type]};
	    $change_files[$type] = [];
	    foreach my $file (@{$orig_change_files[$type]}) {
		if (-l emacs_lockfile($file)) {
		    push @lock_warnings, $file;
		}
		my $names = "";
		if (exists $change_names{$file} &&
		    @{ $change_names{$file} }) {
		    $names = join(", ", @{ $change_names{$file} });
		    $names = substr($names, 0, 40)."..." if length $names > 40;
		    $names = " ($names)";
		}
		if (exists $change_special_flags{$file} &&
			@{ $change_special_flags{$file} }) {
		    $names .= " (" . join(", ", @{ $change_special_flags{$file} }) . ")";
		}
		$check[$type]->{$file} = 1;
		push @checkbutton_info, { -text => "$file$names",
					  -variable => \$check[$type]->{$file},
					};
	    }
	}

	if (@lock_warnings) {
	    my $yn = $top->messageBox(-title => 'Warning',
				      -message => "The following files might be edited in an emacs session:\n" .
				      join("\n", map { "* $_" } @lock_warnings) . "\n" .
				      "Continue editing?",
				      -type => 'YesNo',
				     );
	    if ($yn !~ m{^y}i) {
		return RET_NOMOD;
	    }
	}

	require Tk::DialogBox;
	my $dia = $top->DialogBox
	    (-title => $0,
	     -buttons => (!$editable_operation ? ['Ok'] : ['Ja', 'Nein']),
	    );
	$dia->add('Label', -text => {insert => 'Punkt einfgen',
				     insertmulti => 'Mehrere Punkte einfgen',
				     changeline => 'Strecke verschieben',
				     change => 'Punkt verschieben',
				     grep => 'Punkt gefunden',
				     grepline => 'Strecke gefunden',
				     delete => 'Punkt lschen',
				    }->{$operation}
		 )->pack;
	$dia->add('Label', -text => 'Betroffene Dateien:')->pack;
	for my $cb_info (@checkbutton_info) {
	    if ($editable_operation) {
		$dia->add('Checkbutton', %$cb_info)->pack(-anchor => "w");
	    } else {
		# XXX make this a button for starting emacsclient (or better:
		#     using BBBikeEdit::start_editor) at the correct line
		#     (hmmm, is this information available at this point?)
		$dia->add('Label',
			  -text => $cb_info->{'-text'},
			 )->pack(-anchor => "w");
	    }
	}
	if ($editable_operation) {
	    $dia->add('Label',
		      -text => "Soll die Umwandlung vorgenommen werden?")->pack;
	}

	$ans = $dia->Show;
	$dia->destroy;
	for (my $type = 0; $type <= $#check_files; $type++) {
	    foreach my $file (@{$orig_change_files[$type]}) {
		push @{$change_files[$type]}, $file
		    if $check[$type]->{$file};
	    }
	}
	if ($ans =~ /ja/i and _interpolate(@change_files)) {
	    $ans = 'j';
	} else {
	    $ans = 'n';
	}
    } else {
	print STDERR "$dialog_text (j/N) ";
	$ans = <STDIN>;
    }

    if (!$editable_operation) {
	return RET_NOMOD;
    }

    if ($ans =~ /^j/) {
	# Do the operation!
	my @changed_files;
	for(my $type = 0; $type <= $#check_files; $type++) {
	    foreach my $file (@{$change_files[$type]}) {
		push @changed_files, $file;

		my $map_from     = $from;
		my $map_new_from;
		if ($operation eq 'change') {
		    $map_new_from = $to;
		}
		my @map_middle;
		my @rev_middle;
		if ($operation =~ /^insert(multi)?$/) {
		    @map_middle = @middle;
		    @rev_middle = reverse @map_middle;
		}
		my $map_to;
		$map_to = $to if defined $to;
		my $map_new_to;
		if ($operation eq 'changeline') {
		    $map_new_to = "$new_to";
		}

		if ($operation eq 'change' and $type == T_AMPELSCHALTUNG
		    and length($map_new_from) < length($map_from)) {
		    # mit Leerzeichen auffllen, da ich mit LHS substr arbeite
		    $map_new_from .= " " x (length($map_from)-length($map_new_from));
		}

#warn "from=$map_from, middle=@map_middle, to=$map_to, new_from=$map_new_from, new_to=$map_new_to\n";

		if (!$n) {
		    chmod 0644, "$file~";
		    rename $file, "$file~" or die "rename $file to $file~: $!";
		    open(R, "$file~") or die "Can't open $file~: $!";
		    open(W, ">$file") or die "Can't write to $file: $!";
		} else {
		    open(R, $file) or die "Can't open $file: $!";
		    open(W, ">/tmp/insert_change_points_test") or die "Can't write to file: $!";
		}
		binmode W; # XXX check on NT
		while(<R>) {
		    if ($operation =~ /^insert(multi)?$/) {
			if ($type == T_NORMAL || $type == T_TEMPBLOCK || $type == T_TEMPBLOCKMAIN) {
			    if (/(?:(?<=\s)|^)$map_from $map_to\b/) {
				s/(?:(?<=\s)|^)($map_from) ($map_to)\b/$1 @map_middle $2/;
			    } elsif (/(?:(?<=\s)|^)$map_to $map_from\b/) {
				s/(?:(?<=\s)|^)($map_to) ($map_from)\b/$1 @rev_middle $2/;
			    }
			    print W $_;
			} elsif ($type == T_VORFAHRT) {
			TRY: {
				last if (s/(\t\S+\s+)$map_from( $map_to\b)/$1$map_middle[-1]$2/);
				last if (s/(\t\S+\s+)$map_to( $map_from\b)/$1$map_middle[0]$2/);
				last if (s/(\b$map_from )$map_to$/$1$map_middle[0]/);
				last if (s/(\b$map_to )$map_from$/$1$map_middle[-1]/);
			    }
			    print W $_;
			}
		    } elsif ($operation eq 'changeline') {
			if ($type == T_NORMAL || $type == T_TEMPBLOCK || $type == T_TEMPBLOCKMAIN || $type == T_VORFAHRT) {
			    if (/(?:(?<=\s)|^)$map_from $map_to\b/) {
				s/(?:(?<=\s)|^)($map_from) $map_to\b/$1 $map_new_to/;
			    } elsif (/(?:(?<=\s)|^)$map_to $map_from\b/) {
				s/(?:(?<=\s)|^)$map_to ($map_from)\b/$map_new_to $1/;
			    }
			    print W $_;
			}
		    } elsif ($operation eq 'delete') {
			if ($type == T_NORMAL || $type == T_TEMPBLOCK || $type == T_TEMPBLOCKMAIN || $type == T_VORFAHRT) {
			    s/\s*$map_from\b//g;
			    if (/^[^\t]\t\S+$/) {
				# remove this record
			    } else {
				print W $_;
			    }
			} else {
			    die "NYI!";
			}
		    } elsif ($operation eq 'change') {
			if ($type == T_NORMAL || $type == T_TEMPBLOCK || $type == T_TEMPBLOCKMAIN || $type == T_VORFAHRT) {
			    s/(?:(?<=\s)|^)$map_from\b/$1$map_new_from/g;
			    print W $_;
			} elsif ($type == T_AMPELSCHALTUNG) {
			    if (/^$map_from\b/) {
				substr($_, 0, length($map_new_from)) = $map_new_from;
			    }
			    print W $_;
			}
		    }
		}
		close W;
		close R;
		if (!$n) {
		    chmod 0644, $file;
		}

		my $indexer = get_indexer(file => $file, type => $type, uptodatecheck => 0);
		if ($indexer) {
		    # By using add_point without a delete_point the
		    # index is not exact: it could contain more points
		    # than real.
		    if (defined $map_new_from) {
			$indexer->add_point($map_new_from);
		    }
		    if (defined $map_new_to) {
			$indexer->add_point($map_new_to);
		    }
		    for my $c (@map_middle) {
			if (defined $c) {
			    $indexer->add_point($c);
			}
		    }
		}

	    }
	}
	if (!$n) {
	    do_log($top, @cmd_args, @changed_files);
	}

	{
	    my @warn_user;
	    for my $def (@special_post_handling_files) {
		my $f_new  = $def->{BBDFile};
		my $f_orig = $def->{BBDFileOriginal};
		require File::Compare;
		if (File::Compare::compare($f_new, $f_orig) != 0) {
		    push @warn_user, $def;
		}
	    }
	    if (@warn_user) {
		my $msg = "Bitte die folgenden nderungen manuell durchfhren:\n";
		for my $def (@warn_user) {
		    $msg .= "zwischen $def->{BBDFileOriginal} und $def->{BBDFile} -> $def->{Original}\n";
		}
		if ($use_tk) {
		    $top->messageBox(-title => "Warning",
				     -message => $msg);
		}
		warn $msg, "\n";
	    }
	}
    }
    return RET_MODIFIED;
}

sub _interpolate {
    my(@a) = @_;
    my @res;
    foreach (@a) {
	push @res, @$_ if ref $_ eq 'ARRAY';
    }
    @res;
}

sub do_log {
    my($top, @args) = @_;
    my $logfile = $logfile;
    $logfile = "$datadir/datachange.log" if !$logfile;
    warn "Log to $logfile...\n" if $verbose;

    # EDIT line
    my $last_date_line;
    my @l = localtime;
    my $this_date_line = sprintf "%04d-%02d-%02d", $l[5]+1900, $l[4]+1, $l[3];
    my $user = eval { (getpwuid($<))[0] } || $ENV{USER};
    if ($user) {
	$this_date_line .= " by=$user";
    }
    if (eval { require Sys::Hostname }) {
	$this_date_line .= " on=" . Sys::Hostname::hostname();
    }

    # Do we need a current EDIT line?
    my $date_line_needed = 1;
    my $have_bw_fh = 0;
    if (eval { require File::ReadBackwards; 1 }) {
	if (tie *BW, "File::ReadBackwards", $logfile) {
	    $have_bw_fh = 1;
	}
    } else {
	warn "Installation of File::ReadBackwards module advised!\n";
    }
    if (!$have_bw_fh) {
	if (open BW, $logfile) {
	    $have_bw_fh = 1;
	}
    }
    if ($have_bw_fh) {
	while(<BW>) {
	    chomp;
	    if (/^\#\s+EDIT:\s*(.*)/) { # my edit
		if ($1 eq $this_date_line) {
		    $date_line_needed = 0;
		    last;
		} else { # other people's edit
		    $date_line_needed = 1;
		    last;
		}
	    }
	}
	close BW;
    }

    if (defined &BBBikeEdit::ask_for_co) {
	BBBikeEdit::ask_for_co($top, $logfile);
    }
    if (open(LOG, ">>$logfile")) {
	if ($date_line_needed) {
	    print LOG "# EDIT: $this_date_line\n";
	}
	print LOG "@args\n";
	close LOG;
    } else {
	my $msg = "Can't write to $logfile: $!";
	common_message($msg, "warn");
    }
}

sub common_message {
    my($msg, $type) = @_;
    warn $msg;
    if (defined &main::status_message) {
	main::status_message($msg, $type);
    } elsif ($use_tk) {
	if (!Tk::Exists($top)) {
	    require Tk;
	    $my_top = MainWindow->new;
	    $top = $my_top;
	    $top->withdraw;
	}
	$top->messageBox(-message => $msg);
    }
}

sub get_indexer {
    my(%args) = @_;
    return undef if !$use_indexer;
    my $file = delete $args{file};
    my $type = delete $args{type};
    my $uptodatecheck = exists $args{uptodatecheck} ? delete $args{uptodatecheck} : 1;
    if (($type == T_NORMAL || $type == T_VORFAHRT)
	&& $file !~ m{bbbike-temp-blockings\.pl$} # not a real bbd file
	&& Strassen::Index->can("new")) {
	my $indexer = Strassen::Index->new($file, verbose => $verbose, %args);
	if ($indexer->needs_update) {
	    if ($uptodatecheck) {
		require POSIX;
		double_fork {
		    POSIX::nice(+20) if $^O ne 'MSWin32'; # not implemented under Windows
		    eval {
			warn "Create index for $file/$type in background...\n"
			    if $verbose;
			$indexer->create_index;
			warn "Creation of index for $file/$type completed!\n"
			    if $verbose;
			$indexer->close_index; # for flushing
		    };
		    warn $@ if $@;
		    POSIX::_exit(0) if $^O ne 'MSWin32'; # use this instead of CORE::exit to prevent from swapping everything in --- except on Windows, where POSIX::_exit does not work
		};
		return undef;
	    } else {
		$indexer->open_index;
	    }
	} else {
	    $indexer->open_index;
	}
	return $indexer;
    }
    undef;
}

sub emacs_lockfile {
    my $file = shift;
    my $lock_file;
    if ($file =~ m{/.*?$}) {
	($lock_file = $file) =~ s{/([^/]+)$}{/.#$1};
    } else {
	$lock_file = '.#' . $file;
    }
    $lock_file;
}

sub decode_for_file {
    my($text, $file) = @_;

    # Assume that encoding never changes for files, so we can cache it
    our %file_to_encoding;

    if (!exists $file_to_encoding{$file}) {
	require Strassen::Core;
	my $s = Strassen->new($file, NoRead => 1);
	$s->read_data(ReadOnlyGlobalDirectives => 1);
	my $encoding = $s->get_global_directive('encoding');
	if ($encoding) {
	    $file_to_encoding{$file} = $encoding;
	} else {
	    $file_to_encoding{$file} = undef;
	}
    }

    if (my $encoding = $file_to_encoding{$file}) {
	require Encode;
	Encode::decode($encoding, $text);
    } else {
	$text;
    }
}

sub extract_bbd_names {
    my(@lines) = @_;
    map { /^([^\t]+)/ ? $1 : () } @lines;
}

return 1 if caller;

$operation = ($0 =~ /       insert_points$ /x ? 'insert'      :
	      $0 =~ / insert_multi_points$ /x ? 'insertmulti' :
	      $0 =~ /         change_line$ /x ? 'changeline'  :
	      $0 =~ /          grep_point$ /x ? 'grep'        :
	      $0 =~ /           grep_line$ /x ? 'grepline'    :
	      $0 =~ /        delete_point$ /x ? 'delete'      :
	      $0 =~ /        delete_multi$ /x ? 'deletemulti' :
	      $0 =~ /        deline_lines$ /x ? 'deletelines' :
	      					'change'
	     );

my $ret = process(@ARGV);
exit ($ret == RET_ERROR ? 1 : 0);

__END__
