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-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::Base64;
10 5     5   2544 use vars '$VERSION';
  5         14  
  5         339  
11             $VERSION = '3.013';
12              
13 5     5   32 use base 'Mail::Message::TransferEnc';
  5         11  
  5         1780  
14              
15 5     5   37 use strict;
  5         10  
  5         96  
16 5     5   23 use warnings;
  5         11  
  5         117  
17              
18 5     5   971 use MIME::Base64;
  5         1394  
  5         1468  
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 12 { my ($self, $body, %args) = @_;
35              
36 2         13 my $lines = decode_base64($body->string);
37 2 50       8 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       21 : $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 972 { my ($self, $body, %args) = @_;
58              
59 4   66     18 my $bodytype = $args{result_type} || ref $body;
60              
61 4         20 $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;