From 66890fef9295d866c0b1e3f6cb63a41836e13593 Mon Sep 17 00:00:00 2001 From: azumakuniyuki Date: Thu, 19 Mar 2020 21:25:34 +0900 Subject: [PATCH 1/6] Update comment for "path" accessor method --- lib/Sisimai/Mail/STDIN.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/Sisimai/Mail/STDIN.pm b/lib/Sisimai/Mail/STDIN.pm index e6c45f45f..f162411f4 100644 --- a/lib/Sisimai/Mail/STDIN.pm +++ b/lib/Sisimai/Mail/STDIN.pm @@ -6,7 +6,7 @@ use IO::Handle; use Class::Accessor::Lite ( 'new' => 0, 'ro' => [ - 'path', # [String] Path to mbox + 'path', # [String] Fixed string "" 'name', # [String] File name of the mbox 'size', # [Integer] File size of the mbox ], @@ -127,7 +127,7 @@ azumakuniyuki =head1 COPYRIGHT -Copyright (C) 2014-2016,2018,2019 azumakuniyuki, All rights reserved. +Copyright (C) 2014-2016,2018-2020 azumakuniyuki, All rights reserved. =head1 LICENSE From 7a084a0d30ab6ffdec2177230ea55ed9aac8255c Mon Sep 17 00:00:00 2001 From: azumakuniyuki Date: Thu, 19 Mar 2020 21:26:08 +0900 Subject: [PATCH 2/6] Add Sisimai::Mail::Memory->path accessor method for holding "" string --- lib/Sisimai/Mail/Memory.pm | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lib/Sisimai/Mail/Memory.pm b/lib/Sisimai/Mail/Memory.pm index 9da597e02..2a64a7e3a 100644 --- a/lib/Sisimai/Mail/Memory.pm +++ b/lib/Sisimai/Mail/Memory.pm @@ -5,6 +5,7 @@ use warnings; use Class::Accessor::Lite ( 'new' => 0, 'ro' => [ + 'path', # [String] Fixed string "" 'size', # [Integer] data size ], 'rw' => [ @@ -22,6 +23,7 @@ sub new { my $argv1 = shift // return undef; my $param = { 'data' => [], + 'path' => '', 'size' => length $$argv1 || 0, 'offset' => 0, }; @@ -81,6 +83,12 @@ C is a constructor of Sisimai::Mail::Memory =head1 INSTANCE METHODS +=head2 C> + +C returns "" + + print $mailbox->path; # "" + =head2 C> C returns a memory size of the mailbox or JSON string. From f271491bf5d2c32ec8484521d673d223cb9d5d9c Mon Sep 17 00:00:00 2001 From: azumakuniyuki Date: Thu, 19 Mar 2020 21:26:47 +0900 Subject: [PATCH 3/6] Add code for setting the value of Sisimai::Data->origin to keep the path to original email file --- lib/Sisimai/Data.pm | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lib/Sisimai/Data.pm b/lib/Sisimai/Data.pm index e77f72d7e..2b905539a 100644 --- a/lib/Sisimai/Data.pm +++ b/lib/Sisimai/Data.pm @@ -20,6 +20,7 @@ use Class::Accessor::Lite ( 'listid', # [String] List-Id header of each ML 'reason', # [String] Bounce reason 'action', # [String] The value of Action: header + 'origin', # [String] Email path as a data source 'subject', # [String] UTF-8 Subject text 'timestamp', # [Sisimai::Time] Date: header in the original message 'addresser', # [Sisimai::Address] From address @@ -77,7 +78,7 @@ sub new { my @v1 = (qw| listid subject messageid smtpagent diagnosticcode diagnostictype deliverystatus - reason lhost rhost smtpcommand feedbacktype action softbounce replycode + reason lhost rhost smtpcommand feedbacktype action softbounce replycode origin |); $thing->{ $_ } = $argvs->{ $_ } // '' for @v1; $thing->{'replycode'} ||= Sisimai::SMTP::Reply->find($argvs->{'diagnosticcode'}) || ''; @@ -292,6 +293,7 @@ sub make { # Check the value of SMTP command $p->{'smtpcommand'} = '' unless $p->{'smtpcommand'} =~ /\A(?:EHLO|HELO|MAIL|RCPT|DATA|QUIT)\z/; + $p->{'origin'} = $argvs->{'origin'}; # Set the path to the original email # Check "Action:" field next if length $p->{'action'}; @@ -389,7 +391,7 @@ sub damn { token lhost rhost listid alias reason subject messageid smtpagent smtpcommand destination diagnosticcode senderdomain deliverystatus timezoneoffset feedbacktype diagnostictype action replycode catch - softbounce + softbounce origin |]; for my $e ( @$stringdata ) { @@ -605,6 +607,12 @@ did not include the original message, this value will be empty. Message-Id: <201310160515.r9G5FZh9018575@smtpgw.example.jp> +=head2 C (I) + +C is the path to the original email file of the parsed results. When +the original email data were input from STDIN, the value is C<>, were +input from a variable, the value is C<>. This accessor method has been +implemented at v4.25.6. =head2 C (I From 114123ea110f3f6de0f2187557f9edc548384c19 Mon Sep 17 00:00:00 2001 From: azumakuniyuki Date: Thu, 19 Mar 2020 21:27:35 +0900 Subject: [PATCH 4/6] New argument "origin" for Sisimai::Data->make method --- lib/Sisimai.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/Sisimai.pm b/lib/Sisimai.pm index 87c66ec4b..e56cb5026 100644 --- a/lib/Sisimai.pm +++ b/lib/Sisimai.pm @@ -33,7 +33,8 @@ sub make { my $p = { 'data' => $r, 'hook' => $argv1->{'hook'} }; next unless my $mesg = Sisimai::Message->new(%$p); - my $data = Sisimai::Data->make('data' => $mesg, 'delivered' => $argv1->{'delivered'}); + $p = { 'data' => $mesg, 'delivered' => $argv1->{'delivered'}, 'origin' => $mail->mail->path }; + my $data = Sisimai::Data->make(%$p); push @$list, @$data if scalar @$data; } return undef unless scalar @$list; From bc78ab7a7f2bb4ee3b257de0d47ef4e7d5d9cf52 Mon Sep 17 00:00:00 2001 From: azumakuniyuki Date: Thu, 19 Mar 2020 21:27:59 +0900 Subject: [PATCH 5/6] Add test code for checking the value of Sisimai::Data->origin --- t/001-sisimai.t | 2 +- t/500-data.t | 3 ++- t/501-data-json.t | 3 ++- t/502-data-yaml.t | 3 ++- t/600-lhost-code | 4 ++-- 5 files changed, 9 insertions(+), 6 deletions(-) diff --git a/t/001-sisimai.t b/t/001-sisimai.t index 742b1e1fe..2108e49eb 100644 --- a/t/001-sisimai.t +++ b/t/001-sisimai.t @@ -153,7 +153,7 @@ MAKE_TEST: { my $perlobject = undef; my $tobetested = [ qw| addresser recipient senderdomain destination reason timestamp - token smtpagent| + token smtpagent origin| ]; ok length $jsonstring; utf8::encode $jsonstring if utf8::is_utf8 $jsonstring; diff --git a/t/500-data.t b/t/500-data.t index 9a57d746d..e476e0f31 100644 --- a/t/500-data.t +++ b/t/500-data.t @@ -39,7 +39,7 @@ MAKE_TEST: { while( my $r = $mail->read ){ $mesg = Sisimai::Message->new('data' => $r, 'hook' => $call); - $data = Sisimai::Data->make('data' => $mesg); + $data = Sisimai::Data->make('data' => $mesg, 'origin' => $mail->mail->path); isa_ok $data, 'ARRAY'; for my $e ( @$data ) { @@ -89,6 +89,7 @@ MAKE_TEST: { ok defined $e->feedbacktype, 'feedbacktype = '.$e->feedbacktype; ok defined $e->action, 'action = '.$e->action; + is $e->origin, $file, 'origin = '.$e->origin; isa_ok $e->catch, 'HASH'; is $e->catch->{'type'}, 'email'; diff --git a/t/501-data-json.t b/t/501-data-json.t index f9002cdf0..9e77e31f3 100644 --- a/t/501-data-json.t +++ b/t/501-data-json.t @@ -29,7 +29,7 @@ MAKE_TEST: { while( my $r = $mail->read ){ $mesg = Sisimai::Message->new('data' => $r); - $data = Sisimai::Data->make('data' => $mesg); + $data = Sisimai::Data->make('data' => $mesg, 'origin' => $mail->mail->path); isa_ok $data, 'ARRAY'; for my $e ( @$data ) { @@ -70,6 +70,7 @@ MAKE_TEST: { is $e->feedbacktype, $perl->{'feedbacktype'}, 'feedbacktype = '.$e->feedbacktype; is $e->action, $perl->{'action'}, 'action = '.$e->action; + is $e->origin, $perl->{'origin'}, 'origin = '.$e->origin; } } } diff --git a/t/502-data-yaml.t b/t/502-data-yaml.t index 22cd0fab8..8c0b53108 100644 --- a/t/502-data-yaml.t +++ b/t/502-data-yaml.t @@ -41,7 +41,7 @@ MAKE_TEST: { while( my $r = $mail->read ){ $mesg = Sisimai::Message->new('data' => $r); - $data = Sisimai::Data->make('data' => $mesg); + $data = Sisimai::Data->make('data' => $mesg, 'origin' => $mail->mail->path); isa_ok $data, 'ARRAY'; for my $e ( @$data ) { @@ -82,6 +82,7 @@ MAKE_TEST: { is $e->feedbacktype, $perl->{'feedbacktype'}, 'feedbacktype = '.$e->feedbacktype; is $e->action, $perl->{'action'}, 'action = '.$e->action; + is $e->origin, $perl->{'origin'}, 'origin = '.$e->origin; } } diff --git a/t/600-lhost-code b/t/600-lhost-code index 0f59da837..e61798deb 100644 --- a/t/600-lhost-code +++ b/t/600-lhost-code @@ -198,7 +198,7 @@ my $moduletest = sub { } # End of the loop for checking Sisimai::Message - $dataobject = Sisimai::Data->make('data' => $mesgobject, 'delivered' => 1); + $dataobject = Sisimai::Data->make('data' => $mesgobject, 'delivered' => 1, 'origin' => $mailobject->mail->path); isa_ok $dataobject, 'ARRAY', sprintf("[%s] Data object", $e->{'n'}); isa_ok $dataobject->[0], 'Sisimai::Data', sprintf("[%s] Sisimai::Data", $e->{'n'}); ok scalar @$dataobject, sprintf("%s|Sisimai::Data = %s", $E, scalar @$dataobject); @@ -274,7 +274,7 @@ my $moduletest = sub { $pp = 'alias'; unlike $pr->$pp, qr/[\r]/, sprintf(" [%s] %s->%s = %s", $lb, $E, $pp, $pr->$pp) if $pr->$pp; $re = qr/[ \r]/; - for my $rr ( qw|deliverystatus smtpcommand lhost rhost alias listid action messageid| ) { + for my $rr ( qw|deliverystatus smtpcommand lhost rhost alias listid action messageid origin| ) { # Each value does not include ' ' $pp = $rr; if( $rr ne 'alias' ) { From 4305fedd8f4f73b7b0870a9e5e8b26071d002d3d Mon Sep 17 00:00:00 2001 From: azumakuniyuki Date: Wed, 15 Apr 2020 06:54:19 +0900 Subject: [PATCH 6/6] Add test for Sisimai::Mail::Memory->path --- t/024-mail-memory.t | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/t/024-mail-memory.t b/t/024-mail-memory.t index dbb4626a1..e38e8a0b5 100644 --- a/t/024-mail-memory.t +++ b/t/024-mail-memory.t @@ -7,7 +7,7 @@ use IO::File; my $PackageName = 'Sisimai::Mail::Memory'; my $MethodNames = { 'class' => ['new'], - 'object' => ['size', 'offset', 'data', 'read'], + 'object' => ['path', 'size', 'offset', 'data', 'read'], }; my $SampleEmail = [ './set-of-emails/mailbox/mbox-0', @@ -34,6 +34,7 @@ MAKE_TEST: { can_ok $mailobj, @{ $MethodNames->{'object'} }; isa_ok $mailobj->data, 'ARRAY'; is scalar @{ $mailobj->data }, 37; + is $mailobj->path, '', '->path = '; is $mailobj->size, length $mailset, '->size = '.length($mailset); is $mailobj->offset, 0, '->offset = 0';