view release on metacpan or  search on metacpan

lib/Tripletail/Mail.pm  view on Meta::CPAN

	# （例：JISの場合はASCII<->漢字などで、間に2縲鰀3バイト程の切替シーケンスが入る）

	my $result = '';
	my $maxlinelength = 76;		# RFC上は78文字。今回は76文字。
	my $length = 0;
	
	my $prev_is_enc = 0;
	while( $str =~ /(\s*)(\S*)/g )
	{
		my $spc  = $1;
		my $part = $2;
		
		my $spc_len  = length($spc);
		my $part_len = length($part);
		
		if( !$part_len )
		{
			# 末尾が空白だったとき.
			# はいるならいれておく.
			if( $length + $spc_len <= $maxlinelength )
			{
				$result .= $spc;
			}
			last;
		}
		
		my $is_ascii = $part !~ /[^\0 -~]/;
		if( $is_ascii )
		{
			# ASCIIのみの時.
			
			if( $length + $spc_len + $part_len > $maxlinelength )
			{
				# あふれる.
				$result =~ s/\s\z//;
				if( $result ne '' )
				{
					$result .= "\n ";
				}
				$length = 0;
			}
			$result .= $spc . $part;
			$length += $spc_len + $part_len;
			$prev_is_enc = 0;
		}else
		{
			# マルチバイトあり
			if( $prev_is_enc )
			{
				$part = $spc . $part;
			}else
			{
				$result .= $spc;
			}
			$result =~ s/\s\z//;
			while( $part =~ /($re_char{1,7})/og )
			{
				my $part2 = $1;
				$part2 = Unicode::Japanese->new($part2)->h2zKana->jis;
				
				my $encdata=encode_mimeword($part2, 'B', $charcode);
				
				if( $result ne '' )
				{
					$result .= "\n ";
				}
				$result .= $encdata;
				$length = length($encdata);
			}
			$prev_is_enc = 1;
		}
	}
	
	$result;
}

sub _decodeHeader {
	my $this = shift;
	my $str = shift;
	my $result;

	my $mime_start = '=\?[Ii][Ss][Oo]-2022-[Jj][Pp]\?[Bb]\?';
	my $mime_body = '[A-Za-z0-9\+\/\=]+';
	my $mime_end = '\?=';

	my $mime_regex = "$mime_start$mime_body$mime_end";

	my $jis_start_regex = '\e(?:\$\@|\$B|\&\@\e\$B|\$\(D|\(I)';
	my $jis_end_regex = '\e(?:\$B|\$\(D|\([BJ])';

	while($str =~ s/($mime_regex)[ \t]*\n?[ \t]+($mime_regex)/$1$2/) {
	}

	$str =~ s/$mime_start($mime_body)$mime_end/
	Unicode::Japanese->new($1, 'binary', 'base64')->get/eg;

	$str =~ s/$jis_end_regex$jis_start_regex//g;

	$str = Unicode::Japanese->new($str, 'jis')->utf8;

	$str;
}

sub _makeMailDate {
	my $this = shift;
	my $time = shift;

	my @wdaystr = qw(Sun Mon Tue Wed Thu Fri Sat);
	my @monthstr = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

	my $TZone = '+0900';
	$TZone =~ m/\+(..)(..)/;
	my $tzone = $1 * 60 * 60 + $2 * 60;

	my ($sec, $min, $hour, $mday, $mon, $year, $wday) = (gmtime($time + $tzone))[0..6];

	sprintf("%s, %d %s %d %02d:%02d:%02d %s", 
		$wdaystr[$wday], $mday, $monthstr[$mon],
		1900 + $year, $hour, $min, $sec, $TZone);

}

sub _getHostname {
	my $this = shift;

	if(!defined($HOSTNAME)) {
		$HOSTNAME = $TL->_readcmd("hostname");
		chomp $HOSTNAME;