File Coverage

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

Criterion	Covered	Total	%
statement	71	73	97.2
branch	21	34	61.7
condition	3	4	75.0
subroutine	12	12	100.0
pod	5	6	83.3
total	112	129	86.8

# Copyrights 2001-2023 by [Mark Overmeer ].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.03.
# This code is part of distribution Mail-Message.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package Mail::Message::Convert::Html;
use vars '$VERSION';
$VERSION = '3.013';

use base 'Mail::Message::Convert';

use strict;
use warnings;

use Carp;


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

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

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

    $self->{MMCH_tail}
     = $produce eq 'HTML'  ?   '>'
     : $produce eq 'XHTML' ? ' />'
     : carp "Produce XHTML or HTML, not $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 $subject;
    }

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




76




2





 





 





 





 





14



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




77




6





 





 





 





 





19



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




78




6





 





 





 





 





21



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




79




6





 





 





 





 





27



         push @lines, qq($name_html:




80




 





 





 





 





 





 



                    , qq(    $cont_html




81




 





 





 





 





 





 



     } 




82




 





 





 





 





 





 



   




83




2





 





 





 





 





3



     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, '
110
               . $self->textToHtml($author) . "\"$self->{MMCH_tail}\n"
        if defined $author;

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

    foreach my $f ($self->selectedFields($head))
    {   next if exists $meta{$f->name};
        push @lines, '
123
                   . '" 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) = (shift,shift);
    my $subject = defined $_[0] ? '?subject='.$self->textToHtml(shift) : '';

    my ($body, $comment) = ($self->textToHtml($field->body), $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;