[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package Encode::MIME::Header::ISO_2022_JP; 2 3 use strict; 4 use warnings; 5 6 use base qw(Encode::MIME::Header); 7 8 $Encode::Encoding{'MIME-Header-ISO_2022_JP'} = 9 bless { encode => 'B', bpl => 76, Name => 'MIME-Header-ISO_2022_JP' } => 10 __PACKAGE__; 11 12 use constant HEAD => '=?ISO-2022-JP?B?'; 13 use constant TAIL => '?='; 14 15 use Encode::CJKConstants qw(%RE); 16 17 our $VERSION = do { my @r = ( q$Revision: 1.3 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; 18 19 # I owe the below codes totally to 20 # Jcode by Dan Kogai & http://www.din.or.jp/~ohzaki/perl.htm#JP_Base64 21 22 sub encode { 23 my $self = shift; 24 my $str = shift; 25 26 utf8::encode($str) if ( Encode::is_utf8($str) ); 27 Encode::from_to( $str, 'utf8', 'euc-jp' ); 28 29 my ($trailing_crlf) = ( $str =~ /(\n|\r|\x0d\x0a)$/o ); 30 31 $str = _mime_unstructured_header( $str, $self->{bpl} ); 32 33 not $trailing_crlf and $str =~ s/(\n|\r|\x0d\x0a)$//o; 34 35 return $str; 36 } 37 38 sub _mime_unstructured_header { 39 my ( $oldheader, $bpl ) = @_; 40 my $crlf = $oldheader =~ /\n$/; 41 my ( $header, @words, @wordstmp, $i ) = (''); 42 43 $oldheader =~ s/\s+$//; 44 45 @wordstmp = split /\s+/, $oldheader; 46 47 for ( $i = 0 ; $i < $#wordstmp ; $i++ ) { 48 if ( $wordstmp[$i] !~ /^[\x21-\x7E]+$/ 49 and $wordstmp[ $i + 1 ] !~ /^[\x21-\x7E]+$/ ) 50 { 51 $wordstmp[ $i + 1 ] = "$wordstmp[$i] $wordstmp[$i + 1]"; 52 } 53 else { 54 push( @words, $wordstmp[$i] ); 55 } 56 } 57 58 push( @words, $wordstmp[-1] ); 59 60 for my $word (@words) { 61 if ( $word =~ /^[\x21-\x7E]+$/ ) { 62 $header =~ /(?:.*\n)*(.*)/; 63 if ( length($1) + length($word) > $bpl ) { 64 $header .= "\n $word"; 65 } 66 else { 67 $header .= $word; 68 } 69 } 70 else { 71 $header = _add_encoded_word( $word, $header, $bpl ); 72 } 73 74 $header =~ /(?:.*\n)*(.*)/; 75 76 if ( length($1) == $bpl ) { 77 $header .= "\n "; 78 } 79 else { 80 $header .= ' '; 81 } 82 } 83 84 $header =~ s/\n? $//mg; 85 86 $crlf ? "$header\n" : $header; 87 } 88 89 sub _add_encoded_word { 90 my ( $str, $line, $bpl ) = @_; 91 my $result = ''; 92 93 while ( length($str) ) { 94 my $target = $str; 95 $str = ''; 96 97 if ( 98 length($line) + 22 + 99 ( $target =~ /^(?:$RE{EUC_0212}|$RE{EUC_C})/o ) * 8 > $bpl ) 100 { 101 $line =~ s/[ \t\n\r]*$/\n/; 102 $result .= $line; 103 $line = ' '; 104 } 105 106 while (1) { 107 my $iso_2022_jp = $target; 108 Encode::from_to( $iso_2022_jp, 'euc-jp', 'iso-2022-jp' ); 109 110 my $encoded = 111 HEAD . MIME::Base64::encode_base64( $iso_2022_jp, '' ) . TAIL; 112 113 if ( length($encoded) + length($line) > $bpl ) { 114 $target =~ 115 s/($RE{EUC_0212}|$RE{EUC_KANA}|$RE{EUC_C}|$RE{ASCII})$//o; 116 $str = $1 . $str; 117 } 118 else { 119 $line .= $encoded; 120 last; 121 } 122 } 123 124 } 125 126 $result . $line; 127 } 128 129 1; 130 __END__ 131
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |