#!/usr/bin/perl -w

use utf8;
use strict;
use warnings;

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

use Dbase::Getopt qw(
  :DEFAULT
  getopt_abt_like
  getopt_date
  getopt_flags
  getopt_kunde
  getopt_person
);
use Dbase::Globals qw(kpersinfo update_stunden_cache);
use Dbase::Help qw(DoSelect DoTrans in_list qquote)
  ;    # kein readonly() wegen update_stunden_cache()
use List::Util qw(sum);
use Loader qw(check_perm check_vorgesetzter current_user);
use Text::Abbrev qw(abbrev);
use Umlaut qw(textmodus);

# zur Unterscheidung: "" => kein Ticket, NULL => ROLLUP:
use constant TICKET => q/IFNULL( stunden.ticket, '')/;
use constant {
    ZEIGE       => { abbrev(qw(kunde mitarbeiter queue)) },
    MERKMAL2SQL => {
        mitarbeiter => 'person.user',
        kunde       => \&select_kunde,
        queue       => TICKET,
    },
};

textmodus( \*STDOUT );

my $current_user = current_user();

sub pruefe_berechtigung {
    return if check_perm( 'perso', 1 );
    check_vorgesetzter( $current_user, $_ )
      or die 'Die Zeiterfassung von '
      . kpersinfo($_)
      . " geht Dich nichts an.\n"
      for @_;
}

my (
    $Ab,              @Kunden, @Mitarbeiter,
    @OhneMitarbeiter, %Queue,  $QueueCol,
    @where,           $Vor,    @Zeige,
);
GetOptions(
    'ab=s' => sub { $Ab = &getopt_date },
    'abteilung-like=s' => sub {
        pruefe_berechtigung( my @personen = &getopt_abt_like );
        if (@personen) { push @Mitarbeiter, @personen }
        else { warn "Keine Personen gefunden bei: -$_[0] $_[1]\n" }
    },
    'art=s'       => \my @StundenArt,
    'ohne-art=s'  => \my @OhneStundenArt,
    'art-flags=s' => sub {
        push @where, getopt_flags( stunden_art => 'stunden.art', @_ );
    },
    'debug-sql+' => \( my $DebugSql = 0 ),
    'kunde=s'       => sub { push @Kunden, &getopt_kunde },
    'map-kunde=s'   => \my %MapKunde,
    'mitarbeiter=s' => sub {
        pruefe_berechtigung( my $person = &getopt_person );
        push @Mitarbeiter, $person;
    },
    'ohne-mitarbeiter=s' => sub { push @OhneMitarbeiter, &getopt_person },
    'queue=s' => sub { ( undef, my $queue ) = @_; $Queue{$queue} = undef },
    'prettyprint!' => \my $PrettyPrint,
    'vor=s'        => sub { $Vor = &getopt_date },
    'zeige=s'      => sub {
        ( undef, my $zeige ) = @_;
        defined( my $merkmal = ZEIGE->{ lc $zeige } )
          or die "Das Merkmal $zeige kenne ich nicht.\n";
        if ( grep $_ eq $merkmal, @Zeige ) {
            warn "Ich kann nicht mehrfach nach $zeige aufschlüsseln.\n";
        }
        elsif ( @Zeige == 2 ) {
            die "Ich kann nur maximal zwei Merkmale aufschlüsseln.\n";
        }
        else {
            push @Zeige, $merkmal;
            $QueueCol = $#Zeige if $merkmal eq 'queue';
        }
    },
);

@Mitarbeiter = $current_user unless @Mitarbeiter;
@Zeige       = 'kunde'       unless @Zeige;

sub select_kunde {
    'IF( kunde.name IS NULL, "(ohne)", '
      . (
        keys %MapKunde
        ? 'IFNULL( ELT( '
          . join( ', ',
            'FIELD( '
              . join( ', ', 'kunde.name', map qquote($_), keys %MapKunde )
              . ' )',
            map qquote($_),
            values %MapKunde )
          . ' ), kunde.name )'
        : 'kunde.name'
      ) . ' )';
}

push @where, in_list( 'stunden_art.name', '', @StundenArt ),
  in_list( 'stunden_art.name', NOT => @OhneStundenArt ),
  in_list( 'person.id', '', @Mitarbeiter ),
  in_list( 'person.id', NOT => @OhneMitarbeiter ),
  in_list( 'stunden.kunde', '', @Kunden );
push @where, 'stunden.ticket IS NOT NULL' if keys %Queue && !exists $Queue{''};
push @where, "stunden.beginn >= $Ab" if defined $Ab;
push @where, "stunden.beginn < $Vor" if defined $Vor;

sub elem(\%\@@) : lvalue {
    my $hashref = shift;
    my $keys    = shift;
    defined $_[$_] && ++$keys->[$_]{ $_[$_] } for 0 .. $#_;
    my $key;
    while ( defined( $key = shift ) ) {
        last unless @_ && length $key;
        $hashref = $hashref->{$key} ||= {};
    }
    $hashref->{ defined $key && $key };
}

my ( %zeit, @keys );
{
    my $fields = join ', ', map {
        my $sql = MERKMAL2SQL->{$_};
        $sql = &$sql if ref $sql;
        $sql;
    } @Zeige;
    my $ticket_api;

    # Wichtig: stunden.ticket darf nur _einmal_ in der Spaltenliste vorkommen,
    # weil sonst das GROUP BY stunden.ticket WITH ROLLUP durcheinander gerät:
    my $add_field = '';
    if ( defined $QueueCol || keys %Queue ) {
        require noris::Ticket::API
          and noris::Ticket::API->import('get_pooled_connection');
        $ticket_api = get_pooled_connection();
        $add_field = ', ' . TICKET unless defined $QueueCol;
    }
    DoTrans {
        update_stunden_cache( $Ab, $Vor );
        my $sql = <<_;
	SELECT    SUM(stunden.zeit*stunden_art.faktor/100), $fields$add_field
	FROM      stunden
	JOIN      kunde       ON stunden.kunde  = kunde.id
	JOIN      person      ON stunden.person = person.id
	JOIN      stunden_art ON stunden.art    = stunden_art.id
	WHERE     ${\ join ' AND ', @where }
	GROUP BY  $fields WITH ROLLUP
_
        print $sql if $DebugSql;
        DoSelect {
            if ( $DebugSql > 1 ) {
                require Data::Dump and Data::Dump->import('pp')
                  unless defined &pp;
                my $row = pp(@_);
                $row .= "\n" if $row !~ /\n\z/;
                print $row;
            }
            my ( $zeit, @cols ) = @_;
            if (
                defined $ticket_api
                && defined(
                    my $ticket =
                      defined $QueueCol ? $cols[$QueueCol] : pop @cols
                )
              )
            {
                my $queue = '';
                ($queue) = $ticket_api->get_ticket( $ticket, [qw(queue)] )
                  if length $ticket;
                return
                  if keys %Queue && !exists $Queue{ defined $queue && $queue };
                $cols[$QueueCol] =
                  defined $queue
                  ? length $queue ? $queue : '(ohne)'
                  :   '(geheim)';
            }
            elem( %zeit, @keys, @cols ) += $zeit;
        }
        $sql;
    }
    2;
}

$keys[0] = [
    sort {
            @keys == 1
          ? $zeit{$b} <=> $zeit{$a}
          : $zeit{$b}{''} <=> $zeit{$a}{''}
      } keys %{ $keys[0] }
];

my %spaltensumme;
if ( @keys > 1 ) {
    while ( my ($key) = each %{ $keys[1] } ) {
        $spaltensumme{$key} =
          sum( grep defined, map $zeit{$_}{$key}, @{ $keys[0] } );
    }
    $keys[1] =
      [ sort { $spaltensumme{$b} <=> $spaltensumme{$a} } keys %spaltensumme ];
}

sub prozent { map sprintf( '%.f %%', $_ * 100 ), @_ }
sub stunden { map defined() ? sprintf( '%.f', $_ / 3600 ) : '-', @_ }

my @table;
push @table,
  [
    ucfirst $Zeige[0],
    @keys > 1 ? ( @{ $keys[1] }, qw((Summe) (Anteil)) ) : qw(Stunden Anteil)
  ];
push @table,
  [
    $_,
    stunden( @keys == 1 ? $zeit{$_} : @{ $zeit{$_} }{ @{ $keys[1] }, '' } ),
    prozent( ( @keys == 1 ? $zeit{$_} : $zeit{$_}{''} ) / $zeit{''} )
  ]
  for @{ $keys[0] };
push @table,
  [
    '(Summe)',
    stunden( @keys == 1 ? () : @spaltensumme{ @{ $keys[1] } }, $zeit{''} )
  ];
push @table,
  [ '(Anteil)', prozent( map $spaltensumme{$_} / $zeit{''}, @{ $keys[1] } ) ]
  if @keys > 1;

if ($PrettyPrint) {
    require Text::ASCIITable;
    my $table = Text::ASCIITable->new;
    {
        $table->setCols( my @columns = @{ shift @table } );
        $table->alignCol( $_ => 'right' ) for @columns[ 1 .. $#columns ];
    }
    $table->addRow(@$_) for @table;
    print $table;
}
else { print join( "\t", @$_ ) . "\n" for @table }

__END__

=head1 NAME

zeitstatistik - statistische Auswertungen der Zeiterfassung

=head1 SYNOPSE

    zeitstatistik -abteilung 'Technik, Team Entwicklung' \
                  -art-flags '!keine_arbeit' \
                  -ab 2008-01-01 -vor 2008-02-01 \
                  -queue entwicklung -queue kundebunt \
                  -zeige mitarbeiter -zeige queue

    zeitstatistik -abteilung 'Technik, Team Entwicklung' \
                  -art-flags '!keine_arbeit' \
                  -ab 2008-01-01 -vor 2008-02-01 \
                  -zeige queue -prettyprint

    zeitstatistik -abteilung 'Technik, Team IT%O%' \
                  -ohne-mitarbeiter jschneider \
                  -art-flags '!keine_arbeit' \
                  -ab 'Jan 1' -map-kunde ito=POP

=head1 BESCHREIBUNG

Dieses Programm ermöglicht einfache statistische Auswertungen von
Zeiterfassungsdaten.

=head1 OPTIONEN

=over 4

=item -art Zeiterfassungsart

=item -ohne-art Zeiterfassungsart

um nur bestimmte Zeiterfassungsarten zu berücksichtigen bzw. bestimmte
auszuschließen.
Diese Optionen können mehrfach verwendet werden.

=item -art-flags Flag-Spezifikation

nur Zeiterfassungseinträge berücksichtigen, deren Art zur angegebenen
Flag-Spezifikation passt.

=item -ab Datum

nur Zeiterfassungseinträge ab dem angegebenen Datum berücksichtigen

=item -vor Datum

nur Zeiterfassungseinträge vor dem angegebenen Datum berücksichtigen

=item -zeige { Mitarbeiter | Kunde | Queue }

Aufschlüsseln der Auswertung nach dem angegebenen Merkmal.
Das Merkmal kann beliebig abgekürzt werden.
Die Option kann bis zu zweimal verwendet werden, so dass ggf. eine
zweidimensionale Tabelle entsteht.
Wird sie nicht verwendet, wird nach Kunden aufgeschlüsselt.

=item -kunde Kunde

nur Zeiterfassungseinträge berücksichtigen, die zum angegebenen Kunden
gehören.
Die Option kann mehrfach verwendet werden, um Zeiterfassungseinträge für
unterschiedliche Kunden zu berücksichtigen.

=item -map-kunde Kunde_von=Kunde_zu

um Zeiterfassungseinträge für bestimmte Kunden als zu anderen Kunden
gehörend zu betrachten, beispielsweise

    -map-kunde ito=POP

Man kann das (also) auch nutzen, um Zeiterfassungseinträge für mehrere
Kunden zusammenzufassen, etwa

    -map-kunde quelle=QC -map-kunde quelle-contact=QC

=item -queue Queue-Name

nur Zeiterfassungseinträge berücksichtigen, die auf Tickets gebucht sind, die
zur angegebenen RT-Queue gehören.
Die Option kann mehrfach verwendet werden, um Zeiterfassungseinträge für
Tickets unterschiedlicher Queues zu berücksichtigen.
Um auch Zeiterfassungseinträge zu sehen, die nicht zu einem Ticket gehören,
muss ggf. ein leerer Queue-Name angegeben werden.

=item -prettyprint

um eine fürs menschliche Auge angenehm lesbare Ausgabe zu erzeugen.
Ansonsten wird eine TAB-getrennte Tabelle ausgegeben.

=back

=item -help

=item -?

um (nur) diese Dokumentation anzeigen zu lassen

=back

=head2 Optionen zur Auswahl der Mitarbeiter

Du kannst dieses Programm nur für Dich selbst sowie ggf. Deine Untergebenen
nutzen.
Alle Optionen zur Auswahl von Mitarbeitern können mehrfach verwendet werden,
um mehrere Organisationseinheiten bzw. Mitarbeiter auszuwählen.
Sofern Du keine Mitarbeiter auswählst, werden nur Deine eigenen
Zeiterfassungsdaten berücksichtigt.

=over 4

=item -abteilung-like SQL-Wildcard

Zeiterfassungseinträge von Mitarbeitern berücksichtigen, die einer
Organisationseinheit angehören, die zur angegebenen SQL-Wildcard passt, also
z. B.

 	-abteilung-like 'Technik%'
oder
	-abteilung-like 'Technik, Team Entwicklung'

Die Option kann mehrfach verwendet werden, um Mitarbeiter unterschiedlicher
Organisationseinheiten zu berücksichtigen.

=item -mitarbeiter Person

Zeiterfassungsdaten des angegebenen Mitarbeiters berücksichtigen

=back

