#!/usr/bin/perl -w

# Source: @RPM_PACKAGE_VERSION@-@RPM_PACKAGE_RELEASE@

BEGIN {
        unshift(@INC,($ENV{'POPHOME'}||'@POPHOME@').'/lib')
			unless $ENV{'PERL5LIB'} or $ENV{'TESTING'};
      }

use utf8;
use strict;
use warnings;
use Umlaut qw(textmodus);
$|=1;

use Dbase::Help qw(Do DoFn DoSelect DoTrans unixdate DoTime qquote); 
use Fehler qw(ffehler report_fehler);

use Data::Dumper;
$Data::Dumper::Indent=0;
$Data::Dumper::Terse=1;

sub Usage() {
	my $vers = '@RPM_PACKAGE_VERSION@-@RPM_PACKAGE_RELEASE@';

	textmodus(\*STDERR);
    die <<END;
*** Prüfprogramm für Strings in der Datenbank

Usage: $0 -- prüft auf Steuerzeichen außerhalb von !%ctrl-markierten Feldern
    -f DB Datenbankbeschreibung in Datei "DB" verwenden
    -h    diesen Hilfstext anzeigen
    -v    Fortschritt anzeigen
    -V    Inhalte mit anzeigen
    -d    ab Datum (Default: seit dem letzten Durchlauf)
    -e    bis Datum (Default: alles)
	-r    reparieren (durch Leerstellen ersetzen)
	-R    Reparier-Statements anzeigen
    -a    ab Beginn
    -l #  LIMIT #
    -q    keine Fehlermeldungen
    name  nur diese Tabelle
    name.feld nur dieses Feld
    name.feld.id nur dieses Feld in diesem Datensatz

Version: $vers
END
  exit 1;
}

use Getopt::Std;
use vars qw( $opt_a $opt_R $opt_r $opt_h $opt_f $opt_v $opt_V $opt_d $opt_e $opt_l $opt_q);
getopts("had:e:f:l:rRqvV") or Usage;
my %tabs;
Usage if $opt_h;
Usage if $opt_d and $opt_a;
if($opt_l) {
	$opt_l=" LIMIT $opt_l ";
} else {
	$opt_l="";
}
foreach my $t(@ARGV) { $tabs{$t}=1; }

$opt_f = "./POP-Datenbank" unless $opt_f;
my $jetzt = DoTime;
my $zuletzt = DoFn("select id from nextid where name='string_no_ctrl'");
if($opt_d) {
	my $zul = unixdate $opt_d;
	Usage unless $zul;
	$zuletzt = $zul;
} else {
	$zuletzt=0 unless defined $zuletzt;
}
$zuletzt=0 if $opt_a;

my $end = "";
if($opt_e) {
	my $ed = unixdate $opt_e;
	Usage unless $ed;
	$end = $ed;
}

my $snum = 0;
my $tab = undef;
my $idx = undef;
my @idx;
my @str = ();
my %doit;
if(@ARGV) {
	for (@ARGV) {
		$doit{$_}=1;
		$doit{"$1.?"}=1 if /(.*)(?:\.\d+)+$/;
	}
} else {
	$doit{"*"}=1;
}

open(F,$opt_f) or die "'$opt_f' nicht geoeffnet: $!\n";

my $dbr = Dbase->new();
$dbr->{'queue_result'} = 0;
my $dbw = Dbase->new();
$dbw->{'queue_result'} = 0;

while(<F>) {
	chomp;
	s/(?:^|\s)#.*//;
	s/\s+$//;
	if(/^$/) {
		$tab = undef;
		next;
	}
	if (s/^Tabelle:\t+//) {
		$tab = $_;
		$idx = undef;
	}
	next unless defined $tab;
	if(not defined $idx and s/^Index:\t+//) {
		if(/(?:^|,)\s*(\S+)\s*(?:$|,)/) {
			$idx = $1;
			@idx = ($idx);
		} else {
			s/,.*//;
			$idx = $_;
			@idx = split(/\s+/,$idx);
		}
		$idx = "`".join("`,`",@idx)."`";
	}
	next unless defined $idx;
	my($feld,$typ,$flags,$info) = split(/\t/,$_,4);
	next unless defined $flags;
	next if $flags =~ /!#/;
	next if $flags =~ /!%ctrl\b/;
	next if $typ !~ /^(?:f?char|text|bin)/;
	next unless $doit{"*"} or $doit{"$tab"} or $doit{"$tab.$feld"} or $doit{"$tab.$feld.?"};
	print "  $tab $feld @idx ...    \r" if $opt_v;
	my $step = 0;

	ffehler {
	  $dbr->DoTrans(sub {
		my $nc = 0;
		$dbr->DoSelect(sub {
			my($str,@key) = @_;
			print "  $tab $feld @idx ... $step   \r" if $opt_v and not ++$step % 100;

			return if $doit{"$tab.$feld.?"} and not $doit{"$tab.$feld.".join(".",@key)};
			my $nstr = $str;
			return unless $nstr =~ s/[\x00-\x1F]+/ /g;

			print "$tab $feld @key";
			print " :: ".Dumper($str) if $opt_V;
			print "\n";
			if($opt_r or $opt_R) {
				my $k = ""; my $kx = "where";
				foreach my $kk(@idx) {
					$k .= "$kx `$kk` = ".qquote(shift @key);
					$kx = "and";
				}
				my $sql = "UPDATE `$tab` SET timestamp = timestamp, `$feld`=${\qquote $nstr} $k";
				Do($sql) if $opt_r;
				print "$sql\n" if $opt_R;
			}
			$nc++;
		}, "select `$feld`,$idx from `$tab` where `$feld` is not null and $tab.timestamp >= from_unixtime($zuletzt)" . ($end ? " and $tab.timestamp < from_unixtime($end)" : "") . " $opt_l");
		print "  $tab $feld @idx: $nc         \n" if $nc;
		$snum++ if $nc;
	  });
	} sub {
		report_fehler() unless $opt_q;
	};
}

Do("replace into nextid set id=$jetzt, name='string_no_ctrl'")
	if not @ARGV and not $end;
print "Ende ... \n" if $opt_v;
exit($snum?13:0);
