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   542040 use feature ':5.10';
  9         98  
  9         1198  
3 9     9   53 use strict;
  9         13  
  9         160  
4 9     9   35 use warnings;
  9         13  
  9         221  
5 9     9   3755 use version; our $VERSION = version->declare('v4.25.15'); our $PATCHLV = 0;
  9         16555  
  9         45  
6              
7 1 50   1 1 17 sub version { return substr($VERSION->stringify, 1).($PATCHLV > 0 ? 'p'.$PATCHLV : '') }
8 1     1 0 1973 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 49     49 1 4052573 my $class = shift;
22 49 100 100     163 my $argv0 = shift // return undef; die ' ***error: wrong number of arguments' if scalar @_ % 2;
  48         193  
23 47         102 my $argv1 = { @_ };
24              
25 47         2207 require Sisimai::Data;
26 47         1835 require Sisimai::Message;
27 47         1748 require Sisimai::Mail;
28              
29 47         104 my $list = [];
30 47   50     227 my $mail = Sisimai::Mail->new($argv0) || return undef;
31 47         201 while( my $r = $mail->data->read ) {
32             # Read and parse each email file
33 2297         9096 my $p = { 'data' => $r, 'hook' => $argv1->{'hook'} };
34 2297 100       16326 next unless my $mesg = Sisimai::Message->new(%$p);
35              
36 2292         8825 $p = { 'data' => $mesg, 'delivered' => $argv1->{'delivered'}, 'origin' => $mail->data->path };
37 2292         33012 my $data = Sisimai::Data->make(%$p);
38 2292 100       33160 push @$list, @$data if scalar @$data;
39             }
40 47 100       196 return undef unless scalar @$list;
41 45         491 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 432359 my $class = shift;
54 6 100 100     32 my $argv0 = shift // return undef; die ' ***error: wrong number of arguments' if scalar @_ % 2;
  5         33  
55 4         14 my $argv1 = { @_ };
56 4   100     24 my $nyaan = __PACKAGE__->make($argv0, %$argv1) // [];
57              
58 4         80 for my $e ( @$nyaan ) {
59             # Set UTF8 flag before converting to JSON string
60 579         1410 utf8::decode $e->{'subject'};
61 579         1320 utf8::decode $e->{'diagnosticcode'};
62             }
63              
64 4         688 require Module::Load;
65 4         1171 Module::Load::load('JSON', '-convert_blessed_universally');
66 4         1467 my $jsonparser = JSON->new->allow_blessed->convert_blessed->utf8;
67 4         134 my $jsonstring = $jsonparser->encode($nyaan);
68              
69 4 50       167 utf8::encode $jsonstring if utf8::is_utf8 $jsonstring;
70 4         8194 return $jsonstring;
71             }
72              
73             sub engine {
74             # Parser engine list (MTA modules)
75             # @return [Hash] Parser engine table
76 1     1 1 1257 my $class = shift;
77 1         3 my $table = {};
78              
79 1         3 for my $e ('Lhost', 'ARF', 'RFC3464', 'RFC3834') {
80 4         8 my $r = 'Sisimai::'.$e;
81 4         12 (my $loads = $r) =~ s|::|/|g;
82 4         19 require $loads.'.pm';
83              
84 4 100       10 if( $e eq 'Lhost' ) {
85             # Sisimai::Lhost::*
86 1         3 for my $ee ( @{ $r->index } ) {
  1         5  
87             # Load and get the value of "description" from each module
88 55         82 my $rr = 'Sisimai::'.$e.'::'.$ee;
89 55         135 ($loads = $rr) =~ s|::|/|g;
90 55         183 require $loads.'.pm';
91 55         213 $table->{ $rr } = $rr->description;
92             }
93             } else {
94             # Sisimai::ARF, Sisimai::RFC3464, and Sisimai::RFC3834
95 3         12 $table->{ $r } = $r->description;
96             }
97             }
98 1         4 return $table;
99             }
100              
101             sub reason {
102             # Reason list Sisimai can detect
103             # @return [Hash] Reason list table
104 2     2 1 50633 my $class = shift;
105 2         8 my $table = {};
106              
107             # These reasons are not included in the results of Sisimai::Reason->index
108 2         16 require Sisimai::Reason;
109 2         5 my @names = (@{ Sisimai::Reason->index }, qw|Delivered Feedback Undefined Vacation|);
  2         20  
110              
111 2         8 for my $e ( @names ) {
112             # Call ->description() method of Sisimai::Reason::*
113 58         102 my $r = 'Sisimai::Reason::'.$e;
114 58         185 (my $loads = $r) =~ s|::|/|g;
115 58         7677 require $loads.'.pm';
116 58         394 $table->{ $e } = $r->description;
117             }
118 2         15 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 282 my $class = shift;
126 93   50     142 my $argvs = shift || return undef;
127              
128 93         231 require Sisimai::Reason;
129 93         210 return Sisimai::Reason->match(lc $argvs);
130             }
131              
132             1;
133             __END__