package Mail::ISO2022JP;

use 5.008;
use strict;
use warnings;
use Carp;

our $VERSION = '0.04_04'; # 2003-03-20

use Encode;
use MIME::Base64;

sub new {
	my $class = shift;
	my $self = {};
	bless $self, $class;
	$$self{'sendmail'} = 'sendmail';
	return $self;
}

sub sendmail {
	my $self = shift;
	$$self{'sendmail'} = shift;
	return $self;
}

sub post {
	my ($self) = @_;
	open(MAIL, "| $$self{'sendmail'} -t -i")
		or croak "Could not use sendmail program.\n";
	print MAIL $$self{'mail'};
	close MAIL;
	return $self;
}

sub output {
	my ($self) = @_;
	return $$self{'mail'};
}

sub date {
	my $self = shift;
	$$self{'time'} = shift;
	return $self;
}

sub set {
	my ($self, $entity, $value) = @_;
	$$self{$entity} = $value;
	return $self;
}

sub compose {
	my ($self) = @_;
	
	my $subject = decode('utf8', $$self{'Subject'});
	my $body    = decode('utf8', $$self{'Body'   });
	my @subject = encoded($subject);
	$body = encode('iso-2022-jp', $body);
	
	$$self{'mail'} = <<"EOF";
From: $$self{'From_addr'}
To: $$self{'To_addr'}
Subject: @subject
MIME-Version: 1.0
Content-Type: text/plain; charset=ISO-2022-JP
Content-Transfer-Encoding: 7bit

$body
EOF
	if ($$self{'Date'}) {
		$$self{'mail'} = "Date: $$self{'Date'}\n$$self{'mail'}";
	}
	
	return $self;
}

########################################################################

# RFC2822 describes about a line length
# Max: 998 = 1000 - (CR + LF)
# Rec:  76 =   78 - (CR + LF)
# RFC2047 describes about an encoded-word length
# Max:  75 =   76 - SPACE

sub encoded {
	my ($string) = @_;
	
	my @lines = _encoded_word($string);
	
	foreach my $line (@lines) {
		$line = "\n $line";
	}
	$lines[$#lines] = "$lines[$#lines]\n ";
	
	return @lines;
}

# an encoded-word is composed of
# 'charset', 'encoding', 'encoded-text' and delimiters.
# Hence an encoded-text's max length is:
# 75 - ('charset', 'encoding' and delimiters)
#
# charset 'ISO-2022-JP' is 11.
# encoding 'B' is 1.
# delimiters '=?', '?', '?' and '?=' is total 6.
# 75 - (11 + 1 + 6) = 57
# It is said that an encoded-text's max length is 57
# when we use ISO-2022-JP B encoding.

sub _encoded_word {
	my ($string) = @_;
	
	my @words = _encoded_text($string);
	
	foreach my $word (@words) {
		$word = "=?ISO-2022-JP?B?$word?=";
	}
	
	return @words;
}

# Through Base64 encoding, a group of 4 ASCII-6bit characters
# is generated by 3 ASCII-8bit pre-encode characters.
# We can get 14 group of encoded 4 ASCII-6bit characters under
# the encoded-text's 57 characters limit.
# Hence, we may handle max 42 ASCII-8bit characters as
# a pre-encode text.
# So we should split a ISO-2022-JP text that
# each splitted piece's length is within 42
# if it is counted as ASCII-8bit characters.

sub _encoded_text {
	my ($string) = @_;
	
	my @text = _split($string);
	
	foreach my $text (@text) {
		$text = encode_base64($text);
		$text =~ s/\n//g;
	}
	
	return @text;
}

sub _split {
	my ($string) = @_;
	
	my @strings;
	while ($string) {
		(my $piece, $string) = _cut_once($string);
		push(@strings, $piece);
	}
	
	return @strings;
}

sub _cut_once {
	my ($string) = @_;
	
	my $whole = encode('iso-2022-jp', $string);
	if ( length($whole) <= 42 ) {
		return $whole;
		last;
	}
	
	my $letters = length($string);
	for (my $i = 1; $i <= $letters; $i++) {
		my $temp = substr($string, 0, $i);
		$temp = encode('iso-2022-jp', $temp);
		if (length($temp) > 42) {
			my $piece = substr($string, 0, $i - 1);
			$piece = encode('iso-2022-jp', $piece);
			my $rest  = substr($string, $i - 1);
			return ($piece, $rest);
			last;
		}
	}
}

1;
__END__

=head1 NAME

Mail::ISO2022JP - compose ISO-2022-JP encoded email

=head1 SYNOPSIS

  use Mail::ISO2022JP;
  
  $mail = Mail::ISO2022JP->new;
  $mail->set('From_addr', 'taro@cpan.tld');
  $mail->set('To_addr'  , 'sakura@cpan.tld, yuri@cpan.tld');
  # mail subject containing Japanese characters.
  $mail->set('Subject'  , 'Subject_Containing_Japanese_Characters');
  # mail body    containing Japanese characters.
  $mail->set('Body'     , 'Body_Containing_Japanese_Characters');
  # compose
  $mail->compose;
  # output the composed mail
  print $mail->output;

=head1 DESCRIPTION

This module is mainly for Japanese Perl programmers those who wants to compose an email.

For some reasons, most Japanese internet users have chosen ISO-2022-JP 7bit character encoding for email rather than the other 8bit encodings (eg. EUC-JP, Shift_JIS).

We can use ISO-2022-JP encoded Japanese text as message body safely in an email.

But we should not use ISO-2022-JP encoded Japanese text as a header. We should escape some reserved 'special' characters before composing a header. To enable it, we encode ISO-2022-JP encoded Japanese text with MIME Base64 encoding. Thus MIME Base64 encoded ISO-2022-JP encoded Japanese text is safely using in a mail header.

This module has developed to intend to automate those kinds of operations.

=head1 METHODS

=over

=item new

Creates a new object.

=item set('From_addr', $address)

Specify the originator address. $address should be valid as email address.

=item set('To_addr', $address)

Specify the destination address(es). $address should be valid as email address. Comma-separated list of multiple destination addresses are also usable.

=item set('Subject', $subject)

Specify the mail subject. $subject can contain Japanese characters. Note that this module runs under Unicode/UTF-8 environment, you should input these data in UTF-8 character encoding.

=item set('Body', $body)

Specify the mail body. $body can contain Japanese characters. Note that this module runs under Unicode/UTF-8 environment, you should input these data in UTF-8 character encoding.

=item set('Date', $date)

Specify the mail origination date. Note that date-time format should be compliant to the format of RFC2822 specification. It is like blow:
     
 Mon, 10 Mar 2003 18:48:06 +0900

Don't forget to quote the string. If you don't specify date, sendmail program may add automatically on posting. 

=item compose

Compose a formed email.

=item post *EXPERIMENTAL*

Posts a mail using sendmail program.
At the default setting, it is supposed that sendmail program's name is `sendmail' under the systems's PATH environmental variable. You can specify exact location with sendmail() method.

=item sendmail($path) *EXPERIMENTAL*

Specifies sendmail location. ex. '/usr/bin/sendmail'

=back

=head1 SEE ALSO

=over

=item L<Encode>

=item L<MIME::Base64>

=item RFC2822: L<http://www.ietf.org/rfc/rfc2822.txt> (Mail)

=item RFC2045: L<http://www.ietf.org/rfc/rfc2045.txt> (MIME)

=item RFC2046: L<http://www.ietf.org/rfc/rfc2046.txt> (MIME)

=item RFC2047: L<http://www.ietf.org/rfc/rfc2047.txt> (MIME)

=back

=head1 NOTES

This module runs under Unicode/UTF-8 environment (then Perl5.8 or later is required), you should input data in UTF-8 character encoding.

=head1 TO DO

=over

=item enable originator/destination name containing Japanese characters.

=back

=head1 AUTHOR

Masanori HATA E<lt>lovewing@geocities.co.jpE<gt> (Saitama, JAPAN)

=head1 COPYRIGHT

Copyright (c) 2003 Masanori HATA. All rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut
