Email::MIME::Creator::ISO_2022_JP - Email::MIME mixin to create an iso-2022-jp mail

Email-MIME-Creator-ISO_2022_JP documentation Contained in the Email-MIME-Creator-ISO_2022_JP distribution.

Index

Code Index:

NAME

Top

Email::MIME::Creator::ISO_2022_JP - Email::MIME mixin to create an iso-2022-jp mail

SYNOPSIS

Top

  use Email::Sender::Simple 'sendmail';
  use Email::MIME;
  use Email::MIME::Creator::ISO_2022_JP;
  use utf8;

  my $email_jis = Email::MIME->create(
    header_str => [
      From    => 'foo@example.com',
      To      => 'bar@example.com',
      Subject => 'こんにちは',
    ],
    attributes => {
      content_type => 'text/plain',
      charset      => 'iso-2022-jp',
      encoding     => '7bit',
    },
    body_str => 'メールの本文はutf-8で',
  );

  sendmail($email_jis);  # in iso-2022-jp

  no Email::MIME::Creator::ISO_2022_JP;

  my $email_utf8 = Email::MIME->create(
    header_str => [
      From    => 'foo@example.com',
      To      => 'bar@example.com',
      Subject => 'こんにちは',
    ],
    attributes => {
      content_type => 'text/plain',
      charset      => 'utf-8',
      encoding     => '7bit',
    },
    body_str => 'メールの本文はutf-8で',
  );

  sendmail($email_utf8);  # in utf-8

DESCRIPTION

Top

Email::MIME is nice and handy. With header_str and body_str (since 1.900), you don't need to encode everything by yourself. Just pass flagged (decoded) utf-8 strings, and you'll get what you want. However, it only works when you send utf-8 encoded emails. In Japan, there're still some email clients that only understand iso-2022-jp (jis) encoded emails, and its popularity persuaded the Encode maintainer (who's also Japanese) to include its support (since version 2.11, with Encode::MIME::Header::ISO_2022_JP written by Makamaka). I want it to be supported by Email::MIME, but it's too specific and nonsense for the rest of the world. That's why I write this mixin instead of asking to add extra bit to Email::MIME.

As of this writing, this mixin doesn't care the tangled issues in the Japanese cellular phone industry (thus not ::Japanese). If you need finer control, just use header/body and encoded string/octets, or send me a patch.

METHODS

Top

create_iso_2022_jp, header_str_set_iso_2022_jp

Both work almost the same as Email::MIME's methods do, with one exception. If you pass utf-8 stings to header_str attribute or header_str_set method, they'll be encoded by Encode::MIME::Header::ISO_2022_JP, instead of Encode::MIME::Header.

import, unimport

Actually you don't need to use these directly. As shown in the SYNOPSIS, when this module is used, Email::MIME's original create and header_str_set are replaced with these methods internally. If you want to use the orignal methods again, unimport this module (with no pragma, or unimport method), and they'll be restored.

NOTE

Top

As a bonus, this module eliminates Date and MIME-Version headers from each part in a multipart email.

SEE ALSO

Top

Email::MIME, Encode

AUTHOR

Top

Kenichi Ishigaki, <ishigaki@cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright (C) 2009 by Kenichi Ishigaki.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Email-MIME-Creator-ISO_2022_JP documentation Contained in the Email-MIME-Creator-ISO_2022_JP distribution. 
package Email::MIME::Creator::ISO_2022_JP;

use strict;
use warnings;
use Email::MIME;
use Encode;
use Sub::Install 'reinstall_sub';

BEGIN {
  if ( $Encode::VERSION < 2.11 ) {
    require Encode::compat::MIME::Header::ISO_2022_JP;
  }
}

our $VERSION = '0.02';

sub import {
  my $class = shift;

  if (!$class->can('create_utf8')) {
    for my $method (qw(create header_str_set)) {
      reinstall_sub({
        as   => "${method}_utf8",
        into => $class,
        code => \&{"Email::MIME::${method}"},
      });
    }
  }
  for my $method (qw(create header_str_set)) {
    reinstall_sub({
      as   => $method,
      into => "Email::MIME",
      code => \&{"${class}\::${method}_iso_2022_jp"},
    });
  }

  unless (grep /^$class/, @Email::MIME::ISA) {
    push @Email::MIME::ISA, $class;
  }
}

sub unimport {
  my $class = shift;

  if ($class->can('create_utf8')) {
    for my $method (qw(create header_str_set)) {
      reinstall_sub({
        as   => $method,
        into => "Email::MIME",
        code => \&{"${class}\::${method}_utf8"},
      });
    }
  }
}

sub create_iso_2022_jp {
  my ($class, %args) = @_;

  if (exists $args{header_str}) {
    $args{attributes}{charset} ||= 'ISO-2022-JP';

    my @headers = @{ delete $args{header_str} };
    $args{header} ||= [];
    pop @headers if @headers % 2 == 1;
    while (my ($key, $value) = splice @headers, 0, 2) {
      push @{$args{header}},
        ( $key => Encode::encode('MIME-Header-ISO_2022_JP', $value) );
    }
  }
  if (exists $args{body_str}) {
    $args{attributes}{charset}  ||= 'ISO-2022-JP';
    $args{attributes}{encoding} ||= '7bit';
  }

  my $email = $class->create_utf8(%args);  # i.e. original create

  my $remove; $remove = sub {
    my ($email) = @_;

    my @parts = $email->parts;
    return if $email eq $parts[0]; # avoid recursion

    foreach my $part (@parts) {
      $part->header_set(Date => ());
      $part->header_set('MIME-Version' => ());
      $remove->($part);
    }
    $email->parts_set(\@parts);
  };
  $remove->($email);

  return $email;
}

sub header_str_set_iso_2022_jp {
  my ($self, $name, @vals) = @_;

  my @values = map { Encode::encode('MIME-Header-ISO_2022_JP', $_, 1)  } @vals;

  $self->header_set($name => @values);
}

1;

__END__