use utf8;
use warnings;
use Cf qw($ACCHOST $ACCUSER $ACCPASS $ACCDB);
use Dbase qw(db_handle);
use Dbase::Help qw(Do);
use Dbase::IP;
use Regexp::Common qw(net);
use strict;

# TODO IPv6: Dies sind Altlasten.
sub ipnr_db($) {
	my($ipnr) = @_;
	$ipnr &= 0xFFFFFFFF;
	$ipnr -= 2**32 if $ipnr >= 2**31;
	$ipnr;
}
sub ipnum ($;$) {  # 1.2.3.4/bits -> (0x01020304 32-bits (Kiste))
	my($ip,$bits) = @_;
	$ip = Dbase::IP->new($ip,$bits);
	wantarray ? ($ip->old_ip4, $ip->db_bits) : $ip->old_ip4;
}


my($db,$acp);
my $LOUD=0;
select(STDERR); $|=1; select(STDOUT);

if($ENV{'TESTING2'} or $ACCUSER eq "") {
	$db = db_handle();
} else {
	$db = Dbase->new(
		DATAHOST=>$ACCHOST,
		DATAHOST2=>$ACCHOST,
		DATAUSER=>$ACCUSER,
		DATAPASS=>$ACCPASS,
		DBDATABASE=>$ACCDB)
			or die "Die externe Datenbank ist futsch";
}

my %acc;
my @acc;

sub MAX_ACCT() { $ENV{'TESTING2'} ? 3 : 30000; }

my $acoff=0;
sub acdo($$$$$$) {
	my($acct,$cust, $loc,$rem,$pakete,$bytes) = @_;
	my $acp = $acct->{'einzel_table'};

	no warnings 'numeric';

	if($rem =~ s/^(?:\d+ )?>(\d+)$/$1/) { # "kunde Ziel"
		# nix zu tun
    } elsif($rem =~ /^\d+$/) { # "kunde"
    	die "Das darf nach RT#280119 nun eigentlich nicht mehr passieren.\n";
	} else {
		die "Unfug im remote-Feld: $rem";
	}
	$cust = 0+$cust;
	$loc = ipnum($loc);
	my $key = "$cust/$loc/$rem";

	my $acr = $acc{$key};
	if($acr) {
		print "# found $key\n" if $ENV{'TESTING2'} and $LOUD;
		$acr->[3] += $bytes; $acr->[4] += $pakete;
	} else {
		$acc{$key} = [$cust,$loc,$rem, $bytes,$pakete];
		if(@acc < MAX_ACCT) {
			print "# init $key\n" if $ENV{'TESTING2'} and $LOUD;
			push(@acc,$key);
		} else {
			print "# repl.$acoff $key, old $acc[$acoff]\n" if $ENV{'TESTING2'} and $LOUD;
			acsend($acct, $acc{$acc[$acoff]});
			delete $acc{$acc[$acoff]};
			$acc[$acoff] = $key;
			$acoff=0 if ++$acoff >= MAX_ACCT;
		}
	}
}
sub acflush($) {
	my($acct) = @_;
	foreach my $key(@acc) {
		my $acr = delete $acc{$key};
		next unless $acr;
		acsend($acct,$acr);
	}
	@acc = ();
	%acc = ();
	$acoff=0;
}

my $num=0;
sub acsend($$) {
	my($acct,$acr) = @_;
	my $dat = $acct->{'jjmm'}*100+$acct->{'tt'};
	my $acp = $acct->{'einzel_table'};
	my($cust,$loc,$rem, $bytes,$pakete) = @$acr;
	return if $pakete==0 and $bytes==0; # sicherheitshalber
	my $o0 = $0;
	$0=$acct->{'zb'}." einzel $cust $loc $rem";
	$loc = ipnr_db($loc);

	if($ENV{'TESTING2'} and $LOUD) {
	} elsif($acct->{'verbose'} and not (++$num)%100) {
		print STDERR " $0 \r";
	}

	my $cn = $db->Do("update $acp set pakete = pakete + $pakete, bytes = bytes + $bytes
	                  where quelle = $loc and datum = $dat and ziel = $rem and kunde = $cust");
	$db->Do("insert into $acp set kunde=$cust, quelle=$loc, datum=$dat, ziel=$rem, pakete=$pakete, bytes=$bytes")
		if $cn == 0;

	if($ENV{'TESTING2'} and $LOUD) {
		if($cn==0) {
			print "# ... new $loc $rem $cust\n";
		} else {
			print "# ... inc $loc $rem $cust\n";
		}
	}

	$0 = $o0;
}

sub acct_ip_multi {
	my $acct;
	my %args = (want=> $ENV{'TESTING2'} ? "kunde,ip" : "kunde,ip,ip_dtag,ip_de",
	            dienst=>"ip",
	            quelle=>"multi",
	            logdir=>"ip.multi",
	            do_reverse=>1,
				do_same_customer=>1);
	$acct = do_start(%args);
	return "Kein Accounting" unless ref $acct;

	my $prefpat;
	if($acct->{"redo"}) {
		$acct->{"do_same_customer"} = 0; # bereits doppelt geloggt: RT#541417
		$prefpat = qr/(?:(?:\d+\s)?>\d+\s+)?/;
	} else {
		$prefpat = qr/\s*/;
	}

	my $acp;
	if($ENV{'TESTING2'}) {
		$acp = "quelle";
	} else {
		$acp = lc $acct->{quelle} eq 'netflow' ? 'netflow'
		     :    $acct->{quelle} =~ /^test/i  ? 'test'
		     :                                   'quelle';
		$acp="$ACCDB.$acp" if $ACCUSER eq "";
	}
	$acct->{'einzel_table'} = $acp;
	$db->DoTrans(sub {
		$db->Do("set transaction isolation level READ UNCOMMITTED");

		%acc = (); @acc = ();
		no warnings 'numeric';

		my $line;

		while(defined($line = get_line($acct))) {
			
			my ( $locadr, $remadr, $numpack, $volpack ) =
			  $line =~
			  /^${prefpat}($RE{net}{IPv4})\s+($RE{net}{IPv4})\s+([1-9][0-9]*)\s+([1-9][0-9]*)\s*\z/o
			  or die "Ich verstehe diese Zeile nicht: $line\n";    # vgl. RT#388556

			my($cust,$idienst) = $acct->who_ip4($locadr);
			my($remagg,$rdienst) = $acct->who_ip4($remadr);

			if($volpack < $numpack) { ## a bit of heuristics...
				my $tmp = $volpack;
				$volpack = $numpack;
				$numpack = $tmp || 1;
			}
			$acct->acct( $cust, $idienst, $remagg, $rdienst, $numpack, $volpack,
				"$cust\t$remagg\t$line" );

			if($acct->{'do_logging'}) {
				acdo($acct,$cust,  $locadr,$remagg,$numpack,$volpack) if $cust   > 0;
				acdo($acct,$remagg,$remadr,$cust  ,$numpack,$volpack) if $remagg > 0;
			}
		}
		acflush($acct);
		do_end($acct);
	});
	undef;
}

1;
