File Coverage

blib/lib/Perlanet/Trait/Tidy.pm
Criterion Covered Total %
statement 23 23 100.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 30 30 100.0


line stmt bran cond sub pod time code
1             package Perlanet::Trait::Tidy;
2              
3 6     6   2163 use strict;
  6         11  
  6         167  
4 6     6   25 use warnings;
  6         6  
  6         182  
5              
6 6     6   26 use Moose::Role;
  6         8  
  6         62  
7 6     6   13824 use namespace::autoclean;
  6         13  
  6         38  
8              
9 6     6   313 use Encode;
  6         11  
  6         366  
10 6     6   1227 use HTML::Tidy;
  6         157676  
  6         1512  
11              
12             =head1 NAME
13            
14             Perlanet::Trait::Tidy - run posts through HTML::Tidy
15            
16             =head1 SYNOPSIS
17            
18             my $perlanet = Perlanet->new_with_traits(
19             traits => [ 'Perlanet::Trait::Tidy' ]
20             );
21            
22             $perlanet->run;
23            
24             =head1 DESCRIPTION
25            
26             Before a post is added to the aggregated feed, it will be ran through
27             HTML::Tidy.
28            
29             =head2 Configuring
30            
31             To configure the HTML::Tidy instance, you should override the C<_build_tidy>
32             method. This method takes no input, and returns a HTML::Tidy instance.
33            
34             =head1 ATTRIBUTES
35            
36             =head2 tidy
37            
38             An instance of L<HTML::Tidy> used to tidy the feed entry contents
39             before outputting. For default settings see source..
40            
41             =cut
42              
43             has 'tidy' => (
44               is => 'rw',
45               lazy_build => 1
46             );
47              
48             sub _build_tidy {
49 3     3   35   my $self = shift;
50 3         21   my %tidy = (
51                 doctype => 'omit',
52                 output_xhtml => 1,
53                 wrap => 0,
54                 alt_text => '',
55                 break_before_br => 0,
56                 char_encoding => 'raw',
57                 tidy_mark => 0,
58                 show_body_only => 1,
59                 preserve_entities => 1,
60                 show_warnings => 0,
61               );
62              
63 3         23   my $tidy = HTML::Tidy->new(\%tidy);
64 3         210   $tidy->ignore( type => TIDY_WARNING );
65              
66 3         52   return $tidy;
67             }
68              
69             around 'clean_html' => sub {
70               my $orig = shift;
71               my ($self, $html) = @_;
72              
73               $html = $self->$orig($html);
74              
75               my $clean = $self->tidy->clean(utf8::is_utf8($html)
76                 ? $html
77                 : decode('utf8', $html));
78              
79               return $clean;
80             };
81              
82             =head1 AUTHOR
83            
84             Oliver Charles, <oliver.g.charles@googlemail.com>
85            
86             =head1 COPYRIGHT AND LICENSE
87            
88             Copyright (c) 2010 by Magnum Solutions Ltd.
89            
90             This library is free software; you can redistribute it and/or modify
91             it under the same terms as Perl itself, either Perl version 5.10.0 or,
92             at your option, any later version of Perl 5 you may have available.
93            
94             =cut
95              
96             1;
97