File Coverage

lib/Sisimai.pm
Criterion Covered Total %
statement 77 77 100.0
branch 18 22 81.8
condition 11 12 91.6
subroutine 11 11 100.0
pod 6 7 85.7
total 123 129 95.3


line stmt bran cond sub pod time code
1             package Sisimai;
2 11     11   1150700 use v5.26;
  11         33  
3 11     11   47 use strict;
  11         13  
  11         293  
4 11     11   50 use warnings;
  11         19  
  11         485  
5 11     11   3979 use version; our $VERSION = version->declare('v5.7.0'); our $PATCHLV = 0;
  11         22455  
  11         62  
6 1 50   1 1 16 sub version { return substr($VERSION->stringify, 1).($PATCHLV > 0 ? 'p'.$PATCHLV : '') }
7 1     1 0 280938 sub libname { 'Sisimai' }
8              
9             sub rise {
10             # Wrapper method for decoding mailbox or Maildir/
11             # @param [String] argv0 Path to mbox or Maildir/
12             # @param [Hash] argv0 or Hash (decoded JSON)
13             # @param [Handle] argv0 or STDIN
14             # @param [Hash] argv1 Options for decoding
15             # @options argv1 [Integer] delivered 1 = Including "delivered" reason
16             # @options argv1 [Integer] vacation 1 = Including "vacation" reason
17             # @options argv1 [Array] c___ Code references to a callback method for the message and each file
18             # @return [Array] Decoded objects
19             # @return [undef] undef if the argument was wrong or an empty array
20 113     113 1 6205964 my $class = shift;
21 113 100 100     376 my $argv0 = shift // return undef; die ' ***error: wrong number of arguments' if scalar @_ % 2;
  112         372  
22 111         211 my $argv1 = { @_ };
23              
24 111         3914 require Sisimai::Mail;
25 111         2639 require Sisimai::Fact;
26              
27 111   50     554 my $mail = Sisimai::Mail->new($argv0) || return undef;
28 111         322 my $kind = $mail->kind;
29 111 100       922 my $c___ = ref $argv1->{'c___'} eq 'ARRAY' ? $argv1->{'c___'} : [undef, undef];
30 111         150 my $sisi = [];
31              
32 111         251 while( my $r = $mail->data->read ) {
33             # Read and decode each email file
34 2877         8875 my $path = $mail->data->path;
35             my $args = {
36             'data' => $r, 'hook' => $c___->[0], 'origin' => $path,
37 2877         32296 'delivered' => $argv1->{'delivered'}, 'vacation' => $argv1->{'vacation'}
38             };
39 2877   100     14922 my $fact = Sisimai::Fact->rise($args) || [];
40              
41 2877 100       8514 if( $c___->[1] ) {
42             # Run the callback function specified with "c___" parameter of Sisimai->rise after reading
43             # each email file in Maildir/ every time
44 669         3526 $args = {'kind' => $kind, 'mail' => \$r, 'path' => $path, 'fact' => $fact};
45 669 50       950 eval { $c___->[1]->($args) if ref $c___->[1] eq 'CODE' };
  669         2850  
46 669 50       83353 warn sprintf(" ***warning: Something is wrong in the second element of the 'c___': %s", $@) if $@;
47             }
48 2877 100       19721 push @$sisi, @$fact if scalar @$fact;
49             }
50 111 100       351 return undef unless scalar @$sisi;
51 104         1001 return $sisi;
52             }
53              
54             sub dump {
55             # Wrapper method to decode mailbox/Maildir and dump as JSON
56             # @param [String] argv0 Path to mbox or Maildir/
57             # @param [Hash] argv0 or Hash (decoded JSON)
58             # @param [Handle] argv0 or STDIN
59             # @param [Hash] argv1 Options for decoding
60             # @options argv1 [Integer] delivered 1 = Including "delivered" reason
61             # @options argv1 [Integer] vacation 1 = Including "vacation" reason
62             # @options argv1 [Code] hook Code reference to a callback method
63             # @return [String] Decoded data as JSON text
64 8     8 1 408129 my $class = shift;
65 8 100 100     27 my $argv0 = shift // return undef; die ' ***error: wrong number of arguments' if scalar @_ % 2;
  7         34  
66 6         14 my $argv1 = { @_ };
67 6   100     20 my $nyaan = __PACKAGE__->rise($argv0, %$argv1) // [];
68              
69 6         40 for my $e ( @$nyaan ) {
70             # Set UTF8 flag before converting to JSON string
71 692         1503 utf8::decode $e->{'subject'};
72 692         1153 utf8::decode $e->{'diagnosticcode'};
73             }
74              
75 6         952 require Module::Load;
76 6         1918 Module::Load::load('JSON', '-convert_blessed_universally');
77 6         1585 my $jsonparser = JSON->new->allow_blessed->convert_blessed->utf8;
78 6         172 my $jsonstring = $jsonparser->encode($nyaan);
79              
80 6 50       252 utf8::encode $jsonstring if utf8::is_utf8 $jsonstring;
81 6         9455 return $jsonstring;
82             }
83              
84             sub engine {
85             # Decoding engine list (MTA modules)
86             # @return [Hash] Decoding engine table
87 1     1 1 1025 my $class = shift;
88 1         2 my $table = {};
89              
90 1         3 for my $e ('Lhost', 'ARF', 'RFC3464', 'RFC3834') {
91 4         20 my $r = 'Sisimai::'.$e;
92 4         10 (my $loads = $r) =~ s|::|/|g;
93 4         12 require $loads.'.pm';
94              
95 4 100       8 if( $e eq 'Lhost' ) {
96             # Sisimai::Lhost::*
97 1         5 for my $ee ( $r->index->@* ) {
98             # Load and get the value of "description" from each module
99 38         26 my $rr = 'Sisimai::'.$e.'::'.$ee;
100 38         65 ($loads = $rr) =~ s|::|/|g;
101 38         58 require $loads.'.pm';
102 38         97 $table->{ $rr } = $rr->description;
103             }
104             } else {
105             # Sisimai::ARF, Sisimai::RFC3464, and Sisimai::RFC3834
106 3         9 $table->{ $r } = $r->description;
107             }
108             }
109 1         3 return $table;
110             }
111              
112             sub reason {
113             # Reason list Sisimai can detect
114             # @return [Hash] Reason list table
115 2     2 1 44954 my $class = shift;
116 2         4 my $table = {};
117              
118             # These reasons are not included in the results of Sisimai::Reason->index
119 2         13 require Sisimai::Reason;
120 2         13 my @names = ( Sisimai::Reason->index->@*, qw|Delivered Feedback Undefined Vacation|);
121              
122 2         12 for my $e ( @names ) {
123             # Call ->description() method of Sisimai::Reason::*
124 68         83 my $r = 'Sisimai::Reason::'.$e;
125 68         270 (my $loads = $r) =~ s|::|/|g;
126 68         14615 require $loads.'.pm';
127 68         421 $table->{ $e } = $r->description;
128             }
129 2         12 return $table;
130             }
131              
132             sub match {
133             # Try to match with message patterns
134             # @param [String] Error message text
135             # @return [String] Reason text
136 95     95 1 23888 my $class = shift;
137 95   100     144 my $argvs = shift || return "";
138              
139 94         281 require Sisimai::Reason;
140 94         288 return Sisimai::Reason->match(lc $argvs);
141             }
142              
143             1;
144             __END__