File Coverage

blib/lib/Mail/Message/Convert/Html.pm

Criterion	Covered	Total	%
statement	69	71	97.1
branch	20	34	58.8
condition	3	4	75.0
subroutine	11	11	100.0
pod	5	6	83.3
total	108	126	85.7

# This code is part of Perl distribution Mail-Message version 4.04.
# The POD got stripped from this file by OODoc version 3.06.
# For contributors see file ChangeLog.

# This software is copyright (c) 2001-2026 by Mark Overmeer.

# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later


package Mail::Message::Convert::Html;{
our $VERSION = '4.04';
}

use parent 'Mail::Message::Convert';

use strict;
use warnings;

use Log::Report   'mail-message', import => [ qw/__x error/ ];

#--------------------

sub init($)
{	my ($self, $args)  = @_;

	$self->SUPER::init($args);

	my $produce = $args->{produce} || 'HTML';

	$self->{MMCH_tail}
	  = $produce eq 'HTML'  ?   '>'
	  : $produce eq 'XHTML' ? ' />'
	  :    error __x"produce XHTML or HTML, not {what UNKNOWN}.", what => $produce;

	$self;
}

#--------------------

sub textToHtml(@)
{	my $self  = shift;

	my @lines = @_;    # copy is required
	foreach (@lines)
	{	s/\&/&/gs; s/\
		s/\>/>/gs;  s/\"/"/gs;
	}
	wantarray ? @lines : join('', @lines);
}


sub fieldToHtml($;$)
{	my ($self, $field, $subject) = @_;
	   ''. $self->textToHtml($field->wellformedName) .  ': ' . $self->fieldContentsToHtml($field, $subject);
}


sub headToHtmlTable($;$)
{	my ($self, $head) = (shift, shift);
	my $tp      = @_ ? ' '.shift : '';

	my $subject;
	if($self->{MMHC_mailto_subject})
	{	my $s = $head->get('subject');

		use Mail::Message::Construct;
		$subject = Mail::Message::Construct->replySubject($s) if defined $s;
	}

	my @lines = "\n"; \n), \n); 




73




2





 





 





 





 





12



 	foreach my $f ($self->selectedFields($head)) 




74




6





 





 





 





 





21



 	{	my $name_html = $self->textToHtml($f->wellformedName); 




75




6





 





 





 





 





18



 		my $cont_html = $self->fieldContentsToHtml($f, $subject); 




76




 





 





 





 





 





 



   




77




6





 





 





 





 





27



 		push @lines, 




78




 





 





 





 





 





 



 			qq($name_html:




79




 





 





 





 





 





 



 			qq(    $cont_html




80




 





 





 





 





 





 



 	} 




81




 





 





 





 





 





 



   




82




2





 





 





 





 





7



 	push @lines, "\n";
	foreach my $f ($self->selectedFields($head))
	{	my $name_html = $self->textToHtml($f->wellformedName);
		my $cont_html = $self->fieldContentsToHtml($f, $subject);

		push @lines,
			qq(
			qq(
	}

	push @lines, "
	wantarray ? @lines : join('',@lines);
}


sub headToHtmlHead($@)
{	my ($self, $head) = (shift,shift);
	my %meta;
	while(@_) { my $k = shift; $meta{lc $k} = shift }

	my $title = delete $meta{title} || $head->get('subject') || '';

	my @lines = (
		"\n",
		"".$self->textToHtml($title) . "\n",
	);

	my $author = delete $meta{author};
	unless(defined $author)
	{	my $from = $head->get('from');
		my @addr = defined $from ? $from->addresses : ();
		$author  = @addr ? $addr[0]->format : undef;
	}

	push @lines, '{MMCH_tail}\n"
		if defined $author;

	foreach my $f (map {lc} keys %meta)
	{	next if $meta{$f} eq '';     # empty is skipped.
		push @lines,
			  '
113
			. '" content="'. $self->textToHtml($meta{$f})
			."\"$self->{MMCH_tail}\n";
	}

	foreach my $f ($self->selectedFields($head))
	{	next if exists $meta{$f->name};
		push @lines,
			  '
121
			. '" content="'  . $self->textToHtml($f->content)
			. "\"$self->{MMCH_tail}\n";
	}

	push @lines, "\n";
	wantarray ? @lines : join('',@lines);
}


my $atom          = qr/[^()<>@,;:\\".\[\]\s[:cntrl:]]+/;
my $email_address = qr/(($atom(?:\.$atom)*)\@($atom(?:\.$atom)+))/o;

sub fieldContentsToHtml($;$)
{	my ($self, $field, $subj) = @_;

	my $subject = defined $subj ? '?subject='.$self->textToHtml($subj) : '';
	my $body    = $self->textToHtml($field->body);
	my $comment = $field->comment;

	$body =~ s#$email_address#$1#gx
		if $field->name =~ m/^(resent-)?(to|from|cc|bcc|reply\-to)$/;

	$body . ($comment ? '; '.$self->textToHtml($comment) : '');
}

1;