File Coverage

lib/Sisimai.pm
Criterion Covered Total %
statement 76 76 100.0
branch 14 16 87.5
condition 8 10 80.0
subroutine 12 12 100.0
pod 6 8 75.0
total 116 122 95.0


line stmt bran cond sub pod time code
1             package Sisimai;
2 9     9   468337 use feature ':5.10';
  9         90  
  9         1054  
3 9     9   45 use strict;
  9         12  
  9         135  
4 9     9   29 use warnings;
  9         13  
  9         173  
5 9     9   3253 use version; our $VERSION = version->declare('v4.25.14'); our $PATCHLV = 0;
  9         14649  
  9         38  
6              
7 1 50   1 1 19 sub version { return substr($VERSION->stringify, 1).($PATCHLV > 0 ? 'p'.$PATCHLV : '') }
8 1     1 0 1630 sub sysname { 'bouncehammer' }
9 1     1 0 8 sub libname { 'Sisimai' }
10              
11             sub make {
12             # Wrapper method for parsing mailbox or Maildir/
13             # @param [String] argv0 Path to mbox or Maildir/
14             # @param [Hash] argv0 or Hash (decoded JSON)
15             # @param [Handle] argv0 or STDIN
16             # @param [Hash] argv1 Parser options
17             # @options argv1 [Integer] delivered 1 = Including "delivered" reason
18             # @options argv1 [Code] hook Code reference to a callback method
19             # @return [Array] Parsed objects
20             # @return [Undef] Undef if the argument was wrong or an empty array
21 44     44 1 3606038 my $class = shift;
22 44 100 100     157 my $argv0 = shift // return undef; die ' ***error: wrong number of arguments' if scalar @_ % 2;
  43         179  
23 42         94 my $argv1 = { @_ };
24              
25 42         1896 require Sisimai::Data;
26 42         1761 require Sisimai::Message;
27 42         1613 require Sisimai::Mail;
28              
29 42         106 my $list = [];
30 42   50     241 my $mail = Sisimai::Mail->new($argv0) || return undef;
31 42         154 while( my $r = $mail->data->read ) {
32             # Read and parse each email file
33 2272         8218 my $p = { 'data' => $r, 'hook' => $argv1->{'hook'} };
34 2272 100       16857 next unless my $mesg = Sisimai::Message->new(%$p);
35              
36 2267         8881 $p = { 'data' => $mesg, 'delivered' => $argv1->{'delivered'}, 'origin' => $mail->data->path };
37 2267         34174 my $data = Sisimai::Data->make(%$p);
38 2267 100       33932 push @$list, @$data if scalar @$data;
39             }
40 42 100       159 return undef unless scalar @$list;
41 40         477 return $list;
42             }
43              
44             sub dump {
45             # Wrapper method to parse mailbox/Maildir and dump as JSON
46             # @param [String] argv0 Path to mbox or Maildir/
47             # @param [Hash] argv0 or Hash (decoded JSON)
48             # @param [Handle] argv0 or STDIN
49             # @param [Hash] argv1 Parser options
50             # @options argv1 [Integer] delivered 1 = Including "delivered" reason
51             # @options argv1 [Code] hook Code reference to a callback method
52             # @return [String] Parsed data as JSON text
53 6     6 1 350533 my $class = shift;
54 6 100 100     24 my $argv0 = shift // return undef; die ' ***error: wrong number of arguments' if scalar @_ % 2;
  5         27  
55 4         11 my $argv1 = { @_ };
56 4   100     20 my $nyaan = __PACKAGE__->make($argv0, %$argv1) // [];
57              
58 4         69 for my $e ( @$nyaan ) {
59             # Set UTF8 flag before converting to JSON string
60 574         1085 utf8::decode $e->{'subject'};
61 574         1129 utf8::decode $e->{'diagnosticcode'};
62             }
63              
64 4         631 require Module::Load;
65 4         1050 Module::Load::load('JSON', '-convert_blessed_universally');
66 4         1097 my $jsonparser = JSON->new->allow_blessed->convert_blessed->utf8;
67 4         111 my $jsonstring = $jsonparser->encode($nyaan);
68              
69 4 50       151 utf8::encode $jsonstring if utf8::is_utf8 $jsonstring;
70 4         6458 return $jsonstring;
71             }
72              
73             sub engine {
74             # Parser engine list (MTA modules)
75             # @return [Hash] Parser engine table
76 1     1 1 801 my $class = shift;
77 1         3 my $table = {};
78              
79 1         4 for my $e ('Lhost', 'ARF', 'RFC3464', 'RFC3834') {
80 4         8 my $r = 'Sisimai::'.$e;
81 4         10 (my $loads = $r) =~ s|::|/|g;
82 4         14 require $loads.'.pm';
83              
84 4 100       8 if( $e eq 'Lhost' ) {
85             # Sisimai::Lhost::*
86 1         2 for my $ee ( @{ $r->index } ) {
  1         4  
87             # Load and get the value of "description" from each module
88 55         70 my $rr = 'Sisimai::'.$e.'::'.$ee;
89 55         110 ($loads = $rr) =~ s|::|/|g;
90 55         158 require $loads.'.pm';
91 55         158 $table->{ $rr } = $rr->description;
92             }
93             } else {
94             # Sisimai::ARF, Sisimai::RFC3464, and Sisimai::RFC3834
95 3         10 $table->{ $r } = $r->description;
96             }
97             }
98 1         3 return $table;
99             }
100              
101             sub reason {
102             # Reason list Sisimai can detect
103             # @return [Hash] Reason list table
104 2     2 1 41102 my $class = shift;
105 2         6 my $table = {};
106              
107             # These reasons are not included in the results of Sisimai::Reason->index
108 2         15 require Sisimai::Reason;
109 2         5 my @names = (@{ Sisimai::Reason->index }, qw|Delivered Feedback Undefined Vacation|);
  2         17  
110              
111 2         6 for my $e ( @names ) {
112             # Call ->description() method of Sisimai::Reason::*
113 58         97 my $r = 'Sisimai::Reason::'.$e;
114 58         170 (my $loads = $r) =~ s|::|/|g;
115 58         7997 require $loads.'.pm';
116 58         319 $table->{ $e } = $r->description;
117             }
118 2         10 return $table;
119             }
120              
121             sub match {
122             # Try to match with message patterns
123             # @param [String] Error message text
124             # @return [String] Reason text
125 93     93 1 289 my $class = shift;
126 93   50     131 my $argvs = shift || return undef;
127              
128 93         224 require Sisimai::Reason;
129 93         223 return Sisimai::Reason->match(lc $argvs);
130             }
131              
132             1;
133             __END__