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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Tue Jun 25 09:34:42 2002 UTC (22 years, 5 months ago) by wakaba
Branch: MAIN
2002-06-25  Wakaba <w@suika.fam.cx>

	* RisuukaBan.sb: New module.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24