| 1 |
package Plagger::Plugin::Publish::Maildir; |
|---|
| 2 |
use strict; |
|---|
| 3 |
use base qw( Plagger::Plugin ); |
|---|
| 4 |
|
|---|
| 5 |
use DateTime; |
|---|
| 6 |
use DateTime::Format::Mail; |
|---|
| 7 |
use Encode qw/ from_to encode/; |
|---|
| 8 |
use Encode::MIME::Header; |
|---|
| 9 |
use HTML::Entities; |
|---|
| 10 |
use MIME::Lite; |
|---|
| 11 |
use Digest::MD5 qw/ md5_hex /; |
|---|
| 12 |
use File::Find; |
|---|
| 13 |
|
|---|
| 14 |
sub register { |
|---|
| 15 |
my($self, $context) = @_; |
|---|
| 16 |
$context->register_hook( |
|---|
| 17 |
$self, |
|---|
| 18 |
'plugin.init' => \&initialize, |
|---|
| 19 |
'publish.entry' => \&store_entry, |
|---|
| 20 |
'publish.finalize' => \&finalize, |
|---|
| 21 |
); |
|---|
| 22 |
} |
|---|
| 23 |
|
|---|
| 24 |
sub rule_hook { 'publish.entry' } |
|---|
| 25 |
|
|---|
| 26 |
sub initialize { |
|---|
| 27 |
my($self, $context, $args) = @_; |
|---|
| 28 |
my $cfg = $self->conf; |
|---|
| 29 |
my $permission = $cfg->{permission} || 0700; |
|---|
| 30 |
if (-d $cfg->{maildir}) { |
|---|
| 31 |
my $path = "$cfg->{maildir}/.$cfg->{folder}"; |
|---|
| 32 |
$path =~ s/\/\//\//g; |
|---|
| 33 |
$path =~ s/\/$//g; |
|---|
| 34 |
unless (-d $path) { |
|---|
| 35 |
mkdir($path, 0700) |
|---|
| 36 |
or die $context->log(error => "Could not create $path"); |
|---|
| 37 |
$context->log(info => "Create new folder ($path)"); |
|---|
| 38 |
} |
|---|
| 39 |
unless (-d $path . "/new") { |
|---|
| 40 |
mkdir($path . "/new", 0700) |
|---|
| 41 |
or die $context->log(error => "Could not Create $path/new"); |
|---|
| 42 |
$context->log(info => "Create new folder($path/new)"); |
|---|
| 43 |
} |
|---|
| 44 |
$self->{path} = $path; |
|---|
| 45 |
} |
|---|
| 46 |
else { |
|---|
| 47 |
die $context->log(error => "Could not access $cfg->{maildir}"); |
|---|
| 48 |
} |
|---|
| 49 |
} |
|---|
| 50 |
|
|---|
| 51 |
sub finalize { |
|---|
| 52 |
my($self, $context, $args) = @_; |
|---|
| 53 |
if (my $msg_count = $self->{msg}) { |
|---|
| 54 |
if (my $update_count = $self->{update_msg}) { |
|---|
| 55 |
$context->log(info => |
|---|
| 56 |
"Store $msg_count message(s) ($update_count message(s) updated)" |
|---|
| 57 |
); |
|---|
| 58 |
} |
|---|
| 59 |
else { |
|---|
| 60 |
$context->log(info => "Store $msg_count message(s)"); |
|---|
| 61 |
} |
|---|
| 62 |
} |
|---|
| 63 |
} |
|---|
| 64 |
|
|---|
| 65 |
sub store_entry { |
|---|
| 66 |
my($self, $context, $args) = @_; |
|---|
| 67 |
my $cfg = $self->conf; |
|---|
| 68 |
my $msg; |
|---|
| 69 |
my $entry = $args->{entry}; |
|---|
| 70 |
my $feed_title = $args->{feed}->title->plaintext; |
|---|
| 71 |
$feed_title =~ tr/,//d; |
|---|
| 72 |
my $subject = $entry->title->plaintext || '(no-title)'; |
|---|
| 73 |
my $body = $self->templatize('mail.tt', $args); |
|---|
| 74 |
$body = encode("utf-8", $body); |
|---|
| 75 |
my $from = $cfg->{mailfrom} || 'plagger@localhost'; |
|---|
| 76 |
my $id = md5_hex($entry->id_safe); |
|---|
| 77 |
my $date = $entry->date || Plagger::Date->now(timezone => $context->conf->{timezone}); |
|---|
| 78 |
my @enclosure_cb; |
|---|
| 79 |
|
|---|
| 80 |
if ($self->conf->{attach_enclosures}) { |
|---|
| 81 |
push @enclosure_cb, $self->prepare_enclosures($entry); |
|---|
| 82 |
} |
|---|
| 83 |
$msg = MIME::Lite->new( |
|---|
| 84 |
Date => $date->format('Mail'), |
|---|
| 85 |
From => encode('MIME-Header', qq("$feed_title" <$from>)), |
|---|
| 86 |
To => $cfg->{mailto}, |
|---|
| 87 |
Subject => encode('MIME-Header', $subject), |
|---|
| 88 |
Type => 'multipart/related', |
|---|
| 89 |
); |
|---|
| 90 |
$msg->attach( |
|---|
| 91 |
Type => 'text/html; charset=utf-8', |
|---|
| 92 |
Data => $body, |
|---|
| 93 |
Encoding => 'quoted-printable', |
|---|
| 94 |
); |
|---|
| 95 |
for my $cb (@enclosure_cb) { |
|---|
| 96 |
$cb->($msg); |
|---|
| 97 |
} |
|---|
| 98 |
$msg->add('Message-Id', "<$id.plagger\@localhost>"); |
|---|
| 99 |
$msg->add('X-Tags', encode('MIME-Header', join(' ', @{ $entry->tags }))); |
|---|
| 100 |
my $xmailer = "Plagger/$Plagger::VERSION"; |
|---|
| 101 |
$msg->replace('X-Mailer', $xmailer); |
|---|
| 102 |
store_maildir($self, $context, $msg->as_string(), $id); |
|---|
| 103 |
$self->{msg} += 1; |
|---|
| 104 |
} |
|---|
| 105 |
|
|---|
| 106 |
sub prepare_enclosures { |
|---|
| 107 |
my($self, $entry) = @_; |
|---|
| 108 |
|
|---|
| 109 |
if (grep $_->is_inline, $entry->enclosures) { |
|---|
| 110 |
|
|---|
| 111 |
|
|---|
| 112 |
my %url2enclosure = map { $_->url => $_ } $entry->enclosures; |
|---|
| 113 |
|
|---|
| 114 |
my $output; |
|---|
| 115 |
my $p = HTML::Parser->new(api_version => 3); |
|---|
| 116 |
$p->handler(default => sub { $output .= $_[0] }, "text"); |
|---|
| 117 |
$p->handler( |
|---|
| 118 |
start => sub { |
|---|
| 119 |
my($tag, $attr, $attrseq, $text) = @_; |
|---|
| 120 |
|
|---|
| 121 |
|
|---|
| 122 |
if (my $url = $attr->{src}) { |
|---|
| 123 |
if (my $enclosure = $url2enclosure{$url}) { |
|---|
| 124 |
$attr->{src} = "cid:" . $self->enclosure_id($enclosure); |
|---|
| 125 |
} |
|---|
| 126 |
$output .= $self->generate_tag($tag, $attr, $attrseq); |
|---|
| 127 |
} |
|---|
| 128 |
else { |
|---|
| 129 |
$output .= $text; |
|---|
| 130 |
} |
|---|
| 131 |
}, |
|---|
| 132 |
"tag, attr, attrseq, text" |
|---|
| 133 |
); |
|---|
| 134 |
$p->parse($entry->body); |
|---|
| 135 |
$p->eof; |
|---|
| 136 |
|
|---|
| 137 |
$entry->body($output); |
|---|
| 138 |
} |
|---|
| 139 |
|
|---|
| 140 |
return sub { |
|---|
| 141 |
my $msg = shift; |
|---|
| 142 |
|
|---|
| 143 |
for my $enclosure (grep $_->local_path, $entry->enclosures) { |
|---|
| 144 |
if (!-e $enclosure->local_path) { |
|---|
| 145 |
Plagger->context->log(warning => $enclosure->local_path . " doesn't exist. Skip"); |
|---|
| 146 |
next; |
|---|
| 147 |
} |
|---|
| 148 |
|
|---|
| 149 |
my %param = ( |
|---|
| 150 |
Type => $enclosure->type, |
|---|
| 151 |
Path => $enclosure->local_path, |
|---|
| 152 |
Filename => $enclosure->filename, |
|---|
| 153 |
); |
|---|
| 154 |
|
|---|
| 155 |
if ($enclosure->is_inline) { |
|---|
| 156 |
$param{Id} = '<' . $self->enclosure_id($enclosure) . '>'; |
|---|
| 157 |
$param{Disposition} = 'inline'; |
|---|
| 158 |
} |
|---|
| 159 |
else { |
|---|
| 160 |
$param{Disposition} = 'attachment'; |
|---|
| 161 |
} |
|---|
| 162 |
|
|---|
| 163 |
$msg->attach(%param); |
|---|
| 164 |
} |
|---|
| 165 |
} |
|---|
| 166 |
} |
|---|
| 167 |
|
|---|
| 168 |
sub generate_tag { |
|---|
| 169 |
my($self, $tag, $attr, $attrseq) = @_; |
|---|
| 170 |
|
|---|
| 171 |
return "<$tag " . join( |
|---|
| 172 |
' ', |
|---|
| 173 |
map { |
|---|
| 174 |
$_ eq '/' ? '/' : sprintf qq(%s="%s"), $_, |
|---|
| 175 |
encode_entities($attr->{$_}, q(<>"')) |
|---|
| 176 |
} @$attrseq |
|---|
| 177 |
) |
|---|
| 178 |
. '>'; |
|---|
| 179 |
} |
|---|
| 180 |
|
|---|
| 181 |
sub enclosure_id { |
|---|
| 182 |
my($self, $enclosure) = @_; |
|---|
| 183 |
return Digest::MD5::md5_hex($enclosure->url->as_string) . '@Plagger'; |
|---|
| 184 |
} |
|---|
| 185 |
|
|---|
| 186 |
sub store_maildir { |
|---|
| 187 |
my($self, $context, $msg, $id) = @_; |
|---|
| 188 |
my $filename = $id . ".plagger"; |
|---|
| 189 |
find( |
|---|
| 190 |
sub { |
|---|
| 191 |
if ($_ =~ m!$id.*!) { |
|---|
| 192 |
unlink $_; |
|---|
| 193 |
$self->{update_msg} += 1; |
|---|
| 194 |
} |
|---|
| 195 |
}, |
|---|
| 196 |
$self->{path} . "/cur" |
|---|
| 197 |
); |
|---|
| 198 |
$context->log(debug => "writing: new/$filename"); |
|---|
| 199 |
my $path = $self->{path} . "/new/" . $filename; |
|---|
| 200 |
open my $fh, ">", $path or $context->error("$path: $!"); |
|---|
| 201 |
print $fh $msg; |
|---|
| 202 |
close $fh; |
|---|
| 203 |
} |
|---|
| 204 |
|
|---|
| 205 |
1; |
|---|
| 206 |
|
|---|
| 207 |
=head1 NAME |
|---|
| 208 |
|
|---|
| 209 |
Plagger::Plugin::Publish::Maildir - Store Maildir |
|---|
| 210 |
|
|---|
| 211 |
=head1 SYNOPSIS |
|---|
| 212 |
|
|---|
| 213 |
- module: Publish::Maildir |
|---|
| 214 |
config: |
|---|
| 215 |
maildir: /home/foo/Maildir |
|---|
| 216 |
folder: plagger |
|---|
| 217 |
attach_enclosures: 1 |
|---|
| 218 |
mailfrom: plagger@localhost |
|---|
| 219 |
|
|---|
| 220 |
=head1 DESCRIPTION |
|---|
| 221 |
|
|---|
| 222 |
This plugin changes an entry into e-mail, and saves it to Maildir. |
|---|
| 223 |
|
|---|
| 224 |
=head1 AUTHOR |
|---|
| 225 |
|
|---|
| 226 |
Nobuhito Sato |
|---|
| 227 |
|
|---|
| 228 |
=head1 SEE ALSO |
|---|
| 229 |
|
|---|
| 230 |
L<Plagger> |
|---|
| 231 |
|
|---|
| 232 |
=cut |
|---|
| 233 |
|
|---|
| 234 |
|
|---|