=head1 NAME Suikawari::TomikouKeijiban --- Suikawari module for Tomikou Keijiban Ehttp://tomikou.net/keijiban/E =cut ## This file is written in EUC-japan encoding. package Suikawari::TomikouKeijiban; use strict; use vars qw/$VERSION/; $VERSION=do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; use Message::MIME::Charset::Jcode 'jcode.pl'; sub msg_regex ($) { <<'EOH',
■([\x00-\xFF]+?)
■([\x00-\xFF]+?)  [0-9]+年[0-9]+月[0-9]+日\(..\) [0-9]+:[0-9]+
([\x00-\xFF]*?)

EOH qw (date_year date_month date_day date_hour date_minute date_second misc_subject_background_color misc_subject_color subject from_mail from_name body); } sub meta_regex ($) { my $r = <<'EOH'; ([\x00-\xFF]+?) : [\x00-\xFF]+? EOH $r =~ s/\n$//s; $r, qw (list_name); } sub element_decoders () { ( list_name => 'deentity_html', from_name => 'deentity_html', from_mail => 'deentity_html', ); } sub on_load_source ($$) {shift; my $b = shift; $b->set_hook_function (code_conversion => sub { (Message::MIME::Charset::decode (shift_jisx0213 => $_[1]))[0] }); } sub source ($) { if ($Bunshin::DEBUG) { (file => 'Tomikou-ban.tmp'); (uri => 'http://tomikou.net/keijiban/keijiban.php'); } else { (uri => 'http://tomikou.net/keijiban/keijiban.php'); } } sub face ($) { # my %face; # (faces => \%face); } sub _my_on_make ($$) {shift; my $b = shift; $b->default_parameter (list_name => 'とみこう掲示板'); $b->default_parameter (list_id => 'keijiban.tomikou.net'); $b->default_parameter (urn_template => 'urn:x-tomikou-net:keijiban:%YYYY;:%MM;:%DD;'); } sub _my_msg_header_add ($$$) {shift; my ($msg, $p) = @_; } sub on_make ($$) { my $self = shift; my $b = shift; $b->default_parameter (date_zone => '+0900'); $b->default_parameter (DEFAULT_subject => '(無題)'); $b->default_parameter (msg_id_from => 'news@list.suika.fam.cx'); $b->default_parameter (newsgroups => 'suika.tomikou'); $self->_my_on_make ($b); $b->set_hook_function (msg_header_add => sub { shift; my ($msg, $p) = @_; my $hdr = $msg->header; ## Newsgroups my $group = $p->{newsgroups}; $group = 'suika.test' if $Bunshin::DEBUG; $hdr->replace (newsgroups => $group); $self->_my_msg_header_add ($msg, $p); }); $b->set_hook_function (msg_body => sub { shift; my ($msg, $body, $p) = @_; my $ct = $msg->header->field ('content-type'); $ct->value ('text/html'); $ct->parameter (charset => 'iso-2022-jp'); $msg->header->add (content_location => $p->{base_uri}) if $p->{base_uri}; $body =~ s#
$##; $body =~ s#
#
\n#g; my $meta = ''; $meta .= qq{\n} if $p->{from_mail}; $meta .= qq{\n} if $p->{from_name}; my $html = < @{[Message::Util::enentity_html (Message::Util::deentity_html ($p->{subject}))]} $meta
$body
EOH $msg->body->value ($html); }); } =head1 SEE ALSO Suikawari, Bunshin =head1 LICENSE Copyright 2002 wakaba Ew@suika.fam.cxE. 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. $Date: 2002/09/10 23:37:00 $ =cut 1; ### Suikawari::TomikouKeijiban ends here