summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Encode/MIME/Header/ISO_2022_JP.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Encode/MIME/Header/ISO_2022_JP.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Encode/MIME/Header/ISO_2022_JP.pm127
1 files changed, 0 insertions, 127 deletions
diff --git a/Master/tlpkg/tlperl/lib/Encode/MIME/Header/ISO_2022_JP.pm b/Master/tlpkg/tlperl/lib/Encode/MIME/Header/ISO_2022_JP.pm
deleted file mode 100644
index 5f637a32472..00000000000
--- a/Master/tlpkg/tlperl/lib/Encode/MIME/Header/ISO_2022_JP.pm
+++ /dev/null
@@ -1,127 +0,0 @@
-package Encode::MIME::Header::ISO_2022_JP;
-
-use strict;
-use base qw(Encode::MIME::Header);
-
-$Encode::Encoding{'MIME-Header-ISO_2022_JP'}
- = bless {encode => 'B', bpl => 76, Name => 'MIME-Header-ISO_2022_JP'}
- => __PACKAGE__;
-
-use constant HEAD => '=?ISO-2022-JP?B?';
-use constant TAIL => '?=';
-
-use Encode::CJKConstants qw(%RE);
-
-our $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
-
-
-# I owe the below codes totally to
-# Jcode by Dan Kogai & http://www.din.or.jp/~ohzaki/perl.htm#JP_Base64
-
-sub encode {
- my $self = shift;
- my $str = shift;
-
- utf8::encode($str) if( Encode::is_utf8($str) );
- Encode::from_to($str, 'utf8', 'euc-jp');
-
- my($trailing_crlf) = ($str =~ /(\n|\r|\x0d\x0a)$/o);
-
- $str = _mime_unstructured_header($str, $self->{bpl});
-
- not $trailing_crlf and $str =~ s/(\n|\r|\x0d\x0a)$//o;
-
- return $str;
-}
-
-
-sub _mime_unstructured_header {
- my ($oldheader, $bpl) = @_;
- my $crlf = $oldheader =~ /\n$/;
- my($header, @words, @wordstmp, $i) = ('');
-
- $oldheader =~ s/\s+$//;
-
- @wordstmp = split /\s+/, $oldheader;
-
- for ($i = 0; $i < $#wordstmp; $i++){
- if( $wordstmp[$i] !~ /^[\x21-\x7E]+$/ and $wordstmp[$i + 1] !~ /^[\x21-\x7E]+$/){
- $wordstmp[$i + 1] = "$wordstmp[$i] $wordstmp[$i + 1]";
- }
- else{
- push(@words, $wordstmp[$i]);
- }
- }
-
- push(@words, $wordstmp[-1]);
-
- for my $word (@words){
- if ($word =~ /^[\x21-\x7E]+$/) {
- $header =~ /(?:.*\n)*(.*)/;
- if (length($1) + length($word) > $bpl) {
- $header .= "\n $word";
- }
- else{
- $header .= $word;
- }
- }
- else{
- $header = _add_encoded_word($word, $header, $bpl);
- }
-
- $header =~ /(?:.*\n)*(.*)/;
-
- if(length($1) == $bpl){
- $header .= "\n ";
- }
- else {
- $header .= ' ';
- }
- }
-
- $header =~ s/\n? $//mg;
-
- $crlf ? "$header\n" : $header;
-}
-
-
-sub _add_encoded_word {
- my($str, $line, $bpl) = @_;
- my $result = '';
-
- while( length($str) ){
- my $target = $str;
- $str = '';
-
- if(length($line) + 22 + ($target =~ /^(?:$RE{EUC_0212}|$RE{EUC_C})/o) * 8 > $bpl){
- $line =~ s/[ \t\n\r]*$/\n/;
- $result .= $line;
- $line = ' ';
- }
-
- while(1){
- my $iso_2022_jp = $target;
- Encode::from_to($iso_2022_jp, 'euc-jp', 'iso-2022-jp');
-
- my $encoded
- = HEAD . MIME::Base64::encode_base64($iso_2022_jp, '') . TAIL;
-
- if(length($encoded) + length($line) > $bpl){
- $target =~ s/($RE{EUC_0212}|$RE{EUC_KANA}|$RE{EUC_C}|$RE{ASCII})$//o;
- $str = $1 . $str;
- }
- else{
- $line .= $encoded;
- last;
- }
- }
-
- }
-
- $result . $line;
-}
-
-
-1;
-__END__
-