File Coverage

blib/lib/Parse/BBCode/XHTML.pm
Criterion Covered Total %
statement 19 25 76.0
branch 2 6 33.3
condition n/a
subroutine 7 8 87.5
pod 3 3 100.0
total 31 42 73.8


line stmt bran cond sub pod time code
1             package Parse::BBCode::XHTML;
2             $Parse::BBCode::XHTML::VERSION = '0.15';
3 1     1   38321 use strict;
  1         3  
  1         37  
4 1     1   6 use warnings;
  1         3  
  1         33  
5 1     1   6 use Carp qw(croak carp);
  1         2  
  1         73  
6 1     1   965 use URI::Escape;
  1         9552  
  1         355  
7 1     1   19 use base qw/ Parse::BBCode /;
  1         4  
  1         2950  
8              
9             my $email_valid = 0;
10             eval {
11             require
12             Email::Valid;
13             };
14             $email_valid = 1 unless $@;
15              
16             my %default_tags = (
17             Parse::BBCode::HTML->defaults(),
18             '' => sub {
19             my $text = Parse::BBCode::escape_html($_[2]);
20             $text =~ s{\r?\n|\r}{
\n}g;
21             $text;
22             },
23             'img' => '[%{html}s]',
24             );
25             my %optional_tags = (
26             Parse::BBCode::HTML->optional(),
27             );
28              
29             my %default_escapes = (
30             Parse::BBCode::HTML->default_escapes
31             );
32              
33              
34             sub defaults {
35 1     1 1 2 my ($class, @keys) = @_;
36             return @keys
37 1 50       23 ? (map { $_ => $default_tags{$_} } grep { defined $default_tags{$_} } @keys)
  0         0  
  0         0  
38             : %default_tags;
39             }
40              
41             sub default_escapes {
42 1     1 1 2 my ($class, @keys) = @_;
43             return @keys
44 1 50       11 ? (map { $_ => $default_escapes{$_} } grep { defined $default_escapes{$_} } @keys)
  0            
  0            
45             : %default_escapes;
46             }
47              
48             sub optional {
49 0     0 1   my ($class, @keys) = @_;
50 0 0         return @keys ? (grep defined, @optional_tags{@keys}) : %optional_tags;
51             }
52              
53              
54              
55             1;
56              
57             __END__