use utf8;
use warnings; no warnings "redefine";
use strict;

use Dbase::Globals qw(get_descr get_gruppen name_kunde puny_decode test_gruppe);
use Dbase::Help qw(DoSelect in_list qquote);
use Fehler qw(problem warnung);
use Loader qw(line_printer);

my ( $is_rewrite_grs, $is_rewrite_grc ) =
  get_gruppen( mailrules_ident => 'rewrite', 1 );

my ( $is_to_domain_grs, $is_to_domain_grc ) =
  get_gruppen( mailrules_ident => 'to_domain', 1 );

my ( $is_to_freetext_grs, $is_to_freetext_grc ) =
  get_gruppen( mailrules_ident => 'to_freetext', 1 );

sub list_mailrules($;$) {
	my ( $kunde_id, $match ) = @_;
	line_printer;

	my $format = "%-39s %s\n";
	my $where = '';
	{

		# Trennung von Variablen-Deklaration und bedingter
		# Initialisierung wichtig, vgl. RT#244828
		my @where;
		push @where, "kunde = $kunde_id" if $kunde_id;

		if ( defined $match ) {

			if ( ref $match ) {
				push @where, in_list( 'mailrules.id', '', @$match );
			}
			else {
				my $matchtype;

				# Trennung von Variablen-Deklaration und bedingter
				# Initialisierung wichtig, vgl. RT#244828
				$matchtype = $1 if $match =~ s/^([<>])//;
				warnung <<'_' if $match =~ /[^-0-9a-z%+.=\@_]/i;
Das Suchen nach IDNs wird (noch) nicht unterstützt,
bzw. muss ggf. die Punycode-Repräsentation angegeben werden.
_
				my $qqmatch = qquote($match);
				push @where,
				  defined $matchtype
				  ? ( $matchtype eq '<' ? 'quelle' : 'ziel' ) . " LIKE $qqmatch"
				  : "( quelle LIKE $qqmatch OR ziel LIKE $qqmatch )";
			}
		}
		$where = 'WHERE ' . ( join ' AND ', @where ) . "\n" if @where;
	}

	my $hdr;
	eval {
		DoSelect {
			my ( $quelle, $typ, $ziel, $kunde ) = @_;

			my $is_freetext_target = test_gruppe(
				mailrules => $typ,
				$is_to_freetext_grs, $is_to_freetext_grc
			);
			$quelle = defined $quelle ? puny_decode( $quelle, 4 ) : '*';

			unless ( defined $ziel ) { $ziel = '' }
			elsif ( !$is_freetext_target ) { $ziel = puny_decode( $ziel, 4 ) }

			unless (
				test_gruppe(
					mailrules => $typ,
					$is_rewrite_grs, $is_rewrite_grc
				)
			  )
			{
				$ziel = get_descr( mailrules => $typ ) . "!$ziel";
			}
			elsif ( !length $ziel ) { $ziel = '-' }
			elsif (
				test_gruppe(
					mailrules => $typ,
					$is_to_domain_grs, $is_to_domain_grc
				)
			  )
			{
				$ziel = join ',', map "\@$_", split /,/, $ziel;
			}
			$kunde = $kunde && sprintf '#%4d:%-16s ', $kunde,
			  name_kunde($kunde);

			unless ( $hdr++ ) {
				printf $Db::pr_fh 'K-Nr. Kundenname       ' unless $kunde_id;
				printf $Db::pr_fh $format, qw(Quelladresse Ziel(e));
			}
			for (
				test_gruppe(
					mailrules => $typ,
					$is_to_freetext_grs, $is_to_freetext_grc
				) ? $ziel : $ziel =~ /\G([^,]+(?:,|\z))/g
			  )
			{
				print $Db::pr_fh $kunde if defined $kunde;
				printf $Db::pr_fh $format, $quelle, $_
				  or die "Fehler bei der Ausgabe: $!\n";
				$quelle = $typ = '';
				$kunde &&= ' ' x 23;
			}
		  }
		  "\tSELECT quelle, typ, ziel"
		  . ( !$kunde_id && ', kunde' )
		  . " FROM mailrules $where"
		  . <<'_' or print "(leer)\n";
	ORDER BY quelle IS NULL,
	         SUBSTRING_INDEX(quelle, '@', -1),
	         IF( INSTR(quelle, '@'), 0, 1 ),
	         quelle
_

		# *-Regeln als Letztes anzeigen,
		# ansonsten Sortierung primär nach Domain,
		# dabei user-spezifische Regeln zuerst,
		# sekundär nach Username
	};
	problem $@ if length $@;

	$hdr;
}

1;
