#!/usr/bin/perl -w

use strict;
use utf8;
use warnings;

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

use Dbase::Getopt qw(:DEFAULT);
use Dbase::Globals
  qw(aufzaehlung get_descr get_gruppen persinfo list_descr test_gruppe);
use Dbase::Help qw(DoFn DoSelect);

use constant ATTR_NAME =>
  { email => 'E-Mail-Adresse', pass => 'Kennwort', user => 'Benutzername' };

GetOptions();

my %filter;

list_descr(
    dienst_ident => undef,
    undef,
    sub {
        my ( undef, undef, $name, $info ) = @_;
        my ($attr) = $name =~ /^requires_(\w+)\z/i or return;
        @{ $filter{$attr} }{qw(info grs grc)} =
          ( $info, get_gruppen( dienst_ident => $name, 1 ) );
    }
);

my ( %attr4dienst, %dienst4person );
DoSelect {
    my ( $person, $dienst, $kunden ) = @_;
    @{
        $attr4dienst{$dienst} ||= [
            grep test_gruppe(
                dienst => $dienst,
                $filter{$_}{grs}, $filter{$_}{grc}
            ),
            keys %filter
        ]
      }
      or return;
    $dienst4person{$person}{$dienst} = $kunden;
}
<<_;
	SELECT   kundemail.person, kundemail.dienst, GROUP_CONCAT(kunde.name)
	FROM     kunde, kundemail
	WHERE    kunde.id = kundemail.kunde
	GROUP BY kundemail.person, kundemail.dienst
	ORDER BY kundemail.person, kundemail.dienst
_

for my $person ( sort { $a <=> $b } keys %dienst4person ) {
    my %attr;
    @attr{ @{ $attr4dienst{$_} } } = () for keys %{ $dienst4person{$person} };
    @attr{ keys %attr } =
      DoFn( 'SELECT '
          . join( ',', keys %attr )
          . " FROM person WHERE id = $person" );
    while ( my ( $attr, $value ) = each %attr ) {
        delete $attr{$attr} if defined $value;
    }
    next unless keys %attr;
    print persinfo($person) . ":\n";
    for my $dienst ( sort keys %{ $dienst4person{$person} } ) {
        my @missing = grep exists $attr{$_}, @{ $attr4dienst{$dienst} } or next;
        print aufzaehlung(
            sort map defined ATTR_NAME->{$_} ? ATTR_NAME->{$_} : $_, @missing )
          . ' wegen Dienst '
          . get_descr( dienst => $dienst )
          . " bei $dienst4person{$person}{$dienst}\n";
    }
    print "\n";
}

__END__

=encoding utf8

=head1 NAME

finde_personenassoziierungen_mit_fehlenden_attributen

=head1 BESCHREIBUNG

Das Programm sucht in der Datenbank nach Assoziierungen von Personen, bei denen
Attribute fehlen, die im jeweiligen Rollen-Deskriptor durch Eintrag in eine
Gruppe C<requires_*> als notwendig markiert sind, wie beispielsweise die
E-Mail-Adresse für eine C<trouble>-Assoziierung, und gibt diese auf die
Standardausgabe aus.

=head1 OPTIONEN

=over 4

=item -help

=item -?

um (nur) diese Dokumentation anzeigen zu lassen

=back

