File Coverage

blib/lib/Mail/Message/Convert/HtmlFormatPS.pm
Criterion Covered Total %
statement 30 30 100.0
branch n/a
condition n/a
subroutine 9 9 100.0
pod 1 2 50.0
total 40 41 97.5


line stmt bran cond sub pod time code
1             # This code is part of Perl distribution Mail-Message version 4.04.
2             # The POD got stripped from this file by OODoc version 3.06.
3             # For contributors see file ChangeLog.
4              
5             # This software is copyright (c) 2001-2026 by Mark Overmeer.
6              
7             # This is free software; you can redistribute it and/or modify it under
8             # the same terms as the Perl 5 programming language system itself.
9             # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
10              
11              
12             package Mail::Message::Convert::HtmlFormatPS;{
13             our $VERSION = '4.04';
14             }
15              
16 1     1   42659 use parent 'Mail::Message::Convert';
  1         3  
  1         10  
17              
18 1     1   57 use strict;
  1         2  
  1         25  
19 1     1   5 use warnings;
  1         2  
  1         63  
20              
21 1     1   6 use Log::Report 'mail-message', import => [ qw// ];
  1         21  
  1         33  
22              
23 1     1   640 use Mail::Message::Body::String ();
  1         2  
  1         33  
24              
25 1     1   1078 use HTML::TreeBuilder ();
  1         10308  
  1         32  
26 1     1   8 use HTML::FormatPS ();
  1         2  
  1         299  
27              
28             #--------------------
29              
30             sub init($)
31 1     1 0 4 { my ($self, $args) = @_;
32 1         4 my @formopts = map +($_ => delete $args->{$_}), grep m/^[A-Z]/, keys %$args;
33 1         13 $self->SUPER::init($args);
34              
35 1         13 $self->{MMCH_formatter} = HTML::FormatPS->new(@formopts);
36 1         117 $self;
37             }
38              
39             #--------------------
40              
41             sub format($)
42 1     1 1 10 { my ($self, $body) = @_;
43              
44 1         39 my $dec = $body->encode(transfer_encoding => 'none');
45 1         7 my $tree = HTML::TreeBuilder->new_from_file($dec->file);
46              
47             (ref $body)->new(
48             based_on => $body,
49             mime_type => 'application/postscript',
50 1         10718 data => [ $self->{MMCH_formatter}->format($tree) ],
51             );
52             }
53              
54             1;