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 $/;}; 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/]*\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' -%]
[% SET link = entry.link || entry.id -%] [% entry.title %]
[% feed.title %]
[% IF entry.author %] by [% entry.author | html %] [% END %] [% IF entry.tags.size %] on [% entry.tags.join(',') %] [% END %]
[% IF content.body -%] [% IF content.body.match('(?i)^]') %] [% content.body %] [% ELSE %]
[% content.body %]
[% END %] [% ELSE %]
[% END %]
[% 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 %] | permalink | [% feed.title | html %]