The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
package App::Smarkmail;

=head1 NAME

App::Smarkmail - pipemailer that changes plaintext to multi/alt with Markdown

=head1 VERSION

version 0.003

=cut

our $VERSION = '0.003';

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

=head1 DESCRIPTION

This module implements logic used by the F<smarkdown> command, which accepts an
email message on standard input, tries to convert it from a plaintext message
to multipart alternative, and then sends it via F<sendmail>

All of this is really sketchy and probably has secret mail-damaging or
mail-losing bugs.  -- rjbs, 2008-02-24

=head1 METHODS

=head2 markdown_email

  my $email = App::Smarkmail->markdown_email($message, \%arg);

This method accepts an email message, either as an Email::MIME object or as a
string or a reference to a string, and returns an Email::MIME object.  If the
method is I<passed> an object, the object will be altered in place.

If the message is a single part plaintext message, or a multipart/mixed or
multipart/related message in which the first part is plaintext, then the
plaintext part will be replaced with a multipart/alternative part.  The
multi/alt part will have two alternatives, text and HTML.  The HTML part will
be generated by running the plaintext part through
L<Text::Markdown|Text::Markdown>.

If the text message ends in a signature -- that is, a line containing only
"--\x20" followed by no more than five lines -- the signature will be excluded
from Markdown processing and will be appended to the HTML part wrapped in
C<pre> and C<code> tags.

Note that the HTML alternative is listed second, even though it is I<less> true
to the original composition than the first.  This is because the assumption is
that you want the recipient to see the HTML part, if possible.
Multipart/alternative messages with HTML parts listed before plaintext parts
seem to tickle some bugs in some popular MUAs.

=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 "<pre><code>-- %s</code></pre>",
             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);
}

=head1 BUGS

Please report any bugs or feature requests through the web interface at
L<http://rt.cpan.org>. I will be notified, and then you'll automatically be
notified of progress on your bug as I make changes.

=head1 COPYRIGHT

Copyright 2008, Ricardo SIGNES.  This program is free software;  you can
redistribute it and/or modify it under the same terms as Perl itself.

=cut

1;