view release on metacpan or  search on metacpan

lib/Email/MIME/Kit/Assembler/Markdown.pm  view on Meta::CPAN

  init_arg => undef,
);

has marker => (is => 'ro', isa => 'Str', default => 'CONTENT');

has skip_marker => (is => 'ro', isa => 'Str', default => 'SKIP-LINE');

has path => (
  is   => 'ro',
  isa  => 'Str',
  lazy => 1,
  default => sub { $_[0]->manifest->{path} },
);

sub BUILD {
  my ($self) = @_;
  my $class = ref $self;

  confess "$class does not support alternatives"
    if @{ $self->manifest->{alternatives} || [] };

  confess "$class does not support attachments"
    if @{ $self->manifest->{attachments} || [] };

  confess "$class does not support MIME content attributes"
    if %{ $self->manifest->{attributes} || {} };
}

sub _prep_header {
  my ($self, $header, $stash) = @_;

  my @done_header;
  for my $entry (@$header) {
    confess "no field name candidates"
      unless my (@hval) = grep { /^[^:]/ } keys %$entry;
    confess "multiple field name candidates: @hval" if @hval > 1;
    my $value = $entry->{ $hval[ 0 ] };

    if (ref $value) {
      my ($v, $p) = @$value;
      $value = join q{; }, $v, map { "$_=$p->{$_}" } keys %$p;
    } else {
      my $renderer = $self->renderer;
      if (exists $entry->{':renderer'}) {
        undef $renderer if ! defined $entry->{':renderer'};
        confess 'alternate renderers not supported';
      }

      $value = ${ $renderer->render(\$value, $stash) } if defined $renderer;
    }

    push @done_header, $hval[0] => $value;
  }

  return \@done_header;
}

sub assemble {
  my ($self, $stash) = @_;

  my $markdown  = ${ $self->kit->get_decoded_kit_entry( $self->path ) };
  my $plaintext = $markdown;


  if ($self->renderer) {
    {
      local $stash->{part_type} = 'text';
      my $output = $self->renderer->render(\$markdown, $stash);
      $plaintext = ${ $self->renderer->render(\$markdown, $stash) };
    }

    {
      local $stash->{part_type} = 'html';
      $markdown = ${ $self->renderer->render(\$markdown, $stash) };
    }
  }

  # We'll remove any line containing <!-- SKIP-LINE --> from the plain text
  # part.  Meanwhile, the comment is removed from the Markdown, but the rest of
  # the line is left intact. -- rjbs, 2021-11-23
  my $skip_marker = $self->skip_marker;
  $plaintext =~ s{^.*<!--\s+\Q$skip_marker\E\s+-->.*$}{}mg;
  $markdown  =~ s{<!--\s+\Q$skip_marker\E\s+-->}{}mg;

  if ($self->encode_entities) {
    $markdown = HTML::Entities::encode_entities($markdown);
  }

  if ($self->munge_signature) {
    my ($body, $sig) = split /^-- $/m, $markdown, 2;

    if (defined $sig) {
      $sig =~ s{^}{<br />}mg;
      $markdown = "$body\n\n$sig";
    }
  }

  my %content = (
    html => Text::Markdown->new(tab_width => 2)->markdown($markdown),
    text => $plaintext,
  );

  for my $type (keys %content) {
    my $type_wrapper = "$type\_wrapper";

    if (my $wrapper_path = $self->$type_wrapper) {
      my $wrapper = ${ $self->kit->get_decoded_kit_entry($wrapper_path) };

      if ($self->render_wrapper) {
        local $stash->{wrapped_content} = $content{$type};
        local $stash->{part_type}       = $type;
        my $output_ref = $self->renderer->render(\$wrapper, $stash);
        $content{$type} = $$output_ref;
      } else {
        my $marker  = $self->marker;
        my $marker_re = qr{<!--\s+\Q$marker\E\s+-->};

        confess "$type_wrapper does not contain comment containing marker"
          unless $wrapper =~ $marker_re;

        $wrapper =~ s/$marker_re/$content{$type}/;
        $content{$type} = $wrapper;
      }
    }
  }

  my $header = $self->_prep_header(
    $self->manifest->{header},
    $stash,
  );

  my $html_part = Email::MIME->create(
    body_str   => $content{html},
    attributes => {
      content_type => "text/html",
      charset      => 'utf-8',
      encoding     => 'quoted-printable',
    },
  );

  my $text_part = Email::MIME->create(
    body_str   => $content{text},
    attributes => {
      content_type => "text/plain",
      charset      => 'utf-8',
      encoding     => 'quoted-printable',
    },
  );

  my $container = Email::MIME->create(
    header_str => $header,
    parts      => [ $text_part, $html_part ],
    attributes => { content_type => 'multipart/alternative' },
  );

  return $container;
}

no Moose;
no Moose::Util::TypeConstraints;
__PACKAGE__->meta->make_immutable;
1;

__END__

=pod