root/trunk/plagger/lib/Plagger/Plugin/CustomFeed/Mailman.pm

Revision 480 (checked in by miyagawa, 15 years ago)

remove caveat

  • Property svn:keywords set to Id Revision
Line 
1 package Plagger::Plugin::CustomFeed::Mailman;
2 use strict;
3 use base qw( Plagger::Plugin );
4
5 use List::Util qw(min);
6 use DateTime::Locale;
7 use Encode;
8 use Plagger::UserAgent;
9
10 sub register {
11     my($self, $context) = @_;
12     $context->register_hook(
13         $self,
14         'customfeed.handle' => \&handle,
15     );
16 }
17
18 sub handle {
19     my($self, $context, $args) = @_;
20
21     if ($args->{feed}->url =~ m!/pipermail/[^/]+/$!) {
22         $self->aggregate($context, $args);
23         return 1;
24     }
25
26     return;
27 }
28
29 sub aggregate {
30     my($self, $context, $args) = @_;
31
32     my $url = $args->{feed}->url;
33     $url .= '/' unless $url =~ m!/$!;
34
35     my $now = Plagger::Date->now;
36        $now->set_locale('en_us');
37
38     my $base_url = $url . $now->year . '-' . $now->month_name . '/';
39
40     $url = $base_url . 'date.html';
41     $context->log(info => "GET $url");
42
43     my $agent = Plagger::UserAgent->new;
44     my $response = $agent->get($url);
45
46     unless ($response->is_success) {
47         $context->log(error => "GET $url failed: " . $response->status_line);
48         return;
49     }
50
51     my $content = $response->content;
52     my $encoding = ($content =~ /<META .*; charset=([\w\-]*)/)[0] || 'utf-8';
53
54     eval {
55         $content = decode($encoding, $content);
56     };
57     if ($@) {
58         $context->log(warn => $@);
59     }
60
61     my $year  = $now->year;
62
63     # TODO: only tested with ja and en localization
64     my $month = join '|', @{ DateTime::Locale->load('en_us')->month_names };
65     my $title = ($content =~ /<title>(?:The )?(.*?) (?:(?:$month) )?$year/)[0];
66
67     my $feed = Plagger::Feed->new;
68     $feed->type('mailman');
69     $feed->title($title);
70     $feed->link($args->{feed}->url); # base
71
72     my @matches;
73     while ($content =~ m!<LI><A HREF="(\d+\.html)">(.*?)\n</A><A NAME="(\d+)">&nbsp;</A>\n<I>(.*?)\n</I>!g) {
74         push @matches, {
75             link    => $1,
76             subject => $2,
77             id      => $3,
78             from    => $4,
79         };
80     }
81
82     my $items = min( $self->conf->{fetch_items} || 20, scalar(@matches));
83     @matches  = reverse @matches[-$items .. -1];
84
85     for my $match (@matches) {
86         $match->{subject} =~ s/\[$title(?: \d+)?\]\s+//;
87
88         my $entry = Plagger::Entry->new;
89         $entry->title($match->{subject});
90         $entry->link($base_url . $match->{link});
91         $entry->author($match->{from});
92
93         $feed->add_entry($entry);
94     }
95
96     $context->update->add($feed);
97 }
98
99 1;
100
101 __END__
102
103 =head1 NAME
104
105 Plagger::Plugin::CustomFeed::Mailman - Custom feed for Mailman pipermail
106
107 =head1 SYNOPSIS
108
109   - module: Subscription::Config
110     config:
111       feed:
112         - http://lists.rawmode.org/pipermail/catalyst/
113
114 =head1 DESCRIPTION
115
116 This plugin creates a custom feed off of Mailman's pipermail URL.
117
118 =head1 AUTHOR
119
120 Tatsuhiko Miyagawa
121
122 =head1 SEE ALSO
123
124 L<Plagger>
125
126 =cut
Note: See TracBrowser for help on using the browser.