File Coverage

blib/lib/Pod/Elemental/Document.pm
Criterion Covered Total %
statement 46 56 82.1
branch 5 10 50.0
condition 3 8 37.5
subroutine 9 9 100.0
pod 0 2 0.0
total 63 85 74.1


line stmt bran cond sub pod time code
1             package Pod::Elemental::Document 0.103006;
2             # ABSTRACT: a pod document
3              
4 12     12   57848 use Moose;
  12         388026  
  12         72  
5             with 'Pod::Elemental::Node';
6              
7 12     12   69683 use Class::Load ();
  12         25  
  12         229  
8 12     12   531 use namespace::autoclean;
  12         6511  
  12         81  
9              
10 12     12   4661 use Pod::Elemental::Element::Generic::Blank;
  12         41  
  12         457  
11 12     12   5689 use String::RewritePrefix;
  12         12041  
  12         59  
12              
13             #pod =head1 OVERVIEW
14             #pod
15             #pod Pod::Elemental::Document is a container for Pod documents. It performs
16             #pod L<Pod::Elemental::Node> but I<not> L<Pod::Elemental::Paragraph>.
17             #pod
18             #pod Documents are used almost exclusively to give a small amount of behavior to
19             #pod arrayrefs of paragraphs, and have few methods of their own.
20             #pod
21             #pod =cut
22              
23             sub _expand_name {
24 32     32   53 my ($self, $name) = @_;
25              
26 32         112 return String::RewritePrefix->rewrite(
27             {
28             '' => 'Pod::Elemental::Element::',
29             '=' => ''
30             },
31             $name,
32             );
33             }
34              
35             sub as_pod_string {
36 4     4 0 1357 my ($self) = @_;
37              
38 4         11 my $str = join q{}, map { $_->as_pod_string } @{ $self->children };
  41         106  
  4         109  
39              
40 4 50       113 $str = "=pod\n\n$str" unless $str =~ /\A=pod\n/;
41 4 50       34 $str .= "=cut\n" unless $str =~ /=cut\n+\z/;
42              
43 4         31 return $str;
44             }
45              
46             sub as_debug_string {
47             return 'Document'
48             }
49              
50             sub _elem_from_lol_entry {
51 16     16   26 my ($self, $entry) = @_;
52 16         45 my ($type, $content, $arg) = @$entry;
53 16   50     57 $arg ||= {};
54              
55 16 100       50 if (! defined $type) {
    50          
56 7   50     25 my $n_class = $self->_expand_name($arg->{class} || 'Generic::Text');
57 7         313 Class::Load::load_class($n_class);
58 7         373 return $n_class->new({ content => "$content\n" });
59             } elsif ($type =~ /\A=(\w+)\z/) {
60 9         21 my $command = $1;
61 9   50     31 my $n_class = $self->_expand_name($arg->{class} || 'Generic::Command');
62 9         411 Class::Load::load_class($n_class);
63 9         498 return $n_class->new({
64             command => $command,
65             content => "$content\n"
66             });
67             } else {
68 0   0     0 my $n_class = $self->_expand_name($arg->{class} || 'Pod5::Region');
69 0         0 Class::Load::load_class($n_class);
70              
71 0         0 my @children;
72              
73 0         0 for my $child (@$content) {
74 0         0 push @children, $self->_elem_from_lol_entry($child);
75             } continue {
76 0         0 my $blank = $self->_expand_name('Generic::Blank');
77 0         0 push @children, $blank->new({ content => "\n" });
78             }
79              
80             pop @children
81 0         0 while $children[-1]->isa('Pod::Elemental::Element::Generic::Blank');
82              
83 0         0 my ($colon, $target) = $type =~ /\A(:)?(.+)\z/;
84              
85 0 0       0 return $n_class->new({
86             format_name => $target,
87             is_pod => $colon ? 1 : 0,
88             content => "\n",
89             children => \@children,
90             })
91             }
92             }
93              
94             sub new_from_lol {
95 1     1 0 163 my ($class, $lol) = @_;
96              
97 1         34 my $self = $class->new;
98              
99 1         1 my @children;
100 1         3 ENTRY: for my $entry (@$lol) {
101 16         31 my $elem = $self->_elem_from_lol_entry($entry);
102 16         31 push @children, $elem;
103             } continue {
104 16         37 my $blank = $self->_expand_name('Generic::Blank');
105 16         1198 push @children, $blank->new({ content => "\n" });
106             }
107              
108 1         2 push @{ $self->children }, @children;
  1         28  
109              
110 1         4 return $self;
111             }
112              
113             __PACKAGE__->meta->make_immutable;
114              
115             1;
116              
117             __END__
118              
119             =pod
120              
121             =encoding UTF-8
122              
123             =head1 NAME
124              
125             Pod::Elemental::Document - a pod document
126              
127             =head1 VERSION
128              
129             version 0.103006
130              
131             =head1 OVERVIEW
132              
133             Pod::Elemental::Document is a container for Pod documents. It performs
134             L<Pod::Elemental::Node> but I<not> L<Pod::Elemental::Paragraph>.
135              
136             Documents are used almost exclusively to give a small amount of behavior to
137             arrayrefs of paragraphs, and have few methods of their own.
138              
139             =head1 PERL VERSION
140              
141             This library should run on perls released even a long time ago. It should work
142             on any version of perl released in the last five years.
143              
144             Although it may work on older versions of perl, no guarantee is made that the
145             minimum required version will not be increased. The version may be increased
146             for any reason, and there is no promise that patches will be accepted to lower
147             the minimum required perl.
148              
149             =head1 AUTHOR
150              
151             Ricardo SIGNES <cpan@semiotic.systems>
152              
153             =head1 COPYRIGHT AND LICENSE
154              
155             This software is copyright (c) 2022 by Ricardo SIGNES.
156              
157             This is free software; you can redistribute it and/or modify it under
158             the same terms as the Perl 5 programming language system itself.
159              
160             =cut