/[suikacvs]/messaging/suikawari/module/RisuukaBan.sb
Suika

Contents of /messaging/suikawari/module/RisuukaBan.sb

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations) (download)
Thu Aug 29 12:08:14 2002 UTC (22 years, 3 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +15 -23 lines
2002-08-29  Wakaba <w@suika.fam.cx>

	* RisuukaBan.sb: Update regex.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24