root/trunk/plagger/lib/Plagger/Plugin/Publish/Gmail.pm

Revision 1994 (checked in by tokuhirom, 12 years ago)

Plugin::Publish::Gmail: support higher version of MIME::Lite. thanks poppen++
http://www.karashi.org/~poppen/d/20070921.html

  • Property svn:keywords set to Id Revision
Line 
1 package Plagger::Plugin::Publish::Gmail;
2 use strict;
3 use base qw( Plagger::Plugin );
4
5 our $VERSION = '0.10';
6
7 use DateTime;
8 use DateTime::Format::Mail;
9 use Encode;
10 use Encode::MIME::Header;
11 use HTML::Entities;
12 use HTML::Parser;
13 use MIME::Lite;
14
15 our %TLSConn;
16
17 sub rule_hook { 'publish.feed' }
18
19 sub register {
20     my($self, $context) = @_;
21     $context->register_hook(
22         $self,
23         'publish.init' => \&initialize,
24         'publish.feed' => \&notify,
25     );
26 }
27
28 sub init {
29     my $self = shift;
30     $self->SUPER::init(@_);
31
32     $self->conf->{mailto} or Plagger->context->error("mailto is required");
33     $self->conf->{mailfrom} ||= 'plagger@localhost';
34 }
35
36 sub initialize {
37     my($self,$context) = @_;
38
39     # authenticate POP before SMTP
40     if (my $conf = $self->conf->{pop3}) {
41         require Net::POP3;
42         my $pop = Net::POP3->new($conf->{host});
43         if ($pop->apop($conf->{username}, $conf->{password})) {
44             $context->log(info => 'APOP login succeed');
45         } elsif ($pop->login($conf->{username}, $conf->{password})) {
46             $context->log(info => 'POP3 login succeed');
47         } else {
48             $context->log(error => 'POP3 login error');
49         }
50         $pop->quit;
51     }
52 }
53
54 sub notify {
55     my($self, $context, $args) = @_;
56
57     return if $args->{feed}->count == 0;
58
59     my $feed = $args->{feed};
60     my $subject = $feed->title || '(no-title)';
61
62     my @enclosure_cb;
63     if ($self->conf->{attach_enclosures}) {
64         for my $entry ($args->{feed}->entries) {
65             push @enclosure_cb, $self->prepare_enclosures($entry);
66         }
67     }
68
69     my $encoding = $self->conf->{encoding} || 'utf-8';
70     my $body = $self->templatize('gmail_notify.tt', { feed => $feed, encoding => $encoding });
71
72     my $cfg = $self->conf;
73     $context->log(info => "Sending $subject to $cfg->{mailto}");
74
75     my $feed_title = $feed->title;
76        $feed_title =~ tr/,//d;
77
78     my $now = Plagger::Date->now(timezone => $context->conf->{timezone});
79
80     my $msg = MIME::Lite->new(
81         Date => $now->format('Mail'),
82         From => encode('MIME-Header', qq("$feed_title" <$cfg->{mailfrom}>)),
83         To   => $cfg->{mailto},
84         Subject => encode('MIME-Header', $subject),
85         Type => 'multipart/related',
86     );
87     $msg->replace("X-Mailer" => "Plagger/$Plagger::VERSION");
88
89     $msg->attach(
90         Type => "text/html; charset=$encoding",
91         Data => encode($encoding, $body, Encode::FB_HTMLCREF),
92         Encoding => 'quoted-printable',
93     );
94
95     for my $cb (@enclosure_cb) {
96         $cb->($msg);
97     }
98
99     my $route = $cfg->{mailroute} || { via => 'smtp', host => 'localhost' };
100     $route->{via} ||= 'smtp';
101
102     eval {
103         if ($route->{via} eq 'smtp_tls') {
104             $self->{tls_args} = [
105                 $route->{host},
106                 User     => $route->{username},
107                 Password => $route->{password},
108                 Port     => $route->{port} || 587,
109                 Timeout  => $route->{timeout} || 300,
110             ];
111             $msg->send_by_smtp_tls(@{ $self->{tls_args} });
112         } elsif ($route->{via} eq 'sendmail') {
113             my %param = (FromSender => "<$cfg->{mailfrom}>");
114             $param{Sendmail} = $route->{command} if defined $route->{command};
115             $msg->send('sendmail', %param);
116         } else {
117             my @args  = $route->{host} ? ($route->{host}) : ();
118             $msg->send($route->{via}, @args);
119         }
120     };
121
122     if ($@) {
123         $context->log(error => "Error while sending emails: $@");
124     }
125 }
126
127 sub prepare_enclosures {
128     my($self, $entry) = @_;
129
130     if (grep $_->is_inline, $entry->enclosures) {
131         # replace inline enclosures to cid: entities
132         my %url2enclosure = map { $_->url => $_ } $entry->enclosures;
133
134         my $output;
135         my $p = HTML::Parser->new(api_version => 3);
136         $p->handler( default => sub { $output .= $_[0] }, "text" );
137         $p->handler( start => sub {
138                          my($tag, $attr, $attrseq, $text) = @_;
139                          # TODO: use HTML::Tagset?
140                          if (my $url = $attr->{src}) {
141                              if (my $enclosure = $url2enclosure{$url}) {
142                                  $attr->{src} = "cid:" . $self->enclosure_id($enclosure);
143                              }
144                              $output .= $self->generate_tag($tag, $attr, $attrseq);
145                          } else {
146                              $output .= $text;
147                          }
148                      }, "tag, attr, attrseq, text");
149         $p->parse($entry->body);
150         $p->eof;
151
152         $entry->body($output);
153     }
154
155     return sub {
156         my $msg = shift;
157
158         for my $enclosure (grep $_->local_path, $entry->enclosures) {
159             if (!-e $enclosure->local_path) {
160                 Plagger->context->log(warning => $enclosure->local_path . " doesn't exist. Skip");
161                 next;
162             }
163
164             my %param = (
165                 Type => $enclosure->type,
166                 Path => $enclosure->local_path,
167                 Filename => $enclosure->filename,
168             );
169
170             if ($enclosure->is_inline) {
171                 $param{Id} = '<' . $self->enclosure_id($enclosure) . '>';
172                 $param{Disposition} = 'inline';
173             } else {
174                 $param{Disposition} = 'attachment';
175             }
176
177             $msg->attach(%param);
178         }
179     }
180 }
181
182 sub generate_tag {
183     my($self, $tag, $attr, $attrseq) = @_;
184
185     return "<$tag " .
186         join(' ', map { $_ eq '/' ? '/' : sprintf qq(%s="%s"), $_, encode_entities($attr->{$_}, q(<>"')) } @$attrseq) .
187         '>';
188 }
189
190 sub enclosure_id {
191     my($self, $enclosure) = @_;
192     return Digest::MD5::md5_hex($enclosure->url->as_string) . '@Plagger';
193 }
194
195 sub DESTORY {
196     my $self = shift;
197     return unless $self->{tls_args};
198
199     my $conn_key = join "|", @{ $self->{tls_args} };
200     eval {
201         local $SIG{__WARN__} = sub { };
202         $TLSConn{$conn_key} && $TLSConn{$conn_key}->quit;
203     };
204
205     # known error from Gmail SMTP
206     if ($@ && $@ !~ /An error occurred disconnecting from the mail server/) {
207         warn $@;
208     }
209 }
210
211 # hack MIME::Lite to support TLS Authentication
212 *MIME::Lite::send_by_smtp_tls = sub {
213     my($self, @args) = @_;
214     my $extract_addrs_ref =
215         defined &MIME::Lite::extract_addrs
216         ? \&MIME::Lite::extract_addrs
217         : \&MIME::Lite::extract_full_addrs;
218
219     ### We need the "From:" and "To:" headers to pass to the SMTP mailer:
220     my $hdr   = $self->fields();
221     my($from) = $extract_addrs_ref->( $self->get('From') );
222     my $to    = $self->get('To');
223
224     ### Sanity check:
225     defined($to) or Carp::croak "send_by_smtp_tls: missing 'To:' address\n";
226
227     ### Get the destinations as a simple array of addresses:
228     my @to_all = $extract_addrs_ref->($to);
229     if ($MIME::Lite::AUTO_CC) {
230         foreach my $field (qw(Cc Bcc)) {
231             my $value = $self->get($field);
232             push @to_all, $extract_addrs_ref->($value) if defined($value);
233         }
234     }
235
236     ### Create SMTP TLS client:
237     require Net::SMTP::TLS;
238
239     my $conn_key = join "|", @args;
240     my $smtp;
241     unless ($smtp = $TLSConn{$conn_key}) {
242         $smtp = $TLSConn{$conn_key} = MIME::Lite::SMTP::TLS->new(@args)
243             or Carp::croak("Failed to connect to mail server: $!\n");
244     }
245     $smtp->mail($from);
246     $smtp->to(@to_all);
247     $smtp->data();
248
249     ### MIME::Lite can print() to anything with a print() method:
250     $self->print_for_smtp($smtp);
251     $smtp->dataend();
252
253     1;
254 };
255
256 @MIME::Lite::SMTP::TLS::ISA = qw( Net::SMTP::TLS );
257 sub MIME::Lite::SMTP::TLS::print { shift->datasend(@_) }
258
259 1;
260
261 __END__
262
263 =head1 NAME
264
265 Plagger::Plugin::Publish::Gmail - Notify updates to your email account
266
267 =head1 SYNOPSIS
268
269   - module: Publish::Gmail
270     config:
271       mailto: example@gmail.com
272       mailfrom: you@example.net
273
274 =head1 DESCRIPTION
275
276 This plugin creates HTML emails and sends them to your Gmail mailbox.
277
278 =head1 CONFIG
279
280 =over 4
281
282 =item mailto
283
284 Your email address to send updates to. Required.
285
286 =item mailfrom
287
288 Email address to send email from. Defaults to I<plagger@localhost>.
289
290 =item mailroute
291
292 Hash to specify how to send emails. Defaults to:
293
294   mailroute:
295     via: smtp
296     host: localhost
297
298 the value of I<via> would be either I<smtp>, I<smtp_tls> or I<sendmail>.
299
300   mailroute:
301     via: sendmail
302     command: /usr/sbin/sendmail
303
304 =item attach_enclosures
305
306 Flag to attach enclosures as Email attachments. Defaults to 0.
307
308 =back
309
310 =head1 AUTHOR
311
312 Tatsuhiko Miyagawa
313
314 =head1 SEE ALSO
315
316 L<Plagger>, L<MIME::Lite>
317
318 =cut
319
Note: See TracBrowser for help on using the browser.