File Coverage

blib/lib/Net/AS2/Message.pm
Criterion Covered Total %
statement 32 55 58.1
branch 2 22 9.0
condition 1 22 4.5
subroutine 13 21 61.9
pod 13 17 76.4
total 61 137 44.5


line stmt bran cond sub pod time code
1             package Net::AS2::Message;
2 4     4   21 use strict;
  4         4  
  4         272  
3 4     4   20 use warnings qw(all);
  4         4  
  4         198  
4            
5             =head1 NAME
6            
7             Net::AS2::Message - AS2 incoming message
8            
9             =head1 SYNOPSIS
10            
11             ### Receiving Message and sending MDN
12             my $message = $as2->decode_messages($headers, $post_body);
13             if ($message->is_success) {
14             print $message->content;
15             }
16            
17             =head1 PUBLIC INTERFACE
18            
19             =cut
20            
21 4     4   19 use Carp;
  4         7  
  4         3895  
22            
23             my $crlf = "\x0d\x0a";
24            
25             sub new
26             {
27 1     1 0 1451 my ($class, $message_id, $async_url, $should_mdn_sign, $mic, $content) = @_;
28            
29 1         5 my $self = $class->_create_message($message_id, $async_url, $should_mdn_sign);
30 1         9 $self->{success} = 1;
31 1         3 $self->{content} = $content;
32 1         4 $self->{mic} = $mic;
33 1         4 return $self;
34             }
35            
36             sub create_error_message
37             {
38 1     1 0 30 my $self = _create_message(@_);
39 1         3 $self->{error} = 1;
40 1         3 return $self;
41             }
42            
43             sub create_failure_message
44             {
45 1     1 0 6 my $self = _create_message(@_);
46 1         2 $self->{failure} = 1;
47 1         2 return $self;
48             }
49            
50             sub _create_message
51             {
52 3     3   7 my ($class, $message_id, $async_url, $should_mdn_sign, $status_text, $plain_text) = @_;
53 3   33     16 $class = ref($class) || $class;
54 3         12 my $self = {
55             message_id => $message_id,
56             async_url => $async_url,
57             should_mdn_sign => $should_mdn_sign,
58             status_text => $status_text,
59             plain_text => $plain_text,
60             };
61 3         8 bless ($self, $class);
62 3         7 return $self;
63             }
64            
65             =head2 Constructor
66            
67             =over 4
68            
69             =item $msg = Net::AS2::Message->create_from_serialized_state($state)
70            
71             Create an C from a serialized state data returned from L
72            
73             =back
74            
75             =cut
76            
77             sub create_from_serialized_state
78             {
79 0     0 1 0 my ($class, $state) = @_;
80            
81 0         0 my ($version, $status, $message_id, $mic, $async_url, $should_mdn_sign, $status_text, $plain_text)
82             = split(/\n/, $state);
83 0 0 0     0 croak "Net::AS2::Message state version is not supported"
      0        
84             unless defined $version && $version eq 'v1' && defined $plain_text;
85            
86 0   0     0 $class = ref($class) || $class;
87 0 0       0 my $self = {
    0          
88             (
89             $status eq '1' ? ( success => 1 ) :
90             $status eq '-1' ? ( error => 1 ) :
91             ( failure => 1 )
92             ),
93             message_id => $message_id,
94             mic => $mic,
95             status_text => $status_text,
96             should_mdn_sign => $should_mdn_sign,
97             plain_text => $plain_text,
98             async_url => $async_url
99             };
100 0         0 bless ($self, $class);
101            
102 0         0 return $self;
103             }
104            
105             =head2 Methods
106            
107             =over 4
108            
109             =item $msg->is_success
110            
111             Returns if the message was successfully parsed.
112             C and C would be available.
113            
114             =cut
115            
116 0     0 1 0 sub is_success { return (shift)->{success}; }
117            
118             =item $msg->is_error
119            
120             Returns if the message was failed to parse.
121             C and C would be available.
122            
123             =cut
124            
125 0     0 1 0 sub is_error { return (shift)->{error}; }
126            
127             =item $msg->is_failure
128            
129             Returns if the message was parsed but failed in further processing, e.g. unsupported algorithm request .
130             C and C would be available.
131            
132             =cut
133            
134 0     0 1 0 sub is_failure { return (shift)->{failure}; }
135            
136             =item $msg->is_mdn_async
137            
138             Returns if the partner wants to have the MDN sent in ASYNC.
139             C would be available.
140            
141             =cut
142            
143 1 50   1 1 10 sub is_mdn_async { return (shift)->{async_url} ? 1 : 0; }
144            
145             =item $msg->should_mdn_sign
146            
147             Returns if the partner wants to have the MDN signed.
148            
149             =cut
150            
151 2 50   2 1 11 sub should_mdn_sign { return (shift)->{should_mdn_sign} ? 1 : 0; }
152            
153             =item $msg->message_id
154            
155             Returns the message id of this message. This could be undefined in some failure mode.
156            
157             =cut
158            
159 2     2 1 7 sub message_id { return (shift)->{message_id}; }
160            
161             =item $msg->content
162            
163             Returns the encoded content (binary) of the message.
164             This is only defined when C is true.
165            
166             =cut
167            
168 0     0 1 0 sub content { return (shift)->{content}; }
169            
170             =item $msg->mic
171            
172             Returns the SHA-1 MIC of the message.
173             This is only defined when C is true.
174            
175             =cut
176            
177 4     4 1 17 sub mic { return (shift)->{mic}; }
178            
179             =item $msg->error_status_text
180            
181             Dedicated short error text that should goes into machine readable report in the MDN.
182            
183             =cut
184            
185 1     1 1 4 sub error_status_text { return (shift)->{status_text}; }
186            
187             =item $msg->error_plain_text
188            
189             Error text that goes into human readable report in the MDN.
190            
191             =cut
192            
193 0     0 1 0 sub error_plain_text { return (shift)->{plain_text}; }
194            
195             =item $msg->async_url
196            
197             Returns the url that partner wants us to send MDN to.
198            
199             =cut
200            
201 2     2 1 6 sub async_url { return (shift)->{async_url}; }
202            
203             =item $msg->serialized_state
204            
205             Returns the serialized state of this message.
206            
207             This is usually used for passing C to another process for sending ASYNC MDN.
208            
209             =cut
210            
211             sub serialized_state {
212 0     0 1   my $self = shift;
213 0 0 0       return join("\n",
    0 0        
      0        
      0        
      0        
214             'v1',
215             $self->is_success ? 1 : $self->is_error ? -1 : -2,
216             $self->{message_id},
217             $self->{mic} // '',
218             $self->{async_url} // '',
219             $self->{should_mdn_sign} // '',
220             $self->{status_text} // '',
221             $self->{plain_text} // ''
222             );
223             }
224            
225             # Check if notification options are supported
226             sub notification_options_check
227             {
228 0     0 0   my ($options) = @_;
229 0           foreach (split(/;/, $options))
230             {
231 0           my ($key, $value) = $_ =~ /^\s*(.+?)\s*=\s*(.+?)\s*$/;
232 0           my ($requireness, @values) = lc($value) =~ /\s*(.+?)\s*(?:,|$)/g;
233            
234 0 0         if (lc($key) eq 'signed-receipt-protocol') {
235 0 0         return 'requested MDN protocol is not supported'
236             unless 'pkcs7-signature' ~~ \@values;
237             }
238 0 0         if (lc($key) eq 'signed-receipt-micalg') {
239 0 0         return 'requested MIC algorithm is not supported'
240             unless 'sha1' ~~ \@values;
241             }
242             }
243 0           return undef;
244             }
245            
246             1;
247            
248             =back
249            
250             =head1 SEE ALSO
251            
252             L
253