package FFII::Aktiv2Knecht;

# experimentally packaged Knecht interface for Aktiv

# path to locally installed modules need not be given here (given in main program)
########use lib ('/home/mwasmeier/perllibbeta');

# REMOVE FOR COMMERCIAL USE:
###use strict;
###use Carp; # generate better errors with more context

use vars qw($VERSION @ISA @EXPORT);
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(htmldie_report_err knechtcall_changeid knechtcall_checkID knechtcall_checklogin knechtcall_deleteuser knechtcall_get1val knechtcall_getmepname knechtcall_getmepsquery knechtcall_getmeptext knechtcall_getmep_komit knechtcall_getmep_persdata knechtcall_getmep_remarks knechtcall_getmep_url knechtcall_getvals knechtcall_log knechtcall_mail2id knechtcall_newuser knechtcall_paturl knechtcall_pickmep knechtcall_pickpat knechtcall_profile_world_visibility knechtcall_putvals knechtcall_setpw);

use Log::Agent;   # Initialization done in main::!

# 2004/01: Knecht now uses Postgres as primary data source

use FFII::Knecht;
##use FFII::test::Knecht;
##use FFII::KnechtBeta;
# Reminder: must also change line#80 & #111 to reflect module name! Search for KnechtMw-> or KnechtBeta-> respectively!


use Carp; # generate better errors with more context
###use Carp qw(cluck);
use Data::Dumper;

# ============================================================================================
# ========================= KNECHT INTERFACE =================================================

# (STDOUT+STDERR redirection tips see PerlCookbook_16.7_p565)


###BEGIN       # this block encapsulates the knecht initialization
###{

my $DEBUG = 0;

# data directory (profile root is /var/www/ffii/verein/leute)
my $KNECHT_DPATH = '/var/www';
#####my $KNECHT_DPATH = '/var/www/ffii/test/knecht/beta';   # NEW DB STRUCTURE!  --- THIS PATH FAILS!
# profile root for testing NEW DB STRUCTURE is 
# /var/www/ffii/test/knecht/beta/www/verein/leute
# link: /var/www/ffii/knechttest/www/verein/leute
########$KNECHT_DPATH = '/var/www/ffii/knechttest'    if( $DEBUG  or  $main::appname =~ /.pl$/ );
# $KNECHT_DPATH = '/var/www/ffii/test/knecht/beta'    if( $DEBUG  or  $main::appname =~ /.pl$/ );
# $KNECHT_DPATH = '/var/www/ffii/test/knecht/beta'    if( $DEBUG  or  $main::appname =~ /.b$/ );

# WATCH OUT! KNECHT_DEBUG causes extensive(!) logging to /var/log/apache-ssl/ffii/error.log
my $KNECHT_DEBUG = 0;
#$# these 2 are currently still set up directly by caller - init here nevertheless, will be overridden by caller
our $KNECHT_QUIET = 1;
our $KNECHT_VERBOSE = 0;
our $KNECHT_RDBONLY = 1;
my $K_SUCCESS = 1;                          # knecht return value: action completed successfully


my ( $kdir, $kuser, $kerror  );
my ( $ffii_id, $ffii_pass, $mailadr );

# test sub
#sub a2k_initialize
#{
#    $id = shift;    # into file-global var
#    print "In a2k_initialize: $id\n";
#    return;
#}



# ------------------ knecht related subs --------------------

sub init_kdir
{        
    ### logsay "========== KNECHT_QUIET was set by caller:$KNECHT_QUIET";

# Print main's symbol table...
#foreach my $name (keys %main::) {
#    logsay "SYMTAB_MAIN: $name"; 
#}

    # UNCONDITIONALLY CREATE NEW kdir OBJECT -- OR DIE
    ### logsay "[$main::id] init_kdir()";
    # option bytechar=>1 removes UTF-8
    ## $kdir = FFII::Knecht->newdir($KNECHT_DPATH, undef, debug=>$KNECHT_DEBUG, verb=>$KNECHT_VERBOSE, quiet=>$KNECHT_QUIET, rdbonly=>$KNECHT_RDBONLY);
    my $KNECHT_DEBUG=1;
    my $KNECHT_VERBOSE=1;
    my $KNECHT_QUIET=0;
    my $KNECHT_RDBONLY=1;
    $kdir = FFII::Knecht->newdir($KNECHT_DPATH, undef, debug=>$KNECHT_DEBUG, verb=>$KNECHT_VERBOSE, quiet=>$KNECHT_QUIET, rdbonly=>$KNECHT_RDBONLY);
    
    ($kerror = $kdir->lasterror)   # test for non-zero error-code
        and  !logsay "[$main::id] init_kdir() adm:%d verb:%d   keys:%s",$kdir->bell('adm'), $kdir->bell('verb'), keys %$kdir
        and  htmldie_report_err( 'init_kdir', "Couldn't create dir object [kerror: $kerror]", 'knecht', 0 );
    
    return 0;
}

    sub init_kuser
    {
        # SYNOPSIS:
        # init_kuser(adm=>1);   or   $kerror = init_kuser(adm=>0);
        # CREATE NEW kdir AND kuser OBJECT IF NONE EXISTS
        # UPON FAILURE:
        #    DIE if adm==1
        #    Return ErrorCode if adm==0

        not $kdir  and  init_kdir();
        ### logsay "[$main::id] kdir:",Dumper($kdir),"\n";

        shift eq 'adm'  and  $kdir->bellkv(adm=>shift);
        ### logsay "[$main::id] init_kuser: adm:%d", $kdir->bell('adm');

        $kerror = 0;
        not $kuser and do
        {
            $ffii_id   = $main::q->param('id');
            # ffii_pass and mailadr is set by caller if desired
            ### logsay "[$main::id] init_kuser: id:$ffii_id  pass:****** \n";
            ## $kuser = FFII::Knecht->newuser($kdir, "profil.txt", $ffii_id, $ffii_pass, $mailadr);
            $kuser = FFII::Knecht->newuser($kdir, "profil.txt", $ffii_id, $ffii_pass, $mailadr);
            # test for non-zero error-code and DIE ONLY IF adm==1 -- OTHERWISE RETURN ERRORCODE
            $kerror = $kdir->lasterror
                and  !logsay "[$main::id] init_kuser:  ffii_id:$ffii_id ffii_pass:$ffii_pass   kerror:$kerror   adm:",$kdir->bell('adm')
                and  $kdir->bell('adm') == 1        # report error instead of dieing when adm==0
                and  htmldie_report_err( 'init_kuser', "Couldn't create user object [kerror: $kerror]", 'knecht', 0 );
        };
        return $kerror;
    }

    sub undef_kuser
    {
        $kuser = undef;
}


    # -------------------------------------


sub knechtcall_checkID
{
    # Check with knecht if a certain new user ID would be acceptable
    # CALLS KNECHT w/o ANY REQUEST TO DETERMINE IF ID IS VALID AND IF IT IS ALREADY TAKEN
    # SYNOPSIS:
    # knechtcall_checkID( $main::id );
    # Returns Knecht's error code

    $ffii_id = shift;

    not $kdir  and  init_kdir();

    $kdir->newuserp($ffii_id) != $K_SUCCESS
        and  ($kerror = $kdir->lasterror)   # test for non-zero error-code
        #    returns 37 if user ID is taken ("kennung ist vergeben")
        and  return $kerror;
    return 0;
}


sub knechtcall_newuser
{
    # SYNOPSIS:
    # knechtcall_newuser( $main::id, $pass, $email );
    # CREATE NEW EMPTY USER PROFILE VIA KNECHT --- OR DIE

    $ffii_id   = shift;
    $ffii_pass = shift;
    $mailadr   = shift;

    ###logsay "[$ffii_id] knechtcall_newuser    pw:$ffii_pass  mail:$mailadr  \n";

    $kuser
        and  !logsay "[$ffii_id] knechtcall_newuser:  WOW!  kuser was non-empty!!! Undefining..."
        and  undef_kuser();

    not $kdir  and  init_kdir();
    init_kuser(adm=>1);
}


sub knechtcall_checklogin
{
    # SYNOPSIS:
    # knechtcall_checklogin( $main::id, $pass );
    # Returns 0 if login name + password is good - otherwise Knecht's reject-code

    $ffii_id   = shift;
    $ffii_pass = shift;

    not $kdir  and  init_kdir();

    # check logging in with id and password - THEREFORE adm==0 !!
    $kerror = init_kuser(adm=>0);           # 0 if name+pw is good
    $kerror  and  !logsay "[$ffii_id] knechtcall_checklogin:        kerror:$kerror \n";
    return $kerror;
}


sub knechtcall_log
{
    # SYNOPSIS:
    # knechtcall_log( $string_to_log );
    # log user sign-up confirmation via  KNECHT  -- OR DIE

    my $kstring = shift;

    not $kuser  and  init_kuser(adm=>1);

    $kuser->logprint('norm', $kstring) != $K_SUCCESS
        and  ($kerror = $kdir->lasterror)   # test for non-zero error-code
        and  !logsay "[$main::id] knechtcall_log: kstring:$kstring   kerror:$kerror \n"
        and  htmldie_report_err( 'knechtcall_log', "logprint failed [kerror: $kerror]", 'knecht', 0 );
    return;
}


sub knechtcall_profile_world_visibility
{
    # Change world-visibility of user's profile -- OR DIE
    # param: 0 == hide;  1 == visible (to the world)

    my $visibleflag = shift;
    my $command = $visibleflag ? 'pub' : 'hid';

    logsay "[$main::id] knechtcall_profile_world_visibility():    command:$command\n";

    not $kuser  and  init_kuser(adm=>1);

    logsay "[knechtcall_profile_world_visibility1] command: $command\n";
    ###logsay "[knechtcall_profile_world_visibility2] kuser:",Dumper($kuser),"\n";
    $kuser->zubefehl( 'dabei', $command ) != $K_SUCCESS
        and  ($kerror = $kdir->lasterror)   # test for non-zero error-code
        and  !logsay "[$main::id] knechtcall_profile_world_visibility: command:$command   kerror:$kerror"
        and  htmldie_report_err( 'knechtcall_profile_world_visibility', "$command failed [kerror: $kerror]", 'knecht', 0 );
    return;
}



sub knechtcall_putvals
{
    # Write params to user profile using knecht; Input delivered as a hash
    # SYNOPSIS:
    # knechtcall_putvals( \%hash_with_name-value-pairs );
    # EXAMPLE:  (   pnom_nom => "Robert X. D. DUCK VII",
    #               repr_mdb_bhuber_lvl => 3,
    #           )

    my $input_hash_ref = shift;
        logsay "[$main::id] knechtcall_putvals1(): params: \n%s", Dumper($input_hash_ref);

    not $kuser  and  init_kuser(adm=>1);

    my $err_in_loop = 0;
    foreach( keys %$input_hash_ref )
    {
        $kuser->args2user( split(/_/,$_), $input_hash_ref->{$_} ) != $K_SUCCESS
            and  ($kerror = $kdir->lasterror)   # test for non-zero error-code
            and  !logsay "[$main::id] knechtcall_putvals: dpath:$_  val:%s  kerror:$kerror \n", $input_hash_ref->{$_}
            and  ($err_in_loop  or  $err_in_loop = $kerror);            # report only 1st occurring error
        #   EXAMPLES OF VALID args2user calls
        #   $kuser->args2user("repr", "mdb", "huberbauer", lvl => 2);
        #   $kuser->args2user("pnom", "nom", "dago duck");
    }
    $err_in_loop  and  htmldie_report_err('knechtcall_putvals', "Couldn't write (kerror:$kerror)\n", 'knecht', 0);

    $kuser->user2disk != $K_SUCCESS
        and  ($kerror = $kdir->lasterror)   # test for non-zero error-code
        and  !logsay "[$main::id] knechtcall_putvals: user2disk: kerror:$kerror"
        and  htmldie_report_err('knechtcall_putvals', "user2disk reported kerror $kerror\n", 'knecht', 0);

    return;
}



sub knechtcall_getvals
{
    # Read params from knecht profile; Read them directly into CGI-hash; Params to be read are specified in an array
    # SYNOPSIS:
    # knechtcall_getvals( $username, \@array_of_param_names );
    # Resulting data is stored in global CGI object $main::q!
    # Returns number_of_params_retrieved
    # Dies on errors
    # EXAMPLE: knechtcall_getvals( [ 'pnom' ] );
    #           reads all params starting with pnom_... into CGI hash

    my $input_array_ref  = shift;
    ### logsay "[$main::id] knechtcall_getvals1(): ASKINGFOR:\n%s", Dumper($input_array_ref);

    not $kuser  and  init_kuser(adm=>1);

    my $knum = 0;       # total number of params retrieved
    foreach my $table_id ( @$input_array_ref )
    {   # EXAMPLE: $table_id = 'mail_norm'
        my @result;

        #logsay "[$main::id] knechtcall_getvals37():  table_id:$table_id \n";
        #logsay "[$main::id] knechtcall_getvals38():  splitres:", split(/_/, $table_id ), "\n";

        @result = $kuser->usel2rows( split(/_/, $table_id ) );
        ($kerror = $kdir->lasterror)                # test for non-zero error-code
            and  !logsay "[$main::id] knechtcall_getvals2(): kerror:$kerror  askedFor:\n%s\nresultArray:\n%s", Dumper($input_array_ref), Dumper(\@result)
            and  htmldie_report_err( 'knechtcall_getvals', "usel2rows failed on $table_id   [kerror:$kerror]", 'knecht', 0 );

        ### logsay "[$main::id] kn_getvals:   GOT_TABLE  table_id:$table_id   kerror:$kerror  #elem:%d", $#result+1;

        foreach (@result)
        {
            # Get all values from table $table_id

            # Docs for next line:
            #           $#{$_}   is the index of the last element of the current subarray
            #           @{$_}[0..$#{$_}-1]   is in fact a slice of the subarray
            #           @{$_}   is the dereferenced subarray-Ref
            $knum += $#{$_}+1;      # accumulate number of params

            logsay "[$main::id] kn_getvals1:     LOOP  [last:%d]    name:%s   value:%s", $#{$_}, join('_', @{$_}[0..$#{$_}-1]), @{$_}[$#{$_}];
            my $name  = join("_", @{$_}[0..$#{$_}-1]);
            my $value = @{$_}[$#{$_}];
                # $*$ not sure if this code is still required:
                if( $value eq "" )
                {
                    next;                   # skip empty values
                }
                elsif( $name =~ /^beitrag_typ$/ )      #
                {   # some values may be abbreviated: standardize by cutting to shortest acceptable length
                    $value = substr($value,0,1);        # first char only
                }
#                elsif( $name =~ /^firma_norm_firmmem$|^grev_[^_]{1,4}_g\d{6}$|^epat_dclm$|^pag_pagpub$|^pag_pagpap$|^mepqs0405_[^_]+_removed$|^mepqs0405_[^_]+_declined$/ )
#                {   # convert Postgres' BOOL{t,f} --> {1,0}
#                    # FYI, Postgres auto-converts {1,0} --> BOOL{t,f} upon writing into the DB
#                    $value = substr($value,0,1);
#                    if($value eq 't')
#                    {   $value = 1;   }
#                    elsif($value eq 'f')
#                    {   $value = 0;   }
#                    else
#                    {   $value = '';}
#                }
            ######$name =~ s/^epat_[^_]+_/epat_/i;        #$# special epat handling during beta test
            # logsay "[$main::id] kn_getvals2:     LOOP  [last:%d]    name:$name   value:$value";
            $main::q->param( lc($name) => $value );       # create param in CGI-object
        }
    }

    logsay "[$main::id] knechtcall_getvals:   RETURNING knum:$knum";

    return $knum;
}



sub knechtcall_get1val
{
    # Reads single param from knecht profile; Returns the value; CGI-hash not affected (unlike knechtcall_getvals!!!)
    # SYNOPSIS:
    # knechtcall_get1val( $param_name );
    # returns value (the last one if several match)

    my $param_name  = shift;
    $param_name eq ''  and  return 0;      # must be caught or usel2rows coughs

    not $kuser  and  init_kuser(adm=>1);

    ###logsay "[$main::id] knechtcall_get1val(): ASKINGFOR: $param_name \n";

    my @result;
    @result = $kuser->usel2rows( split(/_/, $param_name ) );
    ($kerror = $kdir->lasterror)   # test for non-zero error-code
        and  !logsay "[$main::id] knechtcall_get1val(): FAILURE   pname:$param_name  kerror:$kerror \nresultArray:\n%s", Dumper(\@result)
        and  htmldie_report_err( 'knechtcall_get1val', "usel2rows failed on $param_name   [kerror:$kerror]", 'knecht', 0 );
        ###### and  return;

    # no match at all?
    ( $#result < 0 )
        and  !logsay "[$main::id] knechtcall_get1val(): FAILURE NO_MATCH  pname:$param_name  \nresult:\n%s", Dumper(\@result)
        and  return;    # don't return 0 here!

    # several matches? --> error!
    ( $#result > 0 )
        and  !logsay "[$main::id] knechtcall_get1val(): FAILURE MULTIMATCH  pname:$param_name  \nresult:\n%s",Dumper(\@result)
        and  return;

    # lazy: code copied from knechtcall_getvals() -- loop executes only once
    my ($name, $value);
    foreach (@result)
    {
        ###logsay "[$main::id] knechtcall_get1val():  [last:", $#{$_}, "]      name:", join('_', @{$_}[0..$#{$_}-1]), " value:", @{$_}[$#{$_}], "\n";
        $name  = join("_", @{$_}[0..$#{$_}-1]);
        $value = @{$_}[$#{$_}];
        # $*$ not sure if this code is still required:
        if( $name =~ /^beitrag_typ$/ )
        {   # some values may be abbreviated: standardize by cutting to shortest acceptable length
            $value = substr($value,0,1);        # first char only
        }
    }
    logsay "[$main::id] knechtcall_get1val(): ASKEDFOR:$param_name  result:$value";

    return $value;          # return the value of the last matching sub-param (usually only 1 should match)
}


sub knechtcall_mail2id
{
    # SYNOPSIS:
    # knechtcall_setpw( $newpw );

    my $email = shift;
    not $kdir  and  init_kdir();    # no user obj possible - we do NOT have an id!
    my $id = $kdir->ffiimail2uid($email);

    logsay "[$main::id] knechtcall_mail2id(): EMAIL:$email  ID_RESULT:$id";
    return $id;
}




sub knechtcall_setpw
{
    # SYNOPSIS:
    # knechtcall_setpw( $newpw );

    my $newpass = shift;

    not $kuser  and  init_kuser(adm=>1);

    $kuser->chpw($newpass) != $K_SUCCESS
        and  ($kerror = $kdir->lasterror)   # test for non-zero error-code
        and  !logsay "[$main::id] knechtcall_setpw(): kerror:$kerror"
        and  return $kerror;

    ###logsay "[$ffii_id] knechtcall_setpw():    newpass:$newpass \n";
    return 0;
}



sub knechtcall_changeid
{
    # SYNOPSIS:
    # knechtcall_changeid( $newid );
    # returns the patent 'number' e.g. 'ep0526034'

    my $newid  = shift;

    not $kuser  and  init_kuser(adm=>1);

    ### $kdir->bellkv(debug=>1);
    $kuser->chid($newid) != $K_SUCCESS
        and  ($kerror = $kdir->lasterror)   # test for non-zero error-code
        and  !logsay "[$main::id] knechtcall_changeid(): newid:$newid  kerror:$kerror"
        and  return $kerror;
    ### $kdir->bellkv(debug=>0);

    logsay "[$main::id] knechtcall_changeid():   OK --- newid:$newid";
    return 0;
}


sub knechtcall_deleteuser
{
    # SYNOPSIS:
    # knechtcall_deleteuser();
#$# according to phm, this call will not be supported in the future

    not $kuser  and  init_kuser(adm=>1);

    $kuser->zubefehl('servus') != $K_SUCCESS
        and  ($kerror = $kdir->lasterror)   # test for non-zero error-code
        and  !logsay "[$main::id] knechtcall_deleteuser():"
        and  return $kerror;


    logsay "[$main::id] knechtcall_deleteuser() \n";
    return 0;
}


sub knechtcall_pickpat
{
    # Pick a random patent for categorization from the patent database
    # SYNOPSIS:
    # knechtcall_pickpat();
    # Returns patent number

    logsay "[$main::id] knechtcall_pickpat() \n";

    not $kuser  and  init_kuser(adm=>1);

    #$# this sub has no err handling yet!

    my $patno = $kuser->pickpat;
        logsay "[$main::id] [knechtcall_pickpat] patno:$patno\n";
    return $patno;
}

sub knechtcall_paturl
{
    # Get URL from the patent database
    # SYNOPSIS:
    # knechtcall_paturl( $patno );
    # Returns: URL in a string

    logsay "[$main::id] knechtcall_paturl() \n";

    not $kuser  and  init_kuser(adm=>1);

    #$# this sub has no err handling yet!
    my $patno = shift;
    my $paturl = $kdir->paturl( $patno );
    logsay "[$main::id] [knechtcall_paturl] patno:$patno   paturl:$paturl\n";
    return $paturl;
}


sub knechtcall_pickmep
{
    # Pick a random MEP from database
    # SYNOPSIS:
    # knechtcall_pickmep();
    # Returns MEP nickname (#$# no underscores!)

    not $kuser  and  init_kuser(adm=>1);

    my $mepnick = $kuser->pickmep
        and  ($kerror = $kdir->lasterror)   # test for non-zero error-code
        and  !logsay "[$main::id] knechtcall_pickmep():  kerror:$kerror\n"
        and  return "pickmepfailed";
    logsay "[$main::id] [knechtcall_pickmep] mepnick:$mepnick\n";

    return $mepnick;
}

sub knechtcall_getmepname
{
    # Get full name of MEP from database
    # SYNOPSIS:
    # knechtcall_getmepname( $mepnick );
    # Returns: First+last name in a single string

    not $kuser  and  init_kuser(adm=>1);

    #$# this sub has no err handling yet!
    #$# we really only need the kdir object - but both objs exist anyways, when this is called
    my $nick = shift;
    my $name = $kdir->mep2val( $nick, 'pnom' );
    logsay "[$main::id] [knechtcall_getmepname] nick:$nick   name:$name \n";
    return $name;
}

sub knechtcall_getmep_url
{
    # Get MEP's URLs from database
    not $kuser  and  init_kuser(adm=>1);

    my $nick = shift;
    my $url = $kdir->mep2val( $nick, 'http' );
    logsay "[$main::id] [knechtcall_getmep_url] nick:$nick   url:$url \n";
    return $url;
}

# MEPS RELATED DATA

# these are multi-occurrence fields:  komit, adreu, fax, deleg,


# http://www.ffii.org/verein/knecht/meps/index.de.html
my %euparties =
(
    de =>
    {
        EUPP => 'Christdemokraten, Konservative',
        PSE  => 'PSE Fraktion der Sozialdemokratischen Partei Europas',
        ELDR => 'Liberale',
        VERD => 'Gr&uuml;ne und Freie Europ&auml;ische Allianz',
        NEUU => 'Union f&uuml;r das Europa der Nationen',
        DIV  => 'Fraktion f&uuml;r das Europa der Demokratien und der Unterschiede',
        LEFT => 'Vereinigte Europ&auml;ische Linke/Nordische Gr&uuml;ne Linke',
        NON  => 'Fraktionslos',
    },
    en =>
    {
        EUPP => 'Christian Democrats, Conservatives',
        PSE  => 'Socialists, Social Democrats',
        ELDR => 'Liberals',
        VERD => 'Ecologists',
        NEUU => 'Union for Europe of the Nations',
        DIV  => 'Europe of Democracies and Diversity',
        LEFT => 'Nordic Left, Communists',
        NON  => 'Non-Attached',
    },
    fr =>
    {
        EUPP => 'Christian Democrats, Conservatives',
        PSE  => 'Socialists, Social Democrats',
        ELDR => 'Liberals',
        VERD => 'Ecologists',
        NEUU => 'Union for Europe of the Nations',
        DIV  => 'Europe of Democracies and Diversity',
        LEFT => 'Nordic Left, Communists',
        NON  => 'Non-Attached',
    },
);

# http://www.europarl.eu.int/committees/home_de.htm
# ATTN: Use HTML-char entities here! (e.g. &uuml;)
my %committees =
(
    de =>
    {
    AFET => 'Ausw&auml;rtige Angelegenheiten, Menschenrechte, gemeinsame Sicherheit und Verteidigungspolitik',
    BUDG => 'Haushaltsausschuss',
    CONT => 'Haushaltskontrolle',
    LIBE => 'Freiheiten und Rechte der B&uuml;rger, Justiz und innere Angelegenheiten',
    ECON => 'Wirtschaft und W&auml;hrung',
    JURI => 'Recht und Binnenmarkt',
    ITRE => 'Industrie, Au&szlig;enhandel, Forschung und Energie',
    EMPL => 'Besch&auml;ftigung und soziale Angelegenheiten',
    ENVI => 'Umweltfragen, Volksgesundheit und Verbraucherpolitik',
    AGRI => 'Landwirtschaft und l&auml;ndliche Entwicklung',
    PECH => 'Fischerei',
    RETT => 'Regionalpolitik, Verkehr und Fremdenverkehr',
    CULT => 'Kultur, Jugend, Bildung, Medien und Sport',
    DEVE => 'Entwicklung und Zusammenarbeit',
    AFCO => 'konstitutionelle Fragen',
    FEMM => 'Rechte der Frau und Chancengleichheit',
    PETI => 'Petitionsausschuss',
    FIAP => 'Maul- und Klauenseuche',
    GENE => 'Humangenetik und die anderen neuen Technologien in der modernen Medizin',
    ECHE => 'Abh&ouml;rsystem ECHELON',
    ESB2 => 'Weiterbehandlung der Empfehlungen zu BSE',
    ESB1 => 'BSE (spongiforme Rinderenzephalopathie)',
    TRAN => 'Gemeinschaftliches Versandverfahren',
    CONV => 'Delegation des Parlaments im Konvent zur Zukunft Europas',
    },
    en =>
    {
    AFET => 'Foreign Affairs, Human Rights, Common Security & Defence Policy',
    BUDG => 'Budgets',
    CONT => 'Budgetary Control',
    LIBE => 'Citizens\' Freedoms and Rights, Justice and Home Affairs',
    ECON => 'Economic and Monetary Affairs',
    JURI => 'Legal Affairs and the Internal Market',
    ITRE => 'Industry, External Trade, Research and Energy',
    EMPL => 'Employment and Social Affairs',
    ENVI => 'Environment, Public Health and Consumer Policy',
    AGRI => 'Agriculture and Rural Development',
    PECH => 'Fisheries',
    RETT => 'Regional Policy, Transport and Tourism',
    CULT => 'Culture, Youth, Education, the Media and Sport',
    DEVE => 'Development and Cooperation',
    AFCO => 'Constitutional Affairs',
    FEMM => 'Women\'s Rights and Equal Opportunities',
    PETI => 'Petitions',
    FIAP => 'Foot and mouth disease',
    GENE => 'Human genetics & new technologies of modern medicine',
    ECHE => 'ECHELON interception system',
    ESB2 => 'Monitor action taken on BSE recommendations',
    ESB1 => 'Inquiry into BSE (bovine spongiform encephalopathy)',
    TRAN => 'Inquiry into the Community transit regime',
    CONV => 'Convention on the Future of Europe',
    },
    fr =>
    {
    AFET => 'Foreign Affairs, Human Rights, Common Security & Defence Policy',
    BUDG => 'Budgets',
    CONT => 'Budgetary Control',
    LIBE => 'Citizens\' Freedoms and Rights, Justice and Home Affairs',
    ECON => 'Economic and Monetary Affairs',
    JURI => 'Legal Affairs and the Internal Market',
    ITRE => 'Industry, External Trade, Research and Energy',
    EMPL => 'Employment and Social Affairs',
    ENVI => 'Environment, Public Health and Consumer Policy',
    AGRI => 'Agriculture and Rural Development',
    PECH => 'Fisheries',
    RETT => 'Regional Policy, Transport and Tourism',
    CULT => 'Culture, Youth, Education, the Media and Sport',
    DEVE => 'Development and Cooperation',
    AFCO => 'Constitutional Affairs',
    FEMM => 'Women\'s Rights and Equal Opportunities',
    PETI => 'Petitions',
    FIAP => 'Foot and mouth disease',
    GENE => 'Human genetics & new technologies of modern medicine',
    ECHE => 'ECHELON interception system',
    ESB2 => 'Monitor action taken on BSE recommendations',
    ESB1 => 'Inquiry into BSE (bovine spongiform encephalopathy)',
    TRAN => 'Inquiry into the Community transit regime',
    CONV => 'Convention on the Future of Europe',
    },
);

# http://www.europarl.eu.int/xxxxxxxxxxx/home_de.htm
my %delegations = (
);

# http://www.ffii.org/verein/knecht/meps/index.de.html
my %roles =
(
    de =>
    {
        1 => 'Vertreter',
        2 => 'Mitglied',
        5 => 'Mitarbeiter der Dienststelle',    # 'Member of the Bureau'
        7 => 'Schatzmeister',
        8 => 'Stellvertr. Vorsitzender',
        9 => 'Vorsitzender',
    },
    en =>
    {
        1 => 'substitute',
        2 => 'Member',
        5 => 'Member of the Bureau',
        7 => 'Treasurer',
        8 => 'Vice Chairman',
        9 => 'Chairman',
    },
    fr =>
    {
        1 => 'substitute',
        2 => 'Member',
        5 => 'Member of the Bureau',
        7 => 'Treasurer',
        8 => 'Vice Chairman',
        9 => 'Chairman',
    },
);









# http://www.ffii.org/verein/knecht/meps/index.de.html
my %fieldname2text = (
    de =>
    {
        pnom  => 'Name',
        adrna => 'Anschrift (national)',
        adreu => 'Anschrift (EU)',
        land  => 'Land',
        mail  => 'E-Mail',
        fon   => 'Tel.',
        fax   => 'Fax-Nr.',
        naprt => 'Parteimitgliedschaft',
        euprt => 'EU-Fraktion',
    },
    en =>
    {
        pnom  => 'Name',
        adrna => 'Address (national)',
        adreu => 'Address (EU)',
        land  => 'Country',
        mail  => 'E-Mail',
        fon   => 'Phone',
        fax   => 'Fax',
        naprt => 'Party Membership',
        euprt => 'EU-Fraction',
    },
    fr =>
    {
        pnom  => 'Name',
        adrna => 'Address (national)',
        adreu => 'Address (EU)',
        land  => 'Country',
        mail  => 'E-Mail',
        fon   => 'Phone',
        fax   => 'Fax',
        naprt => 'Party Membership',
        euprt => 'Fraction EU',
    },
);


# Return info about 1 MEP as an array of hashes

sub knechtcall_getmep_persdata
{
    not $kuser  and  init_kuser(adm=>1);
    my $nick = shift;
    my @mepdata = $kdir->mep2rows( $nick );     # get array of arrays
    ###logsay "[$main::id] [knechtcall_getmep_persdata] nick:$nick   MEPdata:%s\n", Dumper(\@mepdata);
    #
    my @mepfacts;
    foreach( @mepdata )
    {
        my $aref = $_;          # one sub-array e.g.:    [ 'fax', 'hkuhne', '+32 (0)2 284 9428' ]
        my $fieldname = $aref->[0];
        my $fieldnamelong = $fieldname2text{$main::LANG_CODE_ERRMSGS}{ $fieldname };
        # if the field is in our fieldname2text-Hash -> get longtext/label + value
        if( $fieldnamelong )
        {
            # e.g. $aref = [ 'pnom', 'hkuhne', 'Heribert Kuhne' ],
            my $fieldvalue = $aref->[2];
            my $fieldvaluelong;
            if( $fieldname eq 'euprt' )  { $fieldvaluelong = $euparties{$main::LANG_CODE_ERRMSGS}{$fieldvalue}; }
            (! $fieldvaluelong)   and   $fieldvaluelong = $fieldvalue;
            push @mepfacts,
                    {   fieldname => $fieldnamelong,
                        fieldval  => $fieldvaluelong || '(nicht bekannt)',
                    };
        }
    }
    ###logsay "[$main::id] [knechtcall_getmep_persdata] nick:$nick   MEPpersdata:\n",Dumper(\@mepfacts),"\n";
    return \@mepfacts;
}


sub knechtcall_getmep_remarks
{
    not $kuser  and  init_kuser(adm=>1);
    my $nick = shift;
    my @mepremarks = $kuser->ffiimep2rows( $nick );     # get array of arrays
    ###logsay "[$main::id] [knechtcall_getmep_persdata] nick:$nick   MEPdata:\n",Dumper(\@mepremarks),"\n";
    #
    my @tmpl_mepremarks;
    foreach( @mepremarks )
    {
        my $aref = $_;          # one sub-array e.g.:    [ 'fax', 'hkuhne', '+32 (0)2 284 9428' ]
        # e.g. $aref = [ 'ggduckcu', '3', 'der Kommentar und noch mehr' ],
        push @tmpl_mepremarks,
                {
                    other_id  => $aref->[0] || '(nicht bekannt)',
                    other_lvl => $aref->[1] || '(nicht bekannt)',
                    other_txt => $aref->[2] || '(noch kein Eintrag)',
                };
    }
#    logsay "[$main::id] [knechtcall_getmep_persdata] nick:$nick   MEPpersdata:\n",Dumper(\@tmpl_mepremarks),"\n";
    #return Dumper(\@mepremarks);
    return \@tmpl_mepremarks;
}


# Return a description of 1 MEP's committees as an array of hashes

sub knechtcall_getmep_komit
{
    not $kuser  and  init_kuser(adm=>1);
    my $nick = shift;
    my @mepdata = $kdir->mep2rows( $nick );     # get array of arrays
    ### logsay "[$main::id] [knechtcall_getmep_komit] nick:$nick   MEPdata:\n",Dumper(\@mepdata),"\n";
    #
    my @mepfacts;
    foreach my $aref ( @mepdata )
    {   # aref references one sub-array e.g.:    [ 'fax', 'hkuhne', '+32 (0)2 284 9428' ]
        ### my $aref = $_;
        for($aref->[0])
        {
            /^komit$/           # e.g. [ 'komit', 'hkuhne', 'ITRE', '1' ],
            and do
            {   # add 1 hash reference to mepfacts array (=array of hashes)
                push @mepfacts,
                        {   comm_code => $aref->[2],
                            comm_txt => $committees{$main::LANG_CODE_ERRMSGS}{$aref->[2]} || '(nicht bekannt)',
                            role => $roles{$main::LANG_CODE_ERRMSGS}{$aref->[3]} || '(nicht bekannt)',
                        };
            };
        }
    }
    ### logsay "[$main::id] [knechtcall_getmep_komit] nick:$nick   MEPfacts:\n",Dumper(\@mepfacts),"\n";
    return \@mepfacts;
}


# THIS SUB JUST FOR TESTING PURPOSES:
sub knechtcall_getmeptext
{
    # Get data about one specific MEP from MEP-database

    not $kuser  and  init_kuser(adm=>1);

    #$# we really only need the kdir object - but both objs exist anyways, when this is called
    my $nick = shift;
    my @mepdata;
    my $mepinfo = $kdir->mep2text( $nick );
    return $mepinfo;
}


# Return an array of MEP nicknames that fit a certain query

sub knechtcall_getmepsquery
{
    # Get data about MEPs from MEP-database
    not $kuser  and  init_kuser(adm=>1);

    # meps2rows returns an array of arrays like this:
    # [
    #   ['pnom','jmlepen','M. LE PEN'], ['komit','jmlepen','PETI','2'], ['komit','jmlepen','PETI','2'],
    #   ['pnom','lgroener','Frau Lissy GRÖNER'], ['komit','lgroener','CULT','2'],
    #   ...
    # ]

    my $pnompart = $main::q->param('pnompart');
    my $plzpart  = $main::q->param('plzpart');
    my $countrycode = $main::q->param('land');
    my $partycode   = $main::q->param('euprt');
    my $committee   = $main::q->param('komit');

    $kdir->permkv('nmax',0);    # remove max#ofhits limit
    my @mepsres = $kuser->meps2rows("report pnom land euprt adrna", "land $countrycode", "euprt $partycode", "komit $committee");

    my (@results, $previous_nick, $arraylength);
    ### leaving this as an exercise... (the following did not quite achieve ...)
    ### my %mepstmp = map {   $_->[1] => { $_->[0] => $_->[2] }   } @mepsres;
    foreach my $aref ( @mepsres )
    {
        my $nickname = $aref->[1];
        # Heuristically look for implicit separators in data (nickname changes to next one)
        # [this is not beautiful but required by the way Knecht returns its data]
        $nickname ne $previous_nick
            # Push e.g. { mepnick => 'jmlepen' }
            and   $previous_nick = $nickname
            and   $arraylength = push @results, { mepnick => $nickname };
        # Collect + add all reported fields to the most recently created sub-hash
        my $fieldname  = $aref->[0];
        my $value = $aref->[2];
        # Plain field -> just store it
        $results[$arraylength-1]->{ $fieldname } = $value;
        # Hopefully extract zipcode into field 'zip'
        #$# add UK Zipcode regex!
        $fieldname eq 'adrna'
            and   ( $results[$arraylength-1]->{'zip'} ) = ( $value =~ /-(\d{4,5})/ );
        # Make additional entry with unabbreviated party name
        $fieldname eq 'euprt'
            and   $results[$arraylength-1]->{ 'euprtlong' } = $euparties{$main::LANG_CODE_ERRMSGS}{$value};
    }

    # Now reduce the @results array to entries that fit pnom+plz search criteria
    foreach ( @results )
    {   # mark non-matching elements for deletion
###     $pnompart   and   $_->{'pnom'}  !~ /$pnompart/i   and   $_->{'DOOMED'}=1;
#$#     temp replaced by this: (it still is case-sensitive for Umlauts etc ---> 
###         seems that $pnompart is not handled as UTF8!!!
        if( $pnompart )
        {
#$# Problem: A small ö doesn't match a CAPS Ö (e.g.)
#use Devel::Peek;
#Dump $pnompart; (containing "aö")
#SV = PVMG(0x8930790) at 0x84fdce0
#  REFCNT = 1
#  FLAGS = (PADBUSY,PADMY,POK,pPOK)      <--- no utf8 flag set!!!!!!
#  IV = 0
#  NV = 0
#  PV = 0x883cba8 "a\303\266"\0
#  CUR = 3
#  LEN = 4

            my $pnp= lc($pnompart);
            if( lc($_->{'pnom'})  =~ /$pnp/ )
            {
                # leave as is
            }
            else
            {
                $_->{'DOOMED'}=1;
            }
        }
        $plzpart    and   $_->{'zip'}   !~ /^$plzpart/    and   $_->{'DOOMED'}=1;
    }

    # Filter out all DOOMED elements AND limit # of reported hits
    my $i=1;
    my @results_cleaned = grep {  $_->{'DOOMED'} ne 1   and   $i++ <= 50  } @results;

    ### print LOGFILE "[$main::id] [knechtcall_getmepsquery] results:\n",Dumper(\@results),"\n";

    return \@results_cleaned;

    #   Returned arrayref looks like this:
    #@results = [
    #             { 'pnom' => 'M. Jean-Marie LE PEN',
    #               'mepnick' => 'jmlepen',
    #               'euprt' => 'NON',
    #               'land' => 'FR'
    #             },
    #             { 'pnom' => 'Frau Lissy GRÖNER',
    #               'mepnick' => 'lgroener',
    #               'euprt' => 'PSE',
    #               'land' => 'DE'
    #             },
    #             ...
    #           ];

}


## THIS SUB JUST FOR TESTING PURPOSES:
#sub knechtcall_getmepstext
#{
#    # Get data about MEPs from MEP-database
#    not $kuser  and  init_kuser(adm=>1);
#
####    my $res = $kuser->meps2text("rol 2", "nmax 40", "report komit land adrna fax mail http", "komit JURI ITRE CULT");
####    my $res = $kuser->meps2text("rol 2", "nmax 40", "report pnom komit", "komit JURI ITRE CULT");
#    my $res = $kuser->meps2text("rol 2", "nmax 7", "report pnom komit", "komit CULT");
#    my @mepsres = $kuser->meps2rows("rol 2", "nmax 7", "report pnom komit", "komit CULT");
#        # print LOGFILE "[$main::id] [meps2rows test] mepsres:\n",Dumper(\@mepsres),"\n";
#    $res = Dumper(\@mepsres);
#    return $res;
#}






### }   # END OF BEGIN SECTION



return 1;   # END OF PACKAGE




# ========================= ERROR HANDLING SUBS ==============================================

# REPORT FATAL ERRORS AS A HTML PAGE
#$# localize it!

sub htmldie_report_err
{
    # Get hierarchy of calling subs
    my $callers = (caller(1))[3]." <-- ".(caller(2))[3]." <-- ".(caller(3))[3]." <-- ".(caller(4))[3];
    my $id = $main::id;
    my $warningsToBrowser_flag = $main::warningsToBrowser_flag;
    my $headerHTTP_was_sent = $main::headerHTTP_was_sent;
    my $FFII_OFFICE_MAIL = $main::FFII_OFFICE_MAIL;
    my $mode = $main::mode;

    my ($code_loc, $error_descript, $category, $suggest_retry_flag ) = @_;
    my $category_descript = {
        self   => 'FFII Script Error (eintrag)',
        knecht => 'FFII Back-End Failure (knecht)',
        db     => 'FFII Back-End Failure (DB-Server)',
        mail   => 'FFII Mail Server Failure',
    }->{ $category };

# logsay "[$id] [htmldie_report_err] cat:$category   catdesc:$category_descript\n";

    my $ignore_rest_of_page = "";
    if( $warningsToBrowser_flag )
    {   # explain CGI::CARP
        $ignore_rest_of_page = <<EOF_REPORTERR_WTB_FLAG_TRUE;
<FONT SIZE='-1'>DEBUG MODE: Rest of page can usually be ignored (output from CGI::Carp)
<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;
<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>
</FONT>
EOF_REPORTERR_WTB_FLAG_TRUE
    }

    my $general_prose;
    if( $suggest_retry_flag )
    {   # suggest that user retries at a later time
        $general_prose = <<EOF_REPORTERR_SRY_FLAG_TRUE;
We're sorry, there is currently a problem with the function that you chose.
<P>There is a chance that the data you just entered isn't lost. Just keep this window open and do a Browser-Reload/Refresh at a later time.
<BR>Please make sure that your connection to the Internet is up when you try this.
<P>If the problem persists, please let us know which user Id you have used for signing up.
<BR>We'll let you know when the problem has been solved.
<HR>
Wir bedauern, dass die von Ihnen gewaehlte Funktion nicht reibungslos funktioniert hat.
<P>Wenn Sie dieses Fenster geoeffnet lassen und zu einem spaeteren Zeitpunkt einen Browser-Reload/Refresh durchfuehren,
<BR>besteht eine Chance, dass Ihre Eingaben erhalten bleiben.<BR>
Bitte stellen Sie sicher, dass Ihre Internet-Verbindung beim Neuversuch aktiv ist.
<P>
Falls das Problem weiter besteht, teilen Sie uns bitte ueber untenstehende E-Mailadresse mit,
<BR>unter welcher Nutzerkennung Sie sich angemeldet haben.<BR>
Wir melden uns bei Ihnen, wenn das Problem behoben ist.
<HR>
EOF_REPORTERR_SRY_FLAG_TRUE
    }
    else
    {   # do not suggest retry
        $general_prose = <<EOF_REPORTERR_SRY_FLAG_FALSE;
We're sorry, there is currently a problem with the function that you chose.
<P>Please let us know which user Id you have used for signing up.
<BR>We'll let you know when the problem has been solved.
<HR>
Wir bedauern, dass die von Ihnen gewaehlte Funktion nicht reibungslos funktioniert hat.
<P>Bitte teilen Sie uns ueber untenstehende E-Mailadresse mit, unter welcher Nutzerkennung Sie sich angemeldet haben.
<BR>Wir melden uns bei Ihnen, wenn das Problem behoben ist.
<HR>
EOF_REPORTERR_SRY_FLAG_FALSE
    }

    logsay "[$id] HTMLDIE_REPORT_ERR:\nCode: $code_loc   Error: $error_descript   Cat: $category_descript   R-Flag: $suggest_retry_flag\n";
    print "Content-type: text/plain\n\n"   unless $headerHTTP_was_sent;
    print <<EOFDIECANTHELP;
<HTML>
<HEAD><TITLE>$category_descript</TITLE>
<STYLE type="text/css">
<!--
     body { font-family:verdana,helvetica,arial,sans-serif; } -->
</STYLE>
</HEAD>
<BODY>
<H1>$category_descript</H1>
<HR>
$general_prose
<P>
Contact: <a href="mailto:$FFII_OFFICE_MAIL?subject=Error Message: [$code_loc], D=$error_descript, C=$category, F=$suggest_retry_flag" title="$error_descript">$FFII_OFFICE_MAIL</a>
<p align="left">
<b>Error description:</b> $category_descript<BR>
<b>Error detail:</b> $error_descript<BR>
<b>Code segment:</b> $code_loc<BR>
<b>Mode:</b> $mode<BR>
<FONT SIZE='-1'>
<b>Callers:</b> $callers
</FONT>
<HR>
<BR><BR>
$ignore_rest_of_page
</BODY>
</HTML>

EOFDIECANTHELP
die;
}




# ============================================================================================

return 1

# Local Variables:
# coding: utf-8
# srcfile:/i2p/aktiv/perl/Aktiv2Knecht.pm
# mode: perl
# End:
