File Coverage

blib/lib/Mail/Message/TransferEnc/SevenBit.pm
Criterion Covered Total %
statement 25 32 78.1
branch 5 8 62.5
condition 2 3 66.6
subroutine 5 7 71.4
pod 3 3 100.0
total 40 53 75.4


line stmt bran cond sub pod time code
1             # Copyrights 2001-2021 by [Mark Overmeer ].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.02.
5             # This code is part of distribution Mail-Message. Meta-POD processed with
6             # OODoc into POD and HTML manual-pages. See README.md
7             # Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
8              
9             package Mail::Message::TransferEnc::SevenBit;
10 3     3   1487 use vars '$VERSION';
  3         8  
  3         189  
11             $VERSION = '3.011';
12              
13 3     3   18 use base 'Mail::Message::TransferEnc';
  3         7  
  3         726  
14              
15 3     3   20 use strict;
  3         6  
  3         65  
16 3     3   15 use warnings;
  3         8  
  3         1233  
17              
18              
19             sub name() { '7bit' }
20              
21             #------------------------------------------
22              
23             sub check($@)
24 0     0 1 0 { my ($self, $body, %args) = @_;
25 0         0 $body;
26             }
27              
28             #------------------------------------------
29              
30             sub decode($@)
31 0     0 1 0 { my ($self, $body, %args) = @_;
32 0         0 $body->transferEncoding('none');
33 0         0 $body;
34             }
35              
36             #------------------------------------------
37              
38             sub encode($@)
39 2     2 1 14 { my ($self, $body, %args) = @_;
40              
41 2         6 my @lines;
42 2         5 my $changes = 0;
43              
44 2         13 foreach ($body->lines)
45 4 50       23 { $changes++ if s/([^\000-\127])/chr(ord($1) & 0x7f)/ge;
  107         256  
46 4 100       20 $changes++ if s/[\000\013]//g;
47              
48 4 50       12 $changes++ if length > 997;
49 4         14 push @lines, substr($_, 0, 996, '')."\n"
50             while length > 997;
51              
52 4         12 push @lines, $_;
53             }
54              
55 2 50       10 unless($changes)
56 0         0 { $body->transferEncoding('7bit');
57 0         0 return $body;
58             }
59              
60 2   66     10 my $bodytype = $args{result_type} || ref $body;
61              
62 2         17 $bodytype->new
63             ( based_on => $body
64             , transfer_encoding => '7bit'
65             , data => \@lines
66             );
67             }
68              
69             #------------------------------------------
70              
71             1;