File Coverage

blib/lib/HTML/FromMail/Format/OODoc.pm

Criterion	Covered	Total	%
statement	15	46	32.6
branch	0	8	0.0
condition	0	3	0.0
subroutine	5	13	38.4
pod	7	7	100.0
total	27	77	35.0

# This code is part of Perl distribution HTML-FromMail version 4.00.
# The POD got stripped from this file by OODoc version 3.05.
# For contributors see file ChangeLog.

# This software is copyright (c) 2003-2025 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 HTML::FromMail::Format::OODoc;{
our $VERSION = '4.00';
}

use base 'HTML::FromMail::Format';

use strict;
use warnings;

use Log::Report 'html-frommail';

use OODoc::Template ();

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

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

sub oodoc() { $_[0]->{HFFM_oodoc} }

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

sub expand($$$$)
{	my ($self, $args, $tag, $attrs, $textref) = @_;

	# Lookup the method to be called.
	my $method = 'html' . ucfirst($tag);
	my $prod   = $args->{producer};
	$prod->can($method) or return undef;

	my %info  = (%$args, %$attrs, textref => $textref);
	$prod->$method($args->{object}, \%info);
}


sub export($@)
{	my ($self, $message, %args) = @_;

	my $oodoc  = $self->{HFFM_oodoc} = OODoc::Template->new;

	my $output = $args{output};
	open my($out), ">", $output
		or fault __x"cannot write to {out}";

	my $input  = $args{input};
	open my($in), "<", $input
		or fault __x"cannot open template file {in}", in => $input;

	my $template = join '', <$in>;
	close $in;

	my %defaults = (
		DYNAMIC => sub { $self->expand(\%args, @_) },
	);

	my $oldout   = select $out;
	$oodoc->parse($template, \%defaults);
	select $oldout;

	close $out;
	$self;
}

sub containerText($)
{	my ($self, $args) = @_;
	my $textref = $args->{textref};
	defined $textref ? $$textref : undef;
}

sub processText($$)
{	my ($self, $text, $args) = @_;
	$self->oodoc->parse($text, {});
}

sub lookup($$)
{	my ($self, $what, $args) = @_;
	$self->oodoc->valueFor($what);
}

sub onFinalToken($)
{	my ($self, $args) = @_;
	not (defined $args->{textref} && defined ${$args->{textref}});
}

1;