#!/usr/bin/perl

#$# check email filter rule for leading digits allowed?!

#$# after installing new release: do knecht msgs still appear in apachelog?


# Disable next 2 lines for "commercial" use!
#use strict;
#use Carp; # generate better errors with more context
###use Carp qw(cluck);      # non-dieing stack-dumper

# Info: HTML::FormValidator Module now found on CPAN as Data::FormValidator

# mwas:
# ALL UNRESOLVED ITEMS MARKED WITH #$# !!

#================= reminder section ========================

#   - since params are actually retrieved frm the VALIDS array, validation config must include the "id"
#       in order to pass thru the HIDDEN field from the form!! (prblm emerged in form "confirm"!!)
#   - pag_pagsum < 12.78 soll Fehlermeldung "zu gering" erzeugen
#   - was passiert, wenn logdatei noch offen und weitere Prozesse wollen reinschreiben?
#   - viele die_s könnten in sielnt ERR-Logs umgewandelt werden!
#   - Zahlungsart-Param sollte zw. d und u unterscheiden, damit der eMail reminder konkretere Angabe machen kann
#    my %zahlungsarten = (
#        d => 'Dauerauftrag oder Überweisung',
#        l => 'Lastschrift',
#   - BLZ Feld im Moment nur fuer Deutschland geprueft
#   - Lastschrift fuer Ausland nicht sinnvoll

#   ORGANISATORISCHE TODOs:
#   - hinweis auf spendenquittung und abzugsfaehigkeit
#   - bequemere zahlungsmoeglichkeiten wie firstgate/paypal/kreditkarte
#   - Moeglichkeit zur Einmalspende
#   - Link auf die Vereinssatzung und eine einseitige Zus.fassg. der FFII Ziele


# KOMMENTAR IN KNECHT.PM (ZITAT):
# use utf8; # unstabil, erzeugt seltsame Fehler bei Verwendung von HTML::Template
##### DAS IST UNGENAU - ES MUESSSTE WIE FOLGT HEISSEN:
# use utf8; # unstabil, Die utf-Version diverser Funktionen in Perl 5.8.0
#   enthaelt elementare Fehler, z.B. bei Verwendung der uc() Funktion
#   Siehe auch http://sourceforge.net/mailarchive/message.php?msg_id=2384056
#   Unklar ist mir, ob das auch fuer Perl 5.6 gilt.

#===========================================================
# Locally installed HTML::Template, HTML::FillInForm, Data::FormValidator, Mail::Sendmail, Log::Agent
# Therefore, next line is requd. on genba
# 

use FFII::Aktiv2Knecht;
my $usingTestDB = 0;    # temp flag - controls red display text in the UI screens!

# the "standard" is required to allow the bareword-usage of functions like header and start_html
use CGI qw/:standard/;
#use CGI;
use HTML::Template;
use HTML::FillInForm;
use Data::FormValidator;
use Mail::Sendmail;
use File::Basename;
use URI::Escape;

use Data::Dumper;
###use CGI::Carp qw(fatalsToBrowser warningsToBrowser);    #$# to be removed for "commercial" use
###  Always make sure, that assignment in next line is 0 (FALSE) for "commercial" use!
our $warningsToBrowser_flag = 0;    # global const also used by Aktiv2Knecht.pm

### $|=1;       # obsolete: TURN OFF OUTPUT BUFFERING DURING TESTING OF KNECHT INTERACTION

#================= configuration section ========================

my $appname = basename($0);     # zap the app path if it is present

# Live version should enable knecht's switch for quiet operation (no error msgs to STDERR)
$FFII::Aktiv2Knecht::KNECHT_QUIET = not ( $appname =~ /\.pl$|\.beta$|\.alpha$/ );
$FFII::Aktiv2Knecht::KNECHT_VERBOSE = 0;                   # knecht's switch for verbose progress msgs (progress msgs to STDERR)

my $DEBUG = ( $appname =~ /\.pl$/ );             # e.g. script-name eintrag --> NO DEBUG
my $DEBUG_KNECHT = ( $appname =~ /\.pl$/ );      # this is currently UNUSED in all knechtcall* subs!

# UNIX-WINDOWS-etc Switch - this gives "MSWin32" on Windows 95/98/NT/2k
my $PLATFORM = $^O;

# Minimum annual membership fee (use dot, NOT comma for fractions)
my $MEMBER_FEE_MIN = 12.78;

# eMail for user questions / support
our $FFII_OFFICE_MAIL = 'buero@ffii.org';   # global const also used by Aktiv2Knecht.pm

# Recipient of automatically generated mails announcing new users
# (multiple addresses allowed - separator=whitespace)
my $MAILTO = $FFII_OFFICE_MAIL;
   $MAILTO = 'buero@wasmeier.com'    if($PLATFORM eq 'MSWin32'  or  $DEBUG  or  $appname =~ /\.pl$/ );
my $REPLYTO = $FFII_OFFICE_MAIL;

my $HTML_PATH = '/i2p/aktiv/html';
# $HTML_PATH = '/i2p/aktiv/html'  if( $appname =~ m(\.(pl|beta|alpha)\Z) );  # extension '.pl', '.beta', '.alpha'
# $HTML_PATH = 'E:/Program Files/Apache Group/Apache2/htdocs/mailer/mctest' if($PLATFORM eq 'MSWin32');

# Add new languages here or they won't be recognized
my %LANGUAGE_BIGRAMS = map { $_,$_ } qw/de en fr pt es da hu it nl pl sl sv/;
    # result: ( de =>'de', en=>'en', fr=>'fr', ...)
# Define languages which have translated error messages 
#   This also applies for automated emails that are sent!
#   If you add a language here, you must ensure that all uses of LANG_CODE_ERRMSGS have that lang!
my %LANGUAGE_BIGRAMS_ERRMSGS = map { $_,$_ } qw/de en/;

my $FORM1DEFLT_NAME = 'neutral';      # ONLY used if f-param undef or specified page not found in showf()

my $MW_SUCCESS = 0;                         # mwas subs return value convention: action completed successfully

#my $SENDMAIL = "/usr/lib/sendmail -t";    # replaced by Mail::Sendmail

# smtp server only required for win32 platforms - ignored (undef) otherwise
my $WIN_SMTP = "smtp.kundenserver.de";
my $SMTP;
$SMTP = $WIN_SMTP if $PLATFORM eq 'MSWin32';

# ====================== INITIALIZATION =======================================

#$# UMASK --- really must allow group write?
umask 002;

our $headerHTTP_was_sent = 0;         # global for htmldie() defined in Aktiv2Knecht.pm
my ($sec,$min,$hour,$mday,$mon,$pyear) = localtime();           # mon is 0-based!
my $month = $mon+1;
my $year = $pyear+1900;
my $invdate = sprintf "%4d%02d%02d%02d%02d%02d", $year,$month,$mday,$hour,$min,$sec;
my $timedate = sprintf "%02d:%02d.%02d %02d.%02d.%4d", $hour,$min,$sec,$mday,$month,$year;
my $isodate  = sprintf "%4d-%02d-%02d", $year,$month,$mday;


# - - - - - - - - Logging & Debugging configuration - - - - - - - - - - - - - - - - - - -

my $errlogfile = "/tmp/$appname.ERR.log";    # tracing log
   $errlogfile = 'E:/Program Files/Apache Group/Apache2/cgi-bin/err.log'    if($PLATFORM eq 'MSWin32');
my $sgnlogfile = "/tmp/$appname.SGN.log";    # log for new sign-ups
   $sgnlogfile = 'E:/Program Files/Apache Group/Apache2/cgi-bin/sgn.log'    if($PLATFORM eq 'MSWin32');
open (ERRLOGFILE, ">>$errlogfile") || htmldie_report_err("init", "Could not open file $errlogfile", "self", 1);
#my $ERRFILE = *ERRLOGFILE{IO};    # to make the filehandle accessible from subroutines

#$# Consider adding use of     Log::Agent::Rotate

use Log::Agent;
require Log::Agent::Driver::File;       # for logging to a file
logconfig( -driver =>
    Log::Agent::Driver::File->make(
#        -no_prefixing => 1,  #$# should disable 3 opts below but was not accepted...
        -prefix      => '',
        -stampfmt    => 'none',
        -showpid     => 0,
#        -debug       => 1,                 #$# dies with "unknown switch"
        -channels    => {
            'error'  => "$sgnlogfile",      #$# misued for logging new signups (temporarily)
            'output' => "$errlogfile",      # logsay writes there
            'debug'  => "$errlogfile",      # logdbg writes there #$# this didn't work!
        },
    )
);

my $maildisabled = 0;
$maildisabled = ($PLATFORM eq 'MSWin32');    # disable mailer on win32



#======================== APPSTART ============================================

### Module debugging...
### FFII:Aktiv2Knecht::a2k_initialize('test123');   # ok
### a2k_initialize('test456');   # ok

#$# my $q = new CGI;
our $q = new CGI;       # temporarily a global var --- for use in Aktiv2Knecht.pm

#$# Consider catching doubly defined variables right here before they cause problems
### [e.g. INPUT text field 'id && INPUT hidden field 'id']

my $fullactionurl = $q->url;                        # e.g. "http://www.ffii.org/ffii-cgi/eintrag.pl"
my $actionurl = $q->url( -absolute => 1 );          # w/o hostname, e.g. "/ffii-cgi/eintrag.pl"
###logsay "\n\n\n\n[noIDavailable] [urlcheck]   fullactionurl:$fullactionurl   actionurl:$actionurl";

my $ssl_is_on = ( $fullactionurl =~ /^https:/ );
my ( $ssl_url, $nonssl_url ) = ( "", "" );
if( $ssl_is_on )
{   # set up  URL for switching back to non-secure http
    ($nonssl_url = $fullactionurl) =~ s#^https:#http:#;
    $q->param('nonssl_url' => $nonssl_url);   # form-param (for auto-fill-in) (won't be submitted)
}
else
{   # set up  URL for switching to https
    ($ssl_url = $fullactionurl) =~ s#^http:#https:#;
    $q->param('ssl_url' => $ssl_url);         # form-param (for auto-fill-in) (won't be submitted)
}
###logsay "[noIDavailable] [SSLcheck]   ssl_is_on:[%s]   \n\t nonssl_url:%s    \n\t ssl_url:%s", $ssl_is_on, $nonssl_url, $ssl_url;

# zap name of executable (part after rightmost slash)
(my $actionpath = $q->url() ) =~ s#/[\w\._]*$##;    # e.g. "http://www.ffii.org/ffii-cgi"
my $ipaddr = $q->remote_host();
   ### del nxt rel! ### $ipaddr =~ tr/./_/;                 # for use in temp user ID
my $browser = $q->user_agent();

zap_info_texts();                           # Get rid of some info texts possibly submitted by INPUT fields
fix_unchecked_checkboxes(scalar $q->Vars);  # Use hidden "checkboxfix_nn" params to make unchecked checkboxes return something (0).
email_join(scalar $q->Vars);                # Build email from mail_norm_mailuser+mail_norm_mailhost if it is there

#  "M" IS THE MAIN CGI PARAMETER - IT SELECTS THE FUNCTION TO BE PERFORMED
#  It is kept in variable $mode
#       e.g. $mode='confirm' will show the screen referred to in SWITCH section /^confirm$/
our $mode;     #$# global const also used by Aktiv2Knecht.pm
   $mode = $q->param('m') || 'usrmgmt';     # default to user management main menu if no mode given
   $mode =~ tr/a-zA-Z0-9_\-//cd;            # clean it
   # $mode=newusr creates a new user account (n or eintrag are historical synonyms)
   $mode = 'newusr'    if( $mode eq 'n'  or  $mode eq 'eintrag' );

my $prevmode = $q->param('p');               # used to re-display the preceding form in case of errors
   $prevmode =~ tr/a-zA-Z0-9_\-//cd;         # clean it

my $altmode  = $q->param('ma');              # alternate mode (used in some cases e.g. login)
   $altmode  =~ tr/a-zA-Z0-9_\-//cd;         # clean it

my $indirectmode = "";                   # used to remember desired mode if not yet authenticated

my $language = lc( $q->param('l') ) || 'en';          # UI language (default --> EN)
   $language =~ tr/a-z//cd;                           # clean it
   $q->param('l' => $language);     # update CGI-var for auto-setting HIDDEN vars in HTML (see end of subr. showf!)
#$# Following var also used by Aktiv2Knecht.pm
our $LANG_CODE = $LANGUAGE_BIGRAMS{ $language } || 'en';   # only allow lang-codes found in this hash
# Global fall-back for langs with untranslated Error Messages
# HINT: There also is a local fallback in validate() for individually missing translations
our $LANG_CODE_ERRMSGS = $LANGUAGE_BIGRAMS_ERRMSGS{ $language } || 'en';

   # language-dependent html templates are kept in subdirs such as 'de' or 'en'
my $LANG_SUBDIR = $LANG_CODE;

$q->param(demo => ($DEBUG>0) );         # Flag used in HTML-Templates to inform user of demo/live status

# modes must not propagate as CGI parameters
$q->delete('m');
$q->delete('p');

# Form to be shown as first screen, when $mode=='newusr'
my $signup_type;                            # identifies various signup-types (e.g. 'bund028' or 'eubsa')
#$# signup_type and signuptype params should more appropriately be named "signed_appeal" e.g. !!

my $form = $q->param('f');                  # e.g. f=mcbund028 and mode="" will show mcbund028.html
if( $form )
{   # We came in via a campaign link requiring a special signup form
    $form =~ tr/a-zA-Z0-9_\-//cd;           # clean it
    $form =~ s/^mc//;       # take care of older links - remove leading "mc"   (EXA: mcbund028 --> bund028)
    $signup_type = $form;   # Generate signup-type to be logged in user's profile
    $q->param( signuptype => $signup_type );    # make it a CGI-var (required for HIDDEN field in signup form)
    # Whenever an f=xxxx param is given, it means we are signing up a new user:
    $mode = 'newusr'   unless( $mode eq 'v_newusr' );     # or verification will not work...
}

#$# my $id;
our $id;        # Declare $id global for Aktiv2Knecht.pm ---> puts it in packacke main:: (oldstyle: use vars "$id"; )
$id = $q->param('id') || $q->param('email_norm') || $ipaddr || -1;     # informal user ID (whatever is known already) for logging
$id =~ tr/a-z0-9_\.\-//cd;                 # clean it


logsay "\n\n\n\n\n\n\n[$id] ==================== $timedate  [$appname] ===================";
logsay "[$id] [CGI_SWITCH] form:$form  m:$mode  p:$prevmode  am:$altmode f/sign:$signup_type";
logsay "[$id] [CGI_SWITCH] actionpath:$actionpath";
###logsay "[$id] [CGI_SWITCH] HTML_PATH:$HTML_PATH";
logsay "[$id] [Browser] $browser";

# logsay "[$id] ---------Incoming CGI Vars--------\n". Dumper(\%{$q->Vars}) ."---------------\n";

# Tell receiving browser that our encoding is UTF-8 (cgi.pm defaults this to ISO-8859-1 !!!)
# (this overrides any 'META ... charset' setting found in the HTML-templates - yes it does!)
#$# "expires" seems resp for lost logins - sometimes ?!? maybe bad clock setting on genba??
###print $q->header( -type=>'text/html', -charset=>'UTF-8' );
print $q->header( -type=>'text/html', -expires=>'now', -charset=>'UTF-8' );
# META-Tags != HTTP-response-headers!!     -http_equiv=>'cache-control', -content=>'no-cache'

$headerHTTP_was_sent = 1;

# Don't output HTML <head>...<body> stuff here -- this is part of the .tmpl templates!
#   Therefore, there is no     print $q->start_html;   here!

# REMINDER: warningsToBrowser must not be enabled before the html header has been sent!
$warningsToBrowser_flag   and   warningsToBrowser(1);


# ------------- CGI MAIN SWITCH ----------------------

# CHECK FOR AUTHENTICATION INFO & SET FLAG ACCORDINGLY
my $auth = check_authentication();      # authentication flag (1 if authentication ok)
my $valid_parms = undef;
my $err_msgs = undef;
my $retval = undef;

####### CGI_SWITCH: for( my $tmp1 = $mode )   # hangs the system!!!
CGI_SWITCH: for( $mode )
{
    /^newusr$/   and do           # mode for signing up first-time users
    {
        showf( $form, 1, 'newusr', 'v_newusr', '', $err_msgs );    # show the signup-form per $form and set error + success targets
        last CGI_SWITCH;
    };
    /^v_newusr$/   and do
    {
        #$# need to catch multiple calls of this cgi-mode for a single user id
        #$# some users double(!)click on the submit button and the end up receiving 2 confirm emails, only 1 of which will have a working SessionID!
        #$# SOLUTION: this mode should check, if a previous request came in within +/- 1 second and block if yes.

        ($valid_parms, $err_msgs) = validate('newusr');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display

        # NO ERRORS in submitted data
        generate_user_id();         # as CGI param 'id'
        $id = $q->param('id');      # temporary id value was IP-addr or email-Addr up to now

        my $stype = $q->param('signuptype');
        # Special case: Signup forms with "euparl" checkbox for euparl supporters (e.g. Netstrike quick-form "strike")
        if( $q->param('euparl_checked') == 1 )
        {
            $q->delete('euparl_checked');
            delete $valid_parms->{'euparl_checked'};
            $stype = 'euparl';      # e.g. 'strike' overwritten by 'euparl'
        }
        # otherwise leave stype='strike' untouched

        create_user_profile();      # do it - or die deep within the knecht call
        update_user_profile_from_hash( $valid_parms );

        generate_session_id();      # as CGI param 'sid'
        save_session_id();

        ($form ne '')    and   logger( 'formused', $form );   # log which signup form is being used here, e.g. eubsa or strike
        ($stype ne '')   and   logger( 'signuptype', $stype );   # log which signup form is being used here, e.g. eubsa
        ($stype ne '')   and   logsay "[$id] [v_newusr]   Saved signuptype: [$stype] as [persist_signuptype_pstval => $stype]\n";

        send_email_asking_for_confirmation( 'confirm' );
        # fill-in param is '1' because this non-submittable form has an INPUT field for Email-Display (non-changeable)
        #$# ... this is bad UI design - change it!
        showf('signupok', 1, '', '');      # This is a confirm/no_action form!
        last CGI_SWITCH;
    };


    /^usrmgmt$/   and do
    {
        not $auth   and   ($mode = 'login')         and  redo;      # got to log in first!
        $auth       and   ($mode = 'usrmgmt_auth')  and  redo;      # we are logged in
        last CGI_SWITCH;
    };


    /^login$/   and do
    {
        # NEW Auto-jump: "Go directly to this page" (works even, when user is not logged in)
        # (How it works: indirectmode is submitted as "alternate-mode" to pass to the desired mode after login was successful!)
        showf( 'login', 1, 'login', 'v_login', $indirectmode, $err_msgs );
logsay "[$id] login DBG:  indirectmode:$indirectmode";
        ### showf( 'login', 1, 'login', 'v_login', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_login$/   and do
    {
        ($valid_parms, $err_msgs) = validate('login');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display

        # indirectmode has been retrieved as "altmode" here

            if( knechtcall_checklogin( $q->param('id'), $q->param('pass') ) == 0 )
            {   # success, existing id
                generate_session_id();      # login OK - hand out a new session id
                save_session_id();
                $auth = 1;
logsay "[$id] v_login DBG:  auth:$auth  altmode:$altmode";
                ($altmode eq 'v_login')  and  $altmode="";      #$# catch this - find out why it happens
                ($altmode eq 'v_forgot')  and  $altmode="";      #$# catch this - find out why it happens
                ### ($mode = 'usrmgmt')  and  redo;
                ($mode = $altmode || 'usrmgmt')  and  redo;     # altmode might have auto-jump formname!!
            }
            else
            { #$# MOVE THIS TO validate() !!!
                push @$err_msgs, { errors => 'Nutzerkennung bzw. Passwort sind uns leider nicht bekannt!<BR>Bitte versuchen Sie es noch einmal oder waehlen Sie unten "Passwort vergessen"' };
#$# tmp localization - fix it!
($LANG_CODE_ERRMSGS ne 'de') and
                push @$err_msgs, { errors => 'User ID or password is not on file!<BR>Please try again or chose "Forgot your password" below' };
               ($mode = $prevmode)  and  redo;
            }

        last CGI_SWITCH;
    };



    /^forgot$/   and do
    {
        showf('forgot', 1, 'forgot','v_forgot','',$err_msgs);
        last CGI_SWITCH;
    };
    /^v_forgot$/   and do
    {
        # General note: User id is intentionally NOT given to knecht for checking - just a regex check
        # [this is to prevent anyone's robot from scanning our user list]

        ($valid_parms, $err_msgs) = validate('forgot');
        # ERRORS: reset mode + re-display
#$#     clear email to prevent privacy breach in redisplayed form?!
#$#        $err_msgs->[0]  and  ($q->param('email_norm') = '')  and  ($mode = $prevmode)  and  redo;
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;
        # Both ID and email are returned by valid_parms - whatever the user typed in

        $id = $valid_parms->{id};           # global var $id is only used for logging - update it
        $q->param( id => $valid_parms->{id} );

        # if ID still undefined --> redisplay this form  (this should already have been caught by sub validate!)
        ! $q->param('id')   and   ($mode = 'forgot')  and  redo;

        # Create sid for authentication & send out email
        generate_session_id();
        save_session_id();
logsay "[$id] send_email_with_login_link DBG:GOING2CALL...\n",$q->param('email_norm');
        send_email_with_login_link( 'chgpw' );
logsay "[$id] send_email_with_login_link DBG:CALL_RETURNED...\n";
        ($mode = 'login')  and  redo;
        last CGI_SWITCH;
    };



    /^confirm$/   and do         # activated via emailed URL
    {
        #$# localize this!!!
        not $auth   and   htmldie_report_err( '/confirm/', "Ein Eintrag unter der Kennung <b>$id</b> existiert nicht mehr.<BR>Haben Sie evtl. zuvor Ihre Kennung geaendert?<P>There is no user ID <b>$id</b> in our system. Probably, you have changed your user ID when you signed up to our system.", 'self', 0 );

        # get back pnom & mt/email
        ### Pull data required for logging
        retrieve_userdata_from_profile();
        my $s_name  = substr( $q->param('pnom_pnom'), 0, 40);
        my $s_email = substr( $q->param('email_norm'), 0, 40);
        # We can't read out the password [by design] - therefore we create+set a new one & announce it to the user
        # create new pw + update knecht's pw record
        my $pass = generate_new_password();
        set_password( $pass, 1 );

        #$# we are really confirming email adrs here, not ids - arent we???
        if( not idhasbeenconfirmedpreviously() )
        {
            # this prevents multiple execution when user presses browser refresh or double-clicks!
            # logger is called very first, because a CGI process launched by a second click must be blocked
            logger('idconfirmed', $timedate);
            logerr "New Id confirmed    [ID:$id][T:$timedate][E:$s_email][N:$s_name][IP:$ipaddr]";

            # Handle possible signup via special signup-form e.g. eubsa
            my $stype = log_readfrom_profile( 'signuptype' );    # e.g. eubsa, bund028
            logsay "[$id] confirm   stype:$stype"; 
            # e.g. sign_eubsa_siglvl   (value '1' means: "I sign this appeal in private")
            $stype  and  knechtcall_putvals( { 'sign_'.$stype.'_siglvl' => 1 } );

            ### Moved to v_confirm:
            ### send_email_to_admin("Neue Kennung bestaetigt [$id][$s_email][$s_name]", "Neu eingetragen und E-Mail-Adresse geprueft", $ipaddr);
        }

        showf( 'confirm', 1, 'confirm', 'v_confirm', '', $err_msgs );   # flag=1 to preset newid param!
        last CGI_SWITCH;
    };


    # ------ ANYTHING DOWNWARD FROM HERE REQUIRES AUTHENTICATION ---------------
    #
    # #$# maybe add a delay here to frustrate password-guessers
    # NEW: Auto-jump: Desired mode (which fails due to missing auth) is saved in indirectmode, to be used after login!
    # (see clauses "login" and "v_login")

    #$# prevent indirectmode being login,logout,forgot!
    #$# get rid of URL-params by means of browser redirect?!

    not $auth   and   not (($mode eq 'login') or ($mode eq 'logout') or ($mode eq 'forgot'))   and   $indirectmode = $mode;
    logsay "[$id] auth_check   DBG:  auth:$auth   mode:$mode   indirectmode:$indirectmode";
    #$# MORE TRANSPARENT & GENERIC PASSTHRU OF m= AND mep= (ect) SHOULD BE IMPLEMENTED HERE
    ### IDEA: Create a HIDDEN var HTML-fragment for all CGI params that are not in [id sid l]
    ###     Then insert the fragment into the current form before showf()ing it.
    ###     Thus, the params will be automagically there on the next submit!

    not $auth   and   ($mode = 'login')     and  redo;

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


    /^v_confirm$/   and do
    {
        ($valid_parms, $err_msgs) = validate('confirm');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        if( user_requested_id_change() )
        {
            my $oldid = $id;
            if( change_user_id() )
            {   # problem: user ID could not be changed
                my $newid = $q->param('newid');
                push @$err_msgs, { errors => "Ihre gew&uuml;nschte Nutzerkennung \"$newid\" ist leider schon vergeben." };
                #$# tmp localization - fix it!
                ($LANG_CODE_ERRMSGS ne 'de') and
                    push @$err_msgs, { errors => 'The user identification that you chose ($id) is already in use.' };
               ($mode = $prevmode)  and  redo;
            }
            logerr "Id changed by user  [ID:$oldid -> $id][T:$timedate][IP:$ipaddr]";
        }
        # Report newly confirmed supporter (moved here from confirm clause - had to wait for possible id change)
        # get pnom & email
        retrieve_userdata_from_profile();       #$# wasteful - should ask only for data actually required!
        my $s_name  = substr( $q->param('pnom_pnom'), 0, 40);
        my $s_email = substr( $q->param('email_norm'), 0, 40);
        ### send_email_to_admin("Neue Kennung bestaetigt [$id][$s_email][$s_name]", "Neu eingetragen und E-Mail-Adresse geprueft", $ipaddr);
        logerr "Account activated   [ID:$id][T:$timedate][E:$s_email][N:$s_name][IP:$ipaddr]";

        # Go directly to form "Sign Appeals" if new user came in via an Appeal signup form
        my $stype = log_readfrom_profile( 'signuptype' );    # e.g. eubsa, bund028
        $stype  and  ($mode = 'selsign')  and  redo;

        ($mode = 'usrmgmt')  and  redo;
        last CGI_SWITCH;
    };

    # ----------- ADDRESS + PAYMENT --------------

    /^address$/   and do          # bring up address + phone form
    {
        retrieve_all_data_from_profile();
        showf( 'address', 1, 'address', 'v_address', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_address$/   and do
    {
        ($valid_parms, $err_msgs) = validate('address');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        update_user_profile_from_hash( $valid_parms );

        $signup_type = knechtcall_get1val('persist_signuptype_pstval');

        #$# eurolinux was never intended to be a signup-form - it is a form that appears after user gives his address!
        #$#REMOVED### ($signup_type eq 'eurolinux')   and   ($mode = 'eurolinux')  and  redo;

#$# TEMPORARILY DISABLED due to uncoord DB change by phm - waiting for clarification
#$#        ($signup_type eq 'eubsa')       and   ($mode = 'eurolinux')  and  redo;
        ($mode = 'usrmgmt')  and  redo;
        last CGI_SWITCH;
    };

    /^status$/   and do          # bring up membership status form
    {
        retrieve_all_data_from_profile();
        showf( 'status', 1, 'status', 'v_status', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_status$/   and do
    {
        ($valid_parms, $err_msgs) = validate('status');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        update_user_profile_from_hash( $valid_parms );

        #$# add detection of status changes here --> send email to buero?!

        if( is_paying_member(get_member_status_from_cgi()) )
        {
            if( payment_details_available() )
            {
                ($mode = 'payreview')   and   redo;
            }
            else
            {
                ($mode = 'amount')   and   redo;
            }
        }
        else
        {
            ($mode = 'usrmgmt')  and  redo;
        }
        last CGI_SWITCH;
    };

    /^amount$/   and do          # bring up membership fee form
    {
        retrieve_all_data_from_profile();
        showf( 'amount', 1, 'amount', 'v_amount', '', $err_msgs );
        last CGI_SWITCH;
    };

    /^v_amount$/   and do
    {
        ($valid_parms, $err_msgs) = validate('amount');
        # Exceptionally store BEFORE the errmsg-check! (to conserve warnedonce flag!!)
        #$#     consider doing this always - no danger because only validated params are stored
        update_user_profile_from_hash( $valid_parms );
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display

        # log previously stored rate for DEBUGging purposes
        logsay "[$id] [CGIsw:v_amount]   stored pag_pagsum:%s   stored pag_pagmon:%s", knechtcall_get1val('pag_pagsum'), knechtcall_get1val('pag_pagmon');

        # This form is only used for first-time signup -
        #   in that case, the annual rate is identical to pag_pagsum
        #   and the assumed payment interval 'pag_pagmon' is initialized as 12 months
        $valid_parms->{'pag_pagsum'} = $valid_parms->{'annual_rate'};
        $valid_parms->{'pag_pagmon'} = 12;
        update_user_profile_from_hash( $valid_parms );

        #$# TODO: email to buero -- use $FFII_OFFICE_MAIL

        # update params for fct rate_above_minimum
        $q->param( pag_pagsum => $valid_parms->{'annual_rate'} );      # is ok here because pag_pagmon hasn't yet changed!
        $q->param( pag_pagmon => 12 );

        #$# following leaves asoc==2 if user entered e.g. 10EUR --- should write back asoc=1 ??
        not rate_above_minimum()  and  ($mode = 'usrmgmt')  and  redo;

        # ONLY set member status to payingmember if dealing with non-members
        # (i.e. do not overwrite if already >= 2)
        if( get_stored_member_status() <= 1 )       #$# mk $mcode{supporter} visible here
        {
            knechtcall_putvals( { asoc_ffii_asolvl => 2 } );    #$# ditto $mcode{payingmember}
        }

        ($mode = 'pay')  and  redo;
        last CGI_SWITCH;
    };


    /^payreview$/   and do          # bring up payment form
    {
        retrieve_all_data_from_profile();
        showf( 'payreview', 1, 'payreview', '', '', $err_msgs );
        last CGI_SWITCH;
    };

    /^pay$/   and do          # bring up payment form
    {
        retrieve_all_data_from_profile();
        showf( 'pay', 1, 'pay', 'v_pay', '', $err_msgs );
        last CGI_SWITCH;
    };

    /^v_pay$/   and do
    {
        mergepayparams();                # pay form contains duplicate set of params - merge them
        ($valid_parms, $err_msgs) = validate('pay');
        # Exceptionally store BEFORE the errmsg-check! (to conserve choice of radio + warnedonce!!)
        update_user_profile_from_hash( $valid_parms );
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display

        # set + save validated beitrag
        # no errors --> update
        $q->param( pag_pagsum => $valid_parms->{'pag_rate'} );
        knechtcall_putvals( { pag_pagsum => $valid_parms->{'pag_rate'} } );

        if( rate_above_minimum() )                                # final check for valid membership rate
        {
            # mail out payment info  to user
            retrieve_userdata_from_profile();           # this also gets the email addr
            send_email_with_payment_summary();
            # ADMIN STUFF
            my $s_name  = substr( $q->param('pnom_pnom'), 0, 20);
            my $s_email = substr( $q->param('email_norm'), 0, 20);
            my $annualpay = $q->param('pag_pagsum')*12/$q->param('pag_pagmon');
            #$# might add beitrag-change detection & email alert to admin here
            if( not membership_logged() )
            {
                send_email_to_admin("Neues Mitglied [$id][E=$annualpay][$s_email][$s_name]",
                    "Neues zahlendes Mitglied", $ipaddr);

                # Set user's default maillist flags (done only once)
                # This needs localization! -- No, I removed it:
                # phm says: verein autosubscribe is handled by Knecht, neues shouldn't be auto
                # knechtcall_putvals( { subs_verein_sublvl=>1, subs_neues_sublvl=>1 } );
            }
            logger('becamepayingmember', $timedate);       # log always, also changes
        }
        #$# ELSE clause missing here --- user with too low $$$ is thrwon back to usrmgmt w/o comment!

        ### ($mode = 'selsubs')  and  redo;
        ($mode = 'usrmgmt')  and  redo;
        last CGI_SWITCH;
    };

    /^paychange$/   and do          # bring up payment form
    {
        retrieve_all_data_from_profile();
        showf( 'paychange', 1, 'paychange', 'v_paychange', '', $err_msgs );
        last CGI_SWITCH;
    };

    /^v_paychange$/   and do
    {
        mergepayparams();                # pay form contains duplicate set of params - merge them
        ($valid_parms, $err_msgs) = validate('paychange');
        # Exceptionally store BEFORE the errmsg-check! (to conserve choice of radio + warnedonce!!)
        update_user_profile_from_hash( $valid_parms );
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display

        # set + save validated beitrag
        # no errors --> update
        $q->param( pag_pagsum => $valid_parms->{'pag_rate'} );
        knechtcall_putvals( { pag_pagsum => $valid_parms->{'pag_rate'} } );

        if( rate_above_minimum() )                                # final check for valid membership rate
        {
            # mail out payment info  to user
            retrieve_userdata_from_profile();           # this also gets the email addr
            send_email_with_payment_summary();
            # ADMIN STUFF
            my $s_name  = substr( $q->param('pnom_pnom'), 0, 20);
            my $s_email = substr( $q->param('email_norm'), 0, 20);
            my $annualpay = $q->param('pag_pagsum')*12/$q->param('pag_pagmon');
            #$# might add beitrag-change detection & email alert to admin here
            if( not membership_logged() )
            {
                send_email_to_admin("Mitglied Zahlungsaenderung [$id][E=$annualpay][$s_email][$s_name]",
                    "Mitglied hat Zahlungsmodus geaendert", $ipaddr);

                # Set user's default maillist flags (done only once)
                # This needs localization! -- No, I removed it:
                # phm says: verein autosubscribe is handled by Knecht, neues shouldn't be auto
                # knechtcall_putvals( { subs_verein_sublvl=>1, subs_neues_sublvl=>1 } );
            }
            logger('changedpaymodus', $timedate);       # log always, also changes
        }
        ($mode = 'usrmgmt')  and  redo;
        last CGI_SWITCH;
    };

    /^eurolinux$/   and do          # bring up eurolinux form
    {
        retrieve_all_data_from_profile();
        showf( 'eurolinux', 1, 'eurolinux', 'v_eurolinux', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_eurolinux$/   and do
    {
        ($valid_parms, $err_msgs) = validate('eurolinux');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        update_user_profile_from_hash( $valid_parms );
        ($mode = 'usrmgmt')  and  redo;
        last CGI_SWITCH;
    };


    # ----------- USER MANAGEMENT FORMS ----------

    /^usrmgmt_auth$/   and do
    {
        !$auth  and  ($mode = 'login')  and  redo;      # got to log in first!
        retrieve_all_data_from_profile();
        showf( 'usrmgmt', 1, 'usrmgmt', 'usrmgmt', '', $err_msgs );
        last CGI_SWITCH;
    };

    /^chgpw$/   and do
    {
        showf('chgpw', 2, 'chgpw','v_chgpw','',$err_msgs);   # 2-->don't redisplay previous entries
        last CGI_SWITCH;
    };
    /^v_chgpw$/   and do
    {
        ($valid_parms, $err_msgs) = validate('chgpw');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        ($mode = 'usrmgmt')  and  redo;
        last CGI_SWITCH;
    };

    /^logout$/   and do
    {
        $q->param('id' => "");
        $q->param('sid' => "");
        save_session_id();
        $q->delete('id');
        $q->delete('sid');
        showf('logout', 1, 'logout','');
        last CGI_SWITCH;
    };

    /^resign$/   and do
    {   # Terminate the membership
        showf('resign', 1, 'resign','v_resign','',$err_msgs);
        last CGI_SWITCH;
    };
    /^v_resign$/   and do
    {
        ($valid_parms, $err_msgs) = validate('resign');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display

        #$# knechtcall_deleteuser();   # DISABLED FOR NOW
        # FOR NOW - instead of deleting - just set a new password unknown to user + delete session-id
        my $pass = generate_new_password();
        set_password( $pass, 1 );
        $q->param('sid' => "" );
        save_session_id();

        logger('memberresigned', $timedate);
        logsay "[$id] [CGIsw:v_resign]   m:$mode  motivation:\n%s", $q->param('motivation');

        retrieve_userdata_from_profile();
        send_email_to_admin("!! Mitglied ausgetreten [$id]",
            "Ausgetretenes Mitglied", $ipaddr, $browser, '\nBegruendung:\n'.$q->param('motivation') );

        ($mode = 'resignconfirm')  and  redo;
        last CGI_SWITCH;
    };
    /^resignconfirm$/   and do
    {
        showf('resignconfirm', 0, 'resignconfirm','');
        last CGI_SWITCH;
    };

    /^selsign$/   and do
    {
        retrieve_sign_data_from_profile();
        showf( 'selsign', 1, 'selsign', 'v_selsign', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_selsign$/   and do
    {
        ($valid_parms, $err_msgs) = validate('selsign');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        update_user_profile_from_hash( $valid_parms );

        ($mode = 'usrmgmt')  and  redo;
        last CGI_SWITCH;
    };

    /^selevent$/   and do
    {
        retrieve_event_data_from_profile();
        showf( 'selevent', 1, 'selevent', 'v_selevent', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_selevent$/   and do
    {
        ($valid_parms, $err_msgs) = validate('selevent');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        update_user_profile_from_hash( $valid_parms );

        ($mode = 'usrmgmt')  and  redo;
        last CGI_SWITCH;
    };

    /^selsubs$/   and do
    {
        retrieve_subs_data_from_profile();
        # default to email addr if subscription email addr is empty
        $q->param('email_subs')  or  $q->param( 'email_subs' => $q->param('email_norm') );

        # No fill-in for correct dropdownmenu-handling --> arg:2 !
        showf( 'selsubs', 2, 'selsubs', 'v_selsubs', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_selsubs$/   and do
    {
        ($valid_parms, $err_msgs) = validate('selsubs');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        update_user_profile_from_hash( $valid_parms );

        ($mode = 'usrmgmt')  and  redo;
        last CGI_SWITCH;
    };

    /^selassoc$/   and do
    {
        retrieve_assoc_data_from_profile();
        showf( 'selassoc', 1, 'selassoc', 'v_selassoc', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_selassoc$/   and do
    {
        ($valid_parms, $err_msgs) = validate('selassoc');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        update_user_profile_from_hash( $valid_parms );
        ($mode = 'usrmgmt')  and  redo;
        last CGI_SWITCH;
    };


    /^epatovr$/   and do          # bring up PAT overview
    {
        retrieve_epat_data_from_profile();
        showf( 'epatovr', 1, 'epatovr', '', '', $err_msgs );
        last CGI_SWITCH;
        # This page has no form contents - no validation code required
    };

    /^epataddrand$/   and do          # add one PAT to the list
    {
        # This is a non-GUI function - no page is shown
        #$# not requd here - remove: ##retrieve_epat_data_from_profile();
        my $patno = knechtcall_pickpat();
        my $newparam = 'epat_'.$patno.'_tech';          # the epat_12345_tech field is used to recognize entries
        knechtcall_putvals( { $newparam => 0 } );       # set default
        # make sure, this PAT is displayed next
        $q->param( pno => $patno );
        ($mode = 'epat')  and  redo;                    # show detail form
        last CGI_SWITCH;
        # This page has no form contents - no validation code required
    };

    /^epat$/   and do          # bring up patent classification form
    {
        retrieve_epat_data_from_profile();
        #$#     THOUGHTS:
        #       Leider gibts kein filter_regexp_map in Data-FormValidator-1.9 ...
        #       Daher muss ich alle params in showf() in eine generische form wandeln: epat_ep0526034_tech --> epat_tech
        #           und in validate() mittels submitted epat_patno var (HIDDEN) zurueckwandeln
        showf( 'epat', 1, 'epat', 'v_epat', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_epat$/   and do
    {
        ($valid_parms, $err_msgs) = validate('epat');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        update_user_profile_from_hash( $valid_parms );
        ($mode = 'epatovr')  and  redo;
        last CGI_SWITCH;
    };


    /^reprovr$/   and do          # bring up MEP overview (list of MEPs)
    {
        retrieve_repr_data_from_profile();
        showf( 'reprovr', 1, 'reprovr', '', '', $err_msgs );
        last CGI_SWITCH;
        # This page has no form contents - no validation code required
    };

    /^repraddrand$/   and do          # add one MEP to the list of MEPs
    {
        # This is a non-GUI function - no page is shown
        #$# #not requ here -- remove# retrieve_repr_data_from_profile();
        my $mepnick = knechtcall_pickmep();
        my $newparam = 'repr_mep_'.$mepnick.'_replvl';     # the repr_mep_replvl field is used to recognize entries
        knechtcall_putvals( { $newparam => 0 } );       # set default ('just looking')
        # make sure, this MEP is displayed next
        $q->param( mep => $mepnick );
        ($mode = 'repr')  and  redo;                    # show detail form
        last CGI_SWITCH;
        # This page has no form contents - no validation code required
    };

    /^repr$/   and do          # bring up MEP detail form
    {
        retrieve_repr_data_from_profile();
        showf( 'repr', 1, 'repr', 'v_repr', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_repr$/   and do
    {
        ($valid_parms, $err_msgs) = validate('repr');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        update_user_profile_from_hash( $valid_parms );
        ($mode = 'reprovr')  and  redo;
        last CGI_SWITCH;
    };

    /^reprquery$/   and do          # bring up MEP search form or MEP search form with results
    {
        retrieve_all_data_from_profile();           #$# check if needed at all!
        showf( 'reprquery', 1, 'reprquery', 'v_reprquery', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_reprquery$/   and do
    {
        ($valid_parms, $err_msgs) = validate('reprquery');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        ($mode = 'reprquery')  and  redo;                       # reprquery form has result area at bottom
        last CGI_SWITCH;
    };


    /^mepqsovr$/   and do          # bring up MEP overview (list of MEPs)
    {
        retrieve_mepqs0405_data_from_profile();
        showf( 'mepqsovr', 1, 'mepqsovr', 'v_mepqsovr', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_mepqsovr$/   and do
    {
        ($valid_parms, $err_msgs) = validate('mepqsovr');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        ($mode = 'mepqs0405')  and  redo;
        last CGI_SWITCH;
    };

    /^mepqsrm$/   and do          # add one MEP to the list of MEPs
    {
        # This is a non-GUI function - no page is shown
        my $newparam = 'mepqs0405_'.$q->param(mep).'_removed';
        knechtcall_putvals( { $newparam => 1 } );           # set flag marking removed records
        ($mode = 'mepqsovr')  and  redo;
        last CGI_SWITCH;
    };

    /^mepqs0405$/   and do          # bring up MEP questionnaire
    {
        ###logsay "[CASE mepqs0405] %s\n",Dumper(\%{$q->Vars});
        retrieve_mepqs0405_data_from_profile();
        logsay "[CASE mepqs0405] %s\n",Dumper(\%{$q->Vars});
        showf( 'mepqs0405', 1, 'mepqs0405', 'v_mepqs0405', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_mepqs0405$/   and do
    {
        ($valid_parms, $err_msgs) = validate('mepqs0405');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        update_user_profile_from_hash( $valid_parms );
        ($mode = 'mepqsovr')  and  redo;
        ###($mode = 'mepqs0405')  and  redo;
        last CGI_SWITCH;
    };

    /^mepqsquery$/   and do          # bring up MEP search form or MEP search form with results
    {
        retrieve_all_data_from_profile();           #$# check if needed at all!
        showf( 'mepqsquery', 1, 'mepqsquery', 'v_mepqsquery', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_mepqsquery$/   and do
    {
        ($valid_parms, $err_msgs) = validate('mepqsquery');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        ($mode = 'mepqsquery')  and  redo;                       # mepqsquery form has result area at bottom
        last CGI_SWITCH;
    };


    /^myemails$/   and do          # add, verify and remove email addresses
    {
        retrieve_all_emailaddresses_from_profile();
        showf( 'myemails', 1, 'myemails', 'v_myemails', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_myemails$/   and do
    {
        ($valid_parms, $err_msgs) = validate('myemails');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        ###update_user_profile_from_hash( $valid_parms );       # nothing to save here!
        ($mode = 'XXXXXXXXX')  and  redo;
        last CGI_SWITCH;
    };



    /^netstrike$/   and do          # sign up URLs for the net strike
    {
        retrieve_netstrike_data_from_profile();
        showf( 'netstrike', 1, 'netstrike', 'v_netstrike', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_netstrike$/   and do
    {
        ($valid_parms, $err_msgs) = validate('netstrike');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        update_user_profile_from_hash( $valid_parms );
        ($mode = 'usrmgmt')  and  redo;
        last CGI_SWITCH;
    };


    /^projsel$/   and do
    {
        retrieve_proj_data_from_profile();
        # default to email addr if subscription email addr is empty
        $q->param('email_subs')  or  $q->param( 'email_subs' => $q->param('email_norm') );

        # No fill-in for correct dropdownmenu-handling --> arg:2 !
        showf( 'projsel', 1, 'projsel', 'v_projsel', '', $err_msgs );
        last CGI_SWITCH;
    };
    /^v_projsel$/   and do
    {
        ($valid_parms, $err_msgs) = validate('projsel');
        $err_msgs->[0]  and  ($mode = $prevmode)  and  redo;    # ERRORS: reset mode + re-display
        update_user_profile_from_hash( $valid_parms );

        ($mode = 'usrmgmt')  and  redo;
        last CGI_SWITCH;
    };



    # ----------- ONE TIME DONATION FORM ----------

    /^donate$/   and do
    {
        last CGI_SWITCH;
    };
    /^valdonate$/   and do
    {
       last CGI_SWITCH;
    };

    logsay "[$id] FELL THRU CGI-SWITCH!!   m:$mode  a:$auth \n";
    htmldie_report_err( '/EOF CGI-loop/', "MODE $mode not defined", 'self', 0 );


}   # END OF THE CGI_SWITCH





# =============================================================================
# DEFINE VARS GLOBAL TO SUBS  (to be initialized in the BEGINblock below)
my ($RULE_DESCR_ID_DE, $RULE_DESCR_ID_EN);
my %member_types;
my %mcode;
my %asoclvl_short;
my %asoclvl_long;
my %menu_entry1_usrmgmt;
my %sign;
my @signval;

BEGIN       # Initializer-block -- executes at each CGI startup
{
    # Text describing rules for userID
    $RULE_DESCR_ID_DE = '5-8 Kleinbuchstaben, keine Ziffern u. Sonderzeichen';
    $RULE_DESCR_ID_EN = '5-8 lowercase letters and neither digits nor special characters';

    %member_types = (           # also see definition in /var/www/ffii/verein/profil.txt
        0  => 'user',
        1  => 'supporter',
        2  => 'payingmember',
        3  => 'activemember',
        -2 => 'payingmember',         #$# test users always treated as "paying"
    );

    # named codes for use in if-statements to make code more readable
    %mcode = (           # also see definition in /var/www/ffii/verein/profil.txt
         user         => 0,
         supporter    => 1,
         payingmember => 2,
         activemember => 3,
         terminated   => -1,
         demouser     => -2,
    );

    %asoclvl_short =
    (
        de =>
        {
            0  => 'Nutzer der Informationsangebote',
            1  => 'Unterst&uuml;tzer',
            2  => 'F&ouml;rderndes Mitglied',
            3  => 'Gestaltendes Mitglied',
            -1 => 'Unterst&uuml;tzung bzw. Nutzung beendet',
            -2 => 'Demo/Test-Account',
        },
        en =>
        {
            0  => 'User of news + information',
            1  => 'Supporter',
            2  => 'FFII member',
            3  => 'Active FFII member',
            -1 => 'Terminated Support/Usage',
            -2 => 'Demo/Test Entry',
        },
        fr =>
        {
            0  => 'User of news + information',
            1  => 'Supporter',
            2  => 'FFII member',
            3  => 'Active FFII member',
            -1 => 'Terminated Support/Usage',
            -2 => 'Demo/Test Entry',
        },
    );

    %asoclvl_long =
    (
        de =>
        {
            0  => 'Nutzer der Informationsangebote des FFII',
            1  => 'Unterst&uuml;tzer des FFII (d.h. der FFII vertritt meine Anliegen)',
            2  => 'F&ouml;rderndes Mitglied (ich entrichte einen Mitgliedsbeitrag)',
            3  => 'Gestaltendes Mitglied (ich leiste aktive Mitarbeit)',
            -1 => 'Unterst&uuml;tzung bzw. Nutzung der Angebote des FFII beendet',
            -2 => 'Eintrag dient Demo- bzw. Testzwecken',
        },
        en =>
        {
            0  => 'User of information provided by FFII',
            1  => 'Supporter of FFII (FFII represents my causes)',
            2  => 'FFII member',
            3  => 'Active FFII member',
            -1 => 'Terminated support or usage of FFII information',
            -2 => 'Entry made for demo or testing purposes',
        },
        fr =>
        {
            0  => 'User of information provided by FFII',
            1  => 'Supporter of FFII (FFII represents my causes)',
            2  => 'FFII member',
            3  => 'Active FFII member',
            -1 => 'Terminated support or usage of FFII information',
            -2 => 'Entry made for demo or testing purposes',
        },
    );

#    %menu_entry1_usrmgmt = (
#        noaddress    => [ 'address', 'Eintrag vervollst&auml;ndigen' ],
#        noaddress    => [ 'status',  'Eintrag vervollst&auml;ndigen' ],
#
#        user         => 'Eintrag vervollst&auml;ndigen',
#        supporter    => 'Mitglied werden',
#        payingmember => 'Beitrag / Zahlungsweise &auml;ndern',
#        activemember => 'Beitrag / Zahlungsweise &auml;ndern',
#    );

    %sign = (
        signbund028 => [ 'Appell an die Bundesregierung', 'http://swpat.ffii.org/briefe/bund028/index.de.html' ],
        signeubsa   => [ 'Aufruf zum Handeln (Richtlinienvorschlag der Europ&auml;ischen Kommission)', 'http://swpat.ffii.org/papiere/eubsa-swpat0202/appell/index.de.html' ],
    );

#$# localize!!!

    @signval = (
        [ 0, 'Ich unterzeichne diesen Appell/Brief erst mal nicht' ],
        [ 1, 'Ich unterzeichne diesen Appell/Brief privat' ],
        [ 2, 'Bitte listen Sie mich &ouml;ffentlich als Unterzeichner auf' ],
        [-1, 'Einige Formulierungen in diesem Appell missfallen mir' ],
        [-2, 'Dieser Appell geht in die falsche Richtung' ],
    );
}



exit(0);










#================= SUBS START HERE =====================================================================


#----------------- NEW, GENERIC SHOW ROUTINE (will soon replace all other show*() subs ) ---------------------------------------------

sub showf()
{
    # DISPLAY FORM (OR RE-DISPLAY FORM WITH ERROR MESSAGES)
    # showf( $name_of_form, $fill_in_form_FLAG, $cgi_mode, $mode_of_next_screen, $alternate_nextmode_optional, $error_messages_arrayRef )

    my $form_filename = shift || $FORM1DEFLT_NAME;   # name of .html file with form to be shown (w/o extension!)
    my $fill_in_form = shift;
        # 1: USE CGI-OBJECT TO INIT or RE-ENTER ALL INPUT and HIDDEN fields (using data from the CGI object)
        # 2: INIT just the standard HIDDEN fields
        # 3: Don't init anything

    my $cmode_mw = shift || "newusr";                # this form's mode (for redisplay in case of error)

    my $nextmode = shift || "v_newusr";          # mode to be submitted when THIS form is submitted
    my $altmode  = shift;                       # alternate mode to be submitted (optional)
    my $errs = shift;                           # ref to array of hashes a la { errors => error msgs }
    # build full path to html template (e.g. "/var/www/ffii/verein/spende/en/login.en.html")
    my $form_path = "$HTML_PATH/$LANG_SUBDIR/$form_filename.$LANG_CODE.html";
    if( !(-e $form_path) )
    {
        logsay "[$id] ERROR: form not found: $form_path\n";
        htmldie_report_err( 'showf', "TEMPLATE $form_filename not found (m:$cmode_mw nm:$nextmode am:$altmode l:$language)", 'self', 0 );
    }

    logsay "[$id] [showf($form_filename,$fill_in_form,$cmode_mw,$nextmode,$altmode,$#$errs)] FORMPATH:$form_path";

    # create a new template object
    ### my $form_tmpl = HTML::Template->new( filename => $form_path, die_on_bad_params => '0', strict=>0, debug=>1, stack_debug=>1 );

    my $form_tmpl = HTML::Template->new
    (
        filename => $form_path,
#$#        associate => 1,              # enable later, also look at caching but only when running as mod_perl!!
        die_on_bad_params => '0',
        strict => 0,
        global_vars => 1,
        loop_context_vars => 1
    );       # removed: debug=>1


    # UNCONDITIONALLY INIT SOME TEMPLATE VARS THAT ARE REQUIRED IN EVERY TEMPLATE
    $form_tmpl->param( actionurl => $actionurl );
    
    my $tmpstatus = "";
    #$# call get_stored_member_status() instead of using knechtcall_get1val directly!!!
    $auth   and   $tmpstatus = $asoclvl_short{$LANG_CODE_ERRMSGS}{knechtcall_get1val('asoc_ffii_asolvl')};
    $form_tmpl->param( status => $tmpstatus );

    if( $appname =~ /\.beta$|\.alpha$/ )
    {
        $form_tmpl->param( alert => ($appname =~ /\.beta$/)?'BETA-TEST':'ALPHA-TEST' );
        $form_tmpl->param( alertcaption => 'Using Live-Database' );
        $form_tmpl->param( alertcaption => 'Using Test-Database' )    if( $usingTestDB );
    }
    elsif ( $appname =~ /\.pl$/ )
    {
        $form_tmpl->param( alert => 'EXPERIMENTAL' );
        $form_tmpl->param( alertcaption => 'Uses Test-Database' );
    }

    # CONDITIONALLY INIT SOME TEMPLATE VARS (ESPECIALLY COMPUTED HTML FRAGMENTS GO HERE)

    ### for( my $tmp = $cmode_mw ) ### doesn't work
    for( $cmode_mw )
    {
      # /^mymode$/     and do {  last; };   # this is a "one-line" example

        /^usrmgmt$/    and do
        {
            my $addr_known = addr_is_known();
            # WOW: cmode_mw was clobbered here ($_ is global + overwritten in Knecht)!
            #   Set template variable controlling visibiltiy of certain menu options
            $form_tmpl->param( addr_known => $addr_known );
            my $status = get_member_status_from_cgi();

            # DEFINE TEXT & MODE FOR FIRST MENU ENTRY (in User Management Screen "usrmgmt")
            # menu1code:  Is referring to an TMPL_IF clause in the usrmgmt html template
            # menu1mode:  Determines, which CGI-action comes next when clicking said menu entry

            my ($menu1code, $menu1mode);
            if( $status == $mcode{terminated} )
            {
                # Menu text: Account has been terminated
                $menu1code = 'terminated'
                and  ($menu1mode='status');
            }
            elsif( not $addr_known )
            {
                # 'Eintrag vervollst&auml;ndigen'
                $menu1code = 'ask4address'
                and  ($menu1mode='address');
            }
            elsif( $addr_known  and  not defined $status )
            {
                # 'Nutzer- bzw. Mitgliedsstatus festlegen'
                $menu1code = 'ask4status'
                and  ($menu1mode='status');
            }
            elsif( $status == $mcode{supporter}  or  $status == $mcode{user} )
            {
                # 'Mitglied werden';
                $menu1code = 'propose2join'
                and  ($menu1mode='amount');
            }
            elsif( $status == $mcode{payingmember}  or  $status == $mcode{activemember})
            {
                if( rate_above_minimum() )
                {
                    # 'Beitrag + Zahlungsweise einsehen / &auml;ndern';
                    $menu1code = 'view_paymodus';
                    $menu1mode='payreview';
                }
                else
                {
                # 'Nutzer- bzw. Mitgliedsstatus festlegen'
                    $menu1code = 'ask4status';
                    $menu1mode='status';
                }
            }
            elsif( $status == $mcode{demouser} )
            {
                $menu1code = 'demo_user'
                and  ($menu1mode='status');
            }
            else
            {
                # 'DEBUG: wrong status in usrmgmt!!';
                $menu1code = 'bad_status';
                $menu1mode='status';
            }
            # Though tempting, do not try to "fix" next 2 lines before powering up brain
            $form_tmpl->param( $menu1code  => 1          );
            $form_tmpl->param( entry1mode  => $menu1mode );

            logsay "[$id] [showf()]   memberstatus:$status   menu1code:%s   entry1mode:%s", $menu1code, $form_tmpl->param('entry1mode');
            last;
        };

        /^confirm$/    and do {  $form_tmpl->param( usrmgmturl => generate_user_management_url() );   last; };

        /^amount$/    and do
        {
            log_to_profile('amountFormViewed', $timedate);
            last;
        };
        /^pay$/    and do
        {
            # Inject HTML-code for selector "Erstabbuchung" (dropdown-menu) into form
            # [htmlDateSelector() returns HTML code for popup-menu]
            $form_tmpl->param( erstAbbuchSelect => htmlDateSelector('pag_pagbeg') );        # f. Lastschrift
            $form_tmpl->param( erstUewSelect    => htmlDateSelector('pag_pagbeg2') );       # f. Dauerauftr./Ueberweisung
            # log the fact that the pay form has been viewed
            log_to_profile('payFormViewed', $timedate);
            last;
        };
        /^paychange$/    and do
        {
            # Do not display a dropdown-menu for first payment date
            # log the fact that the pay form has been viewed
            log_to_profile('paychangeFormViewed', $timedate);
            last;
        };

        /^payreview$/    and do
        {
            # these vars control which part of form is visible
            for( $q->param('pag_pagtyp') )
            {
                /^l/  and  $form_tmpl->param( beitragtyp_la => 1 )  and last;        # f. Lastschrift
                /^d/  and  $form_tmpl->param( beitragtyp_da => 1 )  and last;       # f. Dauerauftr./Ueberweisung
            }
            my $start_date  = decode_date($q->param('pag_pagbeg'));
            my $payment_interval = $q->param('pag_pagmon');            # months
            if( $payment_interval <= 0 )
            {   htmldie_report_err( 'showf', "payment_interval=$payment_interval\n", 'self', 0 );
            }
            my $n_rates = 12 / $payment_interval;
            my $annual_payment = $q->param('pag_pagsum')*$n_rates;              # per year
            my $rate = $annual_payment / $n_rates;
            $form_tmpl->param( pag_annual => $annual_payment );
            $form_tmpl->param( erstbuchdat    => $start_date );
#$###            $form_tmpl->param( initiatedat    => decode_date($q->param('pag_pagini')) );
            last;
        };
        /^epat$/    and do
        {
            # extract patent numbers from CGI param list
            my @patnos = map { /^epat_([^_]+)_tech$/ }  $q->param;
            #$# my @patnos = sort map { /^epat_([^_]+)_tech$/ }  $q->param;
            # Patent to be displayed may be selected over the URL (CGI-param pno) -- otherwise use first one from list
            my $patno = $q->param('pno')  ||  $patnos[0];
            # Special code 'addrand' causes random patent to be added

            $q->param( epat_patno => $patno );      # this is all we need to generate the param names (see below)!
            $q->param( epat_paturl => knechtcall_paturl($patno) );
        };
        /^epatovr$/    and do
        {
            # list all Patents, one per line, as link to detail form
            # Extract patent numbers from CGI param list
            my @patnos = map { /^epat_([^_]+)_tech$/ }  $q->param;
            # Patent to be displayed may be selected over the URL (param pno) -- otherwise use first one from list
            my $patno = $q->param('pno')  ||  $patnos[0];
            # generate array of hashes for TMPL_LOOP in the HTML-Template
            my @patloopdata;
            foreach (@patnos)  {  push @patloopdata, { patno => $_ }  }
            # print ERRFILE "[$id] [epatovr CASE] patloopdata:\n",Dumper(\@patloopdata),"\n";
            $form_tmpl->param( patloop => \@patloopdata );    # list of patent numbers for switching between several persons
        };
        /^repr$/    and do
        {
            # We rely on Knecht having initialized a MEP for us
            # Extract mep nicknames from CGI param list
            my @meps = map { /^repr_mep_([^_]+)_replvl$/ }  $q->param;
            #$# sorting by nickname (probably not useful)
            #$# my @meps = sort map { /^repr_mep_([^_]+)_replvl$/ }  $q->param;
            #$# phm: Should be sorted by lvl!

            # redisplay of form (hidden var should be renamed to 'mep') or MEP selected over the URL (CGI-param mep) -- else use first one from list
            my $mep = $q->param('repr_mep_mepnick')  ||  $q->param('mep')  ||  $meps[0];

            $q->param( repr_mep_mepnick => $mep );      # this is all we need to generate the param names (see below)!

            $q->param( repr_mep_nom => knechtcall_getmepname($mep) );
            $q->param( repr_mep_url => knechtcall_getmep_url($mep) );

            # setup for LOOPs in HTML-template
            my $mep_persdata = knechtcall_getmep_persdata( $mep );
            $form_tmpl->param( persdata => $mep_persdata );

            my $mep_committees = knechtcall_getmep_komit( $mep );
            $form_tmpl->param( committees => $mep_committees );

            my $mep_remarks = knechtcall_getmep_remarks( $mep );
            $form_tmpl->param( remarks => $mep_remarks );

            #$# Delegations not yet implemented because definitions of Deleg.-Codes not found & topics seem irrelevant

            #$# Get raw data for TEST display in last form field
            ####$q->param( repr_mep_info => knechtcall_getmeptext($mep) );
            ###my $meptextraw = knechtcall_getmeptext($mep);
            ###logsay "[$id] [showf()] [repr clause]  [$meptextraw]";
        };
        /^reprovr$/    and do
        {
            # list all MEPS, one per line, as link to detail form
            # Extract mep nicknames from CGI param list
            my @meps = map { /^repr_mep_([^_]+)_replvl$/ }  $q->param;
            # generate array of hashes for TMPL_LOOP in the HTML-Template
            my @meploopdata;
            foreach my $mep (@meps)  {  push @meploopdata, { mepnick => $mep, mepname => knechtcall_getmepname($mep) }  }
            # print ERRFILE "[$id] [repr CASE] meploopdata:\n",Dumper(\@meploopdata),"\n";
            $form_tmpl->param( meploop => \@meploopdata );           # list of mep nicknames for switching between several persons
        };
        /^reprquery$|^mepqsquery$/    and do
        {
            # put together the result data for HTML_LOOP hitlist
            #$# ONLY DO THIS WHEN RESULTS ARE THERE
            ###my $rawtext = knechtcall_getmepstext();
            ###$form_tmpl->param( rawres => $rawtext );
            if( $q->param('formreused') )
            {
                my $aref = knechtcall_getmepsquery();
                ($#{@$aref} == -1)   and     $form_tmpl->param( emptyresult => 1 );
                $form_tmpl->param( results => $aref );
            }
            else
            {
                $q->param( formreused => 1 );    # clear flag after initial form disp
            }
        };
#        /^mepqsovr$/    and do
#        {
#            # list all MEPS, one per line, as link to detail form
#            # Extract mep nicknames from CGI param (using name of first text field)
#            my @meps = map { /^mepqs0405_([^_]+)_m45q1a$/ }  $q->param;
#            # generate array of hashes for TMPL_LOOP in the HTML-Template
#            my @meploopdata;
#            foreach my $mep (@meps)  {  push @meploopdata, { mepnick => $mep, mepname => knechtcall_getmepname($mep) }  }
#            # print ERRFILE "[$id] [repr CASE] meploopdata:\n",Dumper(\@meploopdata),"\n";
#            $form_tmpl->param( meploop => \@meploopdata );           # list of mep nicknames for switching between several persons
#        };


        /^mepqsovr$/    and do
        {
            # list all MEPS, one per line, as link to detail form
            # Extract mep nicknames from CGI param (using name of first mandatory field)
            my %meps = map{ $_, 1 }  map{ /^mepqs0405_([^_]+)_m45qcdate$/ }  $q->param;
                #my @a = $q->param;
                #logsay "[$id] [mepqs CASE] a:%s\n",Dumper(\@a);
                #logsay "[$id] [mepqs CASE] mepshash:%s\n",Dumper(\%meps);
            # Filter out all records that are marked "removed"
            my @removedmeps = map{ /^mepqs0405_([^_]+)_removed$/ }   grep{ $q->param($_) !=0 }   grep { /^mepqs0405_[^_]+_removed$/ }  $q->param;
                #logsay "[$id] [mepqs CASE] removedmeps:%s\n",Dumper(\@removedmeps);
            delete @meps{ @removedmeps };       # delete elements from hash (hash slice!)
            my @meps = keys %meps;
            
            # generate array of hashes for TMPL_LOOP in the HTML-Template
            my @meploopdata;
            foreach my $mep (@meps)  {  push @meploopdata, { mepnick => $mep, mepname => knechtcall_getmepname($mep) }  }
            # logsay "[$id] [mepqs CASE] meploopdata:%s\n",Dumper(\@meploopdata),"\n";
            $form_tmpl->param( meploop => \@meploopdata );           # list of mep nicknames for switching between several persons
            
            $q->param( mepnick => '' );     # avoid filling in the Input field
        };



        /^mepqs0405$/    and do
        {
            # Extract mep nicknames from CGI param (using name of first text field)
            my @meps = map { /^mepqs0405_([^_]+)_m45qcdate$/ }  $q->param;
            
            # redisplay of form (hidden var should be renamed to 'mep') or MEP selected over the URL (CGI-param mep) -- else use first one from list
            my $mep = $q->param('mepnick')  ||  $q->param('mep')  ||  $meps[0];

            $q->param( mepnick => $mep );      # this is all we need to generate the param names (see below)!

            $q->param( mep_nom => knechtcall_getmepname($mep) );
            $q->param( mep_url => knechtcall_getmep_url($mep) );

            # setup for LOOPs in HTML-template
            my $mep_persdata = knechtcall_getmep_persdata( $mep );
            $form_tmpl->param( persdata => $mep_persdata );

            my $mep_committees = knechtcall_getmep_komit( $mep );
            $form_tmpl->param( committees => $mep_committees );
        };
        
        
        
        /^selsubs$/    and do
        {
            # Prepare dropdown menu for email addr selection used for maillists
            my %emailaddresses;
            foreach( $q->param )
            {   # iterate over all CGI param names, process only email-addresses
                next   unless /^email_([^_]+)$/;
                my $addr = $q->param($_);
                $emailaddresses{ $addr } = $addr;      # exa: $emailaddresses{ggduckcu@duck.com} = "ggduckcu@duck.com";
                # Yes, keys and values are identical in this hash!! This is the input for htmlEmailSelector
                # ...and duplicate email addresses are automatically displayed only once thanks to this!
            }
            ###print ERRFILE "[$id] [selsubs CASE] emailaddresses hash:\n",Dumper(\%emailaddresses),"\n\n";
            ###print ERRFILE "[$id] [selsubs CASE] email_subs: ",$q->param('email_subs'),"\n";

            # Inject HTML-code for dropdown menu (email address selection) into form
            $form_tmpl->param( emailSelector => htmlEmailSelector('email4lists', \%emailaddresses, $q->param('email_subs')) );
            # only one email address?
            ( scalar keys %emailaddresses == 1 )  and  $form_tmpl->param( emailJustOne => (values %emailaddresses)[0] );
        };

    }   # EOF SWITCH BLOCK


    if( not $errs->[0] )
    {
        # NO ERRORS WHERE SUBMITTED FOR DISPLAY IN FORM

        # STUFF SUCH AS DATA CONVERSION & PRESETTING DERIVED PARAMS GOES HERE
        # [This block executes only once, upon initial display - NOT when form is redisplayed due to errors]
        # Select rules by the submitting form's name
        ### for( my $tmp = $cmode_mw ) ### doesn't work
        for( $cmode_mw )
        {
        ### /^address$/     and do {  last; };
            /^amount$/       and do
            {
                # create presets for some input fields
                $q->param( persist_warnedonce_pstval => '0' );
                last;
            };
            /^pay$/       and do
            {
                # create presets for some input fields
                $q->param( konto_inh => $q->param('pnom_pnom') );
                #$# STRANGE: the follwoing 2 fields aren't preset anymore, though code looks OK - -debug!
                $q->param( pag_rate => $q->param('pag_pagsum') );
                $q->param( pag_rate2 => $q->param('pag_pagsum') );
                $q->param( pag_pagmon2 => $q->param('pag_pagmon') );
                $q->param( persist_warnedonce_pstval => '0' );
                ### logsay "[$id] showf payparam init   \$q--------\n%s----------------", Dumper(scalar $q->Vars);
                last;
            };
            /^paychange$/       and do
            {
                # create presets for some input fields
                $q->param( konto_inh => $q->param('pnom_pnom') );
                $q->param( pag_rate => $q->param('pag_pagsum') );
                $q->param( pag_rate2 => $q->param('pag_pagsum') );
                $q->param( pag_pagmon2 => $q->param('pag_pagmon') );
                $q->param( persist_warnedonce_pstval => '0' );
                ### logsay "[$id] showf payparam init   \$q--------\n%s----------------", Dumper(scalar $q->Vars);
                last;
            };
            /^confirm/    and do {  $q->param('newid' => $q->param('id') );  last; };      # init newid INPUT field
            /^epat$/    and do
            {
                # Copy variables for patent number patno into GENERIC name-set for HTML form
                my $patno = $q->param('epat_patno');
                #$# make these lines a one-liner!:
                $q->param( epat_tech => $q->param( 'epat_'.$patno.'_tech' ) );
                $q->param( epat_deal => $q->param( 'epat_'.$patno.'_deal' ) );
                $q->param( epat_clms => $q->param( 'epat_'.$patno.'_clms' ) );
                $q->param( epat_iclm => $q->param( 'epat_'.$patno.'_iclm' ) );
                $q->param( epat_dclm => $q->param( 'epat_'.$patno.'_dclm' ) );
                $q->param( epat_clm1 => $q->param( 'epat_'.$patno.'_clm1' ) );
                $q->param( epat_prog => $q->param( 'epat_'.$patno.'_prog' ) );
                $q->param( epat_epatrem  => $q->param( 'epat_'.$patno.'_epatrem'  ) );
                ## print ERRFILE "[$id] [epat CASE2] qCGI:\n",Dumper(scalar $q->Vars),"\n";
                last;
            };
            /^repr$/    and do
            {
                # Copy variables for MEP mepnick into GENERIC name-set for HTML form
                # E.g.  repr_mep_jleinen_replvl --> repr_mep_replvl
                my $mep = $q->param('repr_mep_mepnick');
                # REMOVE $mep from param name
                #$# make these lines a one-liner!:
                $q->param( repr_mep_replvl  => $q->param( 'repr_mep_'.$mep.'_replvl' ) );
                $q->param( repr_mep_reprem  => $q->param( 'repr_mep_'.$mep.'_reprem' ) );
                ## print ERRFILE "[$id] [repr CASE2] qCGI:\n",Dumper(scalar $q->Vars),"\n";
                last;
            };
            /^mepqs0405$/    and do
            {
                # Copy variables for MEP mepnick into GENERIC name-set for HTML form
                my $mep = $q->param('mepnick');
                my @params = grep {/^mepqs0405_(?:$mep)_/}  $q->param;
                ###logsay "[$id] [mepqs0405_1] mepnick:$mep   params:%s\n",Dumper(\@params);
                # All params: E.g.  mepqs0405_jleinen_m45q1a --> mepqs0405_m45q1a
                # REMOVE $mep from param name
                foreach my $prm (@params)  {  (my $prmcut=$prm) =~ s/_[^_]+_/_/;   $q->param( $prmcut => $q->param($prm) )  };
                ###logsay "[$id] [mepqs0405_2]   CGIarr:\n%s",Dumper(scalar $q->Vars);
                last;
            };
        }   # EOF SWITCH BLOCK
    }
    else
    {   # ERROR MESSAGES WERE SUBMITTED
        # put the error message(s) into the template
        $form_tmpl->param( err_messages => $errs );
    }

    # Set up for fillinform
    $q->param( 'm' =>  $nextmode );     # current form will submit that mode
    $q->param( 'ma' =>  $altmode );     # current form will submit that mode if alternate branch selected
    $q->param( 'p' =>  $cmode_mw );         # current form runs under that mode

    # USE CGI-OBJECT TO INIT ALL TEMPLATE PARAMS FOUND IN TEMPLATE
    my @tmpl_param_names = $form_tmpl->param();
    ### logsay "[$id] [showf()]    SETTING tmpl_param_names:%s", Dumper(\@tmpl_param_names);
    foreach my $pname ( @tmpl_param_names )
    {
        # Info: err_messages is never put into $q
        if( defined($q->param($pname)) )
        {
            ## logsay "[$id] [showf()]    SETTING tmpl-param:$_  =>  q->param:",$q->param($_),"  DUMPER_qparam:",Dumper($q->param($_)),"  Du_value:",Dumper($value),"\n";
            $form_tmpl->param( $pname => $q->param( $pname ) );        #$# should use map instead of loop...
        }
    }

    ###logsay "[$id] ---------CGI Vars before xfer to INPUT fields--------\n". Dumper(\%{$q->Vars}) ."---------------\n";

    #$# IMPROVE EFFICIENCY: FOLLOWING CODE IS NOT ALWAYS REQUIRED
    #      COULD BE CONDITIONALLY RUN BY MEANS OF A FLAG param given to showf()

    ### logsay "[$id] [showf22] ---------CGI Vars--------\n%s---------------", Dumper(\%{$q->Vars});

    if( $fill_in_form == 1 )
    {
        # USE CGI-OBJECT TO INIT or RE-ENTER ALL INPUT and HIDDEN fields (using data from the CGI object)
        my $fif = new HTML::FillInForm;
        my $filledform =
            $fif->fill( scalarref => \$form_tmpl->output,               # HTML string with some INPUT fields
                        fobject => $q,                                  # CGI object holding the CGI-params
                      );
        # BRING UP THE FORM
        print $filledform;
    }
    elsif( $fill_in_form == 2 )
    {   # INIT just the standard HIDDEN fields
        my $tmphashref = {  'id' => $q->param('id'), 'sid' => $q->param('sid'), 'l' => $q->param('l'),
                            'm' => $nextmode, 'ma' => $altmode, 'p' =>  $cmode_mw,
                         };
        my $fif = new HTML::FillInForm;
        my $filledform =
            $fif->fill( scalarref => \$form_tmpl->output,               # HTML string with some INPUT fields
                        fdat => $tmphashref,
                      );
        print $filledform;
    }
    else
    {   # SIMPLE DISPLAY W/O FILL-IN
        print $form_tmpl->output;
    }
    logsay "[$id] [showf()]    EXITING";

    return;
}











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

# GENERIC VALIDATOR ROUTINE

sub validate()
{
    # Returns ref to array of strings (with err messages) in case of error

    my $formname = shift;

    # ------ VALIDATE THE FORM ---------
    my $cgi_hashref = $q->Vars;

    ### The UTF-8 hack is removed - Perl 5.8.3
    #$# <<<<<<<<<<< UTF-8 temporary hack (code outside of this unchanged!) <<<<<<<<<<<<<<<<<<<<<
#    my %cgihash = %$cgi_hashref;     # create copy of hash to work on - dont wanna modifiy the cgi hash!
#    utf2iso( \%cgihash );
#    # overwrite ref
#    $cgi_hashref = \%cgihash;
    #$# <<<<<<<<<<< EOF UTF-8 temporary hack <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

    my ($err_messages, $valid_fields, $missing_fields, $invalid_fields) = validate_params( $formname, $cgi_hashref );
    #   ARRAY          HASH           ARRAY            ARRAY
    # ----------------------------------

    #$# <<<<<<<<<<< UTF-8 temporary hack (code outside of this unchanged!) <<<<<<<<<<<<<<<<<<<<<
#    iso2utf( $valid_fields );    # modifies the hash in place
    #$# <<<<<<<<<<< EOF UTF-8 temporary hack <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


    if($DEBUG>=2)
    {
        logsay "[$id] --------- \$valid_fields in sub --------\n".Dumper($valid_fields)."----------------\n";
        logsay "[$id] --------- \$invalid_fields in sub ----------\n".Dumper($invalid_fields)."----------------\n";
        logsay "[$id] --------- \$missing_fields in sub ----------\n".Dumper($missing_fields)."----------------\n";
    }

# We cancelled doing the following to enforce validation of ALL params
# You now HAVE TO use the @valid_fields to get at params!
#    # Write the validated & cleaned-up params into the CGI object
#    # [required for possible re-display of form for correction]
#    foreach( keys %$valid_fields )  {
#        # iterate over array of the Template's param names
#        $q->param( $_, $valid_fields->{$_} );
#    }

    return ($valid_fields, $err_messages);
}





sub validate_params()
{
    # VALIDATE FORM PARAMS

    my $formname = shift;           # name of form (for lookup in the validation hash)
    my $cgi_vars = shift;           # get ref to hash delivered by $q->Vars

    # These are initialized in the BEGIN section:
    my $validationHashRef;
    my %errmsg_lookup;

    my $validator = new Data::FormValidator( $validationHashRef );

    ### logsay "[$id] --------- cgi_vars before calling validator--------\n".Dumper($cgi_vars)."----------------\n";

    # ----------- CALL TO PARAM VALIDATOR --------------
    #   FYI: Hash referenced by $cgi_vars is NOT modified by the following validator method!
    my( $valids, $missings, $invalids) = $validator->validate( $cgi_vars, $formname );

    ### logsay "[$id] --------- valids after calling validator--------".Dumper($valids)."----------------\n";

    # Any missing or invalid fields? Build array of error messages
    my @errors;
    if ($missings->[0] or $invalids->[0]) {
        foreach my $field (@$missings, @$invalids)
        {
            my $errmsg = $errmsg_lookup{$LANG_CODE_ERRMSGS}{$field};
            not $errmsg   and   $errmsg = $errmsg_lookup{'en'}{$field};     # Fallback to lang EN
            $errmsg =~ s/(\$\w+)/$1/gee;        # interpolate any variables
            not $errmsg   and   $errmsg = "Verification for field \"$field\" failed (there is no specific error message defined for this case - please turn to $FFII_OFFICE_MAIL if you think that your entry is valid)";
            push @errors, $errmsg;
        }
    }

    # ANY ADDITIONAL CUSTOM CHECKS NOT COVERED BY THE VALIDATOR MODULE GO HERE
    # [CURRENTLY UNUSED]

    # [Example]
    # Alternative to Data::FormValidator's built in constraint mechanism
    #   unless ($cgi_vars->{fav_language} =~ m/Perl/i) {
    #       push @errors, $errmsg_lookup{$LANG_CODE_ERRMSGS}{fav_language}
    #   }

    # CUSTOM CHECKS THAT ONLY TAKE PLACE WHEN ALL FIELDS WERE VALIDATED OK (*NO* INVALID FIELDS FOUND)
    # PARAM-CONVERSIONS + RENAMING ALSO GOES HERE
    if ( not ($missings->[0] or $invalids->[0]) )
    {
        # STUFF SUCH AS FORM-SPECIFIC "BUSINESS RULES" GOES HERE

        # Select rules by the submitting form's name
        ### for( my $tmp = $formname ) ### doesn't work!!!
        for( $formname )
        {
            ### /^address$/     and do {  last; };
            /^amount$/   and do
            {
                my $annual_rate = $valids->{annual_rate};      # annual rate with assumed interval == 12 months
                # ONE-TIME WARNING (WILL NOT BE REPEATED)
                if ( !$valids->{persist_warnedonce_pstval} and ($annual_rate < $MEMBER_FEE_MIN) )
                {
                    $valids->{persist_warnedonce_pstval}++;      # this modifies the caller's $q->param!
                    #$# next 3 lines should be hidden in a sub!
                    my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{pag_too_low};
                    $text =~ s/(\$\w+)/$1/gee;                  # interpolate variables found in string
                    push @errors, $text;
                }
                last;
            };
            /^pay$/   and do
            {
                # custom check for pag_rate (periodical payment)
                # pag_pagmon is already validated --> non-zero
                my $annual_rate = $valids->{pag_rate}*12/$valids->{pag_pagmon};
                my $interval = knechtcall_get1val('pag_pagmon');
                my $nrates = 0;
                ($interval > 0)  and  ($nrates = 12/$interval);
                my $previous_annual_rate = knechtcall_get1val('pag_pagsum')*$nrates;
                    logsay "[$id] In validate_params_payment:    annual_rate: $annual_rate    previous_annual_rate: $previous_annual_rate";

                # ONE-TIME WARNINGS (THEY WILL NOT BE REPEATED)
                if ( !$valids->{persist_warnedonce_pstval} and ($annual_rate < $MEMBER_FEE_MIN))
                {
                    $valids->{persist_warnedonce_pstval}++;      # this modifies the caller's $q->param!
                    my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{pag_too_low};
                    $text =~ s/(\$\w+)/$1/gee;                  # interpolate variables found in string
                    push @errors, $text;
                }
                # custom check for annual membership fee (ignores minor differences)
                if ( !$valids->{persist_warnedonce_pstval} and ($annual_rate - $previous_annual_rate) > 0.1 )
                {
                    $valids->{persist_warnedonce_pstval}++;      # this modifies the caller's $q->param!
                    my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{pag_pagsum_differs};
                    $text =~ s/(\$\w+)/$1/gee;                  # interpolate variables found in string
                    push @errors, $text;
                }
                last;
            };
            /^paychange$/   and do
            {
                # custom check for pag_rate (periodical payment)
                # pag_pagmon is already validated --> non-zero
                my $annual_rate = $valids->{pag_rate}*12/$valids->{pag_pagmon};
                my $interval = knechtcall_get1val('pag_pagmon');
                my $nrates = 0;
                ($interval > 0)  and  ($nrates = 12/$interval);
                my $previous_annual_rate = knechtcall_get1val('pag_pagsum')*$nrates;
                    logsay "[$id] In validate_params_payment:    annual_rate: $annual_rate    previous_annual_rate: $previous_annual_rate";

                # ONE-TIME WARNINGS (THEY WILL NOT BE REPEATED)
                if ( !$valids->{persist_warnedonce_pstval} and ($annual_rate < $MEMBER_FEE_MIN))
                {
                    $valids->{persist_warnedonce_pstval}++;      # this modifies the caller's $q->param!
                    my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{pag_too_low};
                    $text =~ s/(\$\w+)/$1/gee;                  # interpolate variables found in string
                    push @errors, $text;
                }
                # custom check for annual membership fee (ignores minor differences)
                if ( !$valids->{persist_warnedonce_pstval} and ($annual_rate - $previous_annual_rate) > 0.1 )
                {
                    $valids->{persist_warnedonce_pstval}++;      # this modifies the caller's $q->param!
                    my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{pag_pagsum_differs};
                    $text =~ s/(\$\w+)/$1/gee;                  # interpolate variables found in string
                    push @errors, $text;
                }
                last;
            };
            /^confirm$/   and do
            {
                # Test for collision with existing user id (ask the knecht)
                if( $valids->{'id'} ne $valids->{'newid'}   and  newID_is_rejected( $valids->{'newid'} ) )
                {
                    logsay "[$id] CASE confirm:    valids(id):%s   valids(newid):%s", $valids->{'id'}, $valids->{'newid'};

                    my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{newid_collides};
                    $text =~ s/(\$\w+)/$1/gee;                  # interpolate variables found in string
                    push @errors, $text;
                }
                # Make sure that both entries for new pw are equal
                if( $valids->{'newpw'} ne $valids->{'newpw2'} )
                {
                    my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{newpw_differ};
                    $text =~ s/(\$\w+)/$1/gee;                  # interpolate variables found in string
                    push @errors, $text;
                }
                elsif( set_password( $q->param('newpw'), 0 ) != 0 )
                {   # pw rejected
                    my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{newpw_insecure};
                    $text =~ s/(\$\w+)/$1/gee;                  # interpolate variables found in string
                    push @errors, $text;
                }
            };
            /^chgpw$/   and do
            {
                # Make sure that both entries for new pw are equal
                if( $valids->{'newpw'} ne $valids->{'newpw2'} )
                {
                    my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{newpw_differ};
                    push @errors, $text;
                    $valids->{'newpw'} = $valids->{'newpw2'} = "";   # clear to avoid xfer for redisplay
                }
                elsif( set_password( $q->param('newpw'), 0 ) != 0 )
                {   # pw rejected
                    my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{newpw_insecure};
                    $text =~ s/(\$\w+)/$1/gee;                  # interpolate variables found in string
                    push @errors, $text;
                    $valids->{'newpw'} = $valids->{'newpw2'} = "";   # clear to avoid xfer for redisplay
                }
            };
            /^forgot$/   and do
            {
#$#              Consider frustrating id-guessing robots
                # Check if ID or EMAIL was given
                my $id_from_email;
                if( $valids->{'id'} )
                {   # ID given -- check it and also retrieve email addr
                    my $retval = knechtcall_checkID( $valids->{'id'} );
                    logsay "[$id] CASE forgot:    retval:%s", $retval;
                    if( $retval != 37 )
                    {   # ID doesn't exist (37 means that user ID is taken ("kennung ist vergeben"))
                        my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{pwforg_id_nonexist};
                        $text =~ s/(\$\w+)/$1/gee;                  # interpolate variables found in string
                        push @errors, $text;
                    }
                    else    # ID is good -- get email
                    {
#$#Temp Error-fix - has now been removed due to new email_split/joins subs!
###$q->param(email => '');
                        retrieve_userdata_from_profile();           # we really just want the email addr
                        $valids->{'email_norm'} = $q->param('email_norm');    # return email as if entered by user
                        if( not $valids->{'email_norm'} )
                        {
                            my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{pwforg_email_missing};
                            $text =~ s/(\$\w+)/$1/gee;        # interpolate variables found in string
                            push @errors, $text;
                        }
                    }
                }
                elsif( $valids->{'email_norm'} )
                {
                    if( not ($id_from_email = knechtcall_mail2id($valids->{'email_norm'}) ) )
                    {
                        # email addr not registered in Knecht-DB
                        my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{pwforg_email_unknown};
                        $text =~ s/(\$\w+)/$1/gee;                  # interpolate variables found in string
                        push @errors, $text;
                    }
                    else    # email found and ID retrieved ok
                    {
                        $valids->{'id'} = $id_from_email;       # return ID as if entered by user
                    }
                }
                else
                {
                    # Message to user that either email or ID must be given!
                    my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{pwforg_no_data};
                    $text =~ s/(\$\w+)/$1/gee;                  # interpolate variables found in string
                    push @errors, $text;
                }
            };
            /^epat$/   and do
            {
                my $patno = $valids->{'epat_patno'};
                delete $valids->{'epat_patno'};       # not needed anymore - not to be stored in profile

                # copy all epat_* --> epat_ep123456_*
                foreach ( keys %$valids )
                {
                    next unless /^epat(_\w+)$/;         # skip non-epat variables
###logsay "::::::::::::: valids_index:$_ ",$valids->{$_},"\n";
                    $valids->{ 'epat_'.$patno.$1 } = $valids->{$_};
                    delete $valids->{$_};               # remove generic epat_* from hash
                }
###print ERRFILE "[$id] [epat validation] valids:\n",Dumper($valids),"\n";

            };
            /^repr$/   and do
            {
                my $mep = $valids->{'repr_mep_mepnick'};
                delete $valids->{'repr_mep_mepnick'};       # not needed anymore - not to be stored in profile
                delete $valids->{'repr_mep_info'};       # not needed anymore - not to be stored in profile

                # copy all repr_mep_* --> repr_mep_ep123456_*
                foreach ( keys %$valids )
                {
                    next unless /^repr_mep(_[^_]+)/;         # skip non-repr variables
                    $valids->{ 'repr_mep_'.$mep.$1 } = $valids->{$_};
                    delete $valids->{$_};               # remove generic repr_mep_* from hash
                }

            };
            /^reprquery$/   and do
            {
                ####my $mep = $valids->{'repr_mep_mepnick'};
            };
            /^mepqs0405$/   and do
            {
                my $mep = $valids->{'mepnick'};
                delete $valids->{'mepnick'};       # not needed anymore - not to be stored in profile

                # Convert names for Knecht e.g.: mepqs0405_m45q1a --> mepqs0405_jleinen_m45q1a
                foreach ( keys %$valids )
                {
                    next unless /^mepqs0405_([^_]+)/;         # skip non-mepqs0405 variables
                    $valids->{ 'mepqs0405_'.$mep.'_'.$1 } = $valids->{$_};
                    delete $valids->{$_};               # remove generic mepqs0405_* from hash
                }
            };
            /^selsubs$/   and do
            {
                # DISABLED AGAIN PER PHMs REQUEST: Detection of changes concerning subscriptions (mail-lists)
                # Load CURRENTLY stored subscription status and email addresses into CGI hash
                ### retrieve_subs_data_from_profile();  # Only required for change-detection

                my $nothing_currently_subscribed = 1;   # init flag
                foreach my $pname ( keys %$valids )               # Iterate thru REQUESTED subs statuses
                {
                    next unless $pname =~ /^subs_([^_]+)_sublvl$/;         # skip variables unlike "subs_*_sublvl"
                    # Flag is reset as soon as at least one subscription is active...
                    $nothing_currently_subscribed = 0   if( $valids->{$pname} != 0 );
    ###printf $ERRFILE "[$id] [validate_params()selsubs]  \$pname:%s  v(_):%s  q(_):%s\n", $pname,$valids->{$pname},$q->param($pname);
    ###logsay "[$id] [validate_params()selsubs]  nothing_currently_subscribed:$nothing_currently_subscribed\n";

                    if( $valids->{$pname} == -1 )
                    {   # -1 means  no action selected
                        delete $valids->{$pname};       # remove no-action status (not to be stored by backend)
                    }
                    else
                    {   # user has requested subscribe/unsubscribe action
                        # Change-detection removed per phm's request -- always pass-on
                        ### if(  ($valids->{$pname} != $q->param($pname))  or  not defined($q->param($pname))  )     # $pname e.g. "subs_swpat_sublvl"
                        if( 1 )
                        {
                            # ----> set knechts immediate_execution_flag "faru"
                            my $ixparamname = 'subs_'.$1.'_faru';            # e.g. $1=="swpat"
                            knechtcall_putvals( { $ixparamname => 1 } );    # e.g. subs_swpat_faru
                            ### logsay "[$id] [validate_params()selsubs]  Setting immediate-exec-flag:$ixparamname\n";
                        }
                    }
                }

                retrieve_all_emailaddresses_from_profile();
                if( $valids->{'email4lists'}  and  $valids->{'email4lists'} ne $q->param('email_subs') )
                {   # User requested a change of email_for_subscription_use
                    if( $nothing_currently_subscribed )
                    {   # change is permitted -- all subs are indeed OFF!
                        # Save bound email address before overwriting (want it to stay in the dropdown menu)
                        $valids->{'email_list01'} = $q->param('email_subs')    unless exists $valids->{'email_list01'};
                        $valids->{'email_subs'} = $valids->{'email4lists'};
                    }
                    else
                    {   # show error - user must unsubscribe everything
                        my $text = $errmsg_lookup{$LANG_CODE_ERRMSGS}{'selsubs_emailchange_subs_off'};
                        $text =~ s/(\$\w+)/$1/gee;                  # interpolate variables found in string
                        push @errors, $text;
                    }
                }
            };


        }   # EOF SWITCH BLOCK
        logsay "[$id] --------- valids at EOF validate() --------\n".Dumper($valids)."----------------";
    }

    logsay "[$id] [validate_params()]  Returning with [%s] errors", ($#errors)+1;

    # Put error msgs into an array of hash refs for HTML::Template
    # [Q: Why not keep it a simple array?   A: Because HTML::Template's LOOP mechanism wants it that way!]
    my $tmpl_errs = [];
    foreach my $err (@errors)
    {
       push @$tmpl_errs, { errors => $err }
    }

    return ($tmpl_errs, $valids, $missings, $invalids);


    # - - - - - - - - - - Validation Configuration Data follows - - - - - - - - - -

    BEGIN
    {
      $validationHashRef =
      {
        login    => {
            required => [qw/id pass/],
            constraints => {
                id    => '/^[a-z]{3,12}$/',
                pass  => '/^[\w]{5,12}$/',
            },
        },
        newusr    => {
            required => [qw/pnom_pnom email_norm/],
            optional => [qw/signuptype grev_1_grevpag euparl_checked/],
            constraints => {
                #$# this check should really be more relaxed - is .{4,99} too dangerous???
                pnom_pnom   => '/^[^$|#!~]{4,99}$/',
                email_norm  => 'email',
                signuptype  => '/^[ A-Za-z0-9_,\.\-\(\)\/]{1,30}$/',
                ### grev_1_grevpag => '/^((http:\/\/)?([\w-.~]{2,}\.)?[\w-.]{2,}\.[a-zA-Z]{2,5}(:\d{2,4})?([\/\w-.~#]{2,})?\s?)+$/',
                grev_1_grevpag => '/^[^<>|]{4,99}$/',
                euparl_checked  => '/^[ft]$/',
            },
                # trim leading and trailing whitespace from all the valid fields.
            filters     => ['trim'],
                # applied to all fields (pre-validation)
            field_filters => { email_norm => "lc", },
        },
        confirm    => {
            required => [qw/id newid newpw newpw2/],
            constraints => {
                newid => '/^[a-z]{5,8}$/',
                newpw  => '/^[\w]{5,12}$/',
#$# add a filter for newpw2 (do not use a constraint to avoid 2nd err msg)
            },
        },
        address    => {
            required => [qw/id pnom_pnom padr_norm_land padr_norm_plz padr_norm_urb padr_norm_str firma_norm_firmmem/],
            optional => [qw/firma_norm_firmnom href_norm_http teln_norm_tel/],
            dependency_groups  => {
                # none_or_all conditions (if one of those is entered, all must be)
                ##obsolete:## beitragfreiw_group => [qw/beitragfreiwill beitragfreiwchecked/],
            },
            constraints => {
                id => '/^[a-z]{3,8}$/',                 # min 5 / max 8 chars, no digits or special chars
                ### plz    => '/^(D-|A-|CH-)?\d{4,5}/',             # e.g. D-12345 or 12345 or 7505
                pnom_pnom    => '/^[^$|#!~]{4,99}$/',
                ### email_norm  => 'email',
                href_norm_http  => '/^[^<>|]{4,99}$/',
                teln_norm_tel   => '/[^$|#!~]{5,}/',                  # e.g. ( 089 ) 123 4567 or 089/1234567
                # ISO specifies 'GB' instead of UK!
##                padr_norm_land  => '/^(BE|DK|DE|GR|ES|FR|IE|IT|LU|NL|AT|PT|FI|SE|GB|CH)$/',
                padr_norm_land  => '/^[a-z]{2}$/',
##                padr_norm_plz   => '/^(D|A|CH)?[ -]?\w{4,5}$/',
                padr_norm_plz   => '/^[\w ]{3,12}$/',
                padr_norm_urb   => '/^[^$|#!~]{2,99}$/',
                padr_norm_str   => '/^[^$|#!~]{2,99}$/',
                firma_norm_firmnom  => '/^[^$|#!~]{2,99}$/',
                firma_norm_firmmem  => '/^[ft]$/',      # radiobutton
            },
                # trim leading and trailing whitespace from all the valid fields.
            filters     => ['trim'],
                # applied to all fields (pre-validation)
            field_filters => {
                # field-specific filters (pre-validation)
                padr_norm_land => 'lc',           # make it lower case
                ### teln_norm_tel => 'phone',
                ### firma_norm_firmnom  => 'firma_norm_fct',
                ## Example for calling a user def function filter_blz_custom():
                ## (function must be defined within this block)
                ## blz => 'blz_custom',
            },
        },
        status  => {
            required => [qw/id asoc_ffii_asolvl/],
            constraints => {
                id => '/^[a-z]{3,8}$/',                 # min 5 / max 8 chars, no digits or special chars
                asoc_ffii_asolvl        => '/\d/',
            },
        },
        amount    => {
            required => [qw/id annual_rate/],
            optional => [qw/persist_warnedonce_pstval/],
            constraints => {
                id => '/^[a-z]{3,8}$/',                 # min 5 / max 8 chars, no digits or special chars
                annual_rate     => '/^\d{1,9}([\.,]\d{1,2})?$|^[nN]ull$/',
            },
                # trim leading and trailing whitespace from all the valid fields.
            filters     => ['trim'],
                # applied to all fields (pre-validation)
            field_filters => {
                # field-specific filters (pre-validation)
                annual_rate => 'pag_fct',
                persist_warnedonce_pstval => 'digit',
            },
        },
        pay => {
            required => [qw/pag_pagtyp pag_pagbeg pag_pagmon pag_rate/],
#$###            required => [qw/pag_pagtyp pag_pagbeg pag_pagmon pag_rate pag_ini/],
            optional => [qw/konto_blz konto_bank konto_knr konto_inh persist_warnedonce_pstval/],
            dependencies => {
                pag_pagtyp => {
                    l   => [ qw/konto_blz konto_bank konto_knr konto_inh/ ],        # little 'L' for Lastschrift
                    ## d => [ qw// ],                                               # dauerauftrag
                },
            },
            constraints => {
                pag_rate    => '/^\d{1,9}([\.,]\d{1,2})?$|^[nN]ull$/',          # accepts any string-type endings such as EUR
                pag_pagmon   => '/^1|2|3|4|6|12$/',            # payment interval
                # FYI: Knecht returns pag_pagbeg WITH DASHES (e.g. 2002-11-03)!
                pag_pagbeg   => '/^\d{8}$/',                   # e.g. 20021103 for 3.Nov.2002
                pag_pagini   => '/^\d{8}$/',                   # e.g. 20021103 for 3.Nov.2002
##                konto_blz    => '/^\d{3}\s*\d{3}\s*\d{2}$/',    # e.g. 700 100 80 or 70010080
                konto_knr     => '/^[ 0-9,\.\-\(\)\/]{2,99}$/',
                konto_bank   => '/^[^$|#!~]{2,99}$/',
                konto_inh    => '/^[^$|#!~]{4,99}$/',
            },
                # trim leading and trailing whitespace from all the valid fields.
            filters     => ['trim'],
                # applied to all fields (pre-validation)
            field_filters => {
                # field-specific filters (pre-validation)
                konto_blz  => 'digit',                             #$# CHECK: Swiss+Austrian BLZ may contain chars?!!
                pag_rate => 'pag_fct',
                persist_warnedonce_pstval => 'digit',
                ## Example for calling a user def function filter_blz_custom():
                ## (function must be defined within this block)
                ## blz => 'blz_custom',
            },
        },
        paychange => {
            required => [qw/pag_pagtyp pag_pagmon pag_rate/],
            optional => [qw/konto_blz konto_bank konto_knr konto_inh persist_warnedonce_pstval/],
            dependencies => {
                pag_pagtyp => {
                    l   => [ qw/konto_blz konto_bank konto_knr konto_inh/ ],        # little 'L' for Lastschrift
                    ## d => [ qw// ],                                               # dauerauftrag
                },
            },
            constraints => {
                pag_rate    => '/^\d{1,9}([\.,]\d{1,2})?$|^[nN]ull$/',          # accepts any string-type endings such as EUR
                pag_pagmon   => '/^1|2|3|4|6|12$/',            # payment interval
                # FYI: Knecht returns pag_pagbeg WITH DASHES (e.g. 2002-11-03)!
##                konto_blz    => '/^\d{3}\s*\d{3}\s*\d{2}$/',    # e.g. 700 100 80 or 70010080
                konto_knr     => '/^[ 0-9,\.\-\(\)\/]{2,99}$/',
                konto_bank   => '/^[^$|#!~]{2,99}$/',
                konto_inh    => '/^[^$|#!~]{4,99}$/',
            },
                # trim leading and trailing whitespace from all the valid fields.
            filters     => ['trim'],
                # applied to all fields (pre-validation)
            field_filters => {
                # field-specific filters (pre-validation)
                konto_blz  => 'digit',                             #$# CHECK: Swiss+Austrian BLZ may contain chars?!!
                pag_rate => 'pag_fct',
                persist_warnedonce_pstval => 'digit',
                ## Example for calling a user def function filter_blz_custom():
                ## (function must be defined within this block)
                ## blz => 'blz_custom',
            },
        },
        eurolinux  => {
            required => [qw/id asoc_org/],
            constraints => {
                id => '/^[a-z]{3,8}$/',                 # min 5 / max 8 chars, no digits or special chars
                asoc_org        => '/^[a-z]{2,12}$/',
            },
        },

        chgpw    =>
        {
            required => [qw/newpw newpw2/],
            constraints => {
                newpw  => '/^[\w]{5,12}$/',
#$# add a filter for newpw2 (do not use a constraint to avoid 2nd err msg)
            },
        },
        forgot   =>
        {
            optional => [qw/id email_norm/],
            constraints => {
                id    => '/^[a-z]{3,12}$/',
                email_norm  => 'email',
            },
        },
        resign    =>
        {
            required => [qw/quitkey pass/],
            constraints => {
                quitkey  => '/^beenden$/i',
                pass     => '/^\w{5,12}$/',
                ### motivation     => '/^[.]{0,999}$/',    #$# not working - always produces err msg
            },
        },
        selsign    =>
        {
            required => [qw/id/],
            required_regexp => '/^sign/',
	    optional_regexp => '/^sign\_\w+\_sigrem$/',
            constraint_regexp_map => { '/^sign\_\w+\_siglvl$/' => '/\d/',  },
            constraints => {
                id    => '/^[a-z]{3,12}$/',
            },
        },
        selevent    =>
        {
            required => [qw/id/],
            required_regexp => '/^ven_/',
            constraint_regexp_map => { '/^ven_/' => '/\d/' },
            constraints => {
                id    => '/^[a-z]{3,12}$/',
            },
        },
        selsubs    =>
        {
            required => [qw/id/],
            optional => [qw/email4lists/],
            required_regexp => '/^subs_/',
            constraint_regexp_map => { '/^subs_/' => '/\d/' },
            constraints => {
                id    => '/^[a-z]{3,12}$/',
                email4lists  => 'email',
            },
        },
        selassoc    =>
        {
            required => [qw/id/],
            required_regexp => '/^memq/',
            constraint_regexp_map => { '/^memq/' => '/\d/' },
            constraints => {
                id    => '/^[a-z]{3,12}$/',
            },
        },

        epat    =>
        {
            required => [qw/id epat_patno/],
            optional => [qw/epat_tech epat_deal epat_clms epat_iclm/],
            optional_regexp => '/^epat_/',
            constraints     => {
                id    => '/^[a-z]{3,12}$/',
                epat_patno  => '/^[a-z0-9]{3,12}$/',
                epat_tech   => '/^-?\d+$/',
                epat_deal   => '/^\d+$/',
                epat_clms   => '/^\d+$/',
                epat_iclm   => '/^\d+$/',
                epat_dclm   => '/^[ft]$/',
                epat_clm1   => '/^[^~]{0,3000}$/',
                epat_prog   => '/^[^~]{0,3000}$/',
                epat_epatrem    => '/^[^~]{0,3000}$/',
            },
#            constraint_regexp_map     => {
#                # epat_pat    => '/^[a-z]{3,12}$/',
#                '/^epat_[^_]+_tech$/'   => '/^\d+$/',
#                '/^epat_[^_]+_clms$/'   => '/^\d+$/',
#                '/^epat_[^_]+_iclm$/'   => '/^\d+$/',
#                '/^epat_[^_]+_dclm$/'   => '/^[ft]$/',
#                '/^epat_[^_]+_clm1$/'   => '/^[^|~]{0,999}$/',
#                '/^epat_[^_]+_prog$/'   => '/^[^|~]{0,999}$/',
#                '/^epat_[^_]+_epatrem $/'   => '/^[^|~]{0,999}$/',
#            },
                # trim leading and trailing whitespace from all the valid fields.
            filters     => ['trim'],
            field_filters => {
                # field-specific filters (pre-validation)
                epat_clm1 => 'textarea_fct',
                epat_prog => 'textarea_fct',
                epat_epatrem  => 'textarea_fct',
            },

        },

        repr    =>
        {
            required => [qw/id repr_mep_mepnick repr_mep_replvl/],
            optional => [qw/repr_addrand/],
            optional_regexp => '/^repr_mep_/',
            constraints     => {
                id    => '/^[a-z]{3,12}$/',
                repr_mep_mepnick  => '/^[a-zA-Z0-9]{3,60}$/',
                repr_addrand    => '/^\d+$/',
                repr_mep_replvl    => '/^-?\d+$/',
                repr_mep_reprem   => '/^[^~]{0,3000}$/',
            },
                # trim leading and trailing whitespace from all the valid fields.
            filters     => ['trim'],
            field_filters => {
                # field-specific filters (pre-validation)
                repr_mep_clm1 => 'textarea_fct',
                repr_mep_prog => 'textarea_fct',
                repr_mep_reprem  => 'textarea_fct',
            },

        },

        reprquery  =>
        {
            required => [qw/id/],
            optional => [qw/pnompart plzpart land euprt komit/],
            optional_regexp => '/^repr_mep_/',
            constraints     => {
                id    => '/^[a-z]{3,12}$/',
                pnompart   => '/^[^$|#!~]{1,99}$/',
                plzpart    => '/^[\w ]{1,12}$/',
                # ISO specifies 'GB' instead of UK!
                land       => '/^(BE|DK|DE|GR|ES|FR|IE|IT|LU|NL|AT|PT|FI|SE|UK|CH)$/',
                euprt      => '/^[^$|#!~]{2,12}$/',
                komit      => '/^[^$|#!~]{2,12}$/',
            },
                # trim leading and trailing whitespace from all the valid fields.
            filters     => ['trim'],

        },

        mepqs0405   =>
        {
            #$# after installing latest form::validator try to remove all the explicits from next line and leave handling to a regex...
            required => [qw/id mepnick mepqs0405_m45qcdate mepqs0405_declined/],
            #$# required_regexp => '/^mepqs0405_....\d[a-k]$/',         # yes/abstain/no radiobuttons
            optional => [qw/mepqs0405_m45qsc mepqs0405_m45qt/],         # qsc is the submitter's comment
            optional_regexp => '/^mepqs0405_....\dt$/',                 # MEP comment textfields
            dependencies   => {
                mepqs0405_declined => {
                    f => [ qw/mepqs0405_m45q1a mepqs0405_m45q1b mepqs0405_m45q2a mepqs0405_m45q2b mepqs0405_m45q3a mepqs0405_m45q3b mepqs0405_m45q4a mepqs0405_m45q4b/ ],
                    t => [ qw/mepqs0405_m45qsc/ ],    # require user comment if MEP declined to take part
                }
            },
            constraints     => {
                id    => '/^[a-z]{3,12}$/',
                mepnick  => '/^[a-zA-Z0-9]{3,60}$/',
                mepqs0405_m45qcdate => '/^[0-9.-]{6,10}$/',
                mepqs0405_declined  => '/^[ft]$/',
                mepqs0405_m45qsc    => '/^[^~]{0,3000}$/',
                mepqs0405_m45q1a    => '/^[+-o]$/',
                mepqs0405_m45q1b    => '/^[+-o]$/',
                mepqs0405_m45q1t    => '/^[^~]{0,3000}$/',
                mepqs0405_m45q2a    => '/^[+-o]$/',
                mepqs0405_m45q2b    => '/^[+-o]$/',
                mepqs0405_m45q2t    => '/^[^~]{0,3000}$/',
                mepqs0405_m45q3a    => '/^[+-o]$/',
                mepqs0405_m45q3b    => '/^[+-o]$/',
                mepqs0405_m45q3t    => '/^[^~]{0,3000}$/',
                mepqs0405_m45q4a    => '/^[+-o]$/',
                mepqs0405_m45q4b    => '/^[+-o]$/',
                mepqs0405_m45q4t    => '/^[^~]{0,3000}$/',
                mepqs0405_m45qt     => '/^[^~]{0,3000}$/',
            },
#            constraint_regexp_map     => {
#                '/^checkboxfix_\d*$/'    => '/^[^|~]{0,250}$/',
#            },
                # trim leading and trailing whitespace from all the valid fields.
            filters     => ['trim'],
            field_filters => {
                # field-specific filters (pre-validation)
                mepqs0405_m45q1t  => 'textarea_fct',
                mepqs0405_m45q2t  => 'textarea_fct',
                mepqs0405_m45q3t  => 'textarea_fct',
                mepqs0405_m45q4t  => 'textarea_fct',
                mepqs0405_m45qt   => 'textarea_fct',
            },

        },

        mepqsovr  =>
        {
            required => [qw/id mepnick/],
            constraints     => {
                id    => '/^[a-z]{3,12}$/',
                mepnick   => '/^[^$|#!~]{1,99}$/',
            },
            filters     => ['trim'],
        },

        mepqsquery  =>
        {
            required => [qw/id/],
            optional => [qw/pnompart plzpart land euprt komit formreused/],
            optional_regexp => '/^repr_mep_/',
            constraints     => {
                id    => '/^[a-z]{3,12}$/',
                formreused  => '/^[01]$/',
                pnompart   => '/^[^$|#!~]{1,99}$/',
                plzpart    => '/^[\w ]{1,12}$/',
                # ISO specifies 'GB' instead of UK!
                land       => '/^(BE|DK|DE|GR|ES|FR|IE|IT|LU|NL|AT|PT|FI|SE|UK|CH)$/',
                euprt      => '/^[^$|#!~]{2,12}$/',
                komit      => '/^[^$|#!~]{2,12}$/',
            },
                # trim leading and trailing whitespace from all the valid fields.
            filters     => ['trim'],

        },

        netstrike  =>
        {
            required => [qw/id/],
            ### optional => [qw//],
            optional_regexp => '/^grev_/',
            constraint_regexp_map     => {
                '/^grev_[^_]+_grevpag$/' => '/^[^<>|]{0,99}$/',
                '/^grev_[^_]+_kovrpag$/' => '/^[^<>|]{0,99}$/',
                '/^grev_[^_]+_grevrem$/' => '/^[^|~]{0,250}$/',
                '/^grev_[^_]+_g\d{6}$/'  => '/^[ft]$/',
            },
            constraints => {
                id    => '/^[a-z]{3,12}$/',
            },
        },
        projsel    =>
        {
            required => [qw/id/],
            optional => [qw/email4lists/],
            required_regexp => '/^projhlp_/',
            constraint_regexp_map => { '/^projhlp_/' => '/\d/' },
            constraints => {
                id    => '/^[a-z]{3,12}$/',
                email4lists  => 'email',
            },
        },

      };    # EOF VALIDATION HASH


    # define err messages for each form field
    #   (Do not use DOUBLEQUOTES for strings that contain $variables for interpolation at runtime!)
    %errmsg_lookup =
    (
        de =>
        {
#login
#$# ATTN the following needs to be interpolated "manually"!
id     =>  'Bitte pr&uuml;fen Sie Ihren Eintrag f&uuml;r die Nutzerkennung ($RULE_DESCR_ID_DE)',
pass   =>  "Ihr Passwort sollte 5-12 alphanumerische Zeichen (d.h. Klein/Grossbuchstaben, Ziffern, keine Umlaute) enthalten",
# newusr
pnom_pnom    =>  'Bitte tragen Sie Ihren vollst&auml;ndigen Namen so im vorgesehenen Feld ein, wie Sie von uns angesprochen werden wollen ($RULE_DESCR_ID_DE)',
email_norm       =>  'Bitte &uuml;berpr&uuml;fen Sie die angegebene E-Mail-Adresse',
# confirm
newid       =>  'Bitte pr&uuml;fen Sie Ihren Eintrag f&uuml;r die Nutzerkennung ($RULE_DESCR_ID_DE)',
newid_collides  =>  "Die gew&uuml;nschte Nutzerkennung ist bereits vergeben",
# address
firma_norm_firmnom   =>  'Unerlaubte Zeichen im Feld \'Organisation\'',
firma_norm_firmmem   =>  'Bitte w&auml;hlen Sie aus, ob Sie pers&ouml;nliches Mitglied oder Firmenmitglied werden wollen',
padr_norm_urb     =>  'Das Adressfeld \'Ort\' ist leer oder enth&auml;lt unerlaubte Zeichen',
padr_norm_str     =>  'Das Adressfeld \'Strasse\' ist leer oder enth&auml;lt unerlaubte Zeichen',
padr_norm_plz     =>  'Bitte &uuml;berpr&uuml;fen Sie die Postleitzahl im Feld PLZ',
padr_norm_land    =>  'Das Land in dem sich Ihr Wohnort befindet, geben Sie bitte als <A HREF="http://www.iso.ch/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1.html">ISO code</A> an. <BR>z.B.: AT=&ouml;sterreich, CH=Schweiz, DE=Deutschland',
teln_norm_tel         =>  'Bitte pr&uuml;fen Sie die angegebene Telefonnummer - ist sie vollst&auml;ndig?',
href_norm_http        =>  'Bitte &uuml;berpr&uuml;fen Sie die Adresse Ihrer Homepage',
# amount
annual_rate =>  'Bitte geben Sie den gew&uuml;nschten Mitgliedsbeitrag in Ziffern ein (Mindestbeitrag 12,78 EUR).',
# pay
konto_inh   =>  'Bitte tragen Sie den Namen des Kontoinhabers ein',
pag_pagtyp =>   'Die Zahlungsart wurde nicht ausgew&auml;hlt. Bitte w&auml;hlen Sie zwischen Einziehungsauftrag und Dauerauftrag.',
pag_rate    =>  'Bitte geben Sie die gew&uuml;nschte Rate f&uuml;r den Mitgliedsbeitrag in Ziffern ein',
pag_too_low =>  'Sie haben sich f&uuml;r einen Jahresbeitrag von $annual_rate EUR entschieden, der unter dem satzungsgem&auml;ssen Mitgliedsbeitrag liegt.<BR>Hiermit haben Sie nochmals Gelegenheit, Ihre Entscheidung zu &uuml;berdenken.',
pag_pagsum_differs =>  'Der berechnete Jahresbeitrag betr&auml;gt $annual_rate EUR.<BR>Bitte pr&uuml;fen Sie abschliessend nochmals Betrag und Zahlungsweise.',
pag_pagbeg =>  'Das erstmalige &uuml;berweisungs- bzw. Abbuchungsdatum wurde nicht ausgew&auml;hlt',
pag_pagmon =>  'Bitte w&auml;hlen Sie das &uuml;berweisungs- bzw. Abbuchungsintervall (Zahlung alle 1,2,3,4,6 oder 12 Monate)',
konto_blz   =>  'Bitte pr&uuml;fen Sie, ob die Bankleitzahl (BLZ) korrekt eingetragen wurde',
konto_bank  =>  'Bitte tragen Sie den Namen der kontof&uuml;hrenden Bank nach',
konto_knr    => 'Bitte &uuml;berpr&uuml;fen Sie Ihre Kontonummer',
persist_warnedonce_pstval  => '[intern] W-Flag falsch belegt. Bitte $FFII_OFFICE_MAIL informieren.',
####persist_warnedonce_pstval  => '[intern] W-Flag falsch belegt. Bitte wenden Sie sich an buero@ffii.org.',
# eurolinux
asoc_org    =>  '[intern] [asoc_org] falsch belegt',
# chgid
#newid           # see above
newid_same_as_oldid  =>  "Die angegebene Nutzerkennung ist bereits die Ihre",
# chgpw and confirm
newpw           =>  "Ihr Passwort sollte 5-12 alphanumerische Zeichen (d.h. Klein/Grossbuchstaben, Ziffern, keine Umlaute) enthalten",
newpw2          =>  "Ihr Passwort sollte 5-12 alphanumerische Zeichen (d.h. Klein/Grossbuchstaben, Ziffern, keine Umlaute) enthalten",
newpw_differ    =>  "Die beiden Felder f&uuml;r das neue Passwort enthalten unterschiedliche Eingaben",
newpw_insecure  =>  "Dieses Passwort wird nicht akzeptiert. Es sollte 5-12 alphanumerische Zeichen enthalten und nicht leicht zu erraten sein.",
# forgot
pwforg_id_nonexist => 'Diese Kennung existiert nicht',
pwforg_email_unknown => 'Unter Ihrer E-Mail-Adresse liegt uns keine Anmeldung vor - bitte wenden Sie sich an buero@ffii.org',
pwforg_email_missing => 'Zu Ihrer Kennung ist keine E-Mail-Adresse gespeichert - bitte wenden Sie sich an buero@ffii.org',
pwforg_no_data       => 'Bitte geben Sie entweder Ihre Kennung oder Ihre E-Mail-Adresse an, die sie bei der Ersteintragung angegeben haben',
# renewpw
#email          # see above
# resign
quitkey     =>  "Bitte geben Sie im Feld \'Aktion\' das Wort \'beenden\' ein, um zu best&auml;tigen, dass Sie Ihre Mitgliedschaft beenden und Ihre Nutzerkennung gel&ouml;scht werden soll.",
#pass           (siehe oben)
motivation  =>  "Die Nachricht enth&auml;lt unerlaubte Zeichen oder ist l&auml;nger als 999 Zeichen.",
# selsubs
email4lists =>  'Bitte &uuml;berpr&uuml;fen Sie die angegebene E-Mail-Adresse',
selsubs_emailchange_subs_off => 'Sie k&ouml;nnen Ihre E-Mail-Adresse nur &auml;ndern, wenn Sie sich zuvor von allen Verteilern abgemeldet haben.',
# epat
epat_patno => '[intern] [epat_patno] falsch belegt',
epat_tech =>  '[intern] [epat_tech] falsch belegt',
epat_deal =>  '[intern] [epat_deal] falsch belegt',
epat_clms =>  'Bitte &uuml;berpr&uuml;fen Sie die angegebene Gesamtzahl der Anspr&uuml;che',
epat_iclm =>  'Bitte &uuml;berpr&uuml;fen Sie die angegebene Zahl der unabh&auml;ngigen Anspr&uuml;che',
epat_dclm =>  'Bitte &uuml;berpr&uuml;fen Sie die angegebene E-Mail-Adresse',
epat_clm1 =>  'Bitte &uuml;berpr&uuml;fen Sie Ihre Eingaben unter "Wortlaut von Anspruch 1" (unerlaubte Zeichen?)',
epat_prog =>  'Bitte &uuml;berpr&uuml;fen Sie Ihre Eingaben unter "Beschreibung der Logik" (unerlaubte Zeichen?)',
epat_epatrem  =>  'Bitte &uuml;berpr&uuml;fen Sie Ihre Eingaben unter "Beschreibung in Worten" (unerlaubte Zeichen?)',
# repr
#                   TO BE DONE!
#
# reprquery
pnompart  =>  'Unerlaubte Zeichen im Namensbestandteil',
plzpart   =>  'Die Postleitzahl sollte nur alphanumerische Zeichen enthalten',
land      =>  "Unerwarteter Laendercode - bitte wenden Sie sich an buero\@ffii.org",
euprt     =>  "Unerwarteter Parteicode - bitte wenden Sie sich an buero\@ffii.org",
komit     =>  "Unerwarteter Kommissionscode - bitte wenden Sie sich an buero\@ffii.org",
# mepqs0405
mepqs0405_m45qcdate =>  'Bitte geben Sie das Datum des Gespr&auml;chs an',
mepqs0405_m45qsc    =>  'Bitte erl&auml;utern Sie, weshalb der MEP keine Angaben machen wollte (im Feld "Mein Kommentar")',
mepqs0405_m45q1a    =>  'Missing selection for item 1.1',
mepqs0405_m45q1b    =>  'Missing selection for item 1.2',
mepqs0405_m45q2a    =>  'Missing selection for item 2.1',
mepqs0405_m45q2b    =>  'Missing selection for item 2.2',
mepqs0405_m45q3a    =>  'Missing selection for item 3.1',
mepqs0405_m45q3b    =>  'Missing selection for item 3.2',
mepqs0405_m45q4a    =>  'Missing selection for item 4.1',
mepqs0405_m45q4b    =>  'Missing selection for item 4.2',
        },   # EOF 'DE' hash

        en =>
        {
#login
#$# ATTN the following needs to be interpolated "manually"!
id     =>  'Please check the record for your user ID ($RULE_DESCR_ID_EN)',
pass   =>  "Your password should consist of 5-12 alphanumeric symbols (i.e. letters in upper/lower case, digits, but no diacritics or umlauts)",

# newusr
pnom_pnom    =>  'Please enter you full name the same way you want to be addressed by us ($RULE_DESCR_ID_EN)',
email_norm       =>  'Please check the email address that you entered',
# confirm
newid       =>  'Please check your user ID entry ($RULE_DESCR_ID_EN)',
newid_collides  =>  "The desired user ID is already assigned",
# address
firma_norm_firmnom   =>  'Disallowed characters in \'Organization\' field',
firma_norm_firmmem   =>  'Please check whether you want to become individual or organizational (company, institution) member',
padr_norm_urb     =>  'The address field \'City/Location\' is still empty or contains disallowed characters',
padr_norm_str     =>  'The address field \'Street address\' is still empty or contains disallowed characters',
padr_norm_plz     =>  'Please check the ZIP in the field \'ZIP\'',
padr_norm_land    =>  'Please use 2-letter <A HREF="http://www.iso.ch/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1.html">ISO codes</A> to specify the country of residence, e.g.: <BR>GB=Great Britain, FR=France, IT=Italy, IE=Ireland, ...',
teln_norm_tel         =>  'Please check the telephone number - is it complete?',
href_norm_http        =>  'Please check the URL of your homepage',

# amount
annual_rate =>  'Please use digits to specify the desired membership contribution (minimal annual contribution: 12.78 EUR).',
# pay
konto_inh   =>  'Please specify the name of the account holder',
pag_pagtyp =>   'The mode of payment has not been specified. Please choose from direct debit or standing order / bank transfer.',
pag_rate    =>  'Please specify the desired installment in digits',
pag_too_low =>  'You have chosen an annual contribution of $annual_rate EUR that is below the minimum contribution for members (according to the association charter).<BR>Here you can reconsider this decision.',
pag_pagsum_differs =>  'The calculated annual contribution is $annual_rate EUR.<BR>Please check again the amount and mode of payment.',
pag_pagbeg =>  'An initial date for the first installment via bank transfer / direct debit has not yet been specified',
pag_pagmon =>  'Please choose the rate of installments (payment every 1,2,3,4,6 or 12 month)',
konto_blz   =>  'Please check whether the bank code has been entered correctly',
konto_bank  =>  'Please add here the name of bank that is managing the account',
konto_knr    => 'Please check your account number here',
#persist_warnedonce_pstval  => "[intern] W flag wrong. Please inform buero\@ffii.org.",
persist_warnedonce_pstval  => '[intern] W flag wrong. Please mail to buero@ffii.org.',
# eurolinux
asoc_org    =>  '[intern] [asoc_org] has bad value',
# chgid
#newid           # see above
newid_same_as_oldid  =>  "The specified new user ID is the same as the old ID",
# chgpw and confirm
newpw   =>  "Your password should consist of 5-12 alphanumeric symbols (i.e. letters in upper/lower case, digits, but no diacritics or umlauts)",
newpw2   =>  "Your password should consist of 5-12 alphanumeric symbols (i.e. letters in upper/lower case, digits, but no diacritics or umlauts)",
newpw_differ    =>  "Sorry, passwords do not match",
newpw_insecure  =>  "This password is not accepted. Your password should consist of 5-12 alphanumeric symbols and it should not be easy to guess.",
# forgot
pwforg_id_nonexist   => 'This user ID does not exist',
pwforg_email_unknown => "There is no user account using this email address - please contact buero\@ffii.org",
pwforg_email_missing => "For this user ID we do not have an email address on file - please contact buero\@ffii.org",
pwforg_no_data       => 'Please specifiy either your user ID or the email address that you used when you signed-up to our system',
# renewpw
#email          # see above
# resign
quitkey     =>  "In the field \'Action\' please type the word \'terminate\' to confirm that your membership is to be terminated and your user ID is to be deleted.",
#pass           (see above)
motivation  =>  "The message contains disallowed characters or is longer than 999 characters.",
# selsubs
email4lists =>  'Please check the email address specified',
selsubs_emailchange_subs_off => 'Please unsubsribe from all mailing lists before attempting to change your email address.',
# epat
epat_patno => '[intern] [epat_patno] wrong booking',
epat_tech =>  '[intern] [epat_tech] wrong booking',
epat_deal =>  '[intern] [epat_deal] wrong booking',
epat_clms =>  'Please check the specified total number of claims',
epat_iclm =>  'Please check the specified number of independent claims',
epat_dclm =>  'Please the specified email address',
epat_clm1 =>  'Please check your input at "Wording of claim 1" (disallowed characters?)',
epat_prog =>  'Please check your input at "Description of logic" (disallowed characters?)',
epat_epatrem  =>  'Please check your input at "Description in plain language" (disallowed characters?)',
# repr
#                   TO BE DONE!
#
# reprquery
pnompart  =>  'Disallowed characters in the \'name\' search string',
plzpart   =>  'The ZIP code should contain nothing but alpha-numeric characters',
land      =>  "Unexpected or new country code - please mail to buero\@ffii.org",
euprt     =>  "Unexpected party code - please mail to buero\@ffii.org",
komit     =>  "Unexpected commission code - please mail to buero\@ffii.org",
# mepqs0405
mepqs0405_m45qcdate =>  'Please enter the date of the interview',
mepqs0405_m45qsc    =>  'Please describe the MEP\'s reasons for declining to answer the questions (field "My Comment")',
mepqs0405_m45q1a    =>  'Missing selection for item 1.1',
mepqs0405_m45q1b    =>  'Missing selection for item 1.2',
mepqs0405_m45q2a    =>  'Missing selection for item 2.1',
mepqs0405_m45q2b    =>  'Missing selection for item 2.2',
mepqs0405_m45q3a    =>  'Missing selection for item 3.1',
mepqs0405_m45q3b    =>  'Missing selection for item 3.2',
mepqs0405_m45q4a    =>  'Missing selection for item 4.1',
mepqs0405_m45q4b    =>  'Missing selection for item 4.2',
        },   # EOF 'EN' hash

        fr =>
        {
#login
#$# ATTN the following needs to be interpolated "manually"!
id     =>  'Please check the record for your user ID ($RULE_DESCR_ID_EN)',
pass   =>  "Your password should consist of 5-12 alphanumeric symbols (i.e. letters in upper/lower case, digits, but no diacritics or umlauts)",

# newusr
pnom_pnom    =>  'Please enter you full name the same way you want to be addressed by us ($RULE_DESCR_ID_EN)',
email_norm       =>  'Please check the email address that you entered',
# confirm
newid       =>  'Please check your user ID entry ($RULE_DESCR_ID_EN)',
newid_collides  =>  "The desired user ID is already assigned",
# address
firma_norm_firmnom   =>  'Disallowed characters in \'Organization\' field',
firma_norm_firmmem   =>  'Please check whether you want to become individual or organizational (company, institution) member',
padr_norm_urb     =>  'The address field \'City/Location\' is still empty or contains disallowed characters',
padr_norm_str     =>  'The address field \'Street address\' is still empty or contains disallowed characters',
padr_norm_plz     =>  'Please check the ZIP in the field \'ZIP\'',
padr_norm_land    =>  'Please use 2-letter <A HREF="http://www.iso.ch/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1.html">ISO codes</A> to specify the country of residence, e.g.: <BR>GB=Great Britain, FR=France, IT=Italy, IE=Ireland, ...',
teln_norm_tel         =>  'Please check the telephone number - is it complete?',
href_norm_http        =>  'Please check the URL of your homepage',

# amount
annual_rate =>  'Please use digits to specify the desired membership contribution (minimal annual contribution: 12.78 EUR).',
# pay
konto_inh   =>  'Please specify the name of the account holder',
pag_pagtyp =>   'The mode of payment has not been specified. Please choose from direct debit or standing order / bank transfer.',
pag_rate    =>  'Please specify the desired installment in digits',
pag_too_low =>  'You have chosen an annual contribution of $annual_rate EUR that is below the minimum contribution for members (according to the association charter).<BR>Here you can reconsider this decision.',
pag_pagsum_differs =>  'The calculated annual contribution is $annual_rate EUR.<BR>Please check again the amount and mode of payment.',
pag_pagbeg =>  'An initial date for the first installment via bank transfer / direct debit has not yet been specified',
pag_pagmon =>  'Please choose the rate of installments (payment every 1,2,3,4,6 or 12 month)',
konto_blz   =>  'Please check whether the bank code has been entered correctly',
konto_bank  =>  'Please add here the name of bank that is managing the account',
konto_knr    => 'Please check your account number here',
#persist_warnedonce_pstval  => "[intern] W flag wrong. Please inform buero\@ffii.org.",
persist_warnedonce_pstval  => '[intern] W flag wrong. Please mail to buero@ffii.org.',
# eurolinux
asoc_org    =>  '[intern] [asoc_org] has bad value',
# chgid
#newid           # see above
newid_same_as_oldid  =>  "The specified new user ID is the same as the old ID",
# chgpw and confirm
newpw   =>  "Your password should consist of 5-12 alphanumeric symbols (i.e. letters in upper/lower case, digits, but no diacritics or umlauts)",
newpw2   =>  "Your password should consist of 5-12 alphanumeric symbols (i.e. letters in upper/lower case, digits, but no diacritics or umlauts)",
newpw_differ    =>  "Sorry, passwords do not match",
newpw_insecure  =>  "This password is not accepted. Your password should consist of 5-12 alphanumeric symbols and it should not be easy to guess.",
# forgot
pwforg_id_nonexist   => 'This user ID does not exist',
pwforg_email_unknown => "There is no user account using this email address - please contact buero\@ffii.org",
pwforg_email_missing => "For this user ID we do not have an email address on file - please contact buero\@ffii.org",
pwforg_no_data       => 'Please specifiy either your user ID or the email address that you used when you signed-up to our system',
# renewpw
#email          # see above
# resign
quitkey     =>  "In the field \'Action\' please type the word \'terminate\' to confirm that your membership is to be terminated and your user ID is to be deleted.",
#pass           (see above)
motivation  =>  "The message contains disallowed characters or is longer than 999 characters.",
# selsubs
email4lists =>  'Please check the email address specified',
selsubs_emailchange_subs_off => 'Please unsubsribe from all mailing lists before attempting to change your email address.',
# epat
epat_patno => '[intern] [epat_patno] wrong booking',
epat_tech =>  '[intern] [epat_tech] wrong booking',
epat_deal =>  '[intern] [epat_deal] wrong booking',
epat_clms =>  'Please check the specified total number of claims',
epat_iclm =>  'Please check the specified number of independent claims',
epat_dclm =>  'Please the specified email address',
epat_clm1 =>  'Please check your input at "Wording of claim 1" (disallowed characters?)',
epat_prog =>  'Please check your input at "Description of logic" (disallowed characters?)',
epat_epatrem  =>  'Please check your input at "Description in plain language" (disallowed characters?)',
# repr
#                   TO BE DONE!
#
# reprquery
pnompart  =>  'Disallowed characters in the \'name\' search string',
plzpart   =>  'The ZIP code should contain nothing but alpha-numeric characters',
land      =>  "Unexpected or new country code - please mail to buero\@ffii.org",
euprt     =>  "Unexpected party code - please mail to buero\@ffii.org",
komit     =>  "Unexpected commission code - please mail to buero\@ffii.org",
        },   # EOF 'FR' hash
    );


    }    # EOF BEGIN BLOCK
}    # EOF sub





# ------------------------------ Custom filters for Data::FormValidator -----------------

# Temp kludgy fix: Had to replace "Data::FormValidator::" by "Data::FormValidator::Results::" for functions to be found by neww formvalidator release!
#$# Check Data\FormValidator\Filters.pm and write my own filter module
###    Then add module name to "validator_packages" in config!

sub Data::FormValidator::Results::filter_firma_norm_fct()
{   my $value = shift;
    return $value    unless( $value =~ /^\(bitte nur bei Firmenmitgliedschaft/  );
    return "";
}

sub Data::FormValidator::Results::filter_pag_fct()
{   my $value = shift;
    $value = 0    if($value =~ /^[nN]ull/ );
    $value =~ tr/,/./;
logsay "IN pag_fct(): $value";
    return $value;
}

sub Data::FormValidator::Results::filter_textarea_fct()
{   # filter out TEXTAREA's 0x0d 0x0a sequences --> 0x0a
    my $value = shift;
    $value =~ s/\r\n/\n/g;
    return $value;
}


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






sub generate_user_management_url()
{   # absolute URL for display on a web page
    my $usrmgmturl = $fullactionurl."?m=usrmgmt";
    $usrmgmturl =~ s#^http://##;        # zap http:// for nicer display
    return $usrmgmturl;
}








#----------------- FORM2 ---------------------------------------------

sub send_email_asking_for_confirmation()
{
    # --------- GENERATE CONFIRMING EMAIL --------------

    my $nextmode = shift;

    my %allvars = $q->Vars;     # just for syntax simplification hereafter
    if( $allvars{email_norm} eq "" )
    {
        logsay "[$id] send_email_asking_for_confirmation failed: Email addr param was empty!";
        return 1;
    }

    my $id = $allvars{id};
    my $sid = $allvars{sid};
    my $confirmURL = "$fullactionurl?m=$nextmode\&sid=$sid\&id=$id\&l=$LANG_CODE";

    logsay "[$id] *************** SENDMAIL:   id:$id     sid:$sid    nextmode:$nextmode";


# ----------- TEXT FOR EMAIL REQUESTING CONFIRMATION ----------------------------------
#$# move elsewhere (to file?)

    my %confirm_mail_msg =
    (
        de =>
        {
            subject => 'FFII: Bitte um Bestaetigung Ihres Eintrags',
#.....................................
            message => <<EOFCONFMSG_DE,
Guten Tag,

jemand hat soeben unter dem Namen

          $allvars{pnom_pnom} <$allvars{email_norm}>

einen Eintrag im Mitwirkungssystem des

        Foerdervereins fuer eine freie informationelle Infrastruktur (FFII)
        http://www.ffii.org

vorgenommen. Hoffentlich waren es wirklich Sie - wenn nicht,
entschuldigen Sie bitte diese Stoerung!

Um Ihren Eintrag zu bestaetigen, klicken Sie bitte auf den untenstehenden
Link (oder geben Sie diesen in Ihrem Browser ein).

$confirmURL

Wir behandeln Ihre Daten vertraulich und geben sie nicht ohne Ihr
ausdrueckliches Einverstaendnis an Dritte weiter.

Vielen Dank fuer Ihre Unterstuetzung!

--
FFII e.V.                                         $FFII_OFFICE_MAIL
Datenverarbeitung ist kein Gebiet der Technik     http://swpat.ffii.org
350000 Stimmen + 3000 Firmen gegen Logikpatente   http://noepatents.org
EOFCONFMSG_DE
#.....................................
        },
        en =>
        {
            subject => 'FFII: Please confirm your entry',
#.....................................
            message => <<EOFCONFMSG_EN,
Hello,

somebody using the name

          $allvars{pnom_pnom} <$allvars{email_norm}>

has just created an entry in our on-line participation system

	    Foundation for a Free Information Infrastructure (FFII)
	    http://www.ffii.org/

We hope that was really you - otherwise please accept our apologies
for the inconvenience !

To confirm your entry, please click onto the link below (or enter
it into your browser)

$confirmURL

We keep your data confidential and we will not provide it to any third party
without your explicit consent.

Many thanks for your support!

--
FFII e.V.                                           $FFII_OFFICE_MAIL
Protecting Innovation from Patent Inflation     http://swpat.ffii.org
140000 signatures against software patents      http://noepatents.org
EOFCONFMSG_EN
#.....................................
        }
    );  # end of hash init

    # SEND OUT TO USER VIA EMAIL
    my %cmail = (
        To =>   $allvars{email_norm},
        From => $FFII_OFFICE_MAIL,
        Subject =>   $confirm_mail_msg{$LANG_CODE_ERRMSGS}{subject},
        smtp => $SMTP,
        'Content-type' => 'text/plain; charset="utf-8"',
        message => $confirm_mail_msg{$LANG_CODE_ERRMSGS}{message},
    );

    $maildisabled   and   return 0;
    if( not sendmail(%cmail) )
    {
        logsay "[$id] send_email_asking_for_confirmation failed: DIEING!\n".Dumper(\%cmail);
        htmldie_report_err( 'send_email_asking_for_confirmation', "Error sending mail: $Mail::Sendmail::error\n", 'mail');
    }
    logsay "[$id] send_email_asking_for_confirmation: DONE";

    return 0;
}





sub generate_session_id()
{
    # --------- CREATE A 12-char SESSION ID AND STORE IT VIA KNECHT IN AN EMPTY USER PROFILE -----------
    my $sid = join '', (0..9, 'A'..'Z', 'a'..'z')[rand 62, rand 62, rand 62, rand 62, rand 62, rand 62];
    $sid .= join '', (0..9, 'A'..'Z', 'a'..'z')[rand 62, rand 62, rand 62, rand 62, rand 62, rand 62];
    $q->param('sid' => $sid);
}




sub generate_user_id()
{
    # --------- GENERATE USER ID -----------------------
    #   generate a known good user ID from [email_addr] or [users real name]
    #   append or change some character(s) if necessary for uniqueness

    # Zap all forbidden characters (numeric, symbols)
    # (it is important that this happens right here, because we will fetch ADDITIONAL characters
    #  from these strings as needed during the ID generation process, and these should not be numeric/symbols)
    my ($mail_norm_mailuser, $mail_norm_mailhost) = split( /@/, $q->param('email_norm') );
    (my $mail_norm_mailuser_cleaned  = lc $mail_norm_mailuser)  =~ tr/_\-0-9/../d;  # underscore,minus->dots, kill all others
    (my $pnom_pnom_cleaned = $q->param('pnom_pnom'))    =~ tr/0-9_-//d;     # don't touch dots and CAPs
    $pnom_pnom_cleaned = asciify_umlauts( $pnom_pnom_cleaned );

    # gen supply of characters for ID extension
    (my $mail_norm_mailuser_char_supply = $mail_norm_mailuser_cleaned)      =~ tr/a-z//cd;    # c: complement search list
    (my $pnom_pnom_char_supply = lc $pnom_pnom_cleaned)    =~ tr/a-z//cd;    # d: deleted all hits

        logsay "[$id] \n\nAUTO-ID GENERATION STARTS...";
        logsay "[$id] [generate_user_id]    mail_norm_mailuser_cleaned: $mail_norm_mailuser_cleaned    pnom_pnom_cleaned: $pnom_pnom_cleaned";
        logsay "[$id] [generate_user_id]    mail_norm_mailuser_char_supply: $mail_norm_mailuser_char_supply    pnom_pnom_char_supply: $pnom_pnom_char_supply";

    my $autoid;

    # TRY TO DERIVE AUTOID FROM EMAIL ADDR
    if( ( split(/\./, $mail_norm_mailuser_cleaned )) > 1 )
    {   # we have at least two elements separated by dot or underscore:
        $autoid = substr( $_[0], 0, 1);     # (might be first name initial)
        $autoid .= $_[1];         # string right of leftmost 'dot' in mail_norm_mailuser (might be last name)
        logsay "[$id] ....... EMAIL_XTR_DOTorUSC: $autoid";   #DEBUG
    }
    else
    {
        $autoid = $mail_norm_mailuser_char_supply;
    }
    $autoid = substr($autoid,0,8);      # cut it to max size
    logsay "[$id] ....... EMAIL_XTR_FINAL: $autoid";   #DEBUG

    if( length($autoid) < 5 )
    {   # ALTERNATIVE ID generator (email name was too short)
        # If the user wrote his last name in CAPITALS, possibly with leading or trailing first name...
        #    we can accurately extract his last name:
        my ($initial1, $lastname, $initial2)  =  $pnom_pnom_cleaned =~ /^(?:([A-Z]?)[^A-Z\s]+\s*)*([A-Z]{2,99})\s*([A-Z]?)[^A-Z]*/ ;
        if( length($lastname) >= 4 )
        {   # try to add initial to make it >=5 chars
            $autoid = lc substr( ($initial1 or $initial2).$lastname, 0, 8);
            logsay "[$id] ....... CAPS-EXTRACTOR: $autoid";   #DEBUG
        }
        else
        {   # lastname too short or not found (userdidn't use CAPS?!)
            # use pnom_pnom and take the trailing 8 characters
            $autoid = $pnom_pnom_char_supply;
            $autoid = lc substr( $autoid, -8, 8);
            logsay "[$id] ....... TRAIL-EXTRACTOR: $autoid";   #DEBUG
        }
        while( length($autoid) < 5 )
        {   # extend short names
            $autoid .= @_[rand scalar split('',$autoid)];
        }
        # make double sure again we are not over 8 chars
        $autoid = substr( $autoid, 0, 8);
    }


    # CHECK WITH KNECHT AND LOOP UNTIL GOOD ID FOUND (5 - 8 chars!!)
    my $loopcounter = 0;
    my $forbiddenwordcounter = 0;
    while( (my $reject_reason = newID_is_rejected( $autoid )) )
    {
        logsay "[$id] ..... LOOP:    autoid: $autoid --> newID_is_rejected retval: $reject_reason";   #DEBUG

        # ARE WE HAVING TROUBLE?
        if( $loopcounter++ > 20 )
        {   # knecht seems to be confused or returns unknown value - use a totally random 8 char string
            $autoid = join '', ('a'..'z')[rand 26, rand 26, rand 26, rand 26, rand 26, rand 26, rand 26, rand 26];
            last;       # We exit this loop even though we don't know if knecht will accept our random ID
                        # Reason: Don't want an infinite loop here
                        # What will happen next if this ID is not accepted by knecht?
                        # --> Knecht will cause this script to diehtml() when the profile is created
        }
        if( $loopcounter++ > 15 )
        {   # this is getting boring - use a totally random 6 char string until we succeed
            $autoid = join '', ('a'..'z')[rand 26, rand 26, rand 26, rand 26, rand 26, rand 26];
            next;
        }
        elsif( $loopcounter > 10 )
        {   # almost last resort: replace 2 final chars by random chars
            $autoid = substr( $autoid, 0, 6 );
            $autoid .= ('a'..'z')[rand 26];
            $autoid .= ('a'..'z')[rand 26];
            next;
        }

        # WHAT DID THE KNECHT THINK OF THIS ID?
        if( $reject_reason ==  1 )
        {   # ID already taken
            $autoid = substr( $autoid, 0, 7 );
            # $autoid .= ('a'..'z')[rand 26];
            $autoid .= @_[rand scalar split('',$mail_norm_mailuser_char_supply)];      # append random char
        }
        elsif( $reject_reason == -1 )
        {   # ID has unacceptable characters OR (more probable:) it is too short
            # (we took care of all this ahead of the while loop, but just in case...)
            if( length($autoid) >= 5 )
            {   # Illegal characters?!! Use a totally random 6 char string
                $autoid = join '', ('a'..'z')[rand 26, rand 26, rand 26, rand 26, rand 26, rand 26];
            }
            else
            {
                $autoid .= @_[rand scalar split('',$pnom_pnom_char_supply)];     # append random char
            }
        }
        elsif( $reject_reason == -2 )
        {   # knecht disallows this ID (it is in knechts 'forbidden' list of words)
            if( $forbiddenwordcounter++ == 0 )
            {   # prepend a random char (knecht disallows all IDs that start with exclude words)
                $autoid = substr( $autoid, 0, 7 );
                $autoid = @_[rand scalar split('',$pnom_pnom_char_supply)].$autoid;
            }
            else
            {   # use a totally random 6 char string
                $autoid = join '', ('a'..'z')[rand 26, rand 26, rand 26, rand 26, rand 26, rand 26];
            }
        }
        else
        {   # unexpected retval - try totally random 6 char string
            $autoid = join '', ('a'..'z')[rand 26, rand 26, rand 26, rand 26, rand 26, rand 26];
            logsay "[$id] WARNING: newID_is_rejected returned unexpected value: $reject_reason";
        }
    }
logsay "[$id] ............................FINAL-AUTOID.......[[ $autoid ]] \n\n";   #DEBUG

    $q->param('id' => $autoid);
}



#----------------- Confirm new user entry to knecht ------------------------------

sub create_user_profile()
{
    # CREATE A NEW USER ENTRY VIA KNECHT
    # Desired user id must be in the CGI object param 'id'
    # Returns 0 if success; Knecht_return_value if failure

    my $id  = $q->param('id');
    my $email = $q->param('email_norm');

    # URL where knecht makes the profile publicly available:
    #$# hard-coded --- unused so far
    ### my $profileURL = "http://www.ffii.org/verein/leute/$id/profil.txt";

    # --------- CREATE NEW USER VIA KNECHT --------------------
    # CREATE NEW USER PROFILE WITH [ id, pass, mail_norm_mailuser, mail_norm_mailhost ]
    # OUR CONVENTION: 100% identical "HTML::Template param-naming"
    #     in HTML form-template(s) and knecht's profile-template

    my $kret;
    # Generate random temporary passwort - to be changed once the users confirms receipt of email!
    # (WARNING: Using a fixed or empty kind-of-default pw here would be insecure!)
    my $temp_pw = join '', (0..9, 'A'..'Z', 'a'..'z')[rand 62, rand 62, rand 62, rand 62, rand 62, rand 62];
    logsay "[$id] \n\nNOW TRYING TO CREATE NEW USER: \n    id: $id\n----";   #DEBUG

    knechtcall_newuser( $id, $temp_pw, $email );

    # --------- MAKE PRELIMINARY KNECHT ENTRY INVISIBLE TO THE WORLD -----------------
    knechtcall_profile_world_visibility(0);

    return $MW_SUCCESS;
}



sub retrieve_userdata_from_profile()
{   # retrieve pnom + emailaddr from profile when user clicks confirm-URL received via email
    knechtcall_getvals( [ 'pnom', 'mail_norm', 'asoc', 'pag' ] );
        logsay "[$id] RETRIEVEUSERDATA:  ",$q->param('id'),"   ",$q->param('pnom_pnom');
    email_join(scalar $q->Vars);
    return;
}

sub retrieve_all_data_from_profile()
{
    knechtcall_getvals( [ 'pnom','mail','href_norm_http','padr_norm','firma_norm','teln_norm_tel','pag','konto','asoc', 'persist' ] );
    #$# some subparam names may be abbreviated: standardize by cutting to shortest acceptable length
        logsay "[$id] [RETRIEVEALLDATA]  pnom:%s", $q->param('pnom_pnom');
    email_join(scalar $q->Vars);
    return;
}

sub retrieve_pay_data_from_profile()
{   # retrieve all pag* parameters from profile
    knechtcall_getvals( [ 'pag' ] );
    return;
}

sub retrieve_sign_data_from_profile()
{   # retrieve all sign* parameters from profile
    knechtcall_getvals( [ 'sign', 'asoc' ] );
    return;
}

sub retrieve_event_data_from_profile()
{   # retrieve all ven_* parameters from profile
    knechtcall_getvals( [ 'ven', 'asoc' ] );
    return;
}

sub retrieve_subs_data_from_profile()
{   # retrieve all mailing list subscription parameters from profile
    knechtcall_getvals( [ 'mail', 'subs', 'asoc' ] );
    email_join(scalar $q->Vars);      # sub modifies contents of CGI-hash in $q !!!
    return;
}

sub retrieve_all_emailaddresses_from_profile()
{   #
    knechtcall_getvals( [ 'mail' ] );
    email_join(scalar $q->Vars);      # sub modifies contents of CGI-hash in $q !!!
    return;
}

sub retrieve_assoc_data_from_profile()
{   # retrieve all industry associations membership parameters from profile
    knechtcall_getvals( [ 'memq', 'asoc' ] );
    return;
}

sub retrieve_epat_data_from_profile()
{   # retrieve all patent classification entries
    my $knum;
    $knum = knechtcall_getvals( [ 'epat' ] );
    $knum   or   $q->param( 'epat_patno_'.knechtcall_pickpat().'_tech' => 0 );      # no patent was defined 
    $knum = knechtcall_getvals( [ 'asoc' ] );
    return;
}

sub retrieve_repr_data_from_profile()
{   # retrieve all MEP entries
    my $knum;
    $knum = knechtcall_getvals( [ 'repr' ] );
    $knum   or   $q->param( 'repr_mep_'.knechtcall_pickmep().'_replvl' => 0 );      # no MEP was defined

    $knum = knechtcall_getvals( [ 'asoc' ] );
    return;
}

sub retrieve_mepqs0405_data_from_profile()
{   # retrieve all parlamentarist entries
    my $knum;
    $knum = knechtcall_getvals( [ 'mepqs0405' ] );
###    $knum   or   $q->param( mepnick => knechtcall_pickmep() );     # no MEP defined in profile
    $knum = knechtcall_getvals( [ 'asoc' ] );
    return;
}



sub retrieve_netstrike_data_from_profile()
{   # retrieve all netstrike entries
    my $knum;
    $knum = knechtcall_getvals( [ 'grev' ] );
    return;
}

sub retrieve_proj_data_from_profile()
{   # retrieve all project-help parameters from profile
    knechtcall_getvals( [ 'mail', 'projhlp', 'asoc' ] );
    email_join(scalar $q->Vars);      # sub modifies contents of CGI-hash in $q !!!
    return;
}




sub generate_new_password()
{   # create the user's initial password (6 characters)
    # Returns new password or 0 if failure

    my $id = $q->param('id');
    my $pass = join '', (0..9, 'A'..'Z', 'a'..'z')[rand 62, rand 62, rand 62, rand 62, rand 62, rand 62];
    return $pass;
    #$# debug this - it only delivers 5 chars instead of 6 expected
}



sub update_user_profile_from_hash($valid_parms)
{
    # SYNOPSIS: update_user_profile_from_hash( $params_hashref )
    # WRITE ALL PARAMS FOUND IN THE HASH INTO THE USER'S PROFILE
    # OUR CONVENTION: 100% identical param-naming
    #     in HTML form-template(s) and knecht's profile-template
    #     result's in extreme simplicity of this sub.

    # WORK ON COPY OF CGI-PARAM-HASH
    my %valids_copy = %{shift()};       # make a copy of the hash  - to be modified!
    email_split(\%valids_copy);

    # CLEAR OUT SOME PARAMS THAT SHOULD NOT END UP IN THE PROFILE
    # [ since we now operate on the "valids" hash, most deletions became redundant ]
#    delete $valids_copy{'actionurl'};
    delete $valids_copy{'signuptype'};
    delete $valids_copy{'email4lists'};
    delete $valids_copy{'annual_rate'};
    delete $valids_copy{'pag_rate'};
    delete $valids_copy{'mepnick'};
#    delete $valids_copy{'pag_rate2'};
#    delete $valids_copy{'pag_pagmon2'};
#    delete $valids_copy{'pag_pagbeg2'};
#    delete $valids_copy{'pw'};
    delete $valids_copy{'sid'};             # written separately, on demand, in sub save_session_id
    delete $valids_copy{'id'};
#    delete $valids_copy{'newid'};
#    delete $valids_copy{'oldid'};
#    delete $valids_copy{'member_type'};

    #*# OBSOLETE: CONVERT HASH TO ARRAY OF STRINGS WITH NAME-VALUE PAIRS
    # my @params = map { "$_ $valids_copy{$_}" } keys %valids_copy;

    logsay "[$id] update_user_profile_from_hash: cleaned hash: ". Dumper(\%valids_copy);

    # CALL THE KNECHT INTERFACE
    knechtcall_putvals( \%valids_copy );

    return;
}



sub save_session_id()
{
    # saves session id from CGI-array using knecht
    # returns zero on success
    my $sid = $q->param('sid');
    knechtcall_putvals( { sid_sidval => $sid } );
        logsay "[$id] [save_session_id()]  sid:$sid";
    return $retval;
}

sub get_session_id()
{
    # loads session id in to CGI-array
    # #$# TBD: returns zero on success
    my $sid = knechtcall_get1val('sid');        #$# temp fix for pending knecht modif
        logsay "[$id] [get_session_id()]  RETURNING sid:$sid";
    return $sid;
}

sub idhasbeenconfirmedpreviously()
{
        #$# should use new sub log_readfrom_profile!!
    # This sub returns FALSE if ID not yet confirmed
    my $val = knechtcall_get1val( 'persist_idconfirmed_pstval' );
        logsay "[$id] [idhasbeenconfirmedpreviously()]  returning: [$val]";
    return $val;
}

sub membership_logged()
{
    # returns false if not yet confirmed
    my $val = knechtcall_get1val( 'persist_becamepayingmember_pstval' );
        logsay "[$id] [membership_logged()]  returning $val";
    return $val;
}


sub log_readfrom_profile()
{
    # read a log entry from a user's profile
    my $logname = shift;
    my $val = knechtcall_get1val( 'persist_'.$logname.'_pstval' );
    ($val eq '')  and  $val=0;
    return $val;
}


sub log_to_profile()
{
    # log events in knecht's central log && as a parameter in user's profile
    # Example:      logger('memberresigned',$timedate);
    # Result:       Parameter "persist_memberresigned_pstval" logged in profile

    my ($logname, $value) = @_;
    $logname =~ tr/_//d;        # underscores would confuse our subparam mechanism!
    $logname = 'persist_'.$logname.'_pstval';

    my $id = $q->param('id');

    # log as single param "description value" in the user's profile
    knechtcall_putvals( { $logname => $value } );
    return;
}



sub logger()
{
    # log events in knecht's central log && as a parameter in user's profile
    # Example:      logger('memberresigned',$timedate);
    # Result:       Parameter "persist_memberresigned_pstval" logged in profile & central knecht log

    my ($logname, $value) = @_;
    $logname =~ tr/_//d;        # underscores would confuse our subparam mechanism!
    $logname = 'persist_'.$logname.'_pstval';

    my $id = $q->param('id');

    # log as single param "description value" in the user's profile
    # this param's intention is to prevent multiple execution of code when user presses browser refresh!
    knechtcall_putvals( { $logname => $value } );
    # log in user-specific log file (one entry for each change)
    knechtcall_log( $logname.' ['.$value.']' );

    # log it in knecht's central log
    # knechtcall_log(uc($logname).' ['.$id.']')

    return;
}





#----------------- ADDRESS --------------------------------------------------------------

sub addr_is_known()
{
    # reports true if user has provided an address (required for some functions to be shown)

    my $city = knechtcall_get1val('padr_norm_urb');

###    This fix did not change anything: cmode_mw was clobbered in exactly the same way!!!
###    my $knum = knechtcall_getvals( [ 'padr_norm_urb' ] );
###    my $city = $q->param('padr_norm_urb');

    my $retval = (length($city) > 0);
    logsay "[$id] addr_is_known:    city:$city   retval:$retval";
    return $retval;
}


sub get_member_status_from_cgi()
{
    # Membership status is in the asoc_ffii_asolvl field
    return $q->param('asoc_ffii_asolvl');
}

sub get_stored_member_status()
{
    return knechtcall_get1val('asoc_ffii_asolvl');
}

sub is_paying_member()
{
    my $statuscode = shift;
    $statuscode == $mcode{payingmember}   and   return 1;
    $statuscode == $mcode{activemember}   and   return 1;
    return 0;
}

sub payment_details_available()
{
    retrieve_pay_data_from_profile();
    return ( rate_above_minimum()  and  ($q->param('pag_pagbeg') ne '') );   # start date known and pag high enough
}


sub annual_rate()
{
    my $rate = $q->param('pag_pagsum');
    $rate =~ tr/,/./;    # change comma to dot
    (my $interval = $q->param('pag_pagmon'))  or  return 0;
    return $rate*12/$interval;
}

sub rate_above_minimum()
{
    # Check chosen membership fee
    return ( annual_rate() >= $MEMBER_FEE_MIN );
}



#----------------- PAYMENT --------------------------------------------------------------

sub mergepayparams()
{
    # IF 'pag_pagtyp' is 'd[auerauftrag]', copy over 'pag' values from other form
    if( $q->param('pag_pagtyp') eq 'd' )
    {
        $q->param('pag_rate' => $q->param('pag_rate2') );
        $q->param('pag_pagmon' => $q->param('pag_pagmon2') );
        $q->param('pag_pagbeg' => $q->param('pag_pagbeg2') );
    }
}



sub send_email_with_payment_summary()
{
    # --------- GENERATE EMAIL REMINDING USER OF CHOSEN PAYMENT PROCEDURE --------------

    my %allvars = $q->Vars;     # just for syntax simplification hereafter
    if( $allvars{email_norm} eq "" )
    {   return 1;
    }
    my %zahlungsarten = (
        d =>
        {   de => 'Dauerauftrag oder Überweisung',
            en => 'Single or recurring money transfer',
        },
        l =>
        {   de => 'Lastschrift',
            en => 'Direct Debit',
        }
    );
    my $zahlungsart = $zahlungsarten{ $allvars{pag_pagtyp} }{$LANG_CODE_ERRMSGS};
    my $start_date  = decode_date($allvars{pag_pagbeg});
    my $payment_interval = $allvars{pag_pagmon};            # months
    my $n_rates = 12 / $payment_interval;
    my $annual_payment = $allvars{pag_pagsum}*$n_rates;              # per year
    my $rate = $annual_payment / $n_rates;

# ----------- TEXT FOR EMAIL ----------------------------------
#$# move elsewhere (to file?)
# hash of hashes

    my %paymsg =
    (
        de =>
        {
#.................................................
            subject => 'Bestaetigung Ihrer Zahlungsdaten',
#.................................................
            part1 => <<EOFPAYMSG_DE_1,
Guten Tag,

wir freuen uns, dass Sie den FFII finanziell unterstuetzen wollen und fassen Ihre Eingaben wie folgt zusammen:

Zahlungsart:  $zahlungsart
Beginn:  $start_date
Jahresbeitrag: $annual_payment EUR,
    in $n_rates Rate(n) von $rate EUR (d.h. alle $payment_interval Monate $rate EUR).

EOFPAYMSG_DE_1
#.................................................
            part2 => <<EOFPAYMSG_DE_2,
Bitte geben Sie bei jeder Ueberweisung Ihre Nutzerkennung ($allvars{id}) mit an, damit wir Ihre Zahlung zuordnen koennen.

EOFPAYMSG_DE_2
#.................................................
            part3 => <<EOFPAYMSG_DE_3,
Die Bankverbindung des FFII lautet:
    FFII e.V.
    Konto-Nr. 31112097
    BLZ 701 500 00 (Stadtsparkasse Muenchen, Lotstr. 1, D-80335 Muenchen, Deutschland)
Weitere Daten zur Bankverbindung:
    BIC (bank identifier code):  SSKMDEMM
    SWIFT:   SSKM DE MM
    IBAN (international bank account number):  DE78701500000031112097
    Kontoinhaber:  FFII e.V.
    Anschrift des Kontoinhabers:  Blutenburgstr 17, D-80636 Muenchen, Deutschland



Vielen Dank fuer Ihre Unterstuetzung!

--
FFII e.V.                                         $FFII_OFFICE_MAIL
Home Page                                         http://www.ffii.org
Innovation statt Patentinflation                  http://swpat.ffii.org
120000 Stimmen + 400 Firmen gegen Logikpatente    http://noepatents.org
EOFPAYMSG_DE_3
#.................................................
        },
        en =>
        {
#.................................................
            subject => 'Confirmation of your contribution to FFII',
#.................................................
            part1 => <<EOFPAYMSG_EN_1,
Hello,

we appreciate that you want to support FFII financially and summarize your data as follows:

Mode of payment:  $zahlungsart
Begin:  $start_date
Annual contribution: $annual_payment EUR,
    in $n_rates installments of $rate EUR (that is every $payment_interval months $rate EUR).

EOFPAYMSG_EN_1
#.................................................
            part2 => <<EOFPAYMSG_EN_2,
On each bank transfer, please specify your user ID ($allvars{id}), so that we can identify your contribution.

EOFPAYMSG_EN_2
#.................................................
            part3 => <<EOFPAYMSG_EN_3,
Bank data of FFII:
    FFII e.V.
    Account No. 31112097
    Bank code 701 500 00 (Stadtsparkasse Muenchen, Lotstr. 1, D-80335 Muenchen, Germany)
    BIC (bank identifier code):  SSKMDEMM
    SWIFT:   SSKM DE MM
    IBAN (international bank account number):  DE78701500000031112097
    Account in the name of:  FFII e.V.
    Address of account holder:  Blutenburgstr 17, D-80636 Muenchen, Deutschland


Many thanks for your support!

--
FFII e.V.                                           $FFII_OFFICE_MAIL
Home Page                                           http://www.ffii.org
Innovation instead of patent inflation              http://swpat.ffii.org
135000 votes + 400 companies against logic patents  http://noepatents.org
EOFPAYMSG_EN_3
#.................................................
        },
    );

my $payminder_mail_msg;
if( $allvars{pag_pagtyp} eq 'd' )
{
    $payminder_mail_msg = $paymsg{$LANG_CODE_ERRMSGS}{part1}.$paymsg{$LANG_CODE_ERRMSGS}{part2}.$paymsg{$LANG_CODE_ERRMSGS}{part3};
}
else
{
    $payminder_mail_msg = $paymsg{$LANG_CODE_ERRMSGS}{part1}.$paymsg{$LANG_CODE_ERRMSGS}{part3};
}
    # SEND OUT TO USER VIA EMAIL
    my %cmail = (
        To =>   $allvars{email_norm},
        From => $FFII_OFFICE_MAIL,
        Subject =>   $paymsg{$LANG_CODE_ERRMSGS}{subject},
        smtp => $SMTP,
        'Content-type' => 'text/plain; charset="utf-8"',
        message => $payminder_mail_msg,
    );

    logsay "[$id] send_email_with_payment_summary: ".Dumper(\%cmail);

    ( sendmail(%cmail)   or   htmldie_report_err( 'send_email_with_payment_summary', "Error sending mail: $Mail::Sendmail::error\n", 'mail') )
        unless( $maildisabled );

    return 0;
}



#----------------- CHANGE OF USER ID -------------------------------------------------------

sub user_requested_id_change()
{
    logsay "[$id] user_requested_id_change()   id:%s   newid:%s", $q->param('id'), $q->param('newid');
    return ( $q->param('id') ne $q->param('newid') );
}


sub change_user_id()
{   # nonzero return value indicates failure
    my $kret;
    $kret = knechtcall_changeid( $q->param('newid') );
    if( $kret == $MW_SUCCESS )
    {
        $q->param('oldid' => $q->param('id'));
        $q->param('id' => $q->param('newid'));
        $id = $q->param('newid');               # update our short-named var - used for logging purposes only
        logsay "[$id] change_user_id:    ***Success***";
    }
    else
    {
        logsay "[$id] change_user_id:    newid probably taken (kret: $kret)";
        ### htmldie_report_err( 'change_user_id', "K-Failure or possible newid race condition (kret:$kret)\n", 'self', 0 );
        return $kret;
    }
    return 0;
}



sub set_password()
{
    my $newpw = shift;
    my $die_on_errors = shift;
    my $kret;
    $kret = knechtcall_setpw( $newpw );

    if( $kret != $MW_SUCCESS )
    {
        $die_on_errors   and   htmldie_report_err( 'set_password', "Couldn't set password (kret:$kret)\n", 'knecht', 0 );
        return $kret;
    }
    return 0;
}




sub send_email_with_login_link()
{
logsay "[$id] send_email_with_login_link DBG:ENTERING...";

    # --------- GENERATE EMAIL WITH LINK TO PASSWORD CHANGE FORM --------------

    my $nextmode = shift;

    my %allvars = $q->Vars;     # just for syntax simplification hereafter
    if( $allvars{email_norm} eq "" )
    {   return 1;
    }

    my $id = $allvars{id};
    my $sid = $allvars{sid};
    my $loginURL = "$fullactionurl?m=usrmgmt\&sid=$sid\&id=$id\&l=$LANG_CODE";
    my $pwURL = "$fullactionurl?m=$nextmode\&sid=$sid\&id=$id\&l=$LANG_CODE";

# ----------- TEXT FOR EMAIL ----------------------------------
#$# move elsewhere (to file?)

    my %mail_msg =
    (
#....................................
        de =>
        {
            subject => 'Ihr FFII-Zugang',
            message => <<EOFPWDMSG_DE,
Guten Tag,

wie gewuenscht, uebersenden wir Ihnen Ihre Zugangsinformationen.

Ihre FFII-Kennung lautet \"$allvars{id}\"

Bitte nutzen Sie den Login unter
$loginURL

oder legen Sie mittels folgendem Link ein neues Passwort an:
$pwURL



--
FFII e.V.                                         $FFII_OFFICE_MAIL
Home Page                                         http://www.ffii.org
Innovation statt Patentinflation                  http://swpat.ffii.org
120000 Stimmen + 400 Firmen gegen Logikpatente    http://noepatents.org
EOFPWDMSG_DE
#....................................
        },
        en =>
        {
            subject => 'Your FFII Account',
            message => <<EOFPWDMSG_EN,
Hello,

as you requested we are sending you information on
how to get access to your FFII user account.

Your FFII user ID is \"$allvars{id}\"

Please log in at:
$loginURL

or set a new password at:
$pwURL



--
FFII e.V.                                           $FFII_OFFICE_MAIL
Data Processing is Not a Field of Technology        http://swpat.ffii.org
350K votes + 3000 CEOs against logic patents        http://noepatents.org
EOFPWDMSG_EN
#....................................
        }
    );    # EOF hash

    # SEND OUT TO USER VIA EMAIL
    my %cmail = (
        To =>   $allvars{email_norm},
        From => $FFII_OFFICE_MAIL,
        Subject =>   $mail_msg{$LANG_CODE_ERRMSGS}{subject},
        smtp => $SMTP,
        'Content-type' => 'text/plain; charset="utf-8"',
        message => $mail_msg{$LANG_CODE_ERRMSGS}{message},
    );

    logsay "[$id] send_email_with_login_link 1: ".Dumper(\%cmail);

    ( sendmail(%cmail)   or   htmldie_report_err( 'send_email_with_login_link', "Error sending mail: $Mail::Sendmail::error\n", 'mail') )
        unless( $maildisabled );

    logsay "[$id] send_email_with_login_link 2 (done)";

    return 0;
}




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


sub send_email_to_admin()
{
    my $subject = shift;
    my $bodytext = shift;
    my $ipaddr   = shift;
    my $longtext   = shift;
    my %allvars = $q->Vars;     # just for syntax simplification hereafter
    my $id = $allvars{id};

# ----------- TEXT FOR EMAIL ----------------------------------
#$# move elsewhere (to file?)

    my $mail_msg = <<EOFADMMSG;
$bodytext:

          Kennung:  $id
          Name:     $allvars{pnom_pnom} <$allvars{email_norm}>

          IP:       $ipaddr
          t_server: $timedate
          agent:    $browser

$longtext

EOFADMMSG


    # SEND EMAIL
    my %cmail = (
        To =>   $MAILTO,
        From => $FFII_OFFICE_MAIL,
        Subject =>   $subject,
        smtp => $SMTP,
        'Content-type' => 'text/plain; charset="utf-8"',
        message => $mail_msg,
    );

    sendmail(%cmail)    unless( $maildisabled );
logsay "[$id] send_email_to_admin $MAILTO";
    return 0;
}



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


sub check_authentication()
{   # returns 1 if received sessionID matches the stored sessionID for user ID
    if( $q->param('sid')  and  $q->param('id') )
    {
        my $id = $q->param('id');
        my $sid = $q->param('sid');
            logsay "[$id] AUTH1:  $id   $sid   ".$q->param('pnom_pnom');
        # Verify session-id with the one stored in profile.txt & get params
        my $stored_sid = get_session_id();                  # into CGI-array!
            logsay "[$id] AUTH2:  sid:$sid:     kn-sid:$stored_sid";
        if( $sid  eq  $stored_sid )
        {
            return 1;
        }
    }
    return 0;
}



#sub email_expander()
#{
#    # --------- AUTO-CONVERT BETWEEN TWO CONCURRENT REPRESENTATIONS OF EMAIL ADDRESSES ---------------
#    # [This is an unfortunate complication required by Knecht - Knecht should really handle this internally ]
#
#    # Expects a CGI hashref as delivered by CGI.pm calling
#        (CGI.pm returns the parameter list as a tied hash reference, when $q->Vars is assigned in scalar context!)
#
#    my $hr = shift;         # get hash-ref
#
#    if( $hr->{email} )
#    {   # Split up user's eMail addr
#        my ($leftmail, $rightmail) = split( /@/, $hr->{email} );
#        $hr->{mail_norm_mailuser}  = $leftmail;
#        $hr->{mail_norm_mailhost} = $rightmail;
#    }
#    elsif( $hr->{mail_norm_mailuser} and $hr->{mail_norm_mailhost} )
#    {   # re-gen eMail addr
#        $hr->{email} = $hr->{mail_norm_mailuser}.'@'.$hr->{mail_norm_mailhost};
#    }
#
#    if( $hr->{email4lists} )
#    {   # Split up user's eMail addr
#        my ($leftmail, $rightmail) = split( /@/, $hr->{email4lists} );
#        $hr->{mail_subs_nom} =  $leftmail;
#        $hr->{mail_subs_host} = $rightmail;
#    }
#    elsif( $hr->{mail_subs_nom} and $hr->{mail_subs_host} )
#    {   # re-gen eMail addr
#        $hr->{email4lists} = $hr->{mail_subs_nom}.'@'.$hr->{mail_subs_host};
#    }
#}


sub email_split()
{
    # --------- AUTO-CONVERT BETWEEN TWO CONCURRENT REPRESENTATIONS OF EMAIL ADDRESSES ---------------
    # [This is an unfortunate complication required by Knecht - Knecht should really handle this internally ]
    # Expects a CGI hashref as delivered by CGI.pm calling
    #   (CGI.pm returns the parameter list as a tied hash reference, when $q->Vars is assigned in scalar context!)


    my $hr = shift;         # get ref to CGI-hash and process it in place

    foreach ( keys %$hr )
    {
        next unless /^email_([^_]+)$/;
        my ($leftpart, $rightpart) = split( /@/, $hr->{$_} );
        $hr->{'mail_'.$1.'_mailuser' } = $leftpart;
        $hr->{'mail_'.$1.'_mailhost'} = $rightpart;
        delete $hr->{$_};                           # cleanup
    }

    #$# CLEANUP: add deletion of email_xxxxx parameters!

#    if( $hr->{email} )
#    {   # Split up user's eMail addr
#        my ($leftmail, $rightmail) = split( /@/, $hr->{email} );
#        $hr->{mail_norm_mailuser}  = $leftmail;
#        $hr->{mail_norm_mailhost} = $rightmail;
#    }
#
#    if( $hr->{email4lists} )
#    {   # Split up user's eMail addr
#        my ($leftmail, $rightmail) = split( /@/, $hr->{email4lists} );
#        $hr->{mail_subs_nom} =  $leftmail;
#        $hr->{mail_subs_host} = $rightmail;
#    }
}

sub email_join()
{
    # --------- AUTO-CONVERT BETWEEN TWO CONCURRENT REPRESENTATIONS OF EMAIL ADDRESSES ---------------
    # [This is an unfortunate complication required by Knecht - Knecht should really handle this internally ]
    # Expects a CGI hashref as delivered by CGI.pm calling
    #   (CGI.pm returns the parameter list as a tied hash reference, when $q->Vars is assigned in scalar context!)

    # ATTN!: generated CGIparam "email" is now called "email_norm" !!!

    my $hr = shift;         # get ref to CGI-hash and process it in place

    my %emailadrs;
    foreach ( keys %$hr )
    {   # store adr part left of '@'
        next  unless /^mail_([^_]+)_mailuser$/;
        $emailadrs{'email_'.$1} = $hr->{$_}.'@';
        delete $hr->{$_};                           # cleanup

    }
    foreach ( keys %$hr )
    {   # append adr part right of '@'
        next  unless /^mail_([^_]+)_mailhost$/;
        $emailadrs{'email_'.$1} .= $hr->{$_};
        delete $hr->{$_};                           # cleanup
    }

    foreach ( keys %emailadrs )
    {   # copy hash into CGI hash
        $hr->{$_} = $emailadrs{$_};
    }


#    if( $hr->{mail_norm_mailuser} and $hr->{mail_norm_mailhost} )
#    {   # re-gen eMail addr
#        $hr->{email} = $hr->{mail_norm_mailuser}.'@'.$hr->{mail_norm_mailhost};
#    }
#
#    if( $hr->{mail_subs_nom} and $hr->{mail_subs_host} )
#    {   # re-gen eMail addr
#        $hr->{email4lists} = $hr->{mail_subs_nom}.'@'.$hr->{mail_subs_host};
#    }
}





sub zap_info_texts()
{
    # --------- ZAP INFO/EXAMPLE TEXTS SUBMITTED BY INPUT FIELDS ---------------
    #$# delete doesn't get rid of it!!! (this may happen due to our use of HTML:FillInForm)
    # $q->delete('firma_norm_firmnom')    if( $q->param('firma_norm_firmnom') =~ /^\(bitte nur bei Firmenmitgliedschaft/ );
    # $q->delete('pag_noncash')    if( $q->param('pag_noncash') =~ /^\(bitte hier kurze Erlaeuterung/ );
    $q->param('firma_norm_firmnom' => "")    if( $q->param('firma_norm_firmnom') =~ /^\(bitte nur bei Firmenmitgliedschaft/ );
    $q->param('pag_noncash' => "")    if( $q->param('pag_noncash') =~ /^\(bitte hier kurze Erlaeuterung/ );
}


sub fix_unchecked_checkboxes()
{
    # HTML-Checkboxes do not submit ANYTHING when they are UNchecked.
    #   Reading a BOOL field from DB as 't' and clicking it off in the browser will do NOTHING!!
    #   Hence my Javascript-free solution, relying on one or several "checkboxfix_" Hidden Params
    #   All you need is an additional HIDDEN param - no declaration needed in the FormValidator config! Example:
    #    <INPUT type="checkbox" value="t" name="mepqs0405_declined"> Example
    #    <INPUT type="hidden" value="mepqs0405_declined" name="checkboxfix_01"> 

    my $hr = shift;         # get ref to CGI-hash and modify it in place

    # Use any checkboxfix_nn params to compile a list of all checkbox param names that appear in the HTML-form
    #   A comma separated list of all checkboxnames is submitted in HIDDEN vars named checkboxfix_01 , _02 (and so on)
    #   (don't forget to add the checkboxfix_xx varnames to the validation config or they will not pass thru!)
    my @checkboxnames = split( /,/ , join( ',', map { chomp $hr->{$_}; $hr->{$_} } grep { /^checkboxfix_\d*$/ } keys %$hr ));
    ### logsay "[$id] fix_unchecked_checkboxes()   CGIhashkeys:\n%s\nCheckboxlist:\n%s", Dumper(\@{keys %$hr}), Dumper(\@checkboxnames);
    foreach( @checkboxnames )
    {
        # Create a checkbox parameter with value=f (Postgres-bool false value) for every unchecked checkbox
        ### logsay "[$id] fix_unchecked_checkboxes()   pre-check   exists hr{%s}=%s", $_, exists $hr->{$_};
        ( not exists $hr->{$_} )   and   $hr->{$_} = 'f';
        logsay "[$id] fix_unchecked_checkboxes()   post-check  hr{%s}=%s", $_, $hr->{$_};
    }

    foreach( grep { /^checkboxfix_\d*$/ } keys %$hr )
    {
        ### logsay "[$id] fix_unchecked_checkboxes()   DELETING hr{%s}=%s", $_,$hr->{$_};
        delete $hr->{$_};      # don't want to store checkboxfix_nn params in DB/Knecht
    }

}


sub htmlDateSelector()
{

# Generate HTML-code for Erstabbuchung selector (popup-menu)
# (offer several dates starting in the month after the current month)
### Example of resulting HTML:
### my $selHTMLsnippet = '<SELECT name="xyz" size="1"> <OPTION selected value="200206">Juni 2002</option> <OPTION value="200207">Juli 2002</option> <OPTION value="200208">August 2002</option> </SELECT>';
# 1st argument = field name to be generated
my $popup_menu_name = shift;
my $selHTMLsnippet;

my $nxmo1 = $month+1;       # the NEXT month after current month
my $nxmo2 = $month+2;       # 2 months after current month

my @month2txt = (qw/ERR Jan Feb Mrz Apr Mai Jun Jul Aug Sep Okt Nov Dez/);
my $choice1 =  sprintf( '%04d%02d%02d', ($year+(($nxmo1)>12)), (($nxmo1-1)%12+1), 1  );
my $choice2 =  sprintf( '%04d%02d%02d', ($year+(($nxmo1)>12)), (($nxmo1-1)%12+1), 15 );
my $choice3 =  sprintf( '%04d%02d%02d', ($year+(($nxmo2)>12)), (($nxmo2-1)%12+1), 1  );
my $choice4 =  sprintf( '%04d%02d%02d', ($year+(($nxmo2)>12)), (($nxmo2-1)%12+1), 15 );
$selHTMLsnippet = $q->popup_menu(-name=>$popup_menu_name,
                        -values  => [ $choice1, $choice2, $choice3, $choice4 ],
                        -default => $choice1,
                        -labels  => {   '' => 'bitte w&auml;hlen',
                                        # $invdate => 'ab sofort',
                                        $choice1 => '01. '.$month2txt[(($nxmo1-1)%12+1)].' '.($year+(($nxmo1)>12)),
                                        $choice2 => '15. '.$month2txt[(($nxmo1-1)%12+1)].' '.($year+(($nxmo1)>12)),
                                        $choice3 => '01. '.$month2txt[(($nxmo2-1)%12+1)].' '.($year+(($nxmo2)>12)),
                                        $choice4 => '15. '.$month2txt[(($nxmo2-1)%12+1)].' '.($year+(($nxmo2)>12)),
                                    }
                        );

return $selHTMLsnippet;
}



sub htmlEmailSelector()
{

# Generate HTML-code for eMail selector (popup-menu)
### Example of resulting HTML:
### my $selHTMLsnippet = '<SELECT name="xyz" size="1"> <OPTION selected value="norm">abc@web.de</option> <OPTION value="subs">abc@gmx.net</option> </SELECT>';
# 1st argument = field name to be generated
# 2nd arg      = ref to hash with email addresses
# 3rd arg      = key of element in hash to appear as selected
my $popup_menu_name = shift;
my $choices = shift;            #$# shouldn't we HTML-escape those email-addresses or is it done by popup_menu????
my $selected = shift;

logsay "[$id] [htmlEmailSelector] selected: $selected     choices-hash:%s", Dumper($choices);

$q->delete($popup_menu_name);      # or popup_menu overrides our default-setting with prev. choice!

my $selHTMLsnippet = $q->popup_menu(-name=>$popup_menu_name,
                        -values  => [ keys %$choices ],
                        -default => $selected,      # ATTN: popup_menu overrides this with prev. selection!
                        ### -labels  => $choices,   # not required since values sames as labels!
                        );
###logsay "[$id] htmlEmailSelector\n $selHTMLsnippet \n\n";

return $selHTMLsnippet;
}


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


#sub send1mail
#{
#    my $TO = shift;
#    # split up the "to" names for multiple recipients
#    my @TO=split($TO);
#
#    # Open Sendmail and do our thing
#    open (SENDMAIL,"| $SENDMAIL") || htmldie_report_err( 'locxxx', "Couldn't run sendmail", 'modxxx', 1 );
#    print SENDMAIL "To: @TO[0]\n";
#    if ($#TO > 0) { foreach (1..$#TO) { print SENDMAIL "Cc: @TO[$_]\n"; } }
#    print SENDMAIL "Subject: $SUBJECT\n";
#    print SENDMAIL "Reply-To: $REPLYTO\n";
#
#    # Display each field and responses
#    my %in;
#    foreach (my @FIELDS)
#    {
#        $in{$_}=~ s/\0/\n\n   * /g;
#        print SENDMAIL "---------------------------------------------------\n";
#        print SENDMAIL "Input Field: $_\n";
#        print SENDMAIL "Response:\n   * $in{$_}\n";
#    }
#    print SENDMAIL "---------------------------------------------------\n";
#    close(SENDMAIL);
#
#    # Read in the response and print it.
#    # undef $/;  $_=<DATA>;  print;
#    warn "sendmail exited with $?" if $?;
#
#}
#



#------------------------ OTHER UTILITY SUBS -------------------------------------------

sub decode_date()
{
    # decode_date("2002-09-05") returns "5.9.2002"
    my $d = shift;
    $d =~ tr/-//d;     # remove dashes
    return ""    if( length($d) == 0 );
    return (substr($d,6,2)+0).'.'.(substr($d,4,2)+0).'.'.substr($d,0,4);
}


sub asciify_umlauts()
{
    # UMLAUT CONVERSION to basic ASCII
    # the CAPS-handling is specific to our auto-ID naming process! (e.g. Ä gives AE not Ae)
    my $x = shift;
    $x =~ s/ä/ae/g;
    $x =~ s/ö/oe/g;
    $x =~ s/ü/ue/g;
    $x =~ s/Ä/AE/g;
    $x =~ s/Ö/OE/g;
    $x =~ s/Ü/UE/g;
    $x =~ s/ß/SS/g;
    return $x;
}


sub utf2iso()
{
    my $href = shift;
    foreach (keys %$href)
    {
        # utf8 ---> iso
        my $utf = $href->{$_};
        my @iso = unpack('U*', $utf);
        my $iso = pack('C*', @iso);
###logsay "[$id] [utf2iso]  key:$_    orig:$utf   iso:$iso";
        $href->{$_} = $iso;
    }
}


sub iso2utf()
{
    my $href = shift;
    foreach (keys %$href)
    {
        # iso ---> utf8
        my $iso = $href->{$_};
        my @iso = unpack('C*', $iso);
        my $utf = pack('U*', @iso);
###logsay "[$id] [iso2utf]  key:$_    orig:$iso   utf:$utf";
        $href->{$_} = $utf;
    }
}



#------------------------ SUBS RELATED TO KNECHT ---------------------------------------



sub newID_is_rejected
{
    # Checks if a user ID is already registered in knecht's database
    # Return values:
    #   0   if ID is Ok
    #   -2  if ID is a forbidden word
    #   -1  if ID has unacceptable characters or is too short or too long
    #   -999 if knecht returned an unexpected error code
    #   +1  if ID is already in use by someone else
    #
    # Specifying PASS and ADMPASS is irrelevant for the cases cited below
    #$# create consts for retvals in config section

    my $id = shift;
    my $kresponse = knechtcall_checkID( $id );
    logsay "[$id] knechtcall_checkID: returned:$kresponse";

    my $result = -999;

    if($PLATFORM eq 'MSWin32' and $DEBUG) { return 0; }         # DEBUG

    if( $kresponse == 38 ) {
        # ID not allowed because it starts with a word from the exclude-list
        ## knecht cleartext msg: Kennung XXXXX enthaelt den Allerwelts-Begriff YYYYY
        $result = -2;
    }
    elsif( $kresponse == 37 ) {
        # ID exists already!
        ## knecht cleartext msg: Kennung XXXXX bereits in Gebrauch
        $result = 1;
    }
    elsif( $kresponse == 29 ) {
        # Password is wrong (given user id exists)
        # [ATTN: A user "exists" if the ID is listed in knecht's .intern/.idpass]
        # [ATTN: In rare cases, a test users pw might be BLANK so that knecht returns 0 here !!!]
        ## knecht cleartext msg: Zugriff verweigert
        $result = 1;
    }
    elsif( $kresponse == 0  or  $kresponse == 32  or  $kresponse == 30 ) {
        #$# [32 and 30 are obsolete and can be removed!]
        # ID does not exist [THATS WHAT WE WOULD LIKE TO HEAR]
        ## knecht cleartext msg: Zur Neueinrichtung/Ã„nderung der Kennung sind Sie nicht berechtigt
        # value 30 added (will normally not occur)
        $result = 0;
    }
    elsif( $kresponse == 34 ) {
        # ID does not exist AND
        #     spelling or length is not allowed (e.g. digits not permitted in ID)
        ## knecht cleartext msg: Kennung XXXXX unzulaessig
        $result = -1;
    }
    elsif( $kresponse == 13 ) {
        # This error is returned by knecht when it is unable to read/write the data directory
        ## knecht cleartext msg: ?????
        $result = -999;
    }
    else {
        # unexpected knecht retval...
        $result = -999;
    }

    logsay "[$id] newID_is_rejected( $result )    ID = $id    KNretval: $kresponse";  #DEBUG
    return $result;
}



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