File Coverage

blib/lib/Mail/Message/TransferEnc/Binary.pm
Criterion Covered Total %
statement 12 28 42.8
branch 0 4 0.0
condition 0 3 0.0
subroutine 4 7 57.1
pod 3 3 100.0
total 19 45 42.2


line stmt bran cond sub pod time code
1             # Copyrights 2001-2023 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.03.
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::Binary;
10 1     1   876 use vars '$VERSION';
  1         2  
  1         53  
11             $VERSION = '3.013';
12              
13 1     1   6 use base 'Mail::Message::TransferEnc';
  1         2  
  1         91  
14              
15 1     1   6 use strict;
  1         2  
  1         19  
16 1     1   6 use warnings;
  1         2  
  1         298  
17              
18              
19             sub name() { 'binary' }
20              
21             #------------------------------------------
22              
23             sub check($@)
24 0     0 1   { my ($self, $body, %args) = @_;
25 0           $body;
26             }
27              
28             #------------------------------------------
29              
30             sub decode($@)
31 0     0 1   { my ($self, $body, %args) = @_;
32 0           $body->transferEncoding('none');
33 0           $body;
34             }
35              
36             #------------------------------------------
37              
38             sub encode($@)
39 0     0 1   { my ($self, $body, %args) = @_;
40              
41 0           my @lines;
42              
43 0           my $changes = 0;
44 0           foreach ($body->lines)
45 0 0         { $changes++ if s/[\000\013]//g;
46 0           push @lines, $_;
47             }
48              
49 0 0         unless($changes)
50 0           { $body->transferEncoding('none');
51 0           return $body;
52             }
53              
54 0   0       my $bodytype = $args{result_type} || ref($self->load);
55              
56 0           $bodytype->new
57             ( based_on => $self
58             , transfer_encoding => 'none'
59             , data => \@lines
60             );
61             }
62              
63             #------------------------------------------
64              
65             1;