view release on metacpan or  search on metacpan

lib/Email/MIME.pm  view on Meta::CPAN

use v5.12.0;
use warnings;
package Email::MIME 1.954;
# ABSTRACT: easy MIME message handling

use Email::Simple 2.212; # nth header value
use parent qw(Email::Simple);

use Carp ();
use Email::MessageID;
use Email::MIME::Creator;
use Email::MIME::ContentType 1.023; # build_content_type
use Email::MIME::Encode;
use Email::MIME::Encodings 1.314;
use Email::MIME::Header;
use Encode 1.9801 ();
use Scalar::Util qw(reftype weaken);

our @CARP_NOT = qw(Email::MIME::ContentType);

our $MAX_DEPTH = 10;

our $CUR_PARTS = 0;
our $MAX_PARTS = 100;

#pod =head1 SYNOPSIS
#pod
#pod B<Wait!>  Before you read this, maybe you just need L<Email::Stuffer>, which is
#pod a much easier-to-use tool for building simple email messages that might have
#pod attachments or both plain text and HTML.  If that doesn't do it for you, then
#pod by all means keep reading.
#pod
#pod   use Email::MIME;
#pod   my $parsed = Email::MIME->new($message);
#pod
#pod   my @parts = $parsed->parts; # These will be Email::MIME objects, too.
#pod   my $decoded = $parsed->body;
#pod   my $non_decoded = $parsed->body_raw;
#pod
#pod   my $content_type = $parsed->content_type;
#pod
#pod ...or...
#pod
#pod   use Email::MIME;
#pod   use IO::All;
#pod
#pod   # multipart message
#pod   my @parts = (
#pod       Email::MIME->create(
#pod           attributes => {
#pod               filename     => "report.pdf",
#pod               content_type => "application/pdf",
#pod               encoding     => "quoted-printable",
#pod               name         => "2004-financials.pdf",
#pod           },
#pod           body => io( "2004-financials.pdf" )->binary->all,
#pod       ),
#pod       Email::MIME->create(
#pod           attributes => {
#pod               content_type => "text/plain",
#pod               disposition  => "attachment",
#pod               charset      => "US-ASCII",
#pod           },
#pod           body_str => "Hello there!",
#pod       ),
#pod   );
#pod
#pod   my $email = Email::MIME->create(
#pod       header_str => [
#pod           From => 'casey@geeknest.com',
#pod           To => [ 'user1@host.com', 'Name <user2@host.com>' ],
#pod           Cc => Email::Address::XS->new("Display Name \N{U+1F600}", 'user@example.com'),
#pod       ],
#pod       parts      => [ @parts ],
#pod   );
#pod
#pod   # nesting parts

lib/Email/MIME.pm  view on Meta::CPAN

  my ($self, $parts) = @_;
  $self->parts_set([ $self->parts, @{$parts}, ]);
}

#pod =method walk_parts
#pod
#pod   $email->walk_parts(sub {
#pod       my ($part) = @_;
#pod       return if $part->subparts; # multipart
#pod
#pod       if ( $part->content_type =~ m[text/html]i ) {
#pod           my $body = $part->body;
#pod           $body =~ s/<link [^>]+>//; # simple filter example
#pod           $part->body_set( $body );
#pod       }
#pod   });
#pod
#pod Walks through all the MIME parts in a message and applies a callback to
#pod each. Accepts a code reference as its only argument. The code reference
#pod will be passed a single argument, the current MIME part within the
#pod top-level MIME object. All changes will be applied in place.
#pod
#pod =cut

sub walk_parts {
  my ($self, $callback) = @_;

  my %changed;

  my $walk_weak;
  my $walk = sub {
    my ($part) = @_;
    $callback->($part);

    if (my @orig_subparts = $part->subparts) {
      my $differ;
      my @subparts;

      for my $part (@orig_subparts) {
        my $str = $part->as_string;
        next unless my $new = $walk_weak->($part);
        $differ = 1 if $str ne $new->as_string;
        push @subparts, $new;
      }

      $differ
        ||=  (@subparts != @orig_subparts)
        ||   (grep { $subparts[$_] != $orig_subparts[$_] } (0 .. $#subparts))
        ||   (grep { $changed{ 0+$subparts[$_] } } (0 .. $#subparts));

      if ($differ) {
        $part->parts_set(\@subparts);
        $changed{ 0+$part }++;
      }
    }

    return $part;
  };

  $walk_weak = $walk;
  weaken $walk_weak;

  my $rv = $walk->($self);

  undef $walk;

  return $rv;
}

sub _compose_content_type {
  my ($self, $ct_header) = @_;
  my $ct = build_content_type({type => $ct_header->{type}, subtype => $ct_header->{subtype}, attributes => $ct_header->{attributes}});
  $self->header_raw_set('Content-Type' => $ct);
  $self->{ct} = $ct_header;
}

sub _get_cid {
  Email::MessageID->new->address;
}

sub _reset_cids {
  my ($self) = @_;

  my $ct_header = parse_content_type($self->header('Content-Type'));

  if ($self->parts > 1) {
    if ($ct_header->{subtype} eq 'alternative') {
      my %cids;
      for my $part ($self->parts) {
        my $cid = $part->header('Content-ID') // q{};
        $cids{$cid}++;
      }
      return if keys(%cids) == 1;

      my $cid = $self->_get_cid;
      $_->header_raw_set('Content-ID' => "<$cid>") for $self->parts;
    } else {
      foreach ($self->parts) {
        my $cid = $self->_get_cid;
        $_->header_raw_set('Content-ID' => "<$cid>")
          unless $_->header('Content-ID');
      }
    }
  }
}

1;

=pod

=encoding UTF-8

=head1 NAME

Email::MIME - easy MIME message handling

=head1 VERSION

version 1.954

=head1 SYNOPSIS