File Coverage

blib/lib/App/Smarkmail.pm

Criterion	Covered	Total	%
statement	44	46	95.6
branch	8	14	57.1
condition			n/a
subroutine	9	9	100.0
pod	1	1	100.0
total	62	70	88.5

use strict;
use warnings;
package App::Smarkmail 0.006;
# ABSTRACT: pipemailer that changes plaintext to multi/alt with Markdown

use Email::MIME;
use Email::MIME::Creator;
use Email::MIME::Modifier;
use HTML::Entities ();
use Text::Markdown;

#pod =head1 DESCRIPTION
#pod
#pod This module implements logic used by the F command, which accepts an
#pod email message on standard input, tries to convert it from a plaintext message
#pod to multipart alternative, and then sends it via F
#pod
#pod All of this is really sketchy and probably has secret mail-damaging or
#pod mail-losing bugs.  -- rjbs, 2008-02-24
#pod
#pod =method markdown_email
#pod
#pod   my $email = App::Smarkmail->markdown_email($message, \%arg);
#pod
#pod This method accepts an email message, either as an Email::MIME object or as a
#pod string or a reference to a string, and returns an Email::MIME object.  If the
#pod method is I an object, the object will be altered in place.
#pod
#pod If the message is a single part plaintext message, or a multipart/mixed or
#pod multipart/related message in which the first part is plaintext, then the
#pod plaintext part will be replaced with a multipart/alternative part.  The
#pod multi/alt part will have two alternatives, text and HTML.  The HTML part will
#pod be generated by running the plaintext part through
#pod L.
#pod
#pod If the text message ends in a signature -- that is, a line containing only
#pod "--\x20" followed by no more than five lines -- the signature will be excluded
#pod from Markdown processing and will be appended to the HTML part wrapped in
#pod C and C tags.
#pod
#pod Note that the HTML alternative is listed second, even though it is I true
#pod to the original composition than the first.  This is because the assumption is
#pod that you want the recipient to see the HTML part, if possible.
#pod Multipart/alternative messages with HTML parts listed before plaintext parts
#pod seem to tickle some bugs in some popular MUAs.
#pod
#pod =cut

sub markdown_email {
  my ($self, $msg, $arg) = @_;

  my $to_send = eval { ref $msg and $msg->isa('Email::MIME') }
              ? $msg
              : Email::MIME->new($msg);

  if ($to_send->content_type =~ m{^text/plain}) {
    my ($text, $html) = $self->_parts_from_text($to_send);

    $to_send->content_type_set('multipart/alternative');
    $to_send->parts_set([ $text, $html ]);
  } elsif ($to_send->content_type =~ m{^multipart/(?:related|mixed)}) {
    my @parts = $to_send->subparts;
    if ($parts[0]->content_type =~ m{^text/plain}) {
      my ($text, $html) = $self->_parts_from_text(shift @parts);

      my $alt = Email::MIME->create(
        attributes => { content_type => 'multipart/alternative' },
        parts      => [ $text, $html ],
      );

      $to_send->parts_set([ $alt, @parts ]);
    }
  }

  return $to_send;
}

sub _parts_from_text {
  my ($self, $email) = @_;

  my $text = $email->body;
  my ($body, $sig) = split /^-- $/m, $text, 2;

  if (($sig =~ tr/\n/\n/) > 5) {
    $body = $text;
    $sig  = '';
  }

  my $html = Text::Markdown::markdown($body, { tab_width => 2 });

  if ($sig) {
    $html .= sprintf "-- %s",
             HTML::Entities::encode_entities($sig);
  }

  my $html_part = Email::MIME->create(
    attributes => { content_type => 'text/html', },
    body       => $html,
  );

  my $text_part = Email::MIME->create(
    attributes => { content_type => 'text/plain', },
    body       => $text,
  );

  return ($text_part, $html_part);
}

1;

__END__