← Back to branch summary

~ubuntu-branches/debian/sid/libembperl-perl/sid

« back to all changes in this revision

Viewing changes to Embperl/Form/Validate/FQDN_IPAddr.pm

  • Committer: Bazaar Package Importer
  • Author(s): Angus Lees
  • Date: 2004-02-15 14:23:39 UTC
  • Revision ID: james.westby@ubuntu.com-20040215142339-n21gqf7mx9tmyb8d
Tags: upstream-2.0b10
Import upstream version 2.0b10

Show diffs side-by-side

added added

removed removed

Lines of Context:
Embperl/Form/Validate/FQDN_IPAddr.pm
 
1
 
 
2
###################################################################################
 
3
#
 
4
#   Embperl - Copyright (c) 1997-2004 Gerald Richter / ecos gmbh   www.ecos.de
 
5
#
 
6
#   You may distribute under the terms of either the GNU General Public
 
7
#   License or the Artistic License, as specified in the Perl README file.
 
8
#
 
9
#   THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
 
10
#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
 
11
#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
 
12
#
 
13
#   $Id: FQDN_IPAddr.pm,v 1.2 2004/01/23 06:50:57 richter Exp $
 
14
#
 
15
###################################################################################
 
16
 
 
17
 
 
18
package Embperl::Form::Validate::FQDN_IPAddr ;
 
19
 
 
20
use base qw(Embperl::Form::Validate::Default);
 
21
 
 
22
my %error_messages = 
 
23
(
 
24
    de => 
 
25
    {
 
26
        validate_fqdn_ipaddr => 'Feld %0: "%1" ist keine g�ltiger Hostname oder IP-Adresse.',
 
27
    },
 
28
 
 
29
    en =>
 
30
    {
 
31
        validate_fqdn_ipaddr => 'Field %0: "%1" isn\\\'t a valid hostname or ip-address.',
 
32
    }
 
33
 );
 
34
 
 
35
# --------------------------------------------------------------
 
36
 
 
37
sub getmsg
 
38
    {
 
39
    my ($self, $id, $language, $default_language) = @_ ;
 
40
 
 
41
    return $error_messages{$language}{$id} || 
 
42
           $error_messages{$default_language}{$id} ||
 
43
           $self -> SUPER::getmsg ($id, $language, $default_language) ;
 
44
    }
 
45
 
 
46
 
 
47
# --------------------------------------------------------------
 
48
 
 
49
sub validate 
 
50
    {
 
51
    my ($self, $key, $value, $fdat, $pref) = @_ ;
 
52
    
 
53
    if ($value =~ /^(\d+)\.(\d+).(\d+)\.(\d+)$/)
 
54
        {
 
55
        if ($1 < 0 || $1 > 255 ||
 
56
            $2 < 0 || $2 > 255 ||
 
57
            $3 < 0 || $3 > 255 ||
 
58
            $4 < 0 || $4 > 255)
 
59
            {
 
60
             ;          
 
61
            }
 
62
        else
 
63
                {           
 
64
                return undef ;
 
65
                }
 
66
        }
 
67
        
 
68
        return undef if ($value =~ /^[-.a-zA-Z0-9]+$/) ;
 
69
    return ['validate_fqdn_ipaddr', $value] ; 
 
70
    }
 
71
 
 
72
# --------------------------------------------------------------
 
73
 
 
74
sub getscript_validate 
 
75
    {
 
76
    my ($self, $arg, $pref) = @_ ;
 
77
    
 
78
    return ('obj.value.search(/^[-.a-zA-Z0-9]+$/) >= 0 ', ['validate_fqdn_ipaddr', "'+obj.value+'"]) ;
 
79
    }
 
80
 
 
81
 
 
82
1;