package Lou5::Mail;
use strict;
our $VERSION = '0.01';

use utf8;
use Acme::Lou;
use Encode;
use Encode::MIME::Header;
use Email::MIME;
use Email::MIME::ContentType;
use MIME::Lite;
use Qpsmtpd::Constants;

use base qw( Qpsmtpd::Plugin Exporter );
our @EXPORT = qw( register hook_queue reply_lou reply_help send );

sub register {
    my ($self, $qp, @args) = @_;
    
    # XXX to config file ?
    $self->{accept} = qr/^ (m|mail|lou | help|together) ([+:].*)? $/ix;
    $self->{presubject} = '[ルー語変換] '; 
    $self->{lou} = Acme::Lou->new(
        lou_rate => 93,
        html_fx_rate => 0,
    );
}

sub hook_queue {
    my ($self, $transaction) = @_;
    
    for my $rcpt ($transaction->recipients) {
        if ($rcpt->user !~ $self->{accept}) {
            next;
        }
        my $req = {
            to      => $1,
            command => $2,
        };
        $req->{source} = join('', @{ $transaction->{_body_array} || [] });
        $req->{sender} = $transaction->sender->address;
        
        $self->log(LOGINFO, "start for <$req->{sender}>");
        
        if ($req->{to} =~ /help|together/) {
            return $self->reply_help($req);
        } else {
            return $self->reply_lou($req);
        }
    }
    return DECLINED;
}

sub reply_lou {
    my ($self, $req) = @_;

    my $mail = new Email::MIME($req->{source}); 
    
    my $subject = $mail->header('Subject');
    my $body; 
    for my $part ($mail->parts) {
        my $ct = Email::MIME::ContentType::parse_content_type($part->content_type); 
        next if $ct->{discrete}  ne 'text';
        next if $ct->{composite} ne 'plain';
        
        $body = Encode::decode($ct->{attributes}{charset}, $part->body);
    }
    
    $self->send({
        from    => 'together@lou5.jp',
        to      => $req->{sender},
        subject => $self->{presubject}
                 . $self->{lou}->translate($subject),
        body    => $self->{lou}->translate($body),
    });
    
    return (OK, "lou5_mail: replied lou-nized mail to <$req->{sender}>");
}

sub reply_help {
    my ($self, $req) = @_;
    
    $self->send({
        from    => 'feedback@lou5.jp',
        to      => $req->{sender},
        subject => $self->{presubject} . 'ヘルプ',
        body    => <<'BODY'
ルー語変換の使い方
==================

メールで「ルー語変換」ができます！ m@lou5.jp にメールを送るだけです。
入力した件名や本文がルー語変換されて戻ってきます。

※機種依存文字とか絵文字は？になってしまいます。

いずれ携帯には絵文字をまぜて返したりとか機能を足したいです。
ただいまテスト中です。

不具合発見・ご意見・ご要望お待ちしています。

-- 
ルー語変換： http://lou5.jp/
問い合わせ： このメールに返信してください
BODY
        ,
    });
    
    return (OK, "lou5_mail: replied help to <$req->{sender}>");
}

sub send {
    my ($self, $param) = @_;
    my $msg = MIME::Lite->new(
        From     => $param->{from},
        To       => $param->{to},
        Subject  => Encode::encode('MIME-Header-ISO_2022_JP', $param->{subject}),
        Data     => Encode::encode('ISO_2022_JP', $param->{body}),
        Type     => 'text/plain; charset="ISO-2022-JP"',
        Encoding => '7bit',
    );
    $msg->replace('Content-Disposition' => '');
    $msg->replace('X-Mailer' => __PACKAGE__ . "/$VERSION");
    $msg->field_order(qw( 
        MIME-Version 
        Content-Type 
        Content-Transfer-Encoding
    ));
    $msg->send;
}

1;