Data-Validate-Email-0.06/0000755000175000017500000000000013175372204014756 5ustar vagrantvagrantData-Validate-Email-0.06/t/0000755000175000017500000000000013175372204015221 5ustar vagrantvagrantData-Validate-Email-0.06/t/is_email_rfc822.t0000644000175000017500000000343013175370505020260 0ustar vagrantvagrant#!/usr/bin/perl # ------------------------------------------------------------------------------- # test harness for Data::Validate::is_email_rfc822 # # Author: Richard Sonnen (http://www.richardsonnen.com/) # ------------------------------------------------------------------------------- use lib './t'; use ExtUtils::TBone; use lib './blib'; use Data::Validate::Email qw(is_email_rfc822); my $t = ExtUtils::TBone->typical(); $t->begin(15); $t->msg("testing is_email_rfc822..."); # valid $t->ok(defined(is_email_rfc822('bob@test.com')), 'bob@test.com'); $t->ok(defined(is_email_rfc822('bob@test.com.au')), 'bob@test.com.au'); $t->ok(defined(is_email_rfc822('foo.bob@test.com.au')), 'foo.bob@test.com.au'); $t->ok(defined(is_email_rfc822('foo-bob@test-com.au')), 'foo-bob@test-com.au'); $t->ok(defined(is_email_rfc822('foo-bob@test.uk')), 'foo-bob@test.uk'); $t->ok(defined(is_email_rfc822('Richard Sonnen ')), 'Richard Sonnen '); $t->ok(defined(is_email_rfc822('')), ''); $t->ok(defined(is_email_rfc822('"Richard Sonnen" ')), '"Richard Sonnen" '); $t->ok(defined(is_email_rfc822('"Richard Sonnen" (comments)')), '"Richard Sonnen" (comments)'); # invalid $t->ok(!defined(is_email_rfc822('')), "bad: ''"); $t->ok(!defined(is_email_rfc822('foo')), 'bad: foo'); $t->ok(!defined(is_email_rfc822('foo bar@bar.com')), 'bad: foo bar@bar.com'); $t->ok(!defined(is_email_rfc822('@bar.com')), 'bad: "@bar.com'); # as an object my $v = Data::Validate::Email->new(); $t->ok(defined($v->is_email_rfc822('bob@test.com')), 'bob@test.com (object)'); $t->ok(!defined($v->is_email_rfc822('foo bar@bar.com')), 'bad: foo bar@bar.com (object)'); # we're done $t->end(); Data-Validate-Email-0.06/t/is_domain.t0000644000175000017500000000261213175370505017353 0ustar vagrantvagrant#!/usr/bin/perl # ------------------------------------------------------------------------------- # test harness for Data::Validate::is_domain # # Author: Richard Sonnen (http://www.richardsonnen.com/) # ------------------------------------------------------------------------------- use lib './t'; use ExtUtils::TBone; use lib './blib'; use Data::Validate::Email qw(is_domain); my $t = ExtUtils::TBone->typical(); $t->begin(12); $t->msg("testing is_domain..."); # valid $t->ok(defined(is_domain('test.com')), 'test.com'); $t->ok(defined(is_domain('sub.test.com')), 'sub.test.com'); $t->ok(defined(is_domain('sub-test.com')), 'sub-test.com'); $t->ok(defined(is_domain('sub-test.com.au')), 'sub-test.com.au'); # invalid $t->ok(!defined(is_domain('')), "bad: ''"); $t->ok(!defined(is_domain('host')), "bad: host"); $t->ok(!defined(is_domain('sonnen@frii.com')), 'bad: sonnen@frii.com'); $t->ok(!defined(is_domain('test dot.com')), "bad: test dot.com"); # test passthrough to Data::Validate::Domain $t->ok(defined(is_domain('com', {domain_allow_single_label => 1})), 'single-label test'); $t->ok(defined(is_domain('bob.foo', {domain_private_tld => {foo => 1}})), 'private TLD test'); # as an object my $v = Data::Validate::Email->new(); $t->ok(defined($v->is_domain('test.com')), 'test.com (object)'); $t->ok(!defined($v->is_domain('foobar@bar.com')), 'bad: foobar@bar.com (object)'); # we're done $t->end(); Data-Validate-Email-0.06/t/is_email.t0000644000175000017500000000274713175370505017204 0ustar vagrantvagrant#!/usr/bin/perl # ------------------------------------------------------------------------------- # test harness for Data::Validate::is_email # # Author: Richard Sonnen (http://www.richardsonnen.com/) # ------------------------------------------------------------------------------- use lib './t'; use ExtUtils::TBone; use lib './blib'; use Data::Validate::Email qw(is_email); my $t = ExtUtils::TBone->typical(); $t->begin(13); $t->msg("testing is_email..."); # valid $t->ok(defined(is_email('bob@test.com')), 'bob@test.com'); $t->ok(defined(is_email('bob@test.com.au')), 'bob@test.com.au'); $t->ok(defined(is_email('foo.bob@test.com.au')), 'foo.bob@test.com.au'); $t->ok(defined(is_email('foo-bob@test-com.au')), 'foo-bob@test-com.au'); $t->ok(defined(is_email('foo-bob@test.uk')), 'foo-bob@test.uk'); # invalid $t->ok(!defined(is_email('')), "bad: ''"); $t->ok(!defined(is_email('foo')), 'bad: foo'); $t->ok(!defined(is_email('foo@bar')), 'bad: foo@bar'); $t->ok(!defined(is_email('foo bar@bar.com')), 'bad: foo bar@bar.com'); # test passthrough to Data::Validate::Domain $t->ok(defined(is_email('test@com', {domain_allow_single_label => 1})), 'single-label test'); $t->ok(defined(is_email('test@bob.foo', {domain_private_tld => {foo => 1}})), 'private TLD test'); # as an object my $v = Data::Validate::Email->new(); $t->ok(defined($v->is_email('bob@test.com')), 'bob@test.com (object)'); $t->ok(!defined($v->is_email('foo bar@bar.com')), 'bad: foo bar@bar.com (object)'); # we're done $t->end(); Data-Validate-Email-0.06/t/ExtUtils/0000755000175000017500000000000013175372204017002 5ustar vagrantvagrantData-Validate-Email-0.06/t/ExtUtils/TBone.pm0000644000175000017500000003044413175370505020356 0ustar vagrantvagrantpackage ExtUtils::TBone; =head1 NAME ExtUtils::TBone - a "skeleton" for writing "t/*.t" test files. =head1 SYNOPSIS Include a copy of this module in your t directory (as t/ExtUtils/TBone.pm), and then write your t/*.t files like this: use lib "./t"; # to pick up a ExtUtils::TBone use ExtUtils::TBone; # Make a tester... here are 3 different alternatives: my $T = typical ExtUtils::TBone; # standard log my $T = new ExtUtils::TBone; # no log my $T = new ExtUtils::TBone "testout/Foo.tlog"; # explicit log # Begin testing, and expect 3 tests in all: $T->begin(3); # expect 3 tests $T->msg("Something for the log file"); # message for the log # Run some tests: $T->ok($this); # test 1: no real info logged $T->ok($that, # test 2: logs a comment "Is that ok, or isn't it?"); $T->ok(($this eq $that), # test 3: logs comment + vars "Do they match?", This => $this, That => $that); # That last one could have also been written... $T->ok_eq($this, $that); # does 'eq' and logs operands $T->ok_eqnum($this, $that); # does '==' and logs operands # End testing: $T->end; =head1 DESCRIPTION This module is intended for folks who release CPAN modules with "t/*.t" tests. It makes it easy for you to output syntactically correct test-output while at the same time logging all test activity to a log file. Hopefully, bug reports which include the contents of this file will be easier for you to investigate. =head1 OUTPUT =head2 Standard output Pretty much as described by C, with a special "# END" comment placed at the very end: 1..3 ok 1 not ok 2 ok 3 # END =head1 Log file A typical log file output by this module looks like this: 1..3 ** A message logged with msg(). ** Another one. 1: My first test, using test(): how'd I do? 1: ok 1 ** Yet another message. 2: My second test, using test_eq()... 2: A: The first string 2: B: The second string 2: not ok 2 3: My third test. 3: ok 3 # END Each test() is logged with the test name and results, and the test-number prefixes each line. This allows you to scan a large file easily with "grep" (or, ahem, "perl"). A blank line follows each test's record, for clarity. =head1 PUBLIC INTERFACE =cut # Globals: use strict; use vars qw($VERSION); use FileHandle; use File::Basename; # The package version, both in 1.23 style *and* usable by MakeMaker: $VERSION = substr q$Revision: 1.124 $, 10; #------------------------------ =head2 Construction =over 4 =cut #------------------------------ =item new [ARGS...] I Create a new tester. Any arguments are sent to log_open(). =cut sub new { my $self = bless { OUT =>\*STDOUT, Begin=>0, End =>0, Count=>0, }, shift; $self->log_open(@_) if @_; $self; } #------------------------------ =item typical I Create a typical tester. Use this instead of new() for most applicaitons. The directory "testout" is created for you automatically, to hold the output log file, and log_warnings() is invoked. =cut sub typical { my $class = shift; my ($tfile) = basename $0; unless (-d "testout") { mkdir "testout", 0755 or die "Couldn't create a 'testout' subdirectory: $!\n"; ### warn "$class: created 'testout' directory\n"; } my $self = $class->new($class->catfile('.', 'testout', "${tfile}log")); $self->log_warnings; $self; } #------------------------------ # DESTROY #------------------------------ # Class method, destructor. # Automatically closes the log. # sub DESTROY { $_[0]->log_close; } #------------------------------ =back =head2 Doing tests =over 4 =cut #------------------------------ =item begin NUMTESTS I Start testing. This outputs the 1..NUMTESTS line to the standard output. =cut sub begin { my ($self, $n) = @_; return if $self->{Begin}++; $self->l_print("1..$n\n\n"); print {$self->{OUT}} "1..$n\n"; } #------------------------------ =item end I Indicate the end of testing. This outputs a "# END" line to the standard output. =cut sub end { my ($self) = @_; return if $self->{End}++; $self->l_print("# END\n"); print {$self->{OUT}} "# END\n"; } #------------------------------ =item ok BOOL, [TESTNAME], [PARAMHASH...] I Do a test, and log some information connected with it. This outputs the test result lines to the standard output: ok 12 not ok 13 Use it like this: $T->ok(-e $dotforward); Or better yet, like this: $T->ok((-e $dotforward), "Does the user have a .forward file?"); Or even better, like this: $T->ok((-e $dotforward), "Does the user have a .forward file?", User => $ENV{USER}, Path => $dotforward, Fwd => $ENV{FWD}); That last one, if it were test #3, would be logged as: 3: Does the user have a .forward file? 3: User: "alice" 3: Path: "/home/alice/.forward" 3: Fwd: undef 3: ok You get the idea. Note that defined quantities are logged with delimiters and with all nongraphical characters suitably escaped, so you can see evidence of unexpected whitespace and other badnasties. Had "Fwd" been the string "this\nand\nthat", you'd have seen: 3: Fwd: "this\nand\nthat" And unblessed array refs like ["this", "and", "that"] are treated as multiple values: 3: Fwd: "this" 3: Fwd: "and" 3: Fwd: "that" =cut sub ok { my ($self, $ok, $test, @ps) = @_; ++($self->{Count}); # next test # Report to harness: my $status = ($ok ? "ok " : "not ok ") . $self->{Count}; print {$self->{OUT}} $status, "\n"; # Log: $self->ln_print($test, "\n") if $test; while (@ps) { my ($k, $v) = (shift @ps, shift @ps); my @vs = ((ref($v) and (ref($v) eq 'ARRAY'))? @$v : ($v)); foreach (@vs) { if (!defined($_)) { # value not defined: output keyword $self->ln_print(qq{ $k: undef\n}); } else { # value defined: output quoted, encoded form s{([\n\t\x00-\x1F\x7F-\xFF\\\"])} {'\\'.sprintf("%02X",ord($1)) }exg; s{\\0A}{\\n}g; $self->ln_print(qq{ $k: "$_"\n}); } } } $self->ln_print($status, "\n"); $self->l_print("\n"); 1; } #------------------------------ =item ok_eq ASTRING, BSTRING, [TESTNAME], [PARAMHASH...] I Convenience front end to ok(): test whether C, and logs the operands as 'A' and 'B'. =cut sub ok_eq { my ($self, $this, $that, $test, @ps) = @_; $self->ok(($this eq $that), ($test || "(Is 'A' string-equal to 'B'?)"), A => $this, B => $that, @ps); } #------------------------------ =item ok_eqnum ANUM, BNUM, [TESTNAME], [PARAMHASH...] I Convenience front end to ok(): test whether C, and logs the operands as 'A' and 'B'. =cut sub ok_eqnum { my ($self, $this, $that, $test, @ps) = @_; $self->ok(($this == $that), ($test || "(Is 'A' numerically-equal to 'B'?)"), A => $this, B => $that, @ps); } #------------------------------ =back =head2 Logging messages =over 4 =cut #------------------------------ =item log_open PATH I Open a log file for messages to be output to. This is invoked for you automatically by C and C. =cut sub log_open { my ($self, $path) = @_; $self->{LogPath} = $path; $self->{LOG} = FileHandle->new(">$path") || die "open $path: $!"; $self; } #------------------------------ =item log_close I Close the log file and stop logging. You shouldn't need to invoke this directly; the destructor does it. =cut sub log_close { my $self = shift; close(delete $self->{LOG}) if $self->{LOG}; } #------------------------------ =item log_warnings I Invoking this redefines $SIG{__WARN__} to log to STDERR and to the tester's log. This is automatically invoked when using the C constructor. =cut sub log_warnings { my ($self) = @_; $SIG{__WARN__} = sub { print STDERR $_[0]; $self->log("warning: ", $_[0]); }; } #------------------------------ =item log MESSAGE... I Log a message to the log file. No alterations are made on the text of the message. See msg() for an alternative. =cut sub log { my $self = shift; print {$self->{LOG}} @_ if $self->{LOG}; } #------------------------------ =item msg MESSAGE... I Log a message to the log file. Lines are prefixed with "** " for clarity, and a terminating newline is forced. =cut sub msg { my $self = shift; my $text = join '', @_; chomp $text; $text =~ s{^}{** }gm; $self->l_print($text, "\n"); } #------------------------------ # # l_print MESSAGE... # # Instance method, private. # Print to the log file if there is one. # sub l_print { my $self = shift; print { $self->{LOG} } @_ if $self->{LOG}; } #------------------------------ # # ln_print MESSAGE... # # Instance method, private. # Print to the log file, prefixed by message number. # sub ln_print { my $self = shift; foreach (split /\n/, join('', @_)) { $self->l_print("$self->{Count}: $_\n"); } } #------------------------------ =back =head2 Utilities =over 4 =cut #------------------------------ =item catdir DIR, ..., DIR I Concatenate several directories into a path ending in a directory. Lightweight version of the one in C; this method dates back to a more-innocent time when File::Spec was younger and less ubiquitous. Paths are assumed to be absolute. To signify a relative path, the first DIR must be ".", which is processed specially. On Mac, the path I end in a ':'. On Unix, the path I end in a '/'. =cut sub catdir { my $self = shift; my $relative = shift @_ if ($_[0] eq '.'); if ($^O eq 'Mac') { return ($relative ? ':' : '') . (join ':', @_) . ':'; } else { return ($relative ? './' : '/') . join '/', @_; } } #------------------------------ =item catfile DIR, ..., DIR, FILE I Like catdir(), but last element is assumed to be a file. Note that, at a minimum, you must supply at least a single DIR. =cut sub catfile { my $self = shift; my $file = pop; if ($^O eq 'Mac') { return $self->catdir(@_) . $file; } else { return $self->catdir(@_) . "/$file"; } } #------------------------------ =back =head1 VERSION $Id: TBone.pm,v 1.124 2001/08/20 20:30:07 eryq Exp $ =head1 CHANGE LOG =over 4 =item Version 1.124 (2001/08/20) The terms-of-use have been placed in the distribution file "COPYING". Also, small documentation tweaks were made. =item Version 1.122 (2001/08/20) Changed output of C<"END"> to C<"# END">; apparently, "END" is not a directive. Maybe it never was. I The storyteller need not say "the end" aloud; Silence is enough. Automatically invoke C when constructing via C. =item Version 1.120 (2001/08/17) Added log_warnings() to support the logging of SIG{__WARN__} messages to the log file (if any). =item Version 1.116 (2000/03/23) Cosmetic improvements only. =item Version 1.112 (1999/05/12) Added lightweight catdir() and catfile() (a la File::Spec) to enhance portability to Mac environment. =item Version 1.111 (1999/04/18) Now uses File::Basename to create "typical" logfile name, for portability. =item Version 1.110 (1999/04/17) Fixed bug in constructor that surfaced if no log was being used. =back Created: Friday-the-13th of February, 1998. =head1 AUTHOR Eryq (F). President, ZeeGee Software Inc. (F). Go to F for the latest downloads and on-line documentation for this module. Enjoy. Yell if it breaks. =cut #------------------------------ 1; __END__ my $T = new ExtUtils::TBone "testout/foo.tlog"; $T->begin(3); $T->msg("before 1\nor 2"); $T->ok(1, "one"); $T->ok(2, "Two"); $T->ok(3, "Three", Roman=>'III', Arabic=>[3, '03'], Misc=>"3\nor 3"); $T->end; 1; Data-Validate-Email-0.06/t/is_username.t0000644000175000017500000000232113175370505017720 0ustar vagrantvagrant#!/usr/bin/perl # ------------------------------------------------------------------------------- # test harness for Data::Validate::is_username # # Author: Richard Sonnen (http://www.richardsonnen.com/) # ------------------------------------------------------------------------------- use lib './t'; use ExtUtils::TBone; use lib './blib'; use Data::Validate::Email qw(is_username); my $t = ExtUtils::TBone->typical(); $t->begin(11); $t->msg("testing is_username..."); # valid $t->ok(defined(is_username('sonnen')), 'sonnen'); $t->ok(defined(is_username('bob.smith')), 'bob.smith'); $t->ok(defined(is_username('bob-smith')), 'bob-smith'); $t->ok(defined(is_username('a')), 'a'); $t->ok(defined(is_username('bob-smith+cpan')), 'bob-smith+cpan'); # invalid $t->ok(!defined(is_username('')), "bad: ''"); $t->ok(!defined(is_username('bob@test.com')), 'bad: bob@test.com'); $t->ok(!defined(is_username('bob smith')), "bad: bob smith"); $t->ok(!defined(is_username('bob*smith')), "bad: bob*smith"); # as an object my $v = Data::Validate::Email->new(); $t->ok(defined($v->is_username('sonnen')), 'sonnen (object)'); $t->ok(!defined($v->is_username('foobar@bar.com')), 'bad: foobar@bar.com (object)'); # we're done $t->end(); Data-Validate-Email-0.06/Changes0000644000175000017500000000142713175372126016260 0ustar vagrantvagrantRevision history for Perl extension Data::Validate::Email. 0.06 20171029 - Patch from Gregor Herrmann fixing POD error 0.05 20170213 - Allowed pluses in usernames per request from Adriano Ferreira (https://github.com/aferreira) 0.04 20061204 - added second argument to is_email and is_domain, passing both through to Data::Validate::Domain 0.03 20050708 - changed is_email to use is_username and is_domain to do its work they previously had different behaviors when it came to underscores in a domain name. Thanks to Doran for the bug report. - changed is_domain to be a passthrough to Neil Neely's Data::Validate::Domain module 0.02 20050420 - fixed error in the POD examples. Thanks to Philip McCarthy for the bug report. 0.01 20041214 - original version Data-Validate-Email-0.06/MANIFEST0000644000175000017500000000032713175370505016113 0ustar vagrantvagrantChanges Makefile.PL MANIFEST INSTALL README Email.pm t/ExtUtils/TBone.pm t/is_email.t t/is_email_rfc822.t t/is_domain.t t/is_username.t META.yml Module meta-data (added by MakeMaker) Data-Validate-Email-0.06/Email.pm0000644000175000017500000001736113175372152016355 0ustar vagrantvagrantpackage Data::Validate::Email; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); require Exporter; use AutoLoader 'AUTOLOAD'; use Email::Address; use Data::Validate::Domain; @ISA = qw(Exporter); # no functions are exported by default. See EXPORT_OK @EXPORT = qw(); @EXPORT_OK = qw( is_email is_email_rfc822 is_domain is_username ); %EXPORT_TAGS = (); $VERSION = '0.06'; # No preloads 1; __END__ =head1 NAME Data::Validate::Email - common email validation methods =head1 SYNOPSIS use Data::Validate::Email qw(is_email is_email_rfc822); if(is_email($suspect)){ print "Looks like an email address\n"; } elsif(is_email_rfc822($suspect)){ print "Doesn't much look like an email address, but passes rfc822\n"; } else { print "Not an email address\n"; } # or as an object my $v = Data::Validate::Email->new(); die "not an email" unless ($v->is_email('foo')); =head1 DESCRIPTION This module collects common email validation routines to make input validation, and untainting easier and more readable. All functions return an untainted value if the test passes, and undef if it fails. This means that you should always check for a defined status explicitly. Don't assume the return will be true. (e.g. is_username('0')) The value to test is always the first (and often only) argument. =head1 FUNCTIONS =cut # ------------------------------------------------------------------------------- =pod =over 4 =item B - constructor for OO usage new([\%opts]); =over 4 =item I Returns a Data::Validator::Email object. This lets you access all the validator function calls as methods without importing them into your namespace or using the clumsy Data::Validate::Email::function_name() format. =item I An optional hash reference is retained and passed on to other function calls in the Data::Validate module series. This module does not utilize the extra data, but some child calls do. See Data::Validate::Domain for an example. =item I Returns a Data::Validate::Email object =back =cut sub new{ my $class = shift; my %self = @_; return bless \%self, ref($class) || $class; } # ------------------------------------------------------------------------------- =pod =item B - is the value a well-formed email address? is_email($value); =over 4 =item I Returns the untainted address if the test value appears to be a well-formed email address. This method tries to match real-world addresses, rather than trying to support everything that rfc822 allows. (see is_email_rfc822 if you want the more permissive behavior.) In short, it pretty much looks for something@something.tld. It does not understand real names ("bob smith" ), or other comments. It will not accept partially-qualified addresses ('bob', or 'bob@machine') =item I =over 4 =item $value The potential address to test. =back =item I Returns the untainted address on success, undef on failure. =item I This function does not make any attempt to check whether an address is genuinely deliverable. It only looks to see that the format is email-like. The function accepts an optional hash reference as a second argument to change the validation behavior. It is passed on unchanged to Neil Neely's Data::Validate::Domain::is_domain() function. See that module's documentation for legal values. =back =cut sub is_email{ my $self = shift if ref($_[0]); my $value = shift; return unless defined($value); my $opt = (defined $self) ? $self : (shift); my @parts = split(/\@/, $value); return unless scalar(@parts) == 2; my($user) = is_username($parts[0], $opt); return unless defined($user); return unless $user eq $parts[0]; my $domain = is_domain($parts[1], $opt); return unless defined($domain); return unless $domain eq $parts[1]; return $user . '@' . $domain; } # ------------------------------------------------------------------------------- =pod =item B - does the value look like an RFC 822 address? is_email_rfc822($value); =over 4 =item I Returns the untainted address if the test value appears to be a well-formed email address according to RFC822. Note that the standard allows for a wide variety of address formats, including ones with real names and comments. In most cases you probably want to use is_email() instead. This one will accept things that you probably aren't expecting ('foo@bar', for example.) =item I =over 4 =item $value The potential address to test. =back =item I Returns the untainted address on success, undef on failure. =item I This check uses Casey West's Email::Address module to do its validation. The function does not make any attempt to check whether an address is genuinely deliverable. It only looks to see that the format is email-like. =back =cut sub is_email_rfc822{ my $self = shift if ref($_[0]); my $value = shift; return unless defined($value); #warn $Email::Address::mailbox; my $address; if($value =~ /^$Email::Address::mailbox$/){ #warn $&; $address = $&; } return $address; } # ------------------------------------------------------------------------------- =pod =item B - does the value look like a domain name? is_domain($value); =over 4 =item I Returns the untainted domain if the test value appears to be a well-formed domain name. This test uses the same logic as is_email(), rather than the somewhat more permissive pattern specified by RFC822. =item I =over 4 =item $value The potential domain to test. =back =item I Returns the untainted domain on success, undef on failure. =item I The function does not make any attempt to check whether a domain is actually exists. It only looks to see that the format is appropriate. As of version 0.03, this is a direct pass-through to Neil Neely's Data::Validate::Domain::is_domain() function. The function accepts an optional hash reference as a second argument to change the validation behavior. It is passed on unchanged to Neil Neely's Data::Validate::Domain::is_domain() function. See that module's documentation for legal values. =back =cut sub is_domain{ my $self = shift if ref($_[0]); my $value = shift; return unless defined($value); my $opt = (defined $self) ? $self : (shift); return Data::Validate::Domain::is_domain($value, $opt); } # ------------------------------------------------------------------------------- =pod =item B - does the value look like a username? is_username($value); =over 4 =item I Returns the untainted username if the test value appears to be a well-formed username. More specifically, it tests to see if the value is legal as the username component of an email address as defined by is_email(). Note that this definition is more restrictive than the one in RFC822. =item I =over 4 =item $value The potential username to test. =back =item I Returns the untainted username on success, undef on failure. =item I The function does not make any attempt to check whether a username actually exists on your system. It only looks to see that the format is appropriate. =back =cut sub is_username{ my $self = shift if ref($_[0]); my $value = shift; return unless defined($value); my($username) = $value =~ /^([a-z0-9_\-\.\+]+)$/i; return $username; } =pod =back =head1 AUTHOR Richard Sonnen >. =head1 COPYRIGHT Copyright (c) 2004 Richard Sonnen. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Data-Validate-Email-0.06/INSTALL0000644000175000017500000000041113175370505016005 0ustar vagrantvagrantINSTALLATION ============ First unpack the kit, if you have not already done so: tar -xzvf Data-Validate-Email-x.xx.tar.gz cd Data-Validate-Email-x.xx Data::Validate::Email can be installed with: perl Makefile.PL make make test make install Data-Validate-Email-0.06/Makefile.PL0000644000175000017500000000114513175370505016733 0ustar vagrantvagrantuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Data::Validate::Email', 'VERSION_FROM' => 'Email.pm', # finds $VERSION 'DISTNAME' => 'Data-Validate-Email', 'AUTHOR' => 'Richard Sonnen (sonnen@richardsonnen.com)', 'PREREQ_PM' => { 'Email::Address' => 0, 'Data::Validate::Domain' => 0.04, }, 'dist' => { 'COMPRESS' => 'gzip -9f', 'SUFFIX' => 'gz', 'ZIP' => '/usr/bin/zip', 'ZIPFLAGS' => '-rl', }, ); Data-Validate-Email-0.06/README0000644000175000017500000001450113175370505015641 0ustar vagrantvagrantNAME Data::Validate::Email - common email validation methods SYNOPSIS use Data::Validate::Email qw(is_email is_email_rfc822); if(is_email($suspect)){ print "Looks like an email address\n"; } elsif(is_email_rfc822($suspect)){ print "Doesn't much look like an email address, but passes rfc822\n"; } else { print "Not an email address\n"; } # or as an object my $v = Data::Validate::Email->new(); die "not an email" unless ($v->is_email('foo')); DESCRIPTION This module collects common email validation routines to make input validation, and untainting easier and more readable. All functions return an untainted value if the test passes, and undef if it fails. This means that you should always check for a defined status explicitly. Don't assume the return will be true. (e.g. is_username('0')) The value to test is always the first (and often only) argument. FUNCTIONS new - constructor for OO usage new([\%opts]); *Description* Returns a Data::Validator::Email object. This lets you access all the validator function calls as methods without importing them into your namespace or using the clumsy Data::Validate::Email::function_name() format. *Arguments* An optional hash reference is retained and passed on to other function calls in the Data::Validate module series. This module does not utilize the extra data, but some child calls do. See Data::Validate::Domain for an example. *Returns* Returns a Data::Validate::Email object is_email - is the value a well-formed email address? is_email($value); *Description* Returns the untainted address if the test value appears to be a well-formed email address. This method tries to match real-world addresses, rather than trying to support everything that rfc822 allows. (see is_email_rfc822 if you want the more permissive behavior.) In short, it pretty much looks for something@something.tld. It does not understand real names ("bob smith" ), or other comments. It will not accept partially-qualified addresses ('bob', or 'bob@machine') *Arguments* $value The potential address to test. *Returns* Returns the untainted address on success, undef on failure. *Notes, Exceptions, & Bugs* This function does not make any attempt to check whether an address is genuinely deliverable. It only looks to see that the format is email-like. The function accepts an optional hash reference as a second argument to change the validation behavior. It is passed on unchanged to Neil Neely's Data::Validate::Domain::is_domain() function. See that module's documentation for legal values. is_email_rfc822 - does the value look like an RFC 822 address? is_email_rfc822($value); *Description* Returns the untainted address if the test value appears to be a well-formed email address according to RFC822. Note that the standard allows for a wide variety of address formats, including ones with real names and comments. In most cases you probably want to use is_email() instead. This one will accept things that you probably aren't expecting ('foo@bar', for example.) *Arguments* $value The potential address to test. *Returns* Returns the untainted address on success, undef on failure. *Notes, Exceptions, & Bugs* This check uses Casey West's Email::Address module to do its validation. The function does not make any attempt to check whether an address is genuinely deliverable. It only looks to see that the format is email-like. is_domain - does the value look like a domain name? is_domain($value); *Description* Returns the untainted domain if the test value appears to be a well-formed domain name. This test uses the same logic as is_email(), rather than the somewhat more permissive pattern specified by RFC822. *Arguments* $value The potential domain to test. *Returns* Returns the untainted domain on success, undef on failure. *Notes, Exceptions, & Bugs* The function does not make any attempt to check whether a domain is actually exists. It only looks to see that the format is appropriate. As of version 0.03, this is a direct pass-through to Neil Neely's Data::Validate::Domain::is_domain() function. The function accepts an optional hash reference as a second argument to change the validation behavior. It is passed on unchanged to Neil Neely's Data::Validate::Domain::is_domain() function. See that module's documentation for legal values. is_username - does the value look like a username? is_username($value); *Description* Returns the untainted username if the test value appears to be a well-formed username. More specifically, it tests to see if the value is legal as the username component of an email address as defined by is_email(). Note that this definition is more restrictive than the one in RFC822. *Arguments* $value The potential username to test. *Returns* Returns the untainted username on success, undef on failure. *Notes, Exceptions, & Bugs* The function does not make any attempt to check whether a username actually exists on your system. It only looks to see that the format is appropriate. AUTHOR Richard Sonnen . COPYRIGHT Copyright (c) 2004 Richard Sonnen. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.