File Coverage

blib/lib/App/Pods2Site/SiteBuilder/BasicFramesSimpleTOC.pm
Criterion Covered Total %
statement 51 51 100.0
branch 9 10 90.0
condition 2 2 100.0
subroutine 6 6 100.0
pod n/a
total 68 69 98.5


line stmt bran cond sub pod time code
1             package App::Pods2Site::SiteBuilder::BasicFramesSimpleTOC;
2              
3 2     2   13 use strict;
  2         4  
  2         64  
4 2     2   9 use warnings;
  2         5  
  2         116  
5              
6             our $VERSION = '1.002';
7             my $version = $VERSION;
8             $VERSION = eval $VERSION;
9              
10 2     2   21 use base qw(App::Pods2Site::SiteBuilder::AbstractBasicFrames);
  2         7  
  2         902  
11              
12 2     2   15 use App::Pods2Site::Util qw(slashify);
  2         6  
  2         879  
13              
14             sub _getCategoryTOC
15             {
16 6     6   15 my $self = shift;
17 6         12 my $groupName = shift;
18 6         10 my $podInfo = shift;
19 6         12 my $sitedir = shift;
20            
21 6         20 my $toc = '';
22 6         14 my %tree;
23 6         59 foreach my $podName (sort(keys(%$podInfo)))
24             {
25 10         42 my $treeloc = \%tree;
26 10         38 for my $level (split(/::/, $podName))
27             {
28 12 100       72 $treeloc->{$level} = {} unless exists($treeloc->{$level});
29 12         38 $treeloc = $treeloc->{$level};
30             }
31             }
32 6         46 $self->_genRefs($sitedir, \$toc, $podInfo, \%tree);
33 6         16 chomp($toc);
34 6 50       23 $toc = qq($groupName

\n$toc

) if $toc;
35            
36 6         39 return $toc;
37             }
38              
39             sub _genRefs
40             {
41 17     17   30 my $self = shift;
42 17         28 my $sitedir = shift;
43 17         29 my $ref = shift;
44 17         25 my $podInfo = shift;
45 17         27 my $treeloc = shift;
46 17   100     69 my $depth = shift || 0;
47 17         31 my $n = shift;
48 17         26 my $np = shift;
49              
50 17         35 my $r = '';
51 17 100       40 if ($n)
52             {
53 11         19 $r = "${n}::";
54 11 100       33 $$ref .= (' ' x ($depth - 1)) if $depth > 1;
55 11         34 my $p = $podInfo->{$n}->{htmlfile};
56 11 100       28 if ($p)
57             {
58 10         107 $p =~ s#\Q$sitedir\E.##;
59 10         37 $p = slashify($p, '/');
60 10         39 $$ref .= qq($np
\n);
61             }
62             else
63             {
64 1         4 $$ref .= qq($np
\n);
65             }
66             }
67 17         83 foreach my $subnp (sort { lc($a) cmp lc($b) } (keys(%$treeloc)))
  3         24  
68             {
69 11         27 my $subn = "$r$subnp";
70            
71 11         18 $depth++;
72 11         55 $self->_genRefs($sitedir, $ref, $podInfo, $treeloc->{$subnp}, $depth, $subn, $subnp);
73 11         22 $depth--;
74             }
75             }
76              
77             1;