r77 - in packages: . libemail-valid-perl libemail-valid-perl/branches libemail-valid-perl/branches/upstream libemail-valid-perl/branches/upstream/current libemail-valid-perl/branches/upstream/current/t
Allard Hoeve
hoeve-guest@haydn.debian.org
Thu, 10 Jun 2004 07:41:10 -0600
Author: hoeve-guest
Date: 2004-06-10 07:41:06 -0600 (Thu, 10 Jun 2004)
New Revision: 77
Added:
packages/libemail-valid-perl/
packages/libemail-valid-perl/branches/
packages/libemail-valid-perl/branches/upstream/
packages/libemail-valid-perl/branches/upstream/current/
packages/libemail-valid-perl/branches/upstream/current/Changes
packages/libemail-valid-perl/branches/upstream/current/MANIFEST
packages/libemail-valid-perl/branches/upstream/current/Makefile.PL
packages/libemail-valid-perl/branches/upstream/current/README
packages/libemail-valid-perl/branches/upstream/current/Valid.pm
packages/libemail-valid-perl/branches/upstream/current/t/
packages/libemail-valid-perl/branches/upstream/current/t/valid.t
packages/libemail-valid-perl/tags/
Log:
[svn-inject] Installing original source of libemail-valid-perl
Added: packages/libemail-valid-perl/branches/upstream/current/Changes
===================================================================
--- packages/libemail-valid-perl/branches/upstream/current/Changes 2004-06-10 13:40:10 UTC (rev 76)
+++ packages/libemail-valid-perl/branches/upstream/current/Changes 2004-06-10 13:41:06 UTC (rev 77)
@@ -0,0 +1,73 @@
+Revision history for Perl extension Email::Valid.
+
+0.15 Sun Sep 7 21:39:12 PDT 2003
+ - Support for top level domain validity check added by Elizabeth
+ Mattijsen (liz@dijkmat.nl). Updated documentation and added tests.
+ - Patch to improve portability when looking
+ for nslookup executable. Thanks to Chromatic<chromatic@wgz.org>
+ - Update AOL rules in local_rules check thanks to
+ Paul Fierro <pablo@nothing.com>
+
+0.14 Wed Jul 3 12:58:50 CEST 2002
+ - Applied patch from Michael G Schwern <schwern@pobox.com>
+ to remove 'use UNIVERSAL'.
+
+0.13 Tue Jan 16 13:25:57 PST 2001
+ - Only load Net::DNS module if required
+
+0.12 Thu Jul 8 22:26:41 PDT 1999
+ - Added details() method to determine why an
+ address check fails. Thanks to Otis Gospodnetic
+ for the suggestion.
+ - Global Net::DNS::Resolver object is now used for
+ DNS queries when Net::DNS is available. Can be accessed
+ directly to tweak the resolver behavior.
+ - The address() method now returns an additional
+ value (an instance of the Mail::Address class)
+ when called in a list context.
+ - Updated documentation.
+
+0.11 Wed Jul 7 04:33:58 PDT 1999
+ - Changed name to Mail::Address
+ - RELEASE WITHDRAWN PENDING DISCUSSION OF THIS NAME CHANGE
+
+0.09 Thu Apr 8 17:21:15 PDT 1999
+ - Added Mail::Address to PREREQ_PM to list
+ dependency, as suggested by Achim.
+ - Moved test.pl to t/valid.t as suggested by Achim.
+ - DNS lookups now use Net::DNS if available, falling
+ back to nslookup if not. Suggested by
+ Lupe Christoph.
+ - Modified documentation
+ - Renamed Email::Valid::NSLookup to Email::Valid::DNS,
+ which is now responsible for all DNS queries.
+
+0.08
+ - Removed a couple of warnings when running under -w
+ - Bug handling AOL local rules fixed
+ - local_rules() now defaults to off
+
+0.07 Tue Jan 12 02:04:57 PST 1999
+ - Mail::Address module is now required
+ - Added Email::Valid::NSLookup module to
+ encapsulate DNS lookups -- now we can
+ add additional classes to use other utilities.
+ - Fixed problem with spaces thanks to David Birnbaum.
+ - Renamed a couple of the parameters -- old names
+ should still work.
+
+0.06 Tue May 26 14:27:34 1998
+ - Modified named parameter parsing
+
+0.05 Mon May 11 00:56:00 1998
+ - fudge() now defaults to false
+ - Modified documentation
+ - Changed behavior of fully_qualified
+
+0.04 Thu May 7 16:42:00 1998
+ - Added support for Mail::Address objects
+ - Added positional/named parameter calling style
+ - Updated documentation
+
+0.01 Fri Mar 6 22:19:54 1998
+ - original version; created by h2xs 1.18
Added: packages/libemail-valid-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libemail-valid-perl/branches/upstream/current/MANIFEST 2004-06-10 13:40:10 UTC (rev 76)
+++ packages/libemail-valid-perl/branches/upstream/current/MANIFEST 2004-06-10 13:41:06 UTC (rev 77)
@@ -0,0 +1,6 @@
+Changes
+Valid.pm
+README
+MANIFEST
+Makefile.PL
+t/valid.t
Added: packages/libemail-valid-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libemail-valid-perl/branches/upstream/current/Makefile.PL 2004-06-10 13:40:10 UTC (rev 76)
+++ packages/libemail-valid-perl/branches/upstream/current/Makefile.PL 2004-06-10 13:41:06 UTC (rev 77)
@@ -0,0 +1,9 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'Email::Valid',
+ 'VERSION_FROM' => 'Valid.pm',
+ 'PREREQ_PM' => { 'Mail::Address' => 0 },
+ 'dist' => { 'COMPRESS'=>'gzip -9f', 'SUFFIX' => 'gz',
+ 'ZIP'=>'/usr/bin/zip', 'ZIPFLAGS'=>'-rl' }
+);
Added: packages/libemail-valid-perl/branches/upstream/current/README
===================================================================
--- packages/libemail-valid-perl/branches/upstream/current/README 2004-06-10 13:40:10 UTC (rev 76)
+++ packages/libemail-valid-perl/branches/upstream/current/README 2004-06-10 13:41:06 UTC (rev 77)
@@ -0,0 +1,59 @@
+DESCRIPTION
+
+ This module determines whether an email address is well-formed, and
+ optionally, whether a mail host exists for the domain or whether
+ the top level domain of the email address is valid.
+
+COPYRIGHT
+
+ Copyright 1998-2003, Maurice Aubrey <maurice@hevanet.com>.
+ All rights reserved.
+
+ This module is free software; you may redistribute it and/or
+ modify it under the same terms as Perl itself.
+
+PREREQUISITES
+
+ This module requires perl 5.004 or later and the Mail::Address module.
+ The Net::DNS module is required for DNS checks.
+
+ Either the Net::DNS module or the nslookup utility are required
+ to perform DNS checks.
+
+ The Net::Domain::TLD module is required to check validity of top level
+ domains.
+
+ Under Win32, the module tests take a very long time, so be patient.
+
+INSTALLATION
+
+ To install this module, move into the directory where this file is
+ located and type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+ This will install the module into the Perl library directory. If
+ you lack sufficient privileges for this, then you can specify an
+ alternate directory like this:
+
+ perl Makefile.PL PREFIX=/where/I/want/it/put
+ make
+ make test
+ make install
+
+ Once installed, you can use the following line to load the module into
+ your scripts:
+
+ use Email::Valid;
+
+ If you installed the module into an alternative directory, you will
+ need to let Perl know where it can be found:
+
+ use lib "/path/to/my/modules";
+ use Email::Valid;
+
+ See the POD documentation for further details.
+
Added: packages/libemail-valid-perl/branches/upstream/current/Valid.pm
===================================================================
--- packages/libemail-valid-perl/branches/upstream/current/Valid.pm 2004-06-10 13:40:10 UTC (rev 76)
+++ packages/libemail-valid-perl/branches/upstream/current/Valid.pm 2004-06-10 13:41:06 UTC (rev 77)
@@ -0,0 +1,601 @@
+package Email::Valid;
+
+use strict;
+use vars qw( $VERSION $RFC822PAT %AUTOLOAD $AUTOLOAD $NSLOOKUP_PAT
+ @NSLOOKUP_PATHS $Details $Resolver $Nslookup_Path
+ $DNS_Method $TLD $Debug );
+use Carp;
+use IO::File;
+use Mail::Address;
+use File::Spec;
+
+$VERSION = '0.15';
+
+%AUTOLOAD = ( mxcheck => 1, tldcheck => 1, fudge => 1, fqdn => 1, local_rules => 1 );
+$NSLOOKUP_PAT = 'preference|serial|expire|mail\s+exchanger';
+@NSLOOKUP_PATHS = File::Spec->path();
+
+# initialize if already loaded, better in prefork mod_perl environment
+$DNS_Method = defined $Net::DNS::VERSION ? 'Net::DNS' : '';
+$TLD = Net::Domain::TLD->new if defined $Net::Domain::TLD::VERSION;
+
+sub new {
+ my $class = shift;
+
+ $class = ref $class || $class;
+ bless my $self = {}, $class;
+ $self->_initialize;
+ %$self = $self->_rearrange([qw( mxcheck tldcheck fudge fqdn local_rules )], \@_);
+ return $self;
+}
+
+sub _initialize {
+ my $self = shift;
+
+ $self->{mxcheck} = 0;
+ $self->{tldcheck} = 0;
+ $self->{fudge} = 0;
+ $self->{fqdn} = 1;
+ $self->{local_rules} = 0;
+ $self->{details} = $Details = undef;
+}
+
+# Pupose: handles named parameter calling style
+sub _rearrange {
+ my $self = shift;
+ my(@names) = @{ shift() };
+ my(@params) = @{ shift() };
+ my(%args);
+
+ ref $self ? %args = %$self : _initialize( \%args );
+ return %args unless @params;
+
+ unless ($params[0] =~ /^-/) {
+ while(@params) {
+ croak 'unexpected number of parameters' unless @names;
+ $args{ lc shift @names } = shift @params;
+ }
+ return %args;
+ }
+
+ while(@params) {
+ my $param = lc substr(shift @params, 1);
+ $args{ $param } = shift @params;
+ }
+
+ %args;
+}
+
+# Purpose: determine why an address failed a check
+sub details {
+ my $self = shift;
+
+ return (ref $self ? $self->{details} : $Details) unless @_;
+ $Details = shift;
+ $self->{details} = $Details if ref $self;
+ return undef;
+}
+
+# Purpose: Check whether address conforms to RFC 822 syntax.
+sub rfc822 {
+ my $self = shift;
+ my %args = $self->_rearrange([qw( address )], \@_);
+
+ my $addr = $args{address} or return $self->details('rfc822');
+ $addr = $addr->address if UNIVERSAL::isa($addr, 'Mail::Address');
+
+ return $self->details('rfc822') unless $addr =~ m/^$RFC822PAT$/o;
+
+ return 1;
+}
+
+# Purpose: attempt to locate the nslookup utility
+sub _find_nslookup {
+ my $self = shift;
+
+ my $ns = 'nslookup';
+ $ns .= '.exe' if $^O =~ /win32/i;
+ foreach my $path (@NSLOOKUP_PATHS) {
+ my $file = File::Spec->catfile($path, $ns);
+ return $file if -x $file and !-d _;
+ }
+ return undef;
+}
+
+sub _select_dns_method {
+ # Configure a global resolver object for DNS queries
+ # if Net::DNS is available
+ eval { require Net::DNS };
+ return $DNS_Method = 'Net::DNS' unless $@;
+
+ $DNS_Method = 'nslookup';
+}
+
+# Purpose: perform DNS query using the Net::DNS module
+sub _net_dns_query {
+ my $self = shift;
+ my $host = shift;
+
+ $Resolver = Net::DNS::Resolver->new unless defined $Resolver;
+
+ my $packet = $Resolver->send($host, 'A') or croak $Resolver->errorstring;
+ return 1 if $packet->header->ancount;
+
+ $packet = $Resolver->send($host, 'MX') or croak $Resolver->errorstring;
+ return 1 if $packet->header->ancount;
+
+ return $self->details('mx');
+}
+
+# Purpose: perform DNS query using the nslookup utility
+sub _nslookup_query {
+ my $self = shift;
+ my $host = shift;
+ local($/, *OLDERR);
+
+ unless ($Nslookup_Path) {
+ $Nslookup_Path = $self->_find_nslookup
+ or croak 'unable to locate nslookup';
+ }
+
+ # Check for an A record
+ return 1 if gethostbyname $host;
+
+ # Check for an MX record
+ if (my $fh = new IO::File '-|') {
+ my $response = <$fh>;
+ print STDERR $response if $Debug;
+ close $fh;
+ $response =~ /$NSLOOKUP_PAT/io or return $self->details('mx');
+ return 1;
+ } else {
+ open OLDERR, '>&STDERR' or croak "cannot dup stderr: $!";
+ open STDERR, '>&STDOUT' or croak "cannot redirect stderr to stdout: $!";
+ {
+ exec $Nslookup_Path, '-query=mx', $host;
+ }
+ open STDERR, ">&OLDERR";
+ croak "unable to execute nslookup '$Nslookup_Path': $!";
+ }
+}
+
+# Purpose: Check whether a top level domain is valid for a domain.
+sub tld {
+ my $self = shift;
+ my %args = $self->_rearrange([qw( address )], \@_);
+
+ if (!defined $TLD) {
+ require Net::Domain::TLD;
+ $TLD = Net::Domain::TLD->new;
+ }
+
+ my $host = $self->_host( $args{address} or return $self->details('tld') );
+ $host =~ m#\.(\w+)$#;
+ $TLD->exists( $1 );
+}
+
+# Purpose: Check whether a DNS record (A or MX) exists for a domain.
+sub mx {
+ my $self = shift;
+ my %args = $self->_rearrange([qw( address )], \@_);
+
+ my $host = $self->_host($args{address}) or return $self->details('mx');
+
+ $self->_select_dns_method unless $DNS_Method;
+
+ if ($DNS_Method eq 'Net::DNS') {
+ print STDERR "using Net::DNS for dns query\n" if $Debug;
+ return $self->_net_dns_query( $host );
+ } elsif ($DNS_Method eq 'nslookup') {
+ print STDERR "using nslookup for dns query\n" if $Debug;
+ return $self->_nslookup_query( $host );
+ } else {
+ croak "unknown DNS method '$DNS_Method'";
+ }
+}
+
+# Purpose: convert address to host
+# Returns: host
+
+sub _host {
+ my $self = shift;
+ my $addr = shift;
+
+ $addr = $addr->address if UNIVERSAL::isa($addr, 'Mail::Address');
+
+ my $host = ($addr =~ /^.*@(.*)$/ ? $1 : $addr);
+ $host =~ s/\s+//g;
+
+ # REMOVE BRACKETS IF IT'S A DOMAIN-LITERAL
+ # RFC822 3.4.6
+ # Square brackets ("[" and "]") are used to indicate the
+ # presence of a domain-literal, which the appropriate
+ # name-domain is to use directly, bypassing normal
+ # name-resolution mechanisms.
+ $host =~ s/(^\[)|(\]$)//g;
+ $host;
+}
+
+# Purpose: Fix common addressing errors
+# Returns: Possibly modified address
+sub _fudge {
+ my $self = shift;
+ my $addr = shift;
+
+ $addr =~ s/\s+//g if $addr =~ /aol\.com$/i;
+ $addr =~ s/,/./g if $addr =~ /compuserve\.com$/i;
+ $addr;
+}
+
+# Purpose: Special address restrictions on a per-domain basis.
+# Caveats: These organizations may change their rules at any time.
+sub _local_rules {
+ my $self = shift;
+ my($user, $host) = @_;
+
+ # AOL addresses cannot:
+ # - Be shorter than 3 or longer than 16 characters
+ # - Begin with numerals
+ # - Contain periods, underscores, dashes or other punctuation characters
+ #
+ # http://postmaster.info.aol.com/faq.html
+ # Last updated: Aug 23, 2003
+ if ($host =~ /aol\.com/i) {
+ return undef unless $user =~ /^[a-zA-Z][a-zA-Z0-9]{2,15}$/;
+ }
+ 1;
+}
+
+# Purpose: Put an address through a series of checks to determine
+# whether it should be considered valid.
+sub address {
+ my $self = shift;
+ my %args = $self->_rearrange([qw( address fudge mxcheck tldcheck fqdn
+ local_rules )], \@_);
+
+ my $addr = $args{address} or return $self->details('rfc822');
+ $addr = $addr->address if UNIVERSAL::isa($addr, 'Mail::Address');
+
+ $addr = $self->_fudge( $addr ) if $args{fudge};
+ $self->rfc822( $addr ) or return undef;
+
+ ($addr) = Mail::Address->parse( $addr );
+ $addr or return $self->details('rfc822'); # This should never happen
+
+ if ($args{local_rules}) {
+ $self->_local_rules( $addr->user, $addr->host )
+ or return $self->details('local_rules');
+ }
+
+ if ($args{fqdn}) {
+ $addr->host =~ /^.+\..+$/ or return $self->details('fqdn');
+ }
+
+ if ($args{mxcheck}) {
+ $self->mx( $addr->host ) or return;
+ }
+
+ if ($args{tldcheck}) {
+ $self->tld( $addr->host ) or return;
+ }
+
+ return (wantarray ? ($addr->address, $addr) : $addr->address);
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+ my $type = ref($self) || die "$self is not an object";
+ my $name = $AUTOLOAD;
+
+ $name =~ s/.*://;
+ return if $name eq 'DESTROY';
+ die "unknown autoload name '$name'" unless $AUTOLOAD{$name};
+
+ return (@_ ? $self->{$name} = shift : $self->{$name});
+}
+
+# Regular expression built using Jeffrey Friedl's example in
+# _Mastering Regular Expressions_ (http://www.ora.com/catalog/regexp/).
+
+$RFC822PAT = <<'EOF';
+[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\
+xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xf
+f\n\015()]*)*\)[\040\t]*)*(?:(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\x
+ff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n\015
+"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[\040\t]*(?:\([^\\\x80-\
+xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80
+-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*
+)*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\
+\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\
+x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x8
+0-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n
+\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[\040\t]*(?:\([^\\\x
+80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^
+\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040
+\t]*)*)*@[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([
+^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\
+\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\
+x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-
+\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()
+]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\
+x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\04
+0\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\
+n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\
+015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?!
+[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\
+]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\
+x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\01
+5()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)*|(?:[^(\040)<>@,;:".
+\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]
+)|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[^
+()<>@,;:".\\\[\]\x80-\xff\000-\010\012-\037]*(?:(?:\([^\\\x80-\xff\n\0
+15()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][
+^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)|"[^\\\x80-\xff\
+n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[^()<>@,;:".\\\[\]\
+x80-\xff\000-\010\012-\037]*)*<[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?
+:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-
+\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:@[\040\t]*
+(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015
+()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()
+]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\0
+40)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\
+[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\
+xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*
+)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80
+-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x
+80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t
+]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\
+\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])
+*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x
+80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80
+-\xff\n\015()]*)*\)[\040\t]*)*)*(?:,[\040\t]*(?:\([^\\\x80-\xff\n\015(
+)]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\
+\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*@[\040\t
+]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\0
+15()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015
+()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(
+\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|
+\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80
+-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()
+]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x
+80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^
+\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040
+\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".
+\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff
+])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\
+\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x
+80-\xff\n\015()]*)*\)[\040\t]*)*)*)*:[\040\t]*(?:\([^\\\x80-\xff\n\015
+()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\
+\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)?(?:[^
+(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-
+\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\
+n\015"]*)*")[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|
+\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))
+[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff
+\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\x
+ff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(
+?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\
+000-\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\
+xff\n\015"]*)*")[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\x
+ff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)
+*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)*@[\040\t]*(?:\([^\\\x80-\x
+ff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-
+\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)
+*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\
+]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\]
+)[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-
+\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\x
+ff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(
+?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80
+-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<
+>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x8
+0-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?:
+\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]
+*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)
+*\)[\040\t]*)*)*>)
+EOF
+
+$RFC822PAT =~ s/\n//g;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Email::Valid - Check validity of Internet email addresses
+
+=head1 SYNOPSIS
+
+ use Email::Valid;
+ print (Email::Valid->address('maurice@hevanet.com') ? 'yes' : 'no');
+
+=head1 DESCRIPTION
+
+This module determines whether an email address is well-formed, and
+optionally, whether a mail host exists for the domain.
+
+Please note that there is no way to determine whether an
+address is deliverable without attempting delivery (for details, see
+perlfaq 9).
+
+=head1 PREREQUISITES
+
+This module requires perl 5.004 or later and the Mail::Address module.
+Either the Net::DNS module or the nslookup utility is required
+for DNS checks. The Net::Domain::TLD module is required to check the
+validity of top level domains.
+
+=head1 METHODS
+
+ Every method which accepts an <ADDRESS> parameter may
+ be passed either a string or an instance of the Mail::Address
+ class. All errors raise an exception.
+
+=over 4
+
+=item new ( [PARAMS] )
+
+This method is used to construct an Email::Valid object.
+It accepts an optional list of named parameters to
+control the behavior of the object at instantiation.
+
+The following named parameters are allowed. See the
+individual methods below of details.
+
+ -mxcheck
+ -tldcheck
+ -fudge
+ -fqdn
+ -local_rules
+
+=item mx ( <ADDRESS>|<DOMAIN> )
+
+This method accepts an email address or domain name and determines
+whether a DNS record (A or MX) exists for it.
+
+The method returns true if a record is found and undef if not.
+
+Either the Net::DNS module or the nslookup utility is required for
+DNS checks. Using Net::DNS is the preferred method since error
+handling is improved. If Net::DNS is available, you can modify
+the behavior of the resolver (e.g. change the default tcp_timeout
+value) by manipulating the global Net::DNS::Resolver instance stored in
+$Email::Valid::Resolver.
+
+=item rfc822 ( <ADDRESS> )
+
+This method determines whether an address conforms to the RFC822
+specification (except for nested comments). It returns true if it
+conforms and undef if not.
+
+=item fudge ( <TRUE>|<FALSE> )
+
+Specifies whether calls to address() should attempt to correct
+common addressing errors. Currently, this results in the removal of
+spaces in AOL addresses, and the conversion of commas to periods in
+Compuserve addresses. The default is false.
+
+=item fqdn ( <TRUE>|<FALSE> )
+
+Species whether addresses passed to address() must contain a fully
+qualified domain name (FQDN). The default is true.
+
+=item local_rules ( <TRUE>|<FALSE> )
+
+Specifies whether addresses passed to address() should be tested
+for domain specific restrictions. Currently, this is limited to
+certain AOL restrictions that I'm aware of. The default is false.
+
+=item mxcheck ( <TRUE>|<FALSE> )
+
+Specifies whether addresses passed to address() should be checked
+for a valid DNS entry. The default is false.
+
+=item tldcheck ( <TRUE>|<FALSE> )
+
+Specifies whether addresses passed to address() should be checked
+for a valid top level domains. The default is false.
+
+=item address ( <ADDRESS> )
+
+This is the primary method which determines whether an email
+address is valid. It's behavior is modified by the values of
+mxcheck(), tldcheck(), local_rules(), fqdn(), and fudge(). If the address
+passes all checks, the (possibly modified) address is returned as
+a string. Otherwise, the undefined value is returned.
+In a list context, the method also returns an instance of the
+Mail::Address class representing the email address.
+
+=item details ()
+
+If the last call to address() returned undef, you can call this
+method to determine why it failed. Possible values are:
+
+ rfc822
+ local_rules
+ fqdn
+ mxcheck
+ tldcheck
+
+If the class is not instantiated, you can get the same information
+from the global $Email::Valid::Details.
+
+=back
+
+=head1 EXAMPLES
+
+Let's see if the address 'maurice@hevanet.com' conforms to the
+RFC822 specification:
+
+ print (Email::Valid->address('maurice@hevanet.com') ? 'yes' : 'no');
+
+Additionally, let's make sure there's a mail host for it:
+
+ print (Email::Valid->address( -address => 'maurice@hevanet.com',
+ -mxcheck => 1 ) ? 'yes' : 'no');
+
+Let's see an example of how the address may be modified:
+
+ $addr = Email::Valid->address('Alfred Neuman <Neuman @ foo.bar>');
+ print "$addr\n"; # prints Neuman@foo.bar
+
+Now let's add the check for top level domains:
+
+ $addr = Email::Valid->address( -address => 'Neuman@foo.bar',
+ -tldcheck => 1 );
+ print "$addr\n"; # doesn't print anything
+
+Need to determine why an address failed?
+
+ unless(Email::Valid->address('maurice@hevanet')) {
+ print "address failed $Email::Valid::Details check.\n";
+ }
+
+If an error is encountered, an exception is raised. This is really
+only possible when performing DNS queries. Trap any exceptions by
+wrapping the call in an eval block:
+
+ eval {
+ $addr = Email::Valid->address( -address => 'maurice@hevanet.com',
+ -mxcheck => 1 );
+ };
+ warn "an error was encountered: $@" if $@;
+
+=head1 BUGS
+
+Email::Valid should work with Perl for Win32. In my experience,
+however, Net::DNS queries seem to take an extremely long time when
+a record cannot be found.
+
+=head1 AUTHOR
+
+Copyright 1998-2003, Maurice Aubrey E<lt>maurice@hevanet.comE<gt>.
+All rights reserved.
+
+This module is free software; you may redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 CREDITS
+
+Significant portions of this module are based on the ckaddr program
+written by Tom Christiansen and the RFC822 address pattern developed
+by Jeffrey Friedl. Neither were involved in the construction of this
+module; all errors are mine.
+
+Thanks very much to the following people for their suggestions and
+bug fixes:
+
+ Otis Gospodnetic <otis@DOMINIS.com>
+ Kim Ryan <kimaryan@ozemail.com.au>
+ Pete Ehlke <pde@listserv.music.sony.com>
+ Lupe Christoph
+ David Birnbaum
+ Achim
+ Elizabeth Mattijsen (liz@dijkmat.nl)
+
+=head1 SEE ALSO
+
+Mail::Address, Net::DNS, Net::Domain::TLD, perlfaq9
+
+=cut
Added: packages/libemail-valid-perl/branches/upstream/current/t/valid.t
===================================================================
--- packages/libemail-valid-perl/branches/upstream/current/t/valid.t 2004-06-10 13:40:10 UTC (rev 76)
+++ packages/libemail-valid-perl/branches/upstream/current/t/valid.t 2004-06-10 13:41:06 UTC (rev 77)
@@ -0,0 +1,59 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..12\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Email::Valid;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+$test = 2;
+my $v = new Email::Valid;
+
+sub not_ok { print "not ok $test\n"; $test++ }
+sub ok { print "ok $test\n"; $test++ }
+
+$v->address('Alfred Neuman <Neuman@BBN-TENEXA>') ? not_ok : ok;
+
+$v->address( -address => 'Alfred Neuman <Neuman@BBN-TENEXA>',
+ -fqdn => 0) ? ok : not_ok;
+
+my $a = $v->address( -address => 'first last@aol.com',
+ -fudge => 1);
+$a eq 'firstlast@aol.com' ? ok : not_ok;
+
+$v->address( -address => 'first last@aol.com',
+ -fudge => 0) ? not_ok : ok;
+$v->details eq 'rfc822' ? ok : not_ok;
+
+$a = $v->address('foo @ foo.com');
+$a eq 'foo@foo.com' ? ok : not_ok;
+
+$a = $v->address("fred&barney\@stonehenge(yup, the rock place).(that's dot)com");
+$a eq 'fred&barney@stonehenge.com' ? ok : not_ok;
+
+$v->address( -address => 'blort@aol.com',
+ -mxcheck => 1) ? ok : not_ok;
+$v->address( -address => 'blort@notarealdomainfoo.com',
+ -mxcheck => 1) ? not_ok : ok;
+
+eval {require Net::Domain::TLD};
+if ($@) {
+ ok; ok;
+} else {
+ $v->address( -address => 'blort@notarealdomainfoo.com',
+ -tldcheck => 1) ? ok : not_ok;
+ $v->address( -address => 'blort@notarealdomainfoo.bla',
+ -tldcheck => 1) ? not_ok : ok;
+}