1#============================================================= -*-Perl-*-
2#
3# Template::Plugin::Filter
4#
5# DESCRIPTION
6#   Template Toolkit module implementing a base class plugin
7#   object which acts like a filter and can be used with the
8#   FILTER directive.
9#
10# AUTHOR
11#   Andy Wardley   <abw@wardley.org>
12#
13# COPYRIGHT
14#   Copyright (C) 2001-2019 Andy Wardley.  All Rights Reserved.
15#
16#   This module is free software; you can redistribute it and/or
17#   modify it under the same terms as Perl itself.
18#
19#============================================================================
20
21package Template::Plugin::Filter;
22
23use strict;
24use warnings;
25use base 'Template::Plugin';
26use Scalar::Util 'weaken', 'isweak';
27
28
29our $VERSION = '3.010';
30our $DYNAMIC = 0 unless defined $DYNAMIC;
31
32
33sub new {
34    my ($class, $context, @args) = @_;
35    my $config = @args && ref $args[-1] eq 'HASH' ? pop(@args) : { };
36
37    # look for $DYNAMIC
38    my $dynamic;
39    {
40        no strict 'refs';
41        $dynamic = ${"$class\::DYNAMIC"};
42    }
43    $dynamic = $DYNAMIC unless defined $dynamic;
44
45    my $self = bless {
46        _CONTEXT => $context,
47        _DYNAMIC => $dynamic,
48        _ARGS    => \@args,
49        _CONFIG  => $config,
50    }, $class;
51
52    return $self->init($config)
53        || $class->error($self->error());
54}
55
56
57sub init {
58    my ($self, $config) = @_;
59    return $self;
60}
61
62
63sub factory {
64    my $self = shift;
65    my $this = $self;
66
67    # avoid a memory leak
68    weaken( $this->{_CONTEXT} ) if ref $this->{_CONTEXT}
69            && !isweak $this->{_CONTEXT};
70
71    if ($self->{ _DYNAMIC }) {
72        return [ sub {
73            my ($context, @args) = @_;
74            my $config = ref $args[-1] eq 'HASH' ? pop(@args) : { };
75
76            return sub {
77                $this->filter(shift, \@args, $config);
78            };
79        }, 1 ];
80    }
81    else {
82        return sub {
83            $this->filter(shift);
84        };
85    }
86}
87
88sub filter {
89    my ($self, $text, $args, $config) = @_;
90    return $text;
91}
92
93
94sub merge_config {
95    my ($self, $newcfg) = @_;
96    my $owncfg = $self->{ _CONFIG };
97    return $owncfg unless $newcfg;
98    return { %$owncfg, %$newcfg };
99}
100
101
102sub merge_args {
103    my ($self, $newargs) = @_;
104    my $ownargs = $self->{ _ARGS };
105    return $ownargs unless $newargs;
106    return [ @$ownargs, @$newargs ];
107}
108
109
110sub install_filter {
111    my ($self, $name) = @_;
112    $self->{ _CONTEXT }->define_filter( $name => $self->factory );
113    return $self;
114}
115
116
117
1181;
119
120__END__
121
122=head1 NAME
123
124Template::Plugin::Filter - Base class for plugin filters
125
126=head1 SYNOPSIS
127
128    package MyOrg::Template::Plugin::MyFilter;
129
130    use Template::Plugin::Filter;
131    use base qw( Template::Plugin::Filter );
132
133    sub filter {
134        my ($self, $text) = @_;
135
136        # ...mungify $text...
137
138        return $text;
139    }
140
141    # now load it...
142    [% USE MyFilter %]
143
144    # ...and use the returned object as a filter
145    [% FILTER $MyFilter %]
146      ...
147    [% END %]
148
149=head1 DESCRIPTION
150
151This module implements a base class for plugin filters.  It hides
152the underlying complexity involved in creating and using filters
153that get defined and made available by loading a plugin.
154
155To use the module, simply create your own plugin module that is
156inherited from the C<Template::Plugin::Filter> class.
157
158    package MyOrg::Template::Plugin::MyFilter;
159
160    use Template::Plugin::Filter;
161    use base qw( Template::Plugin::Filter );
162
163Then simply define your C<filter()> method.  When called, you get
164passed a reference to your plugin object (C<$self>) and the text
165to be filtered.
166
167    sub filter {
168        my ($self, $text) = @_;
169
170        # ...mungify $text...
171
172        return $text;
173    }
174
175To use your custom plugin, you have to make sure that the Template
176Toolkit knows about your plugin namespace.
177
178    my $tt2 = Template->new({
179        PLUGIN_BASE => 'MyOrg::Template::Plugin',
180    });
181
182Or for individual plugins you can do it like this:
183
184    my $tt2 = Template->new({
185        PLUGINS => {
186            MyFilter => 'MyOrg::Template::Plugin::MyFilter',
187        },
188    });
189
190Then you C<USE> your plugin in the normal way.
191
192    [% USE MyFilter %]
193
194The object returned is stored in the variable of the same name,
195'C<MyFilter>'.  When you come to use it as a C<FILTER>, you should add
196a dollar prefix.  This indicates that you want to use the filter
197stored in the variable 'C<MyFilter>' rather than the filter named
198'C<MyFilter>', which is an entirely different thing (see later for
199information on defining filters by name).
200
201    [% FILTER $MyFilter %]
202       ...text to be filtered...
203    [% END %]
204
205You can, of course, assign it to a different variable.
206
207    [% USE blat = MyFilter %]
208
209    [% FILTER $blat %]
210       ...text to be filtered...
211    [% END %]
212
213Any configuration parameters passed to the plugin constructor from the
214C<USE> directive are stored internally in the object for inspection by
215the C<filter()> method (or indeed any other method).  Positional
216arguments are stored as a reference to a list in the C<_ARGS> item while
217named configuration parameters are stored as a reference to a hash
218array in the C<_CONFIG> item.
219
220For example, loading a plugin as shown here:
221
222    [% USE blat = MyFilter 'foo' 'bar' baz = 'blam' %]
223
224would allow the C<filter()> method to do something like this:
225
226    sub filter {
227        my ($self, $text) = @_;
228
229        my $args = $self->{ _ARGS   };  # [ 'foo', 'bar' ]
230        my $conf = $self->{ _CONFIG };  # { baz => 'blam' }
231
232        # ...munge $text...
233
234        return $text;
235    }
236
237By default, plugins derived from this module will create static
238filters.  A static filter is created once when the plugin gets
239loaded via the C<USE> directive and re-used for all subsequent
240C<FILTER> operations.  That means that any argument specified with
241the C<FILTER> directive are ignored.
242
243Dynamic filters, on the other hand, are re-created each time
244they are used by a C<FILTER> directive.  This allows them to act
245on any parameters passed from the C<FILTER> directive and modify
246their behaviour accordingly.
247
248There are two ways to create a dynamic filter.  The first is to
249define a C<$DYNAMIC> class variable set to a true value.
250
251    package MyOrg::Template::Plugin::MyFilter;
252    use base 'Template::Plugin::Filter';
253    our $DYNAMIC = 1;
254
255The other way is to set the internal C<_DYNAMIC> value within the C<init()>
256method which gets called by the C<new()> constructor.
257
258    sub init {
259        my $self = shift;
260        $self->{ _DYNAMIC } = 1;
261        return $self;
262    }
263
264When this is set to a true value, the plugin will automatically
265create a dynamic filter.  The outcome is that the C<filter()> method
266will now also get passed a reference to an array of positional
267arguments and a reference to a hash array of named parameters.
268
269So, using a plugin filter like this:
270
271    [% FILTER $blat 'foo' 'bar' baz = 'blam' %]
272
273would allow the C<filter()> method to work like this:
274
275    sub filter {
276        my ($self, $text, $args, $conf) = @_;
277
278        # $args = [ 'foo', 'bar' ]
279        # $conf = { baz => 'blam' }
280    }
281
282In this case can pass parameters to both the USE and FILTER directives,
283so your filter() method should probably take that into account.
284
285    [% USE MyFilter 'foo' wiz => 'waz' %]
286
287    [% FILTER $MyFilter 'bar' biz => 'baz' %]
288       ...
289    [% END %]
290
291You can use the C<merge_args()> and C<merge_config()> methods to do a quick
292and easy job of merging the local (e.g. C<FILTER>) parameters with the
293internal (e.g. C<USE>) values and returning new sets of conglomerated
294data.
295
296    sub filter {
297        my ($self, $text, $args, $conf) = @_;
298
299        $args = $self->merge_args($args);
300        $conf = $self->merge_config($conf);
301
302        # $args = [ 'foo', 'bar' ]
303        # $conf = { wiz => 'waz', biz => 'baz' }
304        ...
305    }
306
307You can also have your plugin install itself as a named filter by
308calling the C<install_filter()> method from the C<init()> method.  You
309should provide a name for the filter, something that you might
310like to make a configuration option.
311
312    sub init {
313        my $self = shift;
314        my $name = $self->{ _CONFIG }->{ name } || 'myfilter';
315        $self->install_filter($name);
316        return $self;
317    }
318
319This allows the plugin filter to be used as follows:
320
321    [% USE MyFilter %]
322
323    [% FILTER myfilter %]
324       ...
325    [% END %]
326
327or
328
329    [% USE MyFilter name = 'swipe' %]
330
331    [% FILTER swipe %]
332       ...
333    [% END %]
334
335Alternately, you can allow a filter name to be specified as the
336first positional argument.
337
338    sub init {
339        my $self = shift;
340        my $name = $self->{ _ARGS }->[0] || 'myfilter';
341        $self->install_filter($name);
342        return $self;
343    }
344
345    [% USE MyFilter 'swipe' %]
346
347    [% FILTER swipe %]
348       ...
349    [% END %]
350
351=head1 EXAMPLE
352
353Here's a complete example of a plugin filter module.
354
355    package My::Template::Plugin::Change;
356    use Template::Plugin::Filter;
357    use base qw( Template::Plugin::Filter );
358
359    sub init {
360        my $self = shift;
361
362        $self->{ _DYNAMIC } = 1;
363
364        # first arg can specify filter name
365        $self->install_filter($self->{ _ARGS }->[0] || 'change');
366
367        return $self;
368    }
369
370    sub filter {
371        my ($self, $text, $args, $config) = @_;
372
373        $config = $self->merge_config($config);
374        my $regex = join('|', keys %$config);
375
376        $text =~ s/($regex)/$config->{ $1 }/ge;
377
378        return $text;
379    }
380
381    1;
382
383=head1 AUTHOR
384
385Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/>
386
387=head1 COPYRIGHT
388
389Copyright (C) 1996-2020 Andy Wardley.  All Rights Reserved.
390
391This module is free software; you can redistribute it and/or
392modify it under the same terms as Perl itself.
393
394=head1 SEE ALSO
395
396L<Template::Plugin>, L<Template::Filters>, L<Template::Manual::Filters>
397
398=cut
399
400# Local Variables:
401# mode: perl
402# perl-indent-level: 4
403# indent-tabs-mode: nil
404# End:
405#
406# vim: expandtab shiftwidth=4:
407