view release on metacpan or  search on metacpan

lib/Email/Outlook/Message.pm  view on Meta::CPAN

sub _body_html_character_set {
  my $self = shift;
  my $body_encoding = $self->{BODY_HTML_ENCODING};
  $self->_body_character_set($body_encoding)
}

sub _body_character_set {
  my $self = shift;
  my $body_encoding = shift;
  my $codepage = $self->{CODEPAGE};
  if (defined $body_encoding && $body_encoding eq "001F") {
    return "UTF-8";
  } elsif (defined $codepage) {
    return $MAP_CODEPAGE->{$codepage} || "CP$codepage";
  } else {
    return 'CP1252';
  }
}

sub _create_mime_plain_body {
  my $self = shift;
  my $charset = $self->_body_plain_character_set;
  my $body_str = $self->{BODY_PLAIN};
  if ($charset ne "UTF-8") {
    # In this case, the body is a string of octets and needs to be decoded.
    $body_str = Encode::decode($charset, $body_str);
  }
  return Email::MIME->create(
    attributes => {
      content_type => "text/plain",
      charset => $charset,
      disposition => "inline",
      encoding => "8bit",
    },
    body_str => $body_str
  );
}

sub _create_mime_html_body {
  my $self = shift;
  return Email::MIME->create(
    attributes => {
      content_type => "text/html",
      charset => $self->_body_html_character_set,
      disposition => "inline",
      encoding => "8bit",
    },
    body => $self->{BODY_HTML}
  );
}

# Implementation based on the information in
# http://www.freeutils.net/source/jtnef/rtfcompressed.jsp,
# and the implementation in tnef version 1.4.5.
my $MAGIC_COMPRESSED_RTF = 0x75465a4c;
my $MAGIC_UNCOMPRESSED_RTF = 0x414c454d;
my $BASE_BUFFER =
  "{\\rtf1\\ansi\\mac\\deff0\\deftab720{\\fonttbl;}{\\f0\\fnil \\froman "
  . "\\fswiss \\fmodern \\fscript \\fdecor MS Sans SerifSymbolArial"
  . "Times New RomanCourier{\\colortbl\\red0\\green0\\blue0\n\r\\par "
  . "\\pard\\plain\\f0\\fs20\\b\\i\\u\\tab\\tx";


sub _create_mime_rtf_body {
  my $self = shift;
  my $data = $self->{BODY_RTF};

  my ($size, $rawsize, $magic, $crc) = unpack "V4", substr $data, 0, 16;

  my $buffer;

  if ($magic == $MAGIC_COMPRESSED_RTF) {
    $buffer = $BASE_BUFFER;
    my $output_length = length($buffer) + $rawsize;
    my @flags;
    my $in = 16;
    while (length($buffer) < $output_length) {
      if (@flags == 0) {
        @flags = split "", unpack "b8", substr $data, $in++, 1;
      }
      my $flag = shift @flags;
      if ($flag eq "0") {
        $buffer .= substr $data, $in++, 1;
      } else {
        my ($a, $b) = unpack "C2", substr $data, $in, 2;
        my $offset = ($a << 4) | ($b >> 4);
        my $length = ($b & 0xf) + 2;
        my $buflen = length $buffer;
        my $longoffset = $buflen - ($buflen % 4096) + $offset;
        if ($longoffset >= $buflen) { $longoffset -= 4096; }
        while ($length > 0) {
          $buffer .= substr $buffer, $longoffset, 1;
          $length--;
          $longoffset++;
        }
        $in += 2;
      }
    }
    $buffer = substr $buffer, length $BASE_BUFFER;
  } elsif ($magic == $MAGIC_UNCOMPRESSED_RTF) {
    $buffer = substr $data, 16;
  } else {
    carp "Incorrect magic number in RTF body.\n";
  }
  return Email::MIME->create(
    attributes => {
      content_type => "application/rtf",
      disposition => "inline",
      encoding => "base64",
    },
    body => $buffer
  );
}
# Copy original header data.
# Note: This should contain the Date: header.
sub _copy_header_data {
  my ($self, $mime) = @_;

  defined $self->{HEAD} or return;