Changeset 276

Show
Ignore:
Timestamp:
10/05/01 08:37:12
Author:
miyagawa
Message:

RFC 1035 domain name patch

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved
  • Email-Find/trunk/Changes

    r209 r276  
    11Revision history for Perl extension Email::Find. 
     2 
     30.08  Fri Oct  5 08:35:25 JST 2001 
     4    - Test::Simple and Test::More goes out of the distribution 
     5    * Tighten up the definition of domain to match what's in RFC 1035 
     6      Thanks to Michael G Schwern and Gil Vidals 
    27 
    380.07  Tue Jul 31 13:58:30 JST 2001 
    49    * Turned off -local_rules and -fudge for Email::Valid constructor.  
    5       Thanks to Joseph Crotty <jcrotty@matchlogic.com>
     10      Thanks to Joseph Crotty
    611 
    7120.06  Tue Jun 26 19:48:25 JST 2001 
    8     - Nothing new. Maintainer has switched from Schwern to Miyagawa. 
     13    - Nothing new. Maintainer has been switched from Schwern to Miyagawa. 
    914 
    10150.05  Sun Jun 24 22:33:18 EDT 2001 
  • Email-Find/trunk/MANIFEST

    r122 r276  
    66t/Find.t 
    77t/RFC822.t 
    8 t/lib/Test/More.pm 
    9 t/lib/Test/Simple.pm 
    108t/rfc822.txt 
  • Email-Find/trunk/Makefile.PL

    r9 r276  
    3434    PREREQ_PM       => { Email::Valid  => 0, 
    3535                         Mail::Address => 0, 
     36                         Test::More    => 0, 
    3637                       }, 
    3738    'dist'          => { COMPRESS   => 'gzip -9', 
     
    4041                       }, 
    4142); 
     43 
  • Email-Find/trunk/lib/Email/Find.pm

    r208 r276  
    33use strict; 
    44use vars qw($VERSION @EXPORT); 
    5 $VERSION = '0.07'; 
     5$VERSION = '0.08'; 
    66 
    77# Need qr//. 
     
    1414require Mail::Address; 
    1515 
    16  
     16# This is the BNF from RFC 822 
    1717my $esc         = '\\\\';               my $period      = '\.'; 
    1818my $space       = '\040'; 
     
    2727my $quoted_str  = qq<\"$qtext*(?:$quoted_pair$qtext*)*\">; 
    2828my $word        = qq<(?:$atom|$quoted_str)>; 
    29 my $domain_ref  = $atom; 
     29my $local_part  = qq<$word(?:$period$word)*>;   #" for emacs 
     30 
     31# This is a combination of the domain name BNF from RFC 1035 plus the 
     32# domain literal definition from RFC 822, but allowing domains starting 
     33# with numbers. 
     34my $label       = q/[A-Za-z\d](?:[A-Za-z\d-]*[A-Za-z\d])?/; 
     35my $domain_ref  = qq<$label(?:$period$label)*>; 
    3036my $domain_lit  = qq<$open_br(?:$dtext|$quoted_pair)*$close_br>; 
    31 my $sub_domain  = qq<(?:$domain_ref|$domain_lit)>; 
    32 my $domain      = qq<$sub_domain(?:$period$sub_domain)*>; 
    33 my $local_part  = qq<$word(?:$period$word)*>;   #" for emacs 
     37my $domain      = qq<(?:$domain_ref|$domain_lit)>; 
    3438 
    3539 
     
    5963        my($start_cruft) = ''; 
    6064        my($end_cruft)   = ''; 
    61         if( $orig_match =~ s|([),.'";?!]+)$|| ) {  #" for emacs 
    62             $end_cruft = $1;  
    63         }  
     65        if( $orig_match =~ s|([),.'";?!]+)$|| ) { 
     66            $end_cruft = $1; 
     67        } 
    6468 
    6569        if( my $email = $validator->address($orig_match) ) { 
  • Email-Find/trunk/t/Find.t

    r207 r276  
    1 use lib qw(t/lib)
    2 use Test::More tests => 17; 
     1use strict
     2use Test::More 'no_plan'; # XXX 
    33BEGIN { use_ok('Email::Find') } 
    44 
    55my %Tests; 
    66BEGIN { 
    7     %Tests = ('Hahah!  Use "@".+*@[132.205.7.51] and watch them cringe!' 
    8                   => '"@".+*@[132.205.7.51]', 
    9               'What about "@"@foo.com?' => '"@"@foo.com', 
    10               'Eli the Beared <*@qz.to>' => '*@qz.to', 
    11               '"@"+*@[132.205.7.51]'    => '+*@[132.205.7.51]', 
    12               'somelongusername@aol.com' => 'somelongusername@aol.com', 
    13              ); 
     7    %Tests = ( 
     8        'Hahah!  Use "@".+*@[132.205.7.51] and watch them cringe!' 
     9            => '"@".+*@[132.205.7.51]', 
     10        'What about "@"@foo.com?' => '"@"@foo.com', 
     11        'Eli the Beared <*@qz.to>' => '*@qz.to', 
     12        '"@"+*@[132.205.7.51]'    => '+*@[132.205.7.51]', 
     13        'somelongusername@aol.com' => 'somelongusername@aol.com', 
     14        '%2Fjoe@123.com' => '%2Fjoe@123.com', 
     15        'joe@123.com?subject=hello.' => 'joe@123.com', 
     16    ); 
    1417} 
    1518 
    16 while( my($text, $expect) = each %Tests ) { 
     19while (my($text, $expect) = each %Tests) { 
    1720    my($orig_text) = $text; 
    18     ok( find_emails($text, sub { ok( $_[0]->address eq $expect,  
    19                                      "Found $_[1]" ); 
    20                                  return $_[1]  
    21                              }  
    22                    ) == 1, 
    23         "  just one" 
    24       ); 
    25     ok( $text eq $orig_text,    "  and replaced" ); 
     21    my $found = find_emails($text, sub { 
     22                                is $_[0]->address, $expect, "Found $_[1]"; 
     23                                return $_[1] 
     24                            }); 
     25    is $found, 1, "  just one"; 
     26    is $text, $orig_text,    "  and replaced"; 
    2627} 
    27  
    2828 
    2929# Do all the tests again as one big block of text. 
    3030my $mess_text = join "\n", keys %Tests; 
    31 ok( find_emails($mess_text, sub { return $_[1] }) == keys %Tests, 
    32     'One big block' ); 
     31is find_emails($mess_text, sub { return $_[1] }), scalar keys %Tests, 'One big block'; 
    3332 
    3433 
  • Email-Find/trunk/t/RFC822.t

    r67 r276  
    1 use lib qw(t/lib); 
    21use Test::More tests => 2; 
    32