File Coverage

blib/lib/Email/MIME/Encodings.pm

Criterion	Covered	Total	%
statement	33	36	91.6
branch	11	14	78.5
condition	4	9	44.4
subroutine	9	9	100.0
pod	0	4	0.0
total	57	72	79.1

use strict;
use warnings;
package Email::MIME::Encodings;
{
  $Email::MIME::Encodings::VERSION = '1.315';
}
# ABSTRACT: A unified interface to MIME encoding and decoding

use MIME::Base64 3.05;
use MIME::QuotedPrint 3.05;

sub identity { $_[0] }

for (qw(7bit 8bit binary)) {
    no strict 'refs';
    *{"encode_$_"} = *{"decode_$_"} = \&identity;
}

sub codec {
    my ($which, $how, $what, $fb) = @_;
    $how = lc $how;
    $how = "qp" if $how eq "quotedprint" or $how eq "quoted-printable";
    my $sub = __PACKAGE__->can("$which\_$how");

    if (! $sub && $fb) {
        $fb = lc $fb;
        $fb = "qp" if $fb eq "quotedprint" or $fb eq "quoted-printable";
        $sub = __PACKAGE__->can("$which\_$fb");
    }

    unless ($sub) {
        require Carp;
        Carp::croak("Don't know how to $which $how");
    }

    # RFC2822 requires all email lines to end in CRLF. The Quoted-Printable
    # RFC requires CRLF to not be encoded, when representing newlins.  We will
    # assume, in this code, that QP is being used for plain text and not binary
    # data.  This may, someday, be wrong -- but if you are using QP to encode
    # binary data, you are already doing something bizarre.
    #
    # The only way to achieve this with MIME::QuotedPrint is to replace all
    # CRLFs with just LF and then let MIME::QuotedPrint replace all LFs with
    # CRLF. Otherwise MIME::QuotedPrint (by default) encodes CR as =0D, which
    # is against RFCs and breaks MUAs (such as Thunderbird).
    #
    # We don't modify data before Base64 encoding it because that is usually
    # binary data and modifying it at all is a bad idea. We do however specify
    # that the encoder should end lines with CRLF (since that's the email
    # standard).
    # -- rjbs and mkanat, 2009-04-16
    my $eol = "\x0d\x0a";
    if ($which eq 'encode') {
        $what =~ s/$eol/\x0a/sg if $how eq 'qp';
        return $sub->($what, $eol);
    } else {
        my $txt = $sub->($what);
        $txt =~ s/\x0a/$eol/sg if $how eq 'qp';
        return $txt;
    }
}

sub decode { return codec("decode", @_) }
sub encode { return codec("encode", @_) }

1;

__END__