| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Template::Plugin::NoFollow; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | ############################################################################### | 
| 4 |  |  |  |  |  |  | # Required inclusions. | 
| 5 |  |  |  |  |  |  | ############################################################################### | 
| 6 | 2 |  |  | 2 |  | 157596 | use strict; | 
|  | 2 |  |  |  |  | 7 |  | 
|  | 2 |  |  |  |  | 98 |  | 
| 7 | 2 |  |  | 2 |  | 13 | use warnings; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 72 |  | 
| 8 | 2 |  |  | 2 |  | 2322 | use HTML::Parser; | 
|  | 2 |  |  |  |  | 13972 |  | 
|  | 2 |  |  |  |  | 92 |  | 
| 9 | 2 |  |  | 2 |  | 23 | use base qw(Template::Plugin::Filter); | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 2267 |  | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | ############################################################################### | 
| 12 |  |  |  |  |  |  | # Version number. | 
| 13 |  |  |  |  |  |  | ############################################################################### | 
| 14 |  |  |  |  |  |  | our $VERSION = '1.02'; | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | ############################################################################### | 
| 17 |  |  |  |  |  |  | # Subroutine:   init() | 
| 18 |  |  |  |  |  |  | ############################################################################### | 
| 19 |  |  |  |  |  |  | # Initializes the template plugin. | 
| 20 |  |  |  |  |  |  | ############################################################################### | 
| 21 |  |  |  |  |  |  | sub init { | 
| 22 | 11 |  |  | 11 | 1 | 33769 | my ($self) = @_; | 
| 23 | 11 |  |  |  |  | 40 | $self->{'_DYNAMIC'} = 1; | 
| 24 | 11 |  | 50 |  |  | 97 | $self->install_filter( $self->{'_ARGS'}->[0] || 'nofollow' ); | 
| 25 | 11 |  |  |  |  | 383 | return $self; | 
| 26 |  |  |  |  |  |  | } | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | ############################################################################### | 
| 29 |  |  |  |  |  |  | # Subroutine:   filter($text, $args, $conf) | 
| 30 |  |  |  |  |  |  | ############################################################################### | 
| 31 |  |  |  |  |  |  | # Filters the given text, and adds rel="nofollow" to links. | 
| 32 |  |  |  |  |  |  | ############################################################################### | 
| 33 |  |  |  |  |  |  | sub filter { | 
| 34 | 11 |  |  | 11 | 1 | 867 | my ($self, $text, $args, $conf) = @_; | 
| 35 |  |  |  |  |  |  |  | 
| 36 |  |  |  |  |  |  | # Merge the FILTER config with the USE config | 
| 37 | 11 |  |  |  |  | 76 | $conf = $self->merge_config( $conf ); | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | # Get list of "allowed" things (e.g. things we DON'T mark as nofollow) | 
| 40 | 11 |  |  |  |  | 82 | my @allow; | 
| 41 | 11 | 100 |  |  |  | 34 | if ($conf->{'allow'}) { | 
| 42 | 2 |  |  |  |  | 6 | @allow = ref($conf->{'allow'}) eq 'ARRAY' | 
| 43 | 3 | 100 |  |  |  | 11 | ? @{$conf->{'allow'}} | 
| 44 |  |  |  |  |  |  | : $conf->{'allow'}; | 
| 45 |  |  |  |  |  |  | } | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  | # Create a new HTML parser. | 
| 48 | 11 |  |  |  |  | 16 | my $filtered = ''; | 
| 49 |  |  |  |  |  |  | my $p = HTML::Parser->new( | 
| 50 | 62 |  |  | 62 |  | 256 | 'default_h' => [sub { $filtered .= shift; }, 'text'], | 
| 51 |  |  |  |  |  |  | 'start_h'   => [sub { | 
| 52 | 16 |  |  | 16 |  | 32 | my ($tag, $text, $attr) = @_; | 
| 53 | 16 | 50 |  |  |  | 42 | if ($tag eq 'a') { | 
| 54 | 16 |  |  |  |  | 22 | my $should_nofollow = 1; | 
| 55 | 16 | 100 |  |  |  | 33 | if (grep { $attr->{'href'} =~ /$_/ } @allow) { | 
|  | 11 |  |  |  |  | 129 |  | 
| 56 | 4 |  |  |  |  | 8 | $should_nofollow = 0; | 
| 57 |  |  |  |  |  |  | } | 
| 58 | 16 | 100 |  |  |  | 31 | if ($should_nofollow) { | 
| 59 |  |  |  |  |  |  | # remove any existing rel="nofollow" attrs | 
| 60 | 12 |  |  |  |  | 82 | $text =~ s/(<\s*a)([^>]*)\srel\s*=\s*"?nofollow"?([^>]*>)/$1$2$3/gsmi; | 
| 61 |  |  |  |  |  |  | # add in our rel="nofollow" attr | 
| 62 | 12 |  |  |  |  | 106 | $text =~ s/(<\s*a)([^>]*>)/$1 rel="nofollow"$2/gsmi; | 
| 63 |  |  |  |  |  |  | } | 
| 64 |  |  |  |  |  |  | } | 
| 65 | 16 |  |  |  |  | 93 | $filtered .= $text; | 
| 66 | 11 |  |  |  |  | 114 | }, 'tag, text, attr'], | 
| 67 |  |  |  |  |  |  | ); | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | # Filter the text. | 
| 70 | 11 |  |  |  |  | 662 | $p->parse( $text ); | 
| 71 | 11 |  |  |  |  | 40 | $p->eof(); | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  | # Return the filtered text back to the caller. | 
| 74 | 11 |  |  |  |  | 163 | return $filtered; | 
| 75 |  |  |  |  |  |  | }; | 
| 76 |  |  |  |  |  |  |  | 
| 77 |  |  |  |  |  |  | 1; | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | =head1 NAME | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | Template::Plugin::NoFollow - TT filter to add rel="nofollow" to all HTML links | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | [% use NoFollow allow=['www.example.com', '^http://example.com/'] %] | 
| 86 |  |  |  |  |  |  | ... | 
| 87 |  |  |  |  |  |  | [% FILTER nofollow %] | 
| 88 |  |  |  |  |  |  | Google | 
| 89 |  |  |  |  |  |  | [% END %] | 
| 90 |  |  |  |  |  |  | ... | 
| 91 |  |  |  |  |  |  | [% text | nofollow %] | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  | C is a filter plugin for TT, which adds | 
| 96 |  |  |  |  |  |  | C to all HTML links found in the filtered text. | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | Through the use of the C option, you can specify URLs that are I | 
| 99 |  |  |  |  |  |  | marked as C.  This can be used to set up a filter that leaves | 
| 100 |  |  |  |  |  |  | internal links alone, and that marks all external links as C. | 
| 101 |  |  |  |  |  |  | C accepts regular expressions, so you can be as elaborate as you'd like. | 
| 102 |  |  |  |  |  |  |  | 
| 103 |  |  |  |  |  |  | =head1 METHODS | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | =over | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | =item init() | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | Initializes the template plugin. | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | =item filter($text, $args, $conf) | 
| 112 |  |  |  |  |  |  |  | 
| 113 |  |  |  |  |  |  | Filters the given text, and adds rel="nofollow" to links. | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | =back | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | =head1 AUTHOR | 
| 118 |  |  |  |  |  |  |  | 
| 119 |  |  |  |  |  |  | Graham TerMarsch | 
| 120 |  |  |  |  |  |  |  | 
| 121 |  |  |  |  |  |  | =head1 COPYRIGHT | 
| 122 |  |  |  |  |  |  |  | 
| 123 |  |  |  |  |  |  | Copyright (C) 2006-2007, Graham TerMarsch.  All Rights Reserved. | 
| 124 |  |  |  |  |  |  |  | 
| 125 |  |  |  |  |  |  | This is free software; you can redistribute it and/or modify it under the same | 
| 126 |  |  |  |  |  |  | terms as Perl itself. | 
| 127 |  |  |  |  |  |  |  | 
| 128 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 129 |  |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  | L. | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | =cut |