File Coverage

blib/lib/MsOffice/Word/Template/Engine/TT2.pm

Criterion	Covered	Total	%
statement	56	68	82.3
branch	6	8	75.0
condition	5	10	50.0
subroutine	13	14	92.8
pod	0	3	0.0
total	80	103	77.6

use 5.024;
use Template::AutoFilter;                     # a subclass of Template that adds automatic html filtering
use HTML::Entities        qw(encode_entities);

use Moose;
extends 'MsOffice::Word::Template::Engine';

# syntactic sugar for attributes

use namespace::clean -except => 'meta';

our $VERSION = '2.0';

#======================================================================
# ATTRIBUTES
#======================================================================

has       'start_tag' => (is => 'ro', isa => 'Str',    default  => "[% ");
has       'end_tag'   => (is => 'ro', isa => 'Str',    default  => " %]");
has_inner 'TT2'       => (is => 'ro', isa => 'Template');

#======================================================================
# LAZY ATTRIBUTE CONSTRUCTORS
#======================================================================

  my ($self) = @_;

  my $TT2_args = delete $self->{_constructor_args};

  # inject precompiled blocks into the Template parser
  my $precompiled_blocks = $self->_precompiled_blocks;
  $TT2_args->{BLOCKS}{$_} //= $precompiled_blocks->{$_} for keys %$precompiled_blocks;

  return Template::AutoFilter->new($TT2_args);
}

#======================================================================
# METHODS
#======================================================================

  my ($self, $part_name, $template_text) = @_;

  $self->{_compiled_template}{$part_name} = $self->TT2->template(\$template_text);
}


  my ($self, $part_name, $package_part, $vars) = @_;

  # get the compiled template
  my $tmpl         = $self->{_compiled_template}{$part_name}
    or die "don't have a compiled template for '$part_name'";

  # extend $vars with a pointer to the part object, so that it can be called from
  # the template, for example for replacing an image
  my $extended_vars = {package_part => $package_part, %$vars};

  # produce the new contents
  my $new_contents  = $self->TT2->context->process($tmpl, $extended_vars);

  return $new_contents;
}


#======================================================================
# PRE-COMPILED BLOCKS THAT CAN BE INVOKED FROM TEMPLATE DIRECTIVES
#======================================================================

# arbitrary value for the first bookmark id. 100 should most often be above other
# bookmarks generated by Word itself. TODO : would be better to find the highest
# id number really used in the template
my $first_bookmark_id = 100;

# precompiled blocks as facilities to be used within templates

  return {

    # a wrapper block for inserting a Word bookmark
    bookmark => sub {
      my $context     = shift;
      my $stash       = $context->stash;

      # assemble xml markup
      my $bookmark_id = $stash->get('global.bookmark_id') || $first_bookmark_id;
      my $name        = fix_bookmark_name($stash->get('name') || 'anonymous_bookmark');

      my $xml         = qq{<w:bookmarkStart w:id="$bookmark_id" w:name="$name"/>}
                      . $stash->get('content') # content of the wrapper
                      . qq{<w:bookmarkEnd w:id="$bookmark_id"/>};

      # next bookmark will need a fresh id
      $stash->set('global.bookmark_id', $bookmark_id+1);

      return $xml;
    },

    # a wrapper block for linking to a bookmark
    link_to_bookmark => sub {
      my $context = shift;
      my $stash   = $context->stash;

      # assemble xml markup
      my $name    = fix_bookmark_name($stash->get('name') || 'anonymous_bookmark');
      my $content = $stash->get('content');
      my $tooltip = $stash->get('tooltip');
      if ($tooltip) {
        $tooltip = sprintf qq{ w:tooltip="%s"}, encode_entities($tooltip, '<>&"');
      }
      my $xml  = qq{<w:hyperlink w:anchor="$name"$tooltip>$content</w:hyperlink>};

      return $xml;
    },

    # a block for generating a Word field. Can also be used as wrapper.
    field => sub {
      my $context = shift;
      my $stash   = $context->stash;
      my $code    = $stash->get('code');         # field code, including possible flags
      my $text    = $stash->get('content');      # initial text content (before updating the field)

      my $xml     = qq{<w:r><w:fldChar w:fldCharType="begin"/></w:r>}
                  . qq{<w:r><w:instrText xml:space="preserve"> $code </w:instrText></w:r>};
      $xml       .= qq{<w:r><w:fldChar w:fldCharType="separate"/></w:r>$text} if $text;
      $xml       .= qq{<w:r><w:fldChar w:fldCharType="end"/></w:r>};

      return $xml;
    },


    # a block for replacing an image by a new barcode
    barcode => sub {
      require Barcode::Code128;

      my $context      = shift;
      my $stash        = $context->stash;
      my $package_part = $stash->get('package_part'); # Word::Surgeon::PackagePart
      my $img          = $stash->get('img');          # title of an existing image to replace
      my $to_encode    = $stash->get('content');      # text to be encoded
      $to_encode =~ s(<[^>]+>)()g;

      # create PNG image
      my $bc = Barcode::Code128->new;
      $bc->option(border    => 0,
                  show_text => 0,
                  padding   => 0);
      my $png = $bc->png($to_encode);
      $package_part->replace_image($img, $png);
      return "";
    },
  }
}



#======================================================================
# UTILITY ROUTINES (not methods)
#======================================================================


  my $name = shift;

  # see https://stackoverflow.com/questions/852922/what-are-the-limitations-for-bookmark-names-in-microsoft-word

  $name =~ s/[^\w_]+/_/g;                              # only digits, letters or underscores
  $name =~ s/^(\d)/_$1/;                               # cannot start with a digit
  $name = substr($name, 0, 40) if length($name) > 40;  # max 40 characters long

  return $name;
}


1;


=encoding ISO-8859-1

=head1 NAME

MsOffice::Word::Template::Engine::TT2 -- Word::Template engine based on the Template Toolkit

=head1 SYNOPSIS

  my $template = MsOffice::Word::Template->new(docx         => $filename
                                               engine_class => 'TT2',
                                               engine_args  => \%args_for_TemplateToolkit,
                                               );

  my $new_doc  = $template->process(\%data);

See the main synopsis in L<MsOffice::Word::Template>.

=head1 DESCRIPTION

Implements a templating engine for L<MsOffice::Word::Template>, based on the
L<Template Toolkit|Template>.


=head1 AUTHORING NOTES SPECIFIC TO THE TEMPLATE TOOLKIT

This chapter just gives a few hints for authoring Word templates with the
Template Toolkit.

The examples below use [[double square brackets]] to indicate
segments that should be highlighted in B<green> within the Word template.


=head2 Bookmarks

The template processor is instantiated with a predefined wrapper named C<bookmark>
for generating Word bookmarks. Here is an example:

  Here is a paragraph with [[WRAPPER bookmark name="my_bookmark"]]bookmarked text[[END]].

The C<name> argument is automatically truncated to 40 characters, and non-alphanumeric
characters are replaced by underscores, in order to comply with the limitations imposed by Word
for bookmark names.

=head2 Internal hyperlinks

Similarly, there is a predefined wrapper named C<link_to_bookmark> for generating
hyperlinks to bookmarks. Here is an example:

  Click [[WRAPPER link_to_bookmark name="my_bookmark" tooltip="tip top"]]here[[END]].

The C<tooltip> argument is optional.

=head2 Word fields

A predefined block C<field> generates XML markup for Word fields, like for example :

  Today is [[PROCESS field code="DATE \\@ \"h:mm am/pm, dddd, MMMM d\""]]

Beware that quotes or backslashes must be escaped so that the Template Toolkit parser
does not interpret these characters.

The list of Word field codes is documented at
L<https://support.microsoft.com/en-us/office/list-of-field-codes-in-word-1ad6d91a-55a7-4a8d-b535-cf7888659a51>.

When used as a wrapper, the C<field> block generates a Word field with alternative
text content, displayed before the field gets updated. For example :

  [[WRAPPER field code="TOC \o \"1-3\" \h \z \u"]]Table of contents - press F9 to update[[END]]



=head1 AUTHOR

Laurent Dami, E<lt>dami AT cpan DOT org<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2020-2022 by Laurent Dami.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.