-
Notifications
You must be signed in to change notification settings - Fork 26
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Browse files
Browse the repository at this point in the history
- Loading branch information
1 parent
6d0376c
commit 3c128cb
Showing
61 changed files
with
424 additions
and
137 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,236 @@ | ||
| #!/usr/bin/env perl | ||
| package Sisimai::Lhost::Code; | ||
| use lib qw(./lib ./blib/lib); | ||
| use strict; | ||
| use warnings; | ||
|
|
||
| my $moduletest = sub { | ||
| my $modulename = shift || return undef; | ||
| my $isexpected = shift || return undef; | ||
| my $privateset = shift || 0; | ||
| my $onlydebugs = shift || 0; | ||
|
|
||
| my $E = $modulename; | ||
| my $M = sprintf("Sisimai::Lhost::%s", $E); | ||
| my $v = undef; | ||
|
|
||
| use Test::More; | ||
| use Module::Load; Module::Load::load($M); | ||
| use IO::File; | ||
| use JSON; | ||
| use Sisimai::Message; | ||
| use Sisimai::Data; | ||
|
|
||
| my $jsonparser = JSON->new; | ||
| my $samplepath = 'set-of-emails/obsoleted'; | ||
| my $methodlist = ['description', 'make', 'json', 'DELIVERYSTATUS']; | ||
| my $emailindex = 0; | ||
| my $mesgmethod = { | ||
| 'length' => [qw|recipient agent|], | ||
| 'exists' => [qw| | ||
| date spec reason status command action alias rhost lhost | ||
| diagnosis feedbacktype softbounce | ||
| |], | ||
| }; | ||
|
|
||
| use_ok $M; | ||
| can_ok $M, @$methodlist; | ||
|
|
||
| $v = $M->description; ok $v, $E.'->description = '.$v; | ||
| $v = $M->smtpagent; ok $v, $E.'->smtpagent = '.$v; | ||
| $v = $M->make; is $v, undef, $E.'->make = undef'; | ||
| $v = $M->json; is $v, undef, $E.'->json = undef'; | ||
|
|
||
| PARSE_EACH_EMAIL: for my $e ( @$isexpected ) { | ||
| # Open each json file in set-of-emails/ directory | ||
| my $indexlabel = sprintf("%02d", $e->{'n'}); | ||
| my $samplefile = undef; | ||
| my $filehandle = undef; | ||
| my $jsonobject = undef; | ||
| my $bouncedata = []; | ||
|
|
||
| if( $onlydebugs ) { | ||
| # Debug mode | ||
| $emailindex += 1; | ||
| next unless int($onlydebugs) == int($e->{'n'}); | ||
| ok $onlydebugs, sprintf("[%s] %s|DEBUG(%02d)", $indexlabel, $E, $onlydebugs); | ||
| } | ||
|
|
||
| if( $privateset ) { | ||
| # Private sample | ||
| $samplefile = [glob(sprintf("./%s/%s-*.json", $samplepath, $e->{'n'}))]->[0]; | ||
|
|
||
| } else { | ||
| # Public sample | ||
| $samplefile = sprintf("./%s/json-%s-%02d.json", $samplepath, lc $E, $e->{'n'}); | ||
| } | ||
|
|
||
| ok -f $samplefile, sprintf("[%s] %s/json(path) = %s", $indexlabel, $E, $samplefile); | ||
| ok -s $samplefile, sprintf("[%s] %s/json(size) = %s", $indexlabel, $E, -s $samplefile); | ||
|
|
||
| eval { | ||
| $filehandle = IO::File->new($samplefile, 'r'); | ||
| $jsonobject = $jsonparser->decode(<$filehandle>); | ||
| ok ref($jsonobject) =~ qr/\A(?:HASH|ARRAY)\z/; | ||
| }; | ||
| if( $@ ) { $filehandle->close; next; } | ||
|
|
||
| $filehandle->close; | ||
| push @$bouncedata, ( ref $jsonobject eq 'ARRAY' ) ? @$jsonobject : $jsonobject; | ||
|
|
||
| READ_EACH_EMAIL: while( my $r = shift @$bouncedata ) { | ||
| # Read messages in each json object | ||
| my $mesgobject = undef; | ||
| my $dataobject = undef; | ||
| my $foundindex = 0; | ||
|
|
||
| my $pp = undef; # Property | ||
| my $lb = undef; # Label | ||
| my $re = undef; # Regular expression | ||
|
|
||
| $mesgobject = Sisimai::Message->new('data' => $r, 'input' => 'json', 'delivered' => 1); | ||
| isa_ok $mesgobject, 'Sisimai::Message'; | ||
| isa_ok $mesgobject->ds, 'ARRAY'; | ||
| isa_ok $mesgobject->header, 'HASH'; | ||
| isa_ok $mesgobject->rfc822, 'HASH'; | ||
|
|
||
| ok length $mesgobject->from == 0, sprintf("[%s***] %s->from = %s", $indexlabel, $E, $mesgobject->from); | ||
| ok scalar @{ $mesgobject->ds }, sprintf("[%s***] %s->ds = %d entries", $indexlabel, $E, scalar @{ $mesgobject->ds }); | ||
|
|
||
| SISIMAI_MESSAGE: for my $ds ( @{ $mesgobject->ds } ) { | ||
| $foundindex += 1; | ||
| $lb = sprintf("%02d-%02d", $e->{'n'}, $foundindex); | ||
|
|
||
| for my $rr ( @{ $mesgmethod->{'length'} } ) { | ||
| # Lenght of each variable is greater than 0 | ||
| ok length $ds->{ $rr }, sprintf(" [%s] %s->%s = %s", $lb, $E, $rr, $ds->{ $rr }); | ||
| } | ||
|
|
||
| for my $rr ( @{ $mesgmethod->{'exists'} } ) { | ||
| # Each key should be exist | ||
| ok exists $ds->{ $rr }, sprintf(" [%s] %s->%s = %s", $lb, $E, $rr, $ds->{ $rr } || ''); | ||
| } | ||
|
|
||
| $pp = 'agent'; | ||
| $re = 'JSON::'.$E; | ||
| is $ds->{ $pp }, $re, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $ds->{ $pp }); | ||
|
|
||
| $pp = 'recipient'; | ||
| $re = qr/[0-9A-Za-z@-_.]+/; | ||
| like $ds->{ $pp }, $re, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $ds->{ $pp }); | ||
| unlike $ds->{ $pp }, qr/[ ]/, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $ds->{ $pp }); | ||
|
|
||
| $pp = 'command'; | ||
| unlike $ds->{ $pp }, qr/[ ]/, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $ds->{ $pp }); | ||
|
|
||
| $pp = 'status'; | ||
| if( length $ds->{ $pp } ) { | ||
| # Check the value of "status" | ||
| $re = qr/\A(?:[245][.]\d[.]\d+)\z/; | ||
| like $ds->{ $pp }, $re, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $ds->{ $pp }); | ||
| unlike $ds->{ $pp }, qr/[ ]/, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $ds->{ $pp }); | ||
| } | ||
|
|
||
| $pp = 'action'; | ||
| if( length $ds->{ $pp } ) { | ||
| # Check the value of "action" | ||
| $re = qr/\A(?:fail.+|delayed|expired|deliverable)\z/; | ||
| like $ds->{ $pp }, $re, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $ds->{ $pp }); | ||
| unlike $ds->{ $pp }, qr/[ ]/, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $ds->{ $pp }); | ||
| } | ||
|
|
||
| for my $rr ( 'rhost', 'lhost' ) { | ||
| # Check rhost and lhost are valid hostname or not | ||
| next unless $ds->{ $rr }; | ||
| next if $E =~ m/\A(?:qmail|Exim|Exchange|X4|MailRu)/; | ||
| next unless length $ds->{ $rr }; | ||
|
|
||
| $pp = $rr; | ||
| $re = qr/\A(?:localhost|.+[.].+)\z/; | ||
| like $ds->{ $pp }, $re, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $ds->{ $pp }); | ||
| } | ||
| } # End of the loop for checking Sisimai::Message | ||
|
|
||
|
|
||
| $dataobject = Sisimai::Data->make('data' => $mesgobject, 'delivered' => 1); | ||
| isa_ok $dataobject, 'ARRAY'; | ||
| isa_ok $dataobject->[0], 'Sisimai::Data'; | ||
| ok scalar @$dataobject, sprintf("%s|Sisimai::Data = %s", $E, scalar @$dataobject); | ||
|
|
||
| SISIMAI_DATA: for my $pr ( @$dataobject ) { | ||
| # checking each Sisimai::Data object | ||
| isa_ok $pr, 'Sisimai::Data'; | ||
| isa_ok $pr->timestamp, 'Sisimai::Time'; | ||
| isa_ok $pr->addresser, 'Sisimai::Address'; | ||
| isa_ok $pr->recipient, 'Sisimai::Address'; | ||
|
|
||
| $pp = 'replycode'; ok defined $pr->$pp, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| $pp = 'subject'; ok defined $pr->$pp, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, '...'); | ||
| $pp = 'smtpcommand'; ok defined $pr->$pp, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| $pp = 'diagnosticcode'; ok defined $pr->$pp, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| $pp = 'diagnostictype'; ok defined $pr->$pp, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
|
|
||
| if( $pr->reason eq 'feedback' ) { | ||
| # reason: "feedback" | ||
| $pp = 'deliverystatus'; is $pr->$pp, '', sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
|
|
||
| } elsif( $pr->reason eq 'vacation' ) { | ||
| # RFC3834 | ||
| $pp = 'deliverystatus'; is $pr->$pp, '', sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| $pp = 'feedbacktype'; is $pr->$pp, '', sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
|
|
||
| } else { | ||
| # other reasons | ||
| $pp = 'deliverystatus'; ok length $pr->$pp, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| $pp = 'feedbacktype'; is $pr->$pp, '', sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| } | ||
|
|
||
| $pp = 'token'; ok length $pr->$pp, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| $pp = 'smtpagent'; ok length $pr->$pp, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| $pp = 'timezoneoffset'; ok length $pr->$pp, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
|
|
||
| $pp = 'senderdomain'; is $pr->addresser->host, $pr->$pp, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| $pp = 'destination'; is $pr->recipient->host, $pr->$pp, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
|
|
||
| unless( $privateset ) { | ||
| $pp = 'softbounce'; | ||
| cmp_ok $pr->$pp, '>=', -1, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| cmp_ok $pr->$pp, '<=', 1, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| like $pr->$pp, $e->{'b'}, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
|
|
||
| $pp = 'deliverystatus'; | ||
| like $pr->$pp, $e->{'s'}, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| } | ||
|
|
||
| $pp = 'replycode'; like $pr->$pp, qr/\A(?:[245]\d\d|)\z/, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| $pp = 'timezoneoffset'; like $pr->$pp, qr/\A[-+]\d{4}\z/, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| $pp = 'reason'; like $pr->$pp, $e->{'r'}, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| $pp = 'token'; like $pr->$pp, qr/\A([0-9a-f]{40})\z/, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
|
|
||
| $re = qr/[ \r]/; | ||
| for my $rr ( qw|deliverystatus diagnostictype smtpcommand lhost rhost alias listid action messageid| ) { | ||
| # Each value does not include ' ' | ||
| $pp = $rr; unlike $pr->$pp, $re, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
| } | ||
|
|
||
| $re = qr/__END_OF_EMAIL_MESSAGE__/; | ||
| $pp = 'diagnosticcode'; unlike $pr->$pp, $re, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp); | ||
|
|
||
| for my $rr ( qw|user host verp alias| ) { | ||
| # Each value does not include ' ' | ||
| $pp = $rr; | ||
| unlike $pr->addresser->$pp, $re, sprintf(" [%s] %s->addresser->%s = %s", $lb, $E, $pp, $pr->addresser->$pp); | ||
| unlike $pr->recipient->$pp, $re, sprintf(" [%s] %s->recipient->%s = %s", $lb, $E, $pp, $pr->recipient->$pp); | ||
| } | ||
| } # End of the loop for checking each Sisimai::Data object | ||
| $emailindex++; | ||
|
|
||
| } # End of READ_EACH_EMAIL | ||
|
|
||
| } # End of PARSE_EACH_EMAIL | ||
| ok $emailindex, sprintf("%s|the number of json objects = %d", $M, $emailindex); | ||
| }; | ||
|
|
||
| sub maketest { return $moduletest } | ||
|
|
||
| 1; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,20 @@ | ||
| use strict; | ||
| use warnings; | ||
| use Test::More; | ||
| use lib qw(./lib ./blib/lib); | ||
| require './xt/120-obsoleted-bite-json-code'; | ||
|
|
||
| my $enginename = 'AmazonSES'; | ||
| my $enginetest = Sisimai::Lhost::Code->maketest; | ||
| my $isexpected = [ | ||
| { 'n' => '01', 's' => qr/\A5[.]1[.]1\z/, 'r' => qr/userunknown/, 'b' => qr/\A0\z/ }, | ||
| # { 'n' => '02', 's' => qr/\A5[.]1[.]1\z/, 'r' => qr/userunknown/, 'b' => qr/\A0\z/ }, | ||
| { 'n' => '03', 's' => qr/\A\z/, 'r' => qr/feedback/, 'b' => qr/\A-1\z/ }, | ||
| { 'n' => '04', 's' => qr/\A2[.]6[.]0\z/, 'r' => qr/delivered/, 'b' => qr/\A-1\z/ }, | ||
| { 'n' => '05', 's' => qr/\A2[.]6[.]0\z/, 'r' => qr/delivered/, 'b' => qr/\A-1\z/ }, | ||
| { 'n' => '06', 's' => qr/\A5[.]1[.]1\z/, 'r' => qr/userunknown/, 'b' => qr/\A0\z/ }, | ||
| ]; | ||
|
|
||
| $enginetest->($enginename, $isexpected); | ||
| done_testing; | ||
|
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,31 @@ | ||
| use strict; | ||
| use warnings; | ||
| use Test::More; | ||
| use lib qw(./lib ./blib/lib); | ||
| require './xt/120-obsoleted-bite-json-code'; | ||
|
|
||
| my $enginename = 'SendGrid'; | ||
| my $enginetest = Sisimai::Lhost::Code->maketest; | ||
| my $isexpected = [ | ||
| { 'n' => '01', 's' => qr/\A5[.]0[.]\d+\z/, 'r' => qr/filtered/, 'b' => qr/\A1\z/ }, | ||
| { 'n' => '02', 's' => qr/\A5[.].[.]\d+\z/, 'r' => qr/(?:mailboxfull|filtered)/, 'b' => qr/\A1\z/ }, | ||
| { 'n' => '03', 's' => qr/\A5[.]1[.]1\z/, 'r' => qr/userunknown/, 'b' => qr/\A0\z/ }, | ||
| { 'n' => '04', 's' => qr/\A5[.]0[.]\d+\z/, 'r' => qr/filtered/, 'b' => qr/\A1\z/ }, | ||
| { 'n' => '05', 's' => qr/\A5[.]0[.]\d+\z/, 'r' => qr/filtered/, 'b' => qr/\A1\z/ }, | ||
| { 'n' => '06', 's' => qr/\A5[.]1[.]1\z/, 'r' => qr/userunknown/, 'b' => qr/\A0\z/ }, | ||
| { 'n' => '07', 's' => qr/\A5[.]2[.]1\z/, 'r' => qr/filtered/, 'b' => qr/\A1\z/ }, | ||
| { 'n' => '08', 's' => qr/\A5[.]1[.]1\z/, 'r' => qr/userunknown/, 'b' => qr/\A0\z/ }, | ||
| { 'n' => '09', 's' => qr/\A5[.]1[.]1\z/, 'r' => qr/userunknown/, 'b' => qr/\A0\z/ }, | ||
| { 'n' => '10', 's' => qr/\A5[.]1[.]1\z/, 'r' => qr/userunknown/, 'b' => qr/\A0\z/ }, | ||
| { 'n' => '11', 's' => qr/\A5[.]0[.]\d+\z/, 'r' => qr/hostunknown/, 'b' => qr/\A0\z/ }, | ||
| { 'n' => '12', 's' => qr/\A5[.]2[.]2\z/, 'r' => qr/mailboxfull/, 'b' => qr/\A1\z/ }, | ||
| { 'n' => '13', 's' => qr/\A2[.]0[.]0\z/, 'r' => qr/delivered/, 'b' => qr/\A-1\z/}, | ||
| { 'n' => '14', 's' => qr/\A5[.]7[.]13\z/, 'r' => qr/suspend/, 'b' => qr/\A1\z/ }, | ||
| { 'n' => '15', 's' => qr/\A\z/, 'r' => qr/feedback/, 'b' => qr/\A-1\z/ }, | ||
| { 'n' => '16', 's' => qr/\A\z/, 'r' => qr/feedback/, 'b' => qr/\A-1\z/ }, | ||
| { 'n' => '17', 's' => qr/\A\z/, 'r' => qr/feedback/, 'b' => qr/\A-1\z/ }, | ||
| ]; | ||
|
|
||
| $enginetest->($enginename, $isexpected); | ||
| done_testing; | ||
|
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.