You are viewing a plain text version of this content. The canonical link for it is here.
Posted to embperl-cvs@perl.apache.org by ri...@apache.org on 2003/04/11 07:58:35 UTC

cvs commit: embperl/Embperl/Form/Validate FQDN_IPAddr.pm

richter     2003/04/10 22:58:35

  Modified:    .        Changes.pod
               Embperl/Form Validate.pm
  Added:       Embperl/Form/Validate FQDN_IPAddr.pm
  Log:
  form validate fqdn
  
  Revision  Changes    Path
  1.208     +1 -1      embperl/Changes.pod
  
  Index: Changes.pod
  ===================================================================
  RCS file: /home/cvs/embperl/Changes.pod,v
  retrieving revision 1.207
  retrieving revision 1.208
  diff -u -r1.207 -r1.208
  --- Changes.pod	11 Apr 2003 05:41:16 -0000	1.207
  +++ Changes.pod	11 Apr 2003 05:58:35 -0000	1.208
  @@ -63,7 +63,7 @@
      - EMBPERL_COOKIE_EXPIRES now again accepts relatives times like +2h.
      - embpexec.pl now correctly takes config values from environment
        for application object.
  -   - Added -type => Integer, IPAddr, IPAddr_Net, TimeHHMM, TimeHHMMSS,
  +   - Added -type => Integer, IPAddr, IPAddr_Net, FQDN_IPAddr, TimeHHMM, TimeHHMMSS,
        EMail and EMailRFC to Embperl::Form::Validate.
      - Fixed problem with [$var$] and select reported by Joshua Spoerri. 
      - Embperl compiles and tests now correctly if mod_perl installed
  
  
  
  1.6       +6 -2      embperl/Embperl/Form/Validate.pm
  
  Index: Validate.pm
  ===================================================================
  RCS file: /home/cvs/embperl/Embperl/Form/Validate.pm,v
  retrieving revision 1.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- Validate.pm	24 Feb 2003 07:23:01 -0000	1.5
  +++ Validate.pm	11 Apr 2003 05:58:35 -0000	1.6
  @@ -754,6 +754,10 @@
   
   Input must be an ip-address and network mask in the form nnn.nnn.nnn.nnn/mm
   
  +=item FQDN_IPAddr
  +
  +Input must be an ip-address or an fqdn (host.domain)
  +
   =back
   
   
  
  
  
  1.1                  embperl/Embperl/Form/Validate/FQDN_IPAddr.pm
  
  Index: FQDN_IPAddr.pm
  ===================================================================
  
  ###################################################################################
  #
  #   Embperl - Copyright (c) 1997-2002 Gerald Richter / ecos gmbh   www.ecos.de
  #
  #   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.
  #
  #   $Id: FQDN_IPAddr.pm,v 1.1 2003/04/11 05:58:35 richter Exp $
  #
  ###################################################################################
  
  
  package Embperl::Form::Validate::FQDN_IPAddr ;
  
  use base qw(Embperl::Form::Validate::Default);
  
  my %error_messages = 
  (
      de => 
      {
  	validate_fqdn_ipaddr => 'Feld %0: "%1" ist keine g�ltiger Hostname oder IP-Adresse.',
      },
  
      en =>
      {
  	validate_fqdn_ipaddr => 'Field %0: "%1" isn\\\'t a valid hostname or ip-address.',
      }
   );
  
  # --------------------------------------------------------------
  
  sub getmsg
      {
      my ($self, $id, $language, $default_language) = @_ ;
  
      return $error_messages{$language}{$id} || 
             $error_messages{$default_language}{$id} ||
             $self -> SUPER::getmsg ($id, $language, $default_language) ;
      }
  
  
  # --------------------------------------------------------------
  
  sub validate 
      {
      my ($self, $key, $value, $fdat, $pref) = @_ ;
      
      if ($value =~ /^(\d+)\.(\d+).(\d+)\.(\d+)$/)
  	{
  	if ($1 < 0 || $1 > 255 ||
  	    $2 < 0 || $2 > 255 ||
  	    $3 < 0 || $3 > 255 ||
  	    $4 < 0 || $4 > 255)
  	    {
               ;		
  	    }
  	else
  		{	    
  		return undef ;
  		}
  	}
  	
  	return undef if ($value =~ /^[-.a-zA-Z0-9]+$/) ;
      return ['validate_fqdn_ipaddr', $value] ; 
      }
  
  # --------------------------------------------------------------
  
  sub getscript_validate 
      {
      my ($self, $arg, $pref) = @_ ;
      
      return ('obj.value.search(/^[-.a-zA-Z0-9]+$/) >= 0 ', ['validate_fqdn_ipaddr', "'+obj.value+'"]) ;
      }
  
  
  1;
  
  
  

---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org