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

Revision 1781 (checked in by miyagawa, 14 years ago)

Publish::Gmail allows encodings other than utf-8

  • 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 $body = $self->templatize('gmail_notify.tt', { feed => $feed });
70
71     my $cfg = $self->conf;
72     $context->log(info => "Sending $subject to $cfg->{mailto}");
73
74     my $feed_title = $feed->title;
75        $feed_title =~ tr/,//d;
76
77     my $now = Plagger::Date->now(timezone => $context->conf->{timezone});
78
79     my $msg = MIME::Lite->new(
80         Date => $now->format('Mail'),
81         From => encode('MIME-Header', qq("$feed_title" <$cfg->{mailfrom}>)),
82         To   => $cfg->{mailto},
83         Subject => encode('MIME-Header', $subject),
84         Type => 'multipart/related',
85     );
86     $msg->replace("X-Mailer" => "Plagger/$Plagger::VERSION");
87
88     my $encoding = $self->conf->{encoding} || 'utf-8';
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             ];
110             $msg->send_by_smtp_tls(@{ $self->{tls_args} });
111         } elsif ($route->{via} eq 'sendmail') {
112             my %param = (FromSender => "<$cfg->{mailfrom}>");
113             $param{Sendmail} = $route->{command} if defined $route->{command};
114             $msg->send('sendmail', %param);
115         } else {
116             my @args  = $route->{host} ? ($route->{host}) : ();
117             $msg->send($route->{via}, @args);
118         }
119     };
120
121     if ($@) {
122         $context->log(error => "Error while sending emails: $@");
123     }
124 }
125
126 sub prepare_enclosures {
127     my($self, $entry) = @_;
128
129     if (grep $_->is_inline, $entry->enclosures) {
130         # replace inline enclosures to cid: entities
131         my %url2enclosure = map { $_->url => $_ } $entry->enclosures;
132
133         my $output;
134         my $p = HTML::Parser->new(api_version => 3);
135         $p->handler( default => sub { $output .= $_[0] }, "text" );
136         $p->handler( start => sub {
137                          my($tag, $attr, $attrseq, $text) = @_;
138                          # TODO: use HTML::Tagset?
139                          if (my $url = $attr->{src}) {
140                              if (my $enclosure = $url2enclosure{$url}) {
141                                  $attr->{src} = "cid:" . $self->enclosure_id($enclosure);
142                              }
143                              $output .= $self->generate_tag($tag, $attr, $attrseq);
144                          } else {
145                              $output .= $text;
146                          }
147                      }, "tag, attr, attrseq, text");
148         $p->parse($entry->body);
149         $p->eof;
150
151         $entry->body($output);
152     }
153
154     return sub {
155         my $msg = shift;
156
157         for my $enclosure (grep $_->local_path, $entry->enclosures) {
158             my %param = (
159                 Type => $enclosure->type,
160                 Path => $enclosure->local_path,
161                 Filename => $enclosure->filename,
162             );
163
164             if ($enclosure->is_inline) {
165                 $param{Id} = '<' . $self->enclosure_id($enclosure) . '>';
166                 $param{Disposition} = 'inline';
167             } else {
168                 $param{Disposition} = 'attachment';
169             }
170
171             $msg->attach(%param);
172         }
173     }
174 }
175
176 sub generate_tag {
177     my($self, $tag, $attr, $attrseq) = @_;
178
179     return "<$tag " .
180         join(' ', map { $_ eq '/' ? '/' : sprintf qq(%s="%s"), $_, encode_entities($attr->{$_}, q(<>"')) } @$attrseq) .
181         '>';
182 }
183
184 sub enclosure_id {
185     my($self, $enclosure) = @_;
186     return Digest::MD5::md5_hex($enclosure->url->as_string) . '@Plagger';
187 }
188
189 sub DESTORY {
190     my $self = shift;
191     return unless $self->{tls_args};
192
193     my $conn_key = join "|", @{ $self->{tls_args} };
194     eval {
195         local $SIG{__WARN__} = sub { };
196         $TLSConn{$conn_key} && $TLSConn{$conn_key}->quit;
197     };
198
199     # known error from Gmail SMTP
200     if ($@ && $@ !~ /An error occurred disconnecting from the mail server/) {
201         warn $@;
202     }
203 }
204
205 # hack MIME::Lite to support TLS Authentication
206 *MIME::Lite::send_by_smtp_tls = sub {
207     my($self, @args) = @_;
208
209     ### We need the "From:" and "To:" headers to pass to the SMTP mailer:
210     my $hdr   = $self->fields();
211     my($from) = MIME::Lite::extract_addrs( $self->get('From') );
212     my $to    = $self->get('To');
213
214     ### Sanity check:
215     defined($to) or Carp::croak "send_by_smtp_tls: missing 'To:' address\n";
216
217     ### Get the destinations as a simple array of addresses:
218     my @to_all = MIME::Lite::extract_addrs($to);
219     if ($MIME::Lite::AUTO_CC) {
220         foreach my $field (qw(Cc Bcc)) {
221             my $value = $self->get($field);
222             push @to_all, MIME::Lite::extract_addrs($value) if defined($value);
223         }
224     }
225
226     ### Create SMTP TLS client:
227     require Net::SMTP::TLS;
228
229     my $conn_key = join "|", @args;
230     my $smtp;
231     unless ($smtp = $TLSConn{$conn_key}) {
232         $smtp = $TLSConn{$conn_key} = MIME::Lite::SMTP::TLS->new(@args)
233             or Carp::croak("Failed to connect to mail server: $!\n");
234     }
235     $smtp->mail($from);
236     $smtp->to(@to_all);
237     $smtp->data();
238
239     ### MIME::Lite can print() to anything with a print() method:
240     $self->print_for_smtp($smtp);
241     $smtp->dataend();
242
243     1;
244 };
245
246 @MIME::Lite::SMTP::TLS::ISA = qw( Net::SMTP::TLS );
247 sub MIME::Lite::SMTP::TLS::print { shift->datasend(@_) }
248
249 1;
250
251 __END__
252
253 =head1 NAME
254
255 Plagger::Plugin::Publish::Gmail - Notify updates to your email account
256
257 =head1 SYNOPSIS
258
259   - module: Publish::Gmail
260     config:
261       mailto: example@gmail.com
262       mailfrom: you@example.net
263
264 =head1 DESCRIPTION
265
266 This plugin creates HTML emails and sends them to your Gmail mailbox.
267
268 =head1 CONFIG
269
270 =over 4
271
272 =item mailto
273
274 Your email address to send updates to. Required.
275
276 =item mailfrom
277
278 Email address to send email from. Defaults to I<plagger@localhost>.
279
280 =item mailroute
281
282 Hash to specify how to send emails. Defaults to:
283
284   mailroute:
285     via: smtp
286     host: localhost
287
288 the value of I<via> would be either I<smtp>, I<smtp_tls> or I<sendmail>.
289
290   mailroute:
291     via: sendmail
292     command: /usr/sbin/sendmail
293
294 =item attach_enclosures
295
296 Flag to attach enclosures as Email attachments. Defaults to 0.
297
298 =back
299
300 =head1 AUTHOR
301
302 Tatsuhiko Miyagawa
303
304 =head1 SEE ALSO
305
306 L<Plagger>, L<MIME::Lite>
307
308 =cut
309
Note: See TracBrowser for help on using the browser.