Олег OlegTar

use Test;
use strict;

BEGIN { plan tests => 88 };

my $mail_reg = qr/^[^()<>@,;:\\".\[\] \000-\037\177*&]+(\.[^()<>@,;:\\".\[\] \000-\037\177*&]+)*@[^()<>@,;:\\".\[\] \000-\037\177*&]+(\.[^()<>@,;:\\".\[\] \000-\037\177*&]+)*$/i;
#my $mail_reg = qr/^[a-z0-9\-]+(\.[a-z0-9\-]+)*@[a-z0-9\-]+(\.[a-z0-9\-]+)*$/i;

ok(test('Test@test.ru'), 1);
ok(test('test@a.a'), 1);
ok(test('---@example.com'), 1);
ok(test('root@localhost'), 1);
ok(test('foo-bar@example.net'), 1);
ok(test('mailbox.sub1.sub2@this-domain'), 1);
ok(test('sub-net.mailbox@sub-domain.domain'), 1);
ok(test('Neuman@BBN-TENEXA'), 1);

ok(test('Русский@русский'), 1);#поменять на 0, если используется вторая регулярка

###Всё остальное не проходит###
ok(test('test@aa..aa'), 0);
ok(test('a..a@aa.aa'), 0);
ok(test('.aa@aa.aa'), 0);
ok(test('aa.@aa.aa'), 0);
ok(test('aa@aa.aa.'), 0);
ok(test('aa@.aa.aa.'), 0);
ok(test('.@aa.aa.'), 0);
ok(test('a@.'), 0);
ok(test('.@.'), 0);
ok(test('.@..'), 0);
ok(test('..@..'), 0);
ok(test('ab[]igail@example.com'), 0);
ok(test('ab\[\]igail@example.com'), 0);
ok(test('this is string'), 0);
ok(test('abigail@example.com '), 0);
ok(test(' abigail@example.com'), 0);
ok(test('abigail @example.com'), 0);
ok(test('*@example.net'), 0);
ok(test('"\""@foo.bar'), 0);
ok(test('fred&barny@example.com'), 0);
ok(test('"127.0.0.1"@[127.0.0.1]'), 0);
ok(test('Abigail <abigail@example.com>'), 0);
ok(test('Abigail<abigail@example.com>'), 0);
ok(test('Abigail<@a,@b,@c:abigail@example.com>'), 0);
ok(test('"This is a phrase"<abigail@example.com>'), 0);
ok(test('"Abigail "<abigail@example.com>'), 0);
ok(test('"Joe & J. Harvey" <example @Org>'), 0);
ok(test('Abigail <abigail @ example.com>'), 0);
ok(test('Abigail made this < abigail @ example . com >'), 0);
ok(test('Abigail(the bitch)@example.com'), 0);
ok(test('Abigail <abigail @ example . (bar) com >'), 0);
ok(test('Abigail < (one) abigail (two) @(three)example . (bar) com (quz) >'), 0);
ok(test('Abigail (foo) (((baz)(nested) (comment)) ! ) < (one) abigail (two) @(three)example . (bar) com (quz) >'), 0);
ok(test('Abigail <abigail(fo\(o)@example.com>'), 0);
ok(test('Abigail <abigail(fo\)o)@example.com>'), 0);
ok(test('(foo) abigail@example.com'), 0);
ok(test('abigail@example.com (foo)'), 0);
ok(test('"Abi\"gail" <abigail@example.com>'), 0);
ok(test('abigail@[example.com]'), 0);
ok(test('abigail@[exa\[ple.com]'), 0);
ok(test('abigail@[exa\]ple.com]'), 0);
ok(test('":sysmail"@ Some-Group. Some-Org'), 0);
ok(test('Muhammed.(I am the greatest) Ali @(the)Vegas.WBA'), 0);
ok(test('name:;'), 0);
ok(test('\':;'), 0);
ok(test('name: ;'), 0);
ok(test('Alfred Neuman <Neuman@BBN-TENEXA>'), 0);
ok(test('"George, Ted" <Shared@Group.Arpanet>'), 0);
ok(test('Wilt . (the Stilt) Chamberlain@NBA.US'), 0);
ok(test('Cruisers: Port@Portugal, Jones@SEA;'), 0);
ok(test('$@[]'), 0);
ok(test('*()@[]'), 0);
ok(test('"quoted ( brackets" ( a comment )@example.com'), 0);
ok(test(qq {"Joe & J. Harvey"\x0D\x0A <ddd\@ Org>}), 0);
ok(test(qq {"Joe &\x0D\x0A J. Harvey" <ddd \@ Org>}), 0);
ok(test(qq {Gourmets: Pompous Person <WhoZiWhatZit\@Cordon-Bleu>,\x0D\x0A}), 0);
ok(test(qq { Childs\@WGBH.Boston, "Galloping Gourmet"\@\x0D\x0A}), 0);
ok(test(qq { ANT.Down-Under (Australian National Television),\x0D\x0A}), 0);
ok(test(qq { Cheapie\@Discount-Liquors;}),0);

ok(test('Just a string'), 0);
ok(test('string'), 0);
ok(test('(comment)'), 0);
ok(test('()@example.com'), 0);
ok(test('fred(&)barny@example.com'), 0);
ok(test('fred\ barny@example.com'), 0);
ok(test('Abigail <abi gail @ example.com>'), 0);
ok(test('Abigail <abigail(fo(o)@example.com>'), 0);
ok(test('Abigail <abigail(fo)o)@example.com>'), 0);
ok(test('"Abi"gail" <abigail@example.com>'), 0);
ok(test('abigail@[exa]ple.com]'), 0);
ok(test('abigail@[exa[ple.com]'), 0);
ok(test('abigail@[exaple].com]'), 0);
ok(test('abigail@'), 0);
ok(test('@example.com'), 0);
ok(test('phrase: abigail@example.com abigail@example.com ;'), 0);
#ok(test('invalidЈchar@example.com'), 0);

ok(test(qq {"Joe & J. Harvey"\x0A <ddd\@ Org>}), 0);
# Invalid, CR LF not followed by a space.
ok(test(qq {"Joe &\x0D\x0AJ. Harvey" <ddd \@ Org>}), 0);
# This appears in RFC 822, but ``Galloping Gourmet'' should be quoted.
ok(test(qq {Gourmets: Pompous Person <WhoZiWhatZit\@Cordon-Bleu>,\x0D\x0A} .
qq { Childs\@WGBH.Boston, Galloping Gourmet\@\x0D\x0A} .
qq { ANT.Down-Under (Australian National Television),\x0D\x0A} .
qq { Cheapie\@Discount-Liquors;}), 0);
# Invalid, only a CR, no LF.
ok(test(qq {"Joe & J. Harvey"\x0D <ddd\@ Org>}), 0);

sub test {
my $mail = shift;
return ($mail ~~ $mail_reg) ? 1 : 0;
}