Merge pull request #383 from sisimai/new-accessor-origin-in-sisimai-data

New accessor "origin" in Sisimai::Data object
sisimai · Apr 15, 2020 · 9fc5b1b · 9fc5b1b
2 parents 5af4156 + 4305fed
commit 9fc5b1b
Show file tree

Hide file tree

Showing 10 changed files with 33 additions and 12 deletions.
diff --git 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;

diff --git 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<origin> (I<Path to the original email file>)
+
+C<origin> 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<<STDIN>>, were
+input from a variable, the value is C<<MEMORY>>. This accessor method has been
+implemented at v4.25.6.
 
 =head2 C<recipient> (I<Sisimai::Address)>
 

diff --git 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 "<MEMORY>"
         'size',     # [Integer] data size
     ],
     'rw'  => [
@@ -22,6 +23,7 @@ sub new {
     my $argv1 = shift // return undef;
     my $param = {
         'data'   => [],
+        'path'   => '<MEMORY>',
         'size'   => length $$argv1 || 0,
         'offset' => 0,
     };
@@ -81,6 +83,12 @@ C<new()> is a constructor of Sisimai::Mail::Memory
 
 =head1 INSTANCE METHODS
 
+=head2 C<B<path()>>
+
+C<path()> returns "<MEMORY>"
+
+    print $mailbox->path;   # "<MEMORY>"
+
 =head2 C<B<size()>>
 
 C<size()> returns a memory size of the mailbox or JSON string.

diff --git 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 "<STDIN>"
         '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
 

diff --git 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/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, '<MEMORY>', '->path = <MEMORY>';
         is $mailobj->size, length $mailset, '->size = '.length($mailset);
         is $mailobj->offset, 0, '->offset = 0';
 

diff --git 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
@@ -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
@@ -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
@@ -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' ) {