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   820 use strict;
  2         5  
  2         61  
5 2     2   11 use warnings;
  2         5  
  2         51  
6              
7 2     2   10 use Moose;
  2         6  
  2         16  
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 85 my ($self, $node) = @_;
23 17         109 my ($title, @subentries) = $node->get_key;
24 17         64 my $entry = $self->get_top_entry( $title );
25 17         73 $entry->add( $title, @subentries, $node );
26             }
27              
28             sub get_top_entry
29             {
30 17     17 0 40 my ($self, $key) = @_;
31 17         543 my $entries = $self->entries;
32 17 50       76 my $top_key = $key =~ /(\w)/ ? $1 : substr $key, 0, 1;
33 17   66     354 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 3057 my $self = shift;
40 6         220 my $entries = $self->entries;
41 6         15 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         17 my $footer = <<END_HTML_FOOTER;
56             </body>
57             </html>
58             END_HTML_FOOTER
59              
60             return $heading
61 6         39 . join( "\n", map { $entries->{$_}->emit } sort keys %$entries )
  8         36  
62             . $footer;
63             }
64              
65             __PACKAGE__->meta->make_immutable;
66              
67             package Pod::PseudoPod::DOM::Index::EntryList;
68              
69 2     2   16515 use strict;
  2         6  
  2         57  
70 2     2   12 use warnings;
  2         4  
  2         69  
71              
72 2     2   11 use Moose;
  2         4  
  2         9  
73 2     2   14867 use HTML::Entities;
  2         12779  
  2         1823  
74              
75             has 'key', is => 'ro', required => 1;
76             has 'contents', is => 'ro', default => sub { {} };
77              
78             sub add
79             {
80 31     31 0 77 my ($self, $key) = splice @_, 0, 2;
81 31         980 my $contents = $self->contents;
82 31         58 my $node = pop @_;
83 31   100     130 my $elements = $contents->{$key} ||= [];
84              
85 31 100       97 return $self->add_nested_entry( $key, $node, $elements, @_ ) if @_;
86 17         54 $self->add_entry( $key, $node, $elements );
87             }
88              
89             sub add_nested_entry
90             {
91 14     14 0 42 my ($self, $key, $node, $elements, @path) = @_;
92              
93 14         33 for my $element (@$elements)
94             {
95 8 100       33 next unless $element->isa( 'Pod::PseudoPod::DOM::Index::EntryList' );
96 7         21 $element->add( @path, $node );
97 7         26 return;
98             }
99              
100 7         232 my $entry_list = Pod::PseudoPod::DOM::Index::EntryList->new( key => $key );
101              
102 7         31 $entry_list->add( @path, $node );
103 7         12 push @{ $elements }, $entry_list;
  7         25  
104             }
105              
106             sub add_entry
107             {
108 17     17 0 48 my ($self, $key, $node, $elements, @path) = @_;
109              
110 17         44 for my $element (@$elements)
111             {
112 2 100       16 next unless $element->isa( 'Pod::PseudoPod::DOM::Index::Entry' );
113 1         3 $element->add_location( $node );
114 1         4 return;
115             }
116              
117 16         568 my $entry = Pod::PseudoPod::DOM::Index::Entry->new( key => $key );
118 16         60 $entry->add_location( $node );
119 16         30 push @{ $elements }, $entry;
  16         60  
120             }
121              
122             sub emit
123             {
124 7     7 0 18 my $self = shift;
125 7         218 my $key = encode_entities( $self->key );
126              
127 7         153 return qq|$key\n| . $self->emit_contents;
128             }
129              
130             sub sort_content_hash
131             {
132 15     15 0 39 my ($self, $hash) = @_;
133              
134 21         68 return map { $_->[1] }
135 8         25 sort { $a->[0] cmp $b->[0] }
136 15         55 map { my $key = $_; $key =~ s/[^\w\s]//g; [ lc( $key ), $_ ] }
  21         40  
  21         56  
  21         96  
137             keys %$hash;
138             }
139              
140             sub emit_contents
141             {
142 15     15 0 36 my $self = shift;
143 15         502 my $contents = $self->contents;
144 15         33 my $content = qq|<ul>\n|;
145              
146 15         51 for my $key ($self->sort_content_hash( $contents ))
147             {
148 23         63 my @sorted = map { $_->[2] }
149 2 0       12 sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] }
150             map {
151 23         733 my $title = $_->key;
152 23         63 $title =~ s/[^\w\s]//g;
153 23         95 [ lc( $title ), ref $_, $_ ]
154             }
155 21         40 @{ $contents->{$key} };
  21         53  
156              
157 21         58 $content .= join "\n", map { '<li>' . $_->emit . "</li>\n" } @sorted;
  23         67  
158             }
159              
160 15         161 return $content . qq|</ul>\n|;
161             }
162              
163             __PACKAGE__->meta->make_immutable;
164              
165             package Pod::PseudoPod::DOM::Index::Entry;
166              
167 2     2   20 use strict;
  2         10  
  2         49  
168 2     2   16 use warnings;
  2         6  
  2         65  
169              
170 2     2   11 use Moose;
  2         5  
  2         12  
171 2     2   14137 use HTML::Entities;
  2         5  
  2         559  
172              
173             has 'key', is => 'ro', required => 1;
174             has 'locations', is => 'ro', default => sub { [] };
175              
176             sub emit
177             {
178 16     16 0 31 my $self = shift;
179              
180             return encode_entities( $self->key ) . ' '
181 16         484 . join ' ', map { $_->emit } @{ $self->locations };
  17         49  
  16         699  
182             }
183              
184             sub add_location
185             {
186 17     17 0 48 my ($self, $entry) = @_;
187 17         30 push @{ $self->locations },
  17         559  
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   16 use strict;
  2         6  
  2         75  
197 2     2   18 use warnings;
  2         9  
  2         54  
198              
199 2     2   11 use Moose;
  2         5  
  2         9  
200              
201             has 'entry', is => 'ro', required => 1;
202              
203             sub emit
204             {
205 17     17 0 33 my $self = shift;
206 17         540 my $entry = $self->entry;
207              
208 17         58 return '[' . $entry->emit_index_link . ']';
209             }
210              
211             __PACKAGE__->meta->make_immutable;
212              
213             package Pod::PseudoPod::DOM::Index::TopEntryList;
214              
215 2     2   13480 use strict;
  2         8  
  2         47  
216 2     2   10 use warnings;
  2         7  
  2         76  
217              
218 2     2   13 use Moose;
  2         10  
  2         10  
219 2     2   13252 use HTML::Entities;
  2         5  
  2         282  
220              
221             extends 'Pod::PseudoPod::DOM::Index::EntryList';
222              
223             sub emit
224             {
225 8     8 0 16 my $self = shift;
226 8         269 my $key = encode_entities( $self->key );
227              
228 8         174 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.2004
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