path: root/lib/Feed/HelperRole/Mail.pm

package Feed::HelperRole::Mail; 
use Moose::Role;
use 5.012;
use namespace::autoclean;
use Encode;
use Encode::MIME::Header;
use MIME::Lite;
use DateTime::Format::Mail;
use Digest::SHA1 qw/ sha1_hex /;
use Template;
use Template::Provider::Encoding;
use Template::Stash::ForceUTF8;
use Moose::Util::TypeConstraints;
use Try::Tiny;
 
use List::MoreUtils qw(uniq);
use Text::CleanFragment;
use URI;
 
subtype 'ArrayOfStr', as 'ArrayRef[Str]';
coerce 'ArrayOfStr', from 'Str', via { [ $_ ] };
 
has _mail_folders => (
    is => 'ro',
    isa => 'ArrayOfStr',
    coerce => 1,
    default => sub { [] },
    traits => [ 'Array' ],
    init_arg => 'mail_folders',
    handles => {
        mail_folders => 'elements',
    }
);
 
has tt => (
    is => 'ro',
    isa => 'Template',
    lazy_build => 1,
);
 
has template => (
    is => 'ro',
    isa => 'Str',
    lazy_build => 1,
);
 
has date_formatter => (
    is => 'ro',
    lazy_build => 1,
);
 
has inline_images => (
    is => 'ro',
    isa => 'Bool',
);
 
sub _build_tt {
    my ($self) = @_;
 
    return Template->new(
        LOAD_TEMPLATES => [ Template::Provider::Encoding->new ],
        STASH => Template::Stash::ForceUTF8->new,
    );
}
 
sub _build_template {
    my ($self) = @_;
 
    my $curpos = tell(DATA);
    binmode(DATA);
    my $template = do {local $/;<DATA>};
    seek(DATA,$curpos,0);
 
    return $template;
}
 
sub _build_date_formatter {
    return DateTime::Format::Mail->new();
}
 
sub entry_to_mime {
    my ($self,$entry) = @_;
 
    my $from = 'feeder@localhost';
    my $date = $entry->unified_date
        // DateTime->now(time_zone=>'UTC');
    my $from_name = $entry->author // $self->title;
    try { $from_name = decode('utf-8',$from_name) };
    $from_name =~ tr/,//d;
    my $subject = $entry->title//'(no title)';
    try { $subject = decode('utf-8',$subject) };
    my $id   = sha1_hex(encode('utf-8',$entry->unified_id));
 
    my $body = $self->prepare_body($entry);
 
    my $msg = MIME::Lite->new(
        Date => $self->date_formatter->format_datetime($date),
        From => encode('MIME-Header',qq{"$from_name" <$from>}),
        To => $from,
        Subject => encode('MIME-Header',$subject),
        Type => 'multipart/related',
    );
 
    my @images;
    if( $self->inline_images ) {
        # We expect fairly clean HTML here... 
        my $base= $entry->link;
        my @links= uniq $body=~ m/<img\s[^>]*\bsrc="([^"]+)".*?>/ig;
 
        # Fetch all images, append them 
        my $ua= $self->user_agent;
        for my $image ( @links ) {
            my $url= URI->new_abs( $image, $base );
            $self->log->trace( "Retrieving '$url' for inlining" );
            my $res= $ua->get( $url, Referer => $base );
            if( not $res->is_success ) {
                $self->log->error("Error retrieving linked image URL '$url': " . $res->status_line );
                next
            };
 
            my $name= clean_fragment( $image );
            my $id= sprintf "cid:$name";
 
            $body=~ s!src\s*=\s*"\Q$image\E"!src="$id"!g;
            push @images, {
                Type => $res->content_type,
                Id   => $name,
                Data => $res->content,
                Filename => $name,
            };
        };
    };
 
    $msg->attach(
        Type => 'text/html; charset=utf-8',
        Data => encode('utf-8',$body),
        Encoding => 'quoted-printable',
    );
 
    for my $image (@images) {
        # rewrite the HTML to reference the images 
        $self->log->trace( "Attaching " . $image->{Type} );
        $msg->attach(%$image);
    };
 
    $msg->add('Message-Id', "<$id.feeder\@localhost>");
    my @tags = $entry->tags;
    try { @tags = map { decode('utf-8',$_) } @tags };
    $msg->add('X-Tags', encode('MIME-Header', join(' ', @tags )));
 
    return $msg;
}
 
sub prepare_body {
    my ($self,$entry) = @_;
 
    my $template=$self->template;
    my $out;
    $self->tt->process(
        \$template,
        {
            feeder => $self,
            feed => $self->feed,
            entry => $entry,
            content => $entry->unified_content,
        },
        \$out,
    )
        or die $self->tt->error;
    return $out;
}
 
1;
 
__DATA__
[% USE encoding 'utf-8' -%]
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
 <head>
 <meta http-equiv="Content-Type" content="text/html;charset=utf-8" />
  <style TYPE=text/css>
   body { padding:0; margin:20px }
   strong { font-weight:bold; font-size:1.2em }
   div#msgheader { background:#65869E; color:#F5F5F5; padding:10px; margin:-20px -20px 0 -20px } 
   div#msgbody { margin: 1em } 
   div#msgfooter { text-align:right; font-size:0.8em } 
   #msgheader a:link { color:#F5F5F5 } 
   #msgheader a { font-size: 90% } 
   #msgbody a:link { color:#000000 } 
   #msgbody img { border:1px solid; background:#F5F5F5 } 
   #msgbody hr { border:1px solid } 
   #msgbody pre { font-size: 90% } 
  </style>
 </head>
 <body>
  <div id="msgheader">
   [% SET link = entry.link || entry.id -%]
   <a href="[% link | html %]"><strong>[% entry.title %]</strong></a><br />
   [% feed.title %]<br />
   [% IF entry.author %]
    by [% entry.author | html %]
   [% END %]
   [% IF entry.tags.size %]
    on [% entry.tags.join(',') %]
   [% END %]
  </div>
  <div id="msgbody">
   [% IF content.body -%]
    [% IF content.body.match('(?i)^<p[ >]') %]
     [% content.body %]
    [% ELSE %]
     <div id="msgbody">[% content.body %]</div>
    [% END %]
   [% ELSE %]
    <br />
   [% END %]
  </div>
  <div id="msgfooter">
   [% IF entry.issued %]
    Posted on [% feeder.date_formatter.format_datetime(entry.issued) %]
   [% END %]
   [% IF entry.modified %]
    Modified on [% feeder.date_formatter.format_datetime(entry.modified) %]
   [% END %]
    |
   <a href="[% entry.link | html %]">permalink</a>
    |
   <a href="[% feed.link | html %]">[% feed.title | html %]</a>
   <br clear="all" />
  </div>
 </body>
</html>