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