package Encode::MIME::Header::ISO_2022_JP;

use strict;

use warnings;

use parent qw(Encode::MIME::Header);

my $obj =

  bless { decode_b => '1', decode_q => '1', encode => 'B', bpl => 76, Name => 'MIME-Header-ISO_2022_JP' } =>

  __PACKAGE__;

Encode::define_encoding($obj, 'MIME-Header-ISO_2022_JP');

use constant HEAD => '=?ISO-2022-JP?B?';

use constant TAIL => '?=';

use Encode::CJKConstants qw(%RE);

our $VERSION = do { my @r = ( q$Revision: 1.9 $ =~ /\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;

    return undef unless defined $str;

    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__