###################################################################################
#
#   Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh  www.ecos.de
#   Embperl - Copyright (c) 2008-2015 Gerald Richter
#   Embperl - Copyright (c) 2015-2023 actevy.io
#
#   You may distribute under the terms of either the GNU General Public
#   License or the Artistic License, as specified in the Perl README file.
#
#   THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
###################################################################################
package Embperl::Form::Validate::Default;
use strict;
use vars qw($VERSION %error_messages %script_functions %prefixes);
$VERSION = '3.0.1' ;
%script_functions = ();
%prefixes = ();
use utf8 ;
my %errutf8 =
    (
        validate_required => 'Bitte Feld "%0" ausfüllen',
        validate_eq => 'Falscher Inhalt "%1" des Feldes "%0": Erwartet wird "%2"',
        validate_same => '"%0" stimmt nicht mit "%2" überein',
        validate_lt => '"%0" muß kleiner als %2 sein',
        validate_gt => '"%0" muß größer als %2 sein',
        validate_le => '"%0" muß kleiner oder gleich wie %2 sein',
        validate_ge => '"%0" muß größer oder gleich %2 sein',
        validate_ne => '"%0" muß ungleich %2 sein',
        validate_length_max => 'Inhalt des Feldes "%0" ist zu lang, maximale Länge sind %2, eingegeben wurden %1 Zeichen',
        validate_length_min => 'Inhalt des Feldes "%0" ist zu kurz, minimal Länge sind %2, eingegeben wurden %1 Zeichen',
        validate_length_eq => 'Inhalt des Feldes "%0" hat die falsche Länge: Er sollte %2 Zeichen lang sein, ist aber %1 lang',
        validate_matches_regex => 'Inhalt "%1" des Feldes "%0" entspricht nicht dem regulären Ausdruck /%2/',
        validate_matches_regex_js => 'Inhalt "%1" des Feldes "%0" entspricht nicht dem regulären Ausdruck /%2/',
        validate_not_matches_regex => 'Inhalt "%1" des Feldes "%0" darf nicht dem regulären Ausdruck /%2/ entsprechen',
        validate_not_matches_regex_js => 'Inhalt "%1" des Feldes "%0" darf nicht dem regulären Ausdruck /%2/ entsprechen',
        validate_matches_wildcard => 'Inhalt "%1" des Feldes "%0" entspricht nicht dem Wildcard-Ausdruck "%2"',
        validate_must_only_contain => 'Das Feld "%0" darf nur folgende Zeichen enthalten: "%2"',
        validate_must_contain_one_of => 'Das Feld "%0" muß mindestens eines der folgenden Zeichen enthalten: "%2"',
        validate_must_not_contain => 'Das Feld "%0" darf folgende Zeichen nicht enthalten: "%2"'
    ) ;
no utf8 ;
%error_messages = 
(
    de => 
    {
        validate_required => 'Bitte Feld "%0" ausfüllen',
        validate_eq => 'Falscher Inhalt "%1" des Feldes "%0": Erwartet wird "%2"',
        validate_same => '"%0" stimmt nicht mit "%2" überein',
        validate_lt => '"%0" muß kleiner als %2 sein',
        validate_gt => '"%0" muß größer als %2 sein',
        validate_le => '"%0" muß kleiner oder gleich wie %2 sein',
        validate_ge => '"%0" muß größer oder gleich %2 sein',
        validate_ne => '"%0" muß ungleich %2 sein',
        validate_length_max => 'Inhalt des Feldes "%0" ist zu lang, maximale Länge sind %2, eingegeben wurden %1 Zeichen',
        validate_length_min => 'Inhalt des Feldes "%0" ist zu kurz, minimal Länge sind %2, eingegeben wurden %1 Zeichen',
        validate_length_eq => 'Inhalt des Feldes "%0" hat die falsche Länge: Er sollte %2 Zeichen lang sein, ist aber %1 lang',
        validate_matches_regex => 'Inhalt "%1" des Feldes "%0" entspricht nicht dem regulären Ausdruck /%2/',
        validate_matches_regex_js => 'Inhalt "%1" des Feldes "%0" entspricht nicht dem regulären Ausdruck /%2/',
        validate_not_matches_regex => 'Inhalt "%1" des Feldes "%0" darf nicht dem regulären Ausdruck /%2/ entsprechen',
        validate_not_matches_regex_js => 'Inhalt "%1" des Feldes "%0" darf nicht dem regulären Ausdruck /%2/ entsprechen',
        validate_matches_wildcard => 'Inhalt "%1" des Feldes "%0" entspricht nicht dem Wildcard-Ausdruck "%2"',
        validate_must_only_contain => 'Das Feld "%0" darf nur folgende Zeichen enthalten: "%2"',
        validate_must_contain_one_of => 'Das Feld "%0" muß mindestens eines der folgenden Zeichen enthalten: "%2"',
        validate_must_not_contain => 'Das Feld "%0" darf folgende Zeichen nicht enthalten: "%2"'
    },
     
    'de.utf8' => \%errutf8,
     
    en =>
    {
        validate_required => 'Please enter a value in "%0"',
        validate_eq => 'Wrong content "%1" of field "%0": Expected "%2"',
        validate_same => '"%0" does not match "%2"',
        validate_lt => '"%0" must be less then %2',
        validate_gt => '"%0" must be greater then %2',
        validate_le => '"%0" must be less or equal then %2',
        validate_ge => '"%0" must be greater or equal then %2',
        validate_ne => 'Wrong content "%1" of field "%0": Expected not "%2"',
        validate_length_max => 'Content of field "%0" is too long, has %1 characters, maximum is %2 characters',
        validate_length_min => 'Content of field "%0" is too short, has %1 characters, minimum is %2 characters',
        validate_length_eq => 'Content of field "%0" has wrong length: It is %1 characters long, but should be %2 characters long',
        validate_matches_regex => 'Field "%0" doesn"t match regexp /%2/',
        validate_matches_regex_js => 'Field "%0" doesn"t match regexp /%2/',
        validate_not_matches_regex => 'Field "%0" must not match regexp /%2/',
        validate_not_matches_regex_js => 'Field "%0" must not match regexp /%2/',
        validate_matches_wildcard => 'Field "%0" doesn"t match wildcard expression "%2"',
        validate_must_only_contain => 'Field "%0" must contain only the following characters: "%2"',
        validate_must_contain_one_of => 'Field "%0" must contain one of the following characters: "%2"',
        validate_must_not_contain => 'Field "%0" must not contain the following characters: "%2"'
    }
 );
# --------------------------------------------------------------
sub new 
    {
    my $invokedby = shift;
    my $class = ref($invokedby) || $invokedby;
    my $self = {} ;
    bless($self, $class);
    $self->init;
    return $self;
    }
# --------------------------------------------------------------
sub getmsg
    {
    my ($self, $id, $language, $default_language) = @_ ;
    return $error_messages{$language}{$id} || $error_messages{$default_language}{$id} ;
    }
# --------------------------------------------------------------
sub init
    {
    my $self = shift;
    return 1;
    }
# --------------------------------------------------------------
sub validate 
    {
    return undef ; 
    }
# --------------------------------------------------------------
sub validate_required
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return defined($value) && $value ne '' ? undef : ['validate_required'] ;
    }
# --------------------------------------------------------------
sub getscript_required
    {
    my ($self, $arg, $pref) = @_ ;
     
    return ('obj instanceof NodeList?obj[0].value:obj.value', ['validate_required']) ;
    }
# --------------------------------------------------------------
sub validate_emptyok
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return !defined($value) || $value eq ''  ? [] : undef ;
    }
# --------------------------------------------------------------
sub getscript_emptyok
    {
    my ($self, $arg, $pref) = @_ ;
     
    return ('obj.value') ;
    }
# --------------------------------------------------------------
sub validate_checked
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return !defined($value) || $value eq ''  ? undef : []  ;
    }
# --------------------------------------------------------------
sub getscript_checked
    {
    my ($self, $arg, $pref) = @_ ;
     
    return ('obj.checked') ;
    }
# --------------------------------------------------------------
sub validate_notchecked
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return !defined($value) || $value eq ''  ? [] : undef ;
    }
# --------------------------------------------------------------
sub getscript_notchecked
    {
    my ($self, $arg, $pref) = @_ ;
     
    return ('!obj.checked') ;
    }
# --------------------------------------------------------------
sub validate_eq 
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return $value eq $arg ? undef : ['validate_eq', $value, $arg] ;
    }
# --------------------------------------------------------------
sub getscript_eq 
    {
    my ($self, $arg, $pref) = @_ ;
     
    return ("obj.value == '$arg'", ['validate_eq', "+'obj.value'+", $arg]) ;
    }
# --------------------------------------------------------------
sub validate_same
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
    my ($key2, $name2) = split (/:/, $arg) ;
    $name2 ||= $key2 ;
     
    return $value eq $fdat -> {$key2} ? undef : ['validate_same', $value, $name2] ;
    }
# --------------------------------------------------------------
sub getscript_same 
    {
    my ($self, $arg, $pref, $form) = @_ ;
     
    my ($key2, $name2) = split (/:/, $arg) ;
    $name2 ||= $key2 ;
    return ("obj.value == formelem\['$key2'\].value", ['validate_same', "+'obj.value'+", $name2]) ;
    }
# --------------------------------------------------------------
sub validate_gt
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return $value gt $arg ? undef : ['validate_gt', $value, $arg] ;
    }
# --------------------------------------------------------------
sub getscript_gt
    {
    my ($self, $arg, $pref) = @_ ;
     
    return ("obj.value > '$arg'", ['validate_gt', "+'obj.value'+", $arg]) ;
    }
# --------------------------------------------------------------
sub validate_lt
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return $value lt $arg ? undef : ['validate_lt', $value, $arg] ;
    }
# --------------------------------------------------------------
sub getscript_lt
    {
    my ($self, $arg, $pref) = @_ ;
     
    return ("obj.value < '$arg'", ['validate_lt', "+'obj.value'+", $arg]) ;
    }
# --------------------------------------------------------------
sub validate_ge
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return $value ge $arg ? undef : ['validate_ge', $value, $arg] ;
    }
# --------------------------------------------------------------
sub getscript_ge
    {
    my ($self, $arg, $pref) = @_ ;
     
    return ("obj.value >= '$arg'", ['validate_ge', "+'obj.value'+", $arg]) ;
    }
# --------------------------------------------------------------
sub validate_le
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return $value le $arg ? undef : ['validate_le', $value, $arg] ;
    }
# --------------------------------------------------------------
sub getscript_le
    {
    my ($self, $arg, $pref) = @_ ;
     
    return ("obj.value <= '$arg'", ['validate_gt', "+'obj.value'+", $arg]) ;
    }
# --------------------------------------------------------------
sub validate_ne
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return $value ne $arg ? undef : ['validate_ne', $value, $arg] ;
    }
# --------------------------------------------------------------
sub getscript_ne
    {
    my ($self, $arg, $pref) = @_ ;
     
    return ("obj.value != '$arg'", ['validate_gt', "+'obj.value'+", $arg]) ;
    }
# --------------------------------------------------------------
sub validate_length_max
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return length($value) <= $arg ? undef : ['validate_length_max', length($value), $arg] ;
    }
# --------------------------------------------------------------
sub getscript_length_max
    {
    my ($self, $arg, $pref) = @_ ;
     
    return ("obj.value.length <= $arg", ['validate_length_max', "'+obj.value.length+'", $arg]) ;
    }
# --------------------------------------------------------------
sub validate_length_min
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return length($value) >= $arg ? undef : ['validate_length_min', length($value), $arg] ;
    }
# --------------------------------------------------------------
sub getscript_length_min
    {
    my ($self, $arg, $pref) = @_ ;
     
    return ("obj.value.length >= $arg", ['validate_length_min', "'+obj.value.length+'", $arg]) ;
    }
# --------------------------------------------------------------
sub validate_length_eq
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return length($value) == $arg ? undef : ['validate_length_eq', length($value), $arg] ;
    }
# --------------------------------------------------------------
sub getscript_length_eq
    {
    my ($self, $arg, $pref) = @_ ;
     
    return ("obj.value.length == $arg", ['validate_length_eq', "'+obj.value.length+'", $arg]) ;
    }
# --------------------------------------------------------------
sub validate_matches_regex
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return ($value =~ /$arg/) ? undef : ['validate_matches_regex', $value, $arg] ;
    }
# --------------------------------------------------------------
sub validate_matches_regex_perl
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return ($value =~ /$arg/) ? undef : ['validate_matches_regex', $value, $arg] ;
    }
# --------------------------------------------------------------
sub validate_matches_regex_js
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return undef  ; # only client side!
    }
# --------------------------------------------------------------
sub getscript_matches_regex
    {
    my ($self, $arg, $pref) = @_ ;
     
    $arg =~ s(/)(\\/)g; # JS needs / escaping
    return ("obj.value.search(/$arg/) >= 0", ['validate_matches_regex', "'+obj.value+'", $arg]) ;
    }
# --------------------------------------------------------------
sub getscript_matches_regex_js
    {
    my ($self, $arg, $pref) = @_ ;
     
    $arg =~ s(/)(\\/)g; # JS needs / escaping
    return ("obj.value.search(/$arg/) >= 0", ['validate_matches_regex', "'+obj.value+'", $arg]) ;
    }
# --------------------------------------------------------------
sub validate_not_matches_regex
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return ($value !~ /$arg/) ? undef : ['validate_not_matches_regex', $value, $arg] ;
    }
# --------------------------------------------------------------
sub validate_not_matches_regex_perl
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return ($value !~ /$arg/) ? undef : ['validate_not_matches_regex', $value, $arg] ;
    }
# --------------------------------------------------------------
sub validate_not_matches_regex_js
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    return undef ; # only client side!
    }
# --------------------------------------------------------------
sub getscript_not_matches_regex
    {
    my ($self, $arg, $pref) = @_ ;
     
    $arg =~ s(/)(\\/)g; # JS needs / escaping
    return ("obj.value.search(/$arg/) < 0", ['validate_not_matches_regex', "'+obj.value+'", $arg]) ;
    }
# --------------------------------------------------------------
sub getscript_not_matches_regex_js
    {
    my ($self, $arg, $pref) = @_ ;
     
    $arg =~ s(/)(\\/)g; # JS needs / escaping
    return ("obj.value.search(/$arg/) < 0", ['validate_not_matches_regex', "'+obj.value+'", $arg]) ;
    }
# --------------------------------------------------------------
sub validate_matches_wildcard
    {
    my ($self, $key, $value, $wc, $fdat, $pref) = @_ ;
     
    $wc =~ s/=/==/g;
    $wc =~ s/(^|[^\\])\?/$1=./g;
    $wc =~ s/([^\\])\*/$1=.=*/g;
    $wc =~ s/([^\\])([][])/$1=$2/g;
    $wc =~ s/=(.)/$1/g;
    return ($value =~ /$wc/) ? undef : ['validate_matches_wildcard', $value, $wc] ;
    }
# --------------------------------------------------------------
sub validate_must_only_contain
    {
    my ($self, $key, $value, $moc, $fdat, $pref) = @_ ;
     
    $moc =~ s/^\^(.)/$1^/;
    $moc =~ s/^(.*)\]/\]$1/;
    $moc =~ s/^(.*)-/-$1/;
    $moc =~ s#/#\\/#;
    return ($value =~ /^[$moc]*$/) ? undef : ['validate_must_only_contain', $value, $moc] ;
    }
# --------------------------------------------------------------
sub getscript_must_only_contain
    {
    my ($self, $arg, $pref) = @_ ;
     
    $arg =~ s/^\^(.)/$1^/;
    $arg =~ s/^(.*)\]/\]$1/;
    $arg =~ s/^(.*)-/-$1/;
    $arg =~ s#/#\\/#;
    return ("obj.value.search(/^[$arg]*\$/) >= 0", ['validate_must_only_contain', "'+obj.value+'", $arg]) ;
    }
# --------------------------------------------------------------
sub validate_must_not_contain
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    $arg =~ s/^\^(.)/$1^/;
    $arg =~ s/^(.*)\]/\]$1/;
    $arg =~ s/^(.*)-/-$1/;
    $arg =~ s#/#\\/#;
    return ($value !~ /[$arg]/) ? undef : ['validate_must_only_contain', $value, $arg] ;
    }
# --------------------------------------------------------------
sub getscript_must_not_contain
    {
    my ($self, $arg, $pref) = @_ ;
     
    $arg =~ s/^\^(.)/$1^/;
    $arg =~ s/^(.*)\]/\]$1/;
    $arg =~ s/^(.*)-/-$1/;
    $arg =~ s#/#\\/#;
    return ("obj.value.search(/[$arg]/) == -1", ['validate_must_not_contain', "'+obj.value+'", $arg]) ;
    }
# --------------------------------------------------------------
sub validate_must_contain_one_of
    {
    my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
     
    $arg =~ s/^\^(.)/$1^/;
    $arg =~ s/^(.*)\]/\]$1/;
    $arg =~ s/^(.*)-/-$1/;
    $arg =~ s#/#\\/#;
    return ($value =~ /[$arg]/) ? undef : ['validate_must_only_contain', $value, $arg] ;
    }
# --------------------------------------------------------------
sub getscript_must_contain_one_of
    {
    my ($self, $arg, $pref) = @_ ;
     
    $arg =~ s/^\^(.)/$1^/;
    $arg =~ s/^(.*)\]/\]$1/;
    $arg =~ s/^(.*)-/-$1/;
    $arg =~ s#/#\\/#;
    return ("obj.value.search(/[$arg]/) >= 0", ['validate_must_contain_one_of', "'+obj.value+'", $arg]) ;
    }
# --------------------------------------------------------------
1 ;