=head1 NAME

Suikawari::RisuukaDentatsu --- Suikawari module for Risuuka Keijiban

=cut

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

package Suikawari::RisuukaDentatsu;
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',
<td[^>]*>
		<font[^>]*>
(\d+).(\d+).(\d+) [A-Za-z]+<!---->day (\d+):(\d+):(\d+) (.*?)<br>
<hr size=1>
(?:<IMG SRC="([^"]+)"[^>]*>)?<BR>
(.*?)<BR>
<BR>
		</font>
		</td>
EOH
  qw (date_year date_month date_day date_hour date_minute date_second
      subject misc_image_uri body);
}

sub meta_regex ($) {
  my $r = <<'EOH';
<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 => 'RisuukaDentatsu.tmp');
    (uri => 'http://yapeus.com/users/fuyudentatsu/');
  } else {
    (uri => 'http://yapeus.com/users/fuyudentatsu/');
  }
}

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 => 'dentatsu.2000e.risuu.chuubu.suika.fam.cx');
  my $http = $b->meta_information;
  if (ref $http) {
    $b->default_parameter (misc_http_server => $http->field ('server'));
  }
  $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#<BR>#\x0D\x0A#g;
    $body =~ s#(?:\x0D\x0A)+$#\x0D\x0A#s;
    unless ($p->{misc_image_uri}) {
      $msg->body->value ($body);
    } else {
      require URI::WithBase;
      my $uri = URI::WithBase->new ($p->{misc_image_uri}, $p->{base_uri})->abs;
      my ($img, $http) = $b->_get_resource (uri => $uri);
      $msg->header->field ('content-type')->media_type ('multipart/mixed');
      my $text = $msg->body->item (0, -by => 'index');
        $text->body->value ($body);
      my $image = $msg->body->item (1, -by => 'index');
        $image->header->field ('content-type')->media_type ('image/png');
        $image->header->field ('content-location')->value ($uri);
        $http->scan (sub {shift;
          my $item = shift;
          next unless $item->{ns} eq $Message::Header::NS_phname2uri{content};
          $image->header->field ($item->{name} => $item->{body}, -ns => $item->{ns});
        });
        $image->body->value ($img);
    }
  });
}

=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/07/24 12:13:21 $

=cut

1;
### Suikawari::TomikouKeijiban ends here