File Coverage

blib/lib/Template/Plugin/LinkTarget.pm
Criterion Covered Total %
statement 51 51 100.0
branch 11 12 91.6
condition 3 4 75.0
subroutine 10 10 100.0
pod 2 2 100.0
total 77 79 97.4


line stmt bran cond sub pod time code
1             package Template::Plugin::LinkTarget;
2              
3             ###############################################################################
4             # Required inclusions.
5             ###############################################################################
6 1     1   57577 use strict;
  1         3  
  1         31  
7 1     1   5 use warnings;
  1         2  
  1         27  
8 1     1   593 use HTML::Parser;
  1         5882  
  1         39  
9 1     1   8 use HTML::Entities qw(encode_entities);
  1         3  
  1         66  
10 1     1   6 use base qw(Template::Plugin::Filter);
  1         2  
  1         603  
11 1     1   2394 use namespace::clean;
  1         16208  
  1         10  
12              
13             ###############################################################################
14             # Version number.
15             ###############################################################################
16             our $VERSION = '0.04';
17              
18             ###############################################################################
19             # Subroutine: init()
20             ###############################################################################
21             # Initializes the template plugin.
22             ###############################################################################
23             sub init {
24 10     10 1 34533 my $self = shift;
25 10         25 $self->{'_DYNAMIC'} = 1;
26 10   50     63 $self->install_filter( $self->{'_ARGS'}->[0] || 'linktarget' );
27 10         419 return $self;
28             }
29              
30             ###############################################################################
31             # Subroutine: filter($text, $args, $conf)
32             ###############################################################################
33             # Filters the given text, and adds the "target" attribute to links.
34             ###############################################################################
35             sub filter {
36 10     10 1 832 my ($self, $text, $args, $conf) = @_;
37              
38             # Merge the FILTER config with the USE config
39 10         28 $conf = $self->merge_config( $conf );
40              
41             # Get list of "excluded" things (e.g. things we DON'T add targets to)
42 10         94 my @exclude;
43 10 100       29 if ($conf->{'exclude'}) {
44             @exclude = ref($conf->{'exclude'}) eq 'ARRAY'
45 2         5 ? @{$conf->{'exclude'}}
46 3 100       11 : $conf->{'exclude'};
47             }
48              
49             # Get the "target" for links.
50 10   100     38 my $target = $conf->{'target'} || '_blank';
51              
52             # Create a new HTML parser.
53 10         14 my $filtered = '';
54             my $p = HTML::Parser->new(
55 61     61   224 'default_h' => [sub { $filtered .= shift; }, 'text'],
56             'start_h' => [sub {
57 16     16   37 my ($tag, $text, $attr, $attrseq) = @_;
58 16 50       40 if ($tag eq 'a') {
59 16         26 my $should_add = 1;
60 16 100       37 if (grep { $attr->{'href'} =~ /$_/ } @exclude) {
  12         133  
61 5         11 $should_add = 0;
62             }
63 16 100       43 if ($should_add) {
64             # add in our "target" attr, replacing any existing one
65 11 100       26 unless (exists $attr->{'target'}) {
66 10         16 push( @{$attrseq}, 'target' )
  10         21  
67             }
68 11         22 $attr->{'target'} = $target;
69             # rebuild the tag
70 23         247 my @attrs = map { qq{$_="} . encode_entities($attr->{$_}) . qq{"} }
71 11         15 @{$attrseq};
  11         21  
72 11         180 $text = '';
73             }
74             }
75 16         76 $filtered .= $text;
76 10         83 }, 'tag, text, attr, attrseq'],
77             );
78              
79             # Filter the text.
80 10         514 $p->parse( $text );
81 10         35 $p->eof();
82              
83             # Return the filtered text back to the caller.
84 10         146 return $filtered;
85             }
86              
87             1;
88              
89             =head1 NAME
90              
91             Template::Plugin::LinkTarget - Template Toolkit filter to add "target" attribute to all HTML links
92              
93             =head1 SYNOPSIS
94              
95             [% USE LinkTarget(target="_blank" exclude=['www.example.com']) %]
96             ...
97             [% FILTER linktarget %]
98             Google
99             [% END %]
100             ...
101             [% text | linktarget %]
102              
103             =head1 DESCRIPTION
104              
105             C is a filter plugin for C,
106             which adds a C attribute to all HTML links found in the filtered text.
107              
108             Through the use of the C option, you can specify URLs that are I
109             given a new C attribute. This can be used to set up a filter that
110             leaves internal links alone but that sets up external links to open in a new
111             browser window. C accepts a list of regular expressions, so you can
112             be as elaborate as you'd like.
113              
114             The C option specifies what target you'd like to give to links,
115             defaulting to "_blank".
116              
117             =head1 METHODS
118              
119             =over
120              
121             =item init()
122              
123             Initializes the template plugin.
124              
125             =item filter($text, $args, $conf)
126              
127             Filters the given text, and adds the "target" attribute to links.
128              
129             =back
130              
131             =head1 AUTHOR
132              
133             Graham TerMarsch (cpan@howlingfrog.com)
134              
135             =head1 COPYRIGHT
136              
137             Copyright (C) 2008, Graham TerMarsch. All Rights Reserved.
138              
139             This is free software; you can redistribute it and/or modify it under the same
140             terms as Perl itself.
141              
142             =head1 SEE ALSO
143              
144             L.
145              
146             =cut