File Coverage

lib/Pod/Elemental/Transformer/Splint/Util.pm
Criterion Covered Total %
statement 54 65 83.0
branch 10 20 50.0
condition 3 3 100.0
subroutine 10 10 100.0
pod 0 4 0.0
total 77 102 75.4


line stmt bran cond sub pod time code
1 3     3   23957 use 5.14.0;
  3         10  
2 3     3   16 use strict;
  3         6  
  3         65  
3 3     3   14 use warnings;
  3         4  
  3         152  
4              
5             package Pod::Elemental::Transformer::Splint::Util;
6              
7             our $VERSION = '0.1100'; # VERSION
8             # ABSTRACT: Role for attribute renderers
9              
10 3     3   15 use Moose::Role;
  3         5  
  3         24  
11 3     3   19156 use Pod::Simple::XHTML;
  3         133579  
  3         113  
12 3     3   28 use Safe::Isa;
  3         7  
  3         2499  
13              
14             sub parse_pod {
15 33     33 0 493 my $self = shift;
16 33         46 my $pod = shift;
17              
18 33         203 my $podder = Pod::Simple::XHTML->new;
19 33         3053 $podder->html_header('');
20 33         247 $podder->html_footer('');
21 33         208 my $results = '';
22 33         109 $podder->output_string(\$results);
23 33         49349 $podder->parse_string_document("=pod\n\n$pod");
24              
25 33         28558 $results =~ s{</?p>}{}g;
26 33         97 $results =~ s{https?://search\.cpan\.org/perldoc\?}{https://metacpan.org/pod/}g;
27 33         281 $results =~ s{[\v\h]*$}{};
28 33         700 return $results;
29             }
30              
31             sub determine_type_library {
32 2     2 0 3 my $self = shift;
33 2         5 my $type_constraint = shift;
34              
35 2 50       117 return $self->get_library_for_type($type_constraint) if $self->get_library_for_type($type_constraint);
36 2 50       140 return $self->default_type_library if $self->has_default_type_library;
37 0         0 return $type_constraint;
38             }
39              
40             sub make_type_string {
41 9     9 0 65 my $self = shift;
42 9         15 my $type_constraint = shift;
43 9 50       22 return '' if !defined $type_constraint;
44              
45             # The type knows its own library
46 9 100 100     37 return $self->parse_pod(sprintf 'L<%s|%s/"%s>', $type_constraint, $type_constraint->library, $type_constraint) if $type_constraint->$_can('library') && defined $type_constraint->library;
47              
48             # We don't deal with InstanceOf
49 2 50       54 if($type_constraint =~ m{InstanceOf}) {
50 0 0       0 if($self->has_default_type_library) {
51 0         0 $type_constraint =~ s{InstanceOf}{$self->type_string_helper('InstanceOf', $self->default_type_library, 'InstanceOf')}egi;
  0         0  
52 0         0 $type_constraint =~ s{"}{'}g;
53             }
54 0         0 return $type_constraint
55             }
56              
57             # If there are multiple types we deal with them individually
58 2 100       64 if($type_constraint =~ m{[^a-z0-9_]}i) {
59              
60 1         13 $type_constraint =~ s{\b([a-z0-9_]+)\b}{$self->type_string_helper($1, $self->determine_type_library($1), $1)}egi;
  2         23  
61              
62             # cleanup and ensure some whitespace
63 1         5 $type_constraint =~ s{\v}{}g;
64 1         3 $type_constraint =~ s{\|}{ | }g;
65 1         5 $type_constraint =~ s{\[}{ [ }g;
66 1         3 $type_constraint =~ s{]}{ ]}g;
67 1         12 return $type_constraint;
68             }
69              
70              
71             # it can't do library, but it can do name?
72 1 50       38 if($self->$_can('name')) {
73 0         0 my $name = $type_constraint->name;
74              
75 0 0       0 if($self->get_library_for_type($name)) {
76 0         0 return $self->parse_pod(sprintf 'L<%s|%s/"%s>', $name, $self->get_library_for_type($name), $name);
77             }
78 0         0 return $self->parse_pod(sprintf 'L<%s|%s/"%s>', $name, $self->has_default_type_library, $name);
79             }
80              
81 1 50       75 if($self->get_library_for_type($type_constraint)) {
82 0         0 return $self->parse_pod(sprintf 'L<%s|%s/"%s>', $type_constraint, $self->get_library_for_type($type_constraint), $type_constraint);
83             }
84              
85 1         98 return $self->parse_pod(sprintf 'L<%s|%s/"%s>', $type_constraint, $self->has_default_type_library, $type_constraint);
86             }
87              
88             sub type_string_helper {
89 2     2 0 4 my $self = shift;
90 2         5 my $text = shift;
91 2         3 my $type_library = shift;
92 2         4 my $anchor = shift;
93              
94 2         12 return $self->parse_pod(sprintf 'L<%s|%s/"%s>', $text, $type_library, $anchor);
95             }
96              
97             1;
98              
99             __END__
100              
101             =pod
102              
103             =encoding UTF-8
104              
105             =head1 NAME
106              
107             Pod::Elemental::Transformer::Splint::Util - Role for attribute renderers
108              
109             =head1 VERSION
110              
111             Version 0.1100, released 2016-01-12.
112              
113             =head1 SOURCE
114              
115             L<https://github.com/Csson/p5-Pod-Elemental-Transformer-Splint>
116              
117             =head1 HOMEPAGE
118              
119             L<https://metacpan.org/release/Pod-Elemental-Transformer-Splint>
120              
121             =head1 AUTHOR
122              
123             Erik Carlsson <info@code301.com>
124              
125             =head1 COPYRIGHT AND LICENSE
126              
127             This software is copyright (c) 2016 by Erik Carlsson.
128              
129             This is free software; you can redistribute it and/or modify it under
130             the same terms as the Perl 5 programming language system itself.
131              
132             =cut