File Coverage

blib/lib/Mail/Message/TransferEnc/Base64.pm
Criterion Covered Total %
statement 23 27 85.1
branch 4 6 66.6
condition 2 3 66.6
subroutine 7 8 87.5
pod 3 3 100.0
total 39 47 82.9


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::Base64;
10 5     5   2545 use vars '$VERSION';
  5         13  
  5         334  
11             $VERSION = '3.011';
12              
13 5     5   33 use base 'Mail::Message::TransferEnc';
  5         11  
  5         1783  
14              
15 5     5   34 use strict;
  5         12  
  5         108  
16 5     5   27 use warnings;
  5         12  
  5         131  
17              
18 5     5   1125 use MIME::Base64;
  5         1537  
  5         1602  
19              
20              
21             sub name() { 'base64' }
22              
23             #------------------------------------------
24              
25             sub check($@)
26 0     0 1 0 { my ($self, $body, %args) = @_;
27 0         0 $body;
28             }
29              
30             #------------------------------------------
31              
32              
33             sub decode($@)
34 2     2 1 14 { my ($self, $body, %args) = @_;
35              
36 2         12 my $lines = decode_base64($body->string);
37 2 50       9 unless($lines)
38 0         0 { $body->transferEncoding('none');
39 0         0 return $body;
40             }
41            
42             my $bodytype
43             = defined $args{result_type} ? $args{result_type}
44 2 50       28 : $body->isBinary ? 'Mail::Message::Body::File'
    100          
45             : ref $body;
46              
47 2         25 $bodytype->new
48             ( based_on => $body
49             , transfer_encoding => 'none'
50             , data => $lines
51             );
52             }
53              
54             #------------------------------------------
55              
56             sub encode($@)
57 4     4 1 866 { my ($self, $body, %args) = @_;
58              
59 4   66     21 my $bodytype = $args{result_type} || ref $body;
60              
61 4         23 $bodytype->new
62             ( based_on => $body
63             , checked => 1
64             , transfer_encoding => 'base64'
65             , data => encode_base64($body->string)
66             );
67             }
68              
69             #------------------------------------------
70              
71             1;