suikawari/module/RisuukaBan.sb


=head1 NAME

Suikawari::RisuukaBan --- Suikawari module for Risuuka Keijiban

=cut

## This file is written in EUC-japan encoding.

package Suikawari::RisuukaBan;
use strict;
use vars qw/$VERSION/;
$VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
use Message::MIME::Charset::Jcode 'jcode.pl';

sub msg_regex ($) {
<<'EOH',
<HR width="500" size="1" color="#cccccc">
 <BR>
 <TABLE width="500" cellpadding="0" cellspacing="0">
   <TBODY>
     <TR>
       <TD align="left">([0-9]+). <FONT color="([^"]+)">([\x00-\xFF]*?)</FONT></TD>
       <TD align="right">From: (?:<A href="mailto:([^"]+)">)?([\x00-\xFF]+?)(?:</A>)? (?:<A href="([^"]+)" target="_blank">\+Home</A>)?</TD>
     </TR>
     <TR>
       <TD colspan="2" align="left" class="a4"><BR>
       <FONT color="(?:[^"]+)">([\x00-\xFF]+?)</FONT><BR>
       <BR>
       </TD>
     </TR>
     <TR>
       <TD colspan="2" align="center">([0-9]+)/([0-9]+)/([0-9]+) ([0-9]+):([0-9]+)</TD>
     </TR>
   </TBODY>
 </TABLE>
EOH
  qw (msg_count misc_color subject from_mail from_name from_uri
      body date_year date_month date_day date_hour date_minute);
}

sub meta_regex ($) {
  my $r = <<'EOH';
(?i)<TITLE>([^<]+)</TITLE>
EOH
  $r =~ s/\n$//s;
  $r, qw (list_name);
}

sub on_load_source ($$) {shift;
  my $b = shift;
  $b->set_hook_function (code_conversion => sub { jcode::euc ($_[1]) });
}

sub source ($) {
  if ($Bunshin::DEBUG) {
    (file => '');
    (uri => 'http://bbs7.otd.co.jp/703265/bbs_plain');
  } else {
    (uri => 'http://bbs7.otd.co.jp/703265/bbs_plain');
  }
}

sub face ($) {
#  my %face;
#  (faces => \%face);
}

sub on_make ($$) {
  my $self = shift;
  my $b = shift;
  $b->default_parameter (date_zone => '+0900');
  $b->default_parameter (DEFAULT_subject => '(痰玛)');
  $b->default_parameter (newsgroups => 'suika.chuubu.r.55');
  $b->default_parameter (list_name => '妄眶彩非绩饶');
  $b->default_parameter (list_id => '2000e.risuu.chuubu.suika.fam.cx');
  $b->default_parameter (urn_template => 'urn:x-suika-fam-cx:chuubu:r:55:bbs:%msg_count;');
  $b->set_format (msg_count => sub { $_[3]->{msg_count} });
  $b->set_hook_function (msg_header_add => sub {
    my $self = shift;
    my ($msg, $p) = @_;
    my $hdr = $msg->header;
    ## Newsgroups
      my $group = $p->{newsgroups};
      $group = 'suika.test' if $Bunshin::DEBUG;
      $hdr->replace (newsgroups => $group);
  });
  $b->set_hook_function (msg_body => sub {
    shift;
    my ($msg, $body, $p) = @_;
    $body =~ s#[\x0D\x0A]*<br>[\x0D\x0A]*#\x0D\x0A#g;
    $msg->body->value ($body);
  });
}

=head1 SEE ALSO

Suikawari, Bunshin

=head1 LICENSE

Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.

=head1 CHANGE

See F<ChangeLog>.
$Date: 2002/06/16 10:50:15 $

=cut

1;
### Suikawari::TomikouKeijiban ends here
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