1 |
|
2 |
=head1 NAME
|
3 |
|
4 |
Suikawari::RisuukaBan --- Suikawari module for Risuuka Keijiban
|
5 |
|
6 |
=cut
|
7 |
|
8 |
## This file is written in EUC-japan encoding.
|
9 |
|
10 |
package Suikawari::RisuukaBan;
|
11 |
use strict;
|
12 |
use vars qw/$VERSION/;
|
13 |
$VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
|
14 |
use Message::MIME::Charset::Jcode 'jcode.pl';
|
15 |
|
16 |
sub msg_regex ($) {
|
17 |
<<'EOH',
|
18 |
<br><center><table cellpadding=2 width=550>
|
19 |
<tr><td width=100 valign=top>
|
20 |
<font color=([0-9A-Za-z#]*)>(?:
|
21 |
<a href="([^"]+)" target="_blank">)?
|
22 |
<font color=[0-9A-Za-z#]*>(.+?)</font>(?:</a>
|
23 |
)?
|
24 |
</td>
|
25 |
<td>
|
26 |
<font color=[0-9A-Za-z#]*>(.+?)</font><br><div align=right>
|
27 |
[^0-9]+([0-9]+)/([0-9]+)/([0-9]+) ([0-9]+):([0-9]+)[^<]+</td>
|
28 |
</tr></table>
|
29 |
EOH
|
30 |
qw (misc_color from_uri from_name
|
31 |
body date_year date_month date_day date_hour date_minute);
|
32 |
}
|
33 |
|
34 |
sub meta_regex ($) {
|
35 |
my $r = <<'EOH';
|
36 |
(?i)<title>([^<]+)</title>
|
37 |
EOH
|
38 |
$r =~ s/\n$//s;
|
39 |
$r, qw (list_name);
|
40 |
}
|
41 |
|
42 |
sub on_load_source ($$) {shift;
|
43 |
my $b = shift;
|
44 |
$b->set_hook_function (code_conversion => sub { jcode::euc ($_[1]) });
|
45 |
}
|
46 |
|
47 |
sub source ($) {
|
48 |
if ($Bunshin::DEBUG) {
|
49 |
(file => '');
|
50 |
(uri => 'http://bbs7.otd.co.jp/703265/bbs_plain');
|
51 |
} else {
|
52 |
(uri => 'http://bbs7.otd.co.jp/703265/bbs_plain');
|
53 |
}
|
54 |
}
|
55 |
|
56 |
sub face ($) {
|
57 |
# my %face;
|
58 |
# (faces => \%face);
|
59 |
}
|
60 |
|
61 |
sub on_make ($$) {
|
62 |
my $self = shift;
|
63 |
my $b = shift;
|
64 |
$b->default_parameter (date_zone => '+0900');
|
65 |
$b->default_parameter (DEFAULT_subject => '(無題)');
|
66 |
$b->default_parameter (newsgroups => 'suika.chuubu.r.55');
|
67 |
$b->default_parameter (list_name => '理数科掲示板');
|
68 |
$b->default_parameter (list_id => '2000e.risuu.chuubu.suika.fam.cx');
|
69 |
$b->default_parameter (urn_template => 'urn:x-suika-fam-cx:chuubu:r:55:bbs:%msg_count;');
|
70 |
$b->set_format (msg_count => sub { $_[1]->{msg_count} });
|
71 |
$b->set_hook_function (msg_header_add => sub {
|
72 |
my $self = shift;
|
73 |
my ($msg, $p) = @_;
|
74 |
my $hdr = $msg->header;
|
75 |
## Newsgroups
|
76 |
my $group = $p->{newsgroups};
|
77 |
$group = 'suika.test' if $Bunshin::DEBUG;
|
78 |
$hdr->replace (newsgroups => $group);
|
79 |
});
|
80 |
$b->set_hook_function (msg_body => sub {
|
81 |
shift;
|
82 |
my ($msg, $body, $p) = @_;
|
83 |
$body =~ s#[\x0D\x0A]*<br>[\x0D\x0A]*#\x0D\x0A#g;
|
84 |
$msg->body->value ($body);
|
85 |
});
|
86 |
}
|
87 |
|
88 |
=head1 SEE ALSO
|
89 |
|
90 |
Suikawari, Bunshin
|
91 |
|
92 |
=head1 LICENSE
|
93 |
|
94 |
Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
|
95 |
|
96 |
This program is free software; you can redistribute it and/or modify
|
97 |
it under the terms of the GNU General Public License as published by
|
98 |
the Free Software Foundation; either version 2 of the License, or
|
99 |
(at your option) any later version.
|
100 |
|
101 |
This program is distributed in the hope that it will be useful,
|
102 |
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
103 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
104 |
GNU General Public License for more details.
|
105 |
|
106 |
You should have received a copy of the GNU General Public License
|
107 |
along with this program; see the file COPYING. If not, write to
|
108 |
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
109 |
Boston, MA 02111-1307, USA.
|
110 |
|
111 |
=head1 CHANGE
|
112 |
|
113 |
See F<ChangeLog>.
|
114 |
$Date: 2002/06/25 09:34:42 $
|
115 |
|
116 |
=cut
|
117 |
|
118 |
1;
|
119 |
### Suikawari::TomikouKeijiban ends here
|