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

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

added Test::Spelling and fixed typoes

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