File Coverage

blib/lib/Perlanet/Trait/Tidy.pm
Criterion Covered Total %
statement 18 23 78.2
branch n/a
condition n/a
subroutine 6 7 85.7
pod n/a
total 24 30 80.0


line stmt bran cond sub pod time code
1             package Perlanet::Trait::Tidy;
2              
3 6     6   3207 use strict;
  6         17  
  6         177  
4 6     6   31 use warnings;
  6         18  
  6         162  
5              
6 6     6   32 use Moose::Role;
  6         13  
  6         49  
7 6     6   36427 use namespace::autoclean;
  6         16  
  6         63  
8              
9 6     6   499 use Encode;
  6         16  
  6         530  
10 6     6   3317 use HTML::Tidy;
  6         17534  
  6         1467  
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 0     0     my $self = shift;
50 0           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 0           my $tidy = HTML::Tidy->new(\%tidy);
64 0           $tidy->ignore( type => TIDY_WARNING );
65              
66 0           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;