File Coverage

lib/Pod/PseudoPod/DOM/TableOfContents.pm
Criterion Covered Total %
statement 27 70 38.5
branch 0 8 0.0
condition n/a
subroutine 9 16 56.2
pod 0 7 0.0
total 36 101 35.6


line stmt bran cond sub pod time code
1             package Pod::PseudoPod::DOM::TableOfContents;
2             # ABSTRACT: table of contents for a PPDOM Corpus
3              
4 1     1   8 use strict;
  1         2  
  1         36  
5 1     1   6 use warnings;
  1         3  
  1         32  
6              
7 1     1   5 use Moose;
  1         2  
  1         8  
8              
9             has 'contents',
10             is => 'ro',
11             default => sub { Pod::PseudoPod::DOM::TableOfContents::TopContents->new };
12              
13             sub add_document
14             {
15 0     0 0   my ($self, $document) = @_;
16 0           my $headings = $document->extract_headings( max_depth => 5 );
17 0           my @stack = ($self->contents);
18 0           my $current_level = 0;
19 0           my $class = 'Pod::PseudoPod::DOM::TableOfContents::Entry';
20 0           my $last_entry;
21              
22 0           for my $heading (@$headings)
23             {
24 0           my $level = $heading->level;
25 0           my $entry = $class->new( heading => $heading );
26              
27 0 0         if ($level == $current_level)
    0          
28             {
29 0           $stack[-1]->add( $entry );
30             }
31             elsif ($level > $current_level)
32             {
33 0           $last_entry->add( $entry );
34 0           push @stack, $last_entry;
35             }
36             else
37             {
38 0           my $diff = $current_level - $level;
39 0           $last_entry = pop @stack for 1 .. $diff;
40 0           $stack[-1]->add( $entry );
41             }
42              
43 0           $last_entry = $entry;
44 0           $current_level = $level;
45             }
46             }
47              
48             sub emit_toc
49             {
50 0     0 0   my $self = shift;
51 0           return <<END_HTML . $self->contents->emit . "</ul></body></html>";
52             <!DOCTYPE html>
53             <html lang="en">
54             <head>
55             <link rel="stylesheet" href="../css/style.css" type="text/css" />
56             </head>
57             <body>
58             END_HTML
59             }
60              
61             __PACKAGE__->meta->make_immutable;
62              
63             package Pod::PseudoPod::DOM::TableOfContents::TopContents;
64              
65 1     1   7326 use strict;
  1         2  
  1         22  
66 1     1   5 use warnings;
  1         2  
  1         37  
67              
68 1     1   6 use Moose;
  1         2  
  1         5  
69              
70             has 'kids', is => 'ro', default => sub { [] };
71              
72             sub add
73             {
74 0     0 0   my ($self, $entry) = @_;
75 0           push @{ $self->kids }, $entry;
  0            
76             }
77              
78             sub emit
79             {
80 0     0 0   my $self = shift;
81 0           my $kids = $self->kids;
82 0 0         return '' unless @$kids;
83              
84 0           my $contents = '';
85 0           for my $kid (@$kids)
86             {
87 0           $contents .= '<h2>' . $kid->heading->get_heading_link . "</h2>\n"
88             . $kid->emit_kids;
89             }
90              
91 0           return $contents;
92             }
93              
94             __PACKAGE__->meta->make_immutable;
95              
96             package Pod::PseudoPod::DOM::TableOfContents::Entry;
97              
98 1     1   6707 use strict;
  1         3  
  1         22  
99 1     1   5 use warnings;
  1         2  
  1         37  
100              
101 1     1   6 use Moose;
  1         2  
  1         5  
102              
103             has 'kids', is => 'ro', default => sub { [] };
104             has 'heading', is => 'ro', required => 1;
105              
106             sub add
107             {
108 0     0 0   my ($self, $entry) = @_;
109 0           push @{ $self->kids }, $entry;
  0            
110             }
111              
112             sub emit_kids
113             {
114 0     0 0   my $self = shift;
115 0           my $kids = $self->kids;
116 0 0         return '' unless @$kids;
117 0           my $contents = "<ul>\n";
118              
119 0           for my $kid (@$kids)
120             {
121 0           $contents .= $kid->emit;
122             }
123              
124 0           return $contents . "\n</ul>\n";
125             }
126              
127             sub emit
128             {
129 0     0 0   my $self = shift;
130 0           my $kids = $self->kids;
131 0           return "<li>" . $self->heading->get_heading_link
132             . $self->emit_kids . "</li>\n";
133             }
134              
135             __PACKAGE__->meta->make_immutable;
136              
137             __END__
138              
139             =pod
140              
141             =encoding UTF-8
142              
143             =head1 NAME
144              
145             Pod::PseudoPod::DOM::TableOfContents - table of contents for a PPDOM Corpus
146              
147             =head1 VERSION
148              
149             version 1.20210620.2032
150              
151             =head1 AUTHOR
152              
153             chromatic <chromatic@wgz.org>
154              
155             =head1 COPYRIGHT AND LICENSE
156              
157             This software is copyright (c) 2021 by chromatic.
158              
159             This is free software; you can redistribute it and/or modify it under
160             the same terms as the Perl 5 programming language system itself.
161              
162             =cut