File Coverage

lib/Pod/Elemental/Transformer/Splint/Util.pm
Criterion Covered Total %
statement 53 64 82.8
branch 10 20 50.0
condition 3 3 100.0
subroutine 10 10 100.0
pod 0 4 0.0
total 76 101 75.2


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