File Coverage

lib/Pod/PseudoPod/DOM/Index.pm
Criterion Covered Total %
statement 129 132 97.7
branch 7 10 70.0
condition 4 5 80.0
subroutine 31 32 96.8
pod 0 14 0.0
total 171 193 88.6


line stmt bran cond sub pod time code
1             package Pod::PseudoPod::DOM::Index;
2             # ABSTRACT: an index for a PPDOM Corpus
3              
4 2     2   835 use strict;
  2         4  
  2         63  
5 2     2   10 use warnings;
  2         6  
  2         50  
6              
7 2     2   11 use Moose;
  2         5  
  2         82  
8              
9             has 'entries', is => 'ro', default => sub { {} };
10             has 'seen_entries', is => 'ro', default => sub { {} };
11              
12             sub add_document
13             {
14 0     0 0 0 my ($self, $document) = @_;
15 0         0 my $seen_entries = $self->seen_entries;
16             $self->add_entry( $_ )
17 0         0 for $document->get_index_entries( $seen_entries );
18             }
19              
20             sub add_entry
21             {
22 17     17 0 93 my ($self, $node) = @_;
23 17         115 my ($title, @subentries) = $node->get_key;
24 17         64 my $entry = $self->get_top_entry( $title );
25 17         130 $entry->add( $title, @subentries, $node );
26             }
27              
28             sub get_top_entry
29             {
30 17     17 0 38 my ($self, $key) = @_;
31 17         559 my $entries = $self->entries;
32 17 50       81 my $top_key = $key =~ /(\w)/ ? $1 : substr $key, 0, 1;
33 17   66     384 return $entries->{uc $top_key}
34             ||= Pod::PseudoPod::DOM::Index::TopEntryList->new( key => uc $top_key );
35             }
36              
37             sub emit_index
38             {
39 6     6 0 3138 my $self = shift;
40 6         215 my $entries = $self->entries;
41 6         19 my $heading = <<END_HTML_HEAD;
42             <?xml version="1.0" encoding="UTF-8"?>
43             <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
44             "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
45             <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
46             <head>
47             <title></title>
48             <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
49             <link rel="stylesheet" href="../css/style.css" type="text/css" />
50             </head>
51             <body>
52             <h1 id="index">Index</h1>
53             END_HTML_HEAD
54              
55 6         14 my $footer = <<END_HTML_FOOTER;
56             </body>
57             </html>
58             END_HTML_FOOTER
59              
60             return $heading
61 6         42 . join( "\n", map { $entries->{$_}->emit } sort keys %$entries )
  8         39  
62             . $footer;
63             }
64              
65             __PACKAGE__->meta->make_immutable;
66              
67             package Pod::PseudoPod::DOM::Index::EntryList;
68              
69 2     2   15672 use strict;
  2         6  
  2         55  
70 2     2   11 use warnings;
  2         5  
  2         67  
71              
72 2     2   13 use Moose;
  2         3  
  2         9  
73 2     2   14086 use HTML::Entities;
  2         11919  
  2         1771  
74              
75             has 'key', is => 'ro', required => 1;
76             has 'contents', is => 'ro', default => sub { {} };
77              
78             sub add
79             {
80 31     31 0 89 my ($self, $key) = splice @_, 0, 2;
81 31         1052 my $contents = $self->contents;
82 31         62 my $node = pop @_;
83 31   100     127 my $elements = $contents->{$key} ||= [];
84              
85 31 100       113 return $self->add_nested_entry( $key, $node, $elements, @_ ) if @_;
86 17         62 $self->add_entry( $key, $node, $elements );
87             }
88              
89             sub add_nested_entry
90             {
91 14     14 0 49 my ($self, $key, $node, $elements, @path) = @_;
92              
93 14         33 for my $element (@$elements)
94             {
95 8 100       41 next unless $element->isa( 'Pod::PseudoPod::DOM::Index::EntryList' );
96 7         21 $element->add( @path, $node );
97 7         26 return;
98             }
99              
100 7         245 my $entry_list = Pod::PseudoPod::DOM::Index::EntryList->new( key => $key );
101              
102 7         32 $entry_list->add( @path, $node );
103 7         14 push @{ $elements }, $entry_list;
  7         25  
104             }
105              
106             sub add_entry
107             {
108 17     17 0 42 my ($self, $key, $node, $elements, @path) = @_;
109              
110 17         43 for my $element (@$elements)
111             {
112 2 100       21 next unless $element->isa( 'Pod::PseudoPod::DOM::Index::Entry' );
113 1         5 $element->add_location( $node );
114 1         4 return;
115             }
116              
117 16         536 my $entry = Pod::PseudoPod::DOM::Index::Entry->new( key => $key );
118 16         63 $entry->add_location( $node );
119 16         30 push @{ $elements }, $entry;
  16         55  
120             }
121              
122             sub emit
123             {
124 7     7 0 19 my $self = shift;
125 7         228 my $key = encode_entities( $self->key );
126              
127 7         122 return qq|$key\n| . $self->emit_contents;
128             }
129              
130             sub sort_content_hash
131             {
132 15     15 0 35 my ($self, $hash) = @_;
133              
134 21         59 return map { $_->[1] }
135 8         23 sort { $a->[0] cmp $b->[0] }
136 15         55 map { my $key = $_; $key =~ s/[^\w\s]//g; [ lc( $key ), $_ ] }
  21         35  
  21         58  
  21         98  
137             keys %$hash;
138             }
139              
140             sub emit_contents
141             {
142 15     15 0 29 my $self = shift;
143 15         484 my $contents = $self->contents;
144 15         36 my $content = qq|<ul>\n|;
145              
146 15         47 for my $key ($self->sort_content_hash( $contents ))
147             {
148 23         69 my @sorted = map { $_->[2] }
149 2 0       17 sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] }
150             map {
151 23         802 my $title = $_->key;
152 23         72 $title =~ s/[^\w\s]//g;
153 23         109 [ lc( $title ), ref $_, $_ ]
154             }
155 21         44 @{ $contents->{$key} };
  21         49  
156              
157 21         62 $content .= join "\n", map { '<li>' . $_->emit . "</li>\n" } @sorted;
  23         66  
158             }
159              
160 15         158 return $content . qq|</ul>\n|;
161             }
162              
163             __PACKAGE__->meta->make_immutable;
164              
165             package Pod::PseudoPod::DOM::Index::Entry;
166              
167 2     2   18 use strict;
  2         3  
  2         45  
168 2     2   11 use warnings;
  2         3  
  2         52  
169              
170 2     2   11 use Moose;
  2         4  
  2         12  
171 2     2   13469 use HTML::Entities;
  2         6  
  2         528  
172              
173             has 'key', is => 'ro', required => 1;
174             has 'locations', is => 'ro', default => sub { [] };
175              
176             sub emit
177             {
178 16     16 0 29 my $self = shift;
179              
180             return encode_entities( $self->key ) . ' '
181 16         502 . join ' ', map { $_->emit } @{ $self->locations };
  17         54  
  16         725  
182             }
183              
184             sub add_location
185             {
186 17     17 0 42 my ($self, $entry) = @_;
187 17         32 push @{ $self->locations },
  17         550  
188             Pod::PseudoPod::DOM::Index::Location->new( entry => $entry );
189             }
190              
191             __PACKAGE__->meta->make_immutable;
192              
193             package Pod::PseudoPod::DOM::Index::Location;
194             # ABSTRACT: represents a location to which an index entry points
195              
196 2     2   17 use strict;
  2         4  
  2         53  
197 2     2   11 use warnings;
  2         4  
  2         63  
198              
199 2     2   11 use Moose;
  2         5  
  2         7  
200              
201             has 'entry', is => 'ro', required => 1;
202              
203             sub emit
204             {
205 17     17 0 27 my $self = shift;
206 17         546 my $entry = $self->entry;
207              
208 17         57 return '[' . $entry->emit_index_link . ']';
209             }
210              
211             __PACKAGE__->meta->make_immutable;
212              
213             package Pod::PseudoPod::DOM::Index::TopEntryList;
214              
215 2     2   13242 use strict;
  2         4  
  2         60  
216 2     2   11 use warnings;
  2         4  
  2         64  
217              
218 2     2   28 use Moose;
  2         4  
  2         10  
219 2     2   12918 use HTML::Entities;
  2         4  
  2         309  
220              
221             extends 'Pod::PseudoPod::DOM::Index::EntryList';
222              
223             sub emit
224             {
225 8     8 0 18 my $self = shift;
226 8         277 my $key = encode_entities( $self->key );
227              
228 8         175 return qq|<h2>$key</h2>\n\n| . $self->emit_contents;
229             }
230              
231             __PACKAGE__->meta->make_immutable;
232              
233             __END__
234              
235             =pod
236              
237             =encoding UTF-8
238              
239             =head1 NAME
240              
241             Pod::PseudoPod::DOM::Index - an index for a PPDOM Corpus
242              
243             =head1 VERSION
244              
245             version 1.20210620.2032
246              
247             =head1 AUTHOR
248              
249             chromatic <chromatic@wgz.org>
250              
251             =head1 COPYRIGHT AND LICENSE
252              
253             This software is copyright (c) 2021 by chromatic.
254              
255             This is free software; you can redistribute it and/or modify it under
256             the same terms as the Perl 5 programming language system itself.
257              
258             =cut