# Copyrights 2001-2022 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.012'; 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/\/>/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"; foreach my $f ($self->selectedFields($head)) { my $name_html = $self->textToHtml($f->wellformedName); my $cont_html = $self->fieldContentsToHtml($f, $subject); push @lines, qq(\n) , qq( \n); } push @lines, "
$name_html:$cont_html
\n"; 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, '{MMCH_tail}\n"; } foreach my $f ($self->selectedFields($head)) { next if exists $meta{$f->name}; push @lines, '{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;