From b645030efc22e13c2498a1522083634ab91b2de1 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Wed, 12 May 2010 16:51:27 +0000 Subject: move tlperl to tlperl.old git-svn-id: svn://tug.org/texlive/trunk@18209 c570f23f-e606-0410-a88d-b1316a301751 --- .../tlperl/lib/Encode/MIME/Header/ISO_2022_JP.pm | 127 --------------------- 1 file changed, 127 deletions(-) delete mode 100644 Master/tlpkg/tlperl/lib/Encode/MIME/Header/ISO_2022_JP.pm (limited to 'Master/tlpkg/tlperl/lib/Encode/MIME/Header/ISO_2022_JP.pm') 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__ - -- cgit v1.2.3