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