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         5  
  2         58  
4 2     2   10 use warnings;
  2         4  
  2         113  
5              
6             our $VERSION = '1.001';
7             my $version = $VERSION;
8             $VERSION = eval $VERSION;
9              
10 2     2   19 use base qw(App::Pods2Site::SiteBuilder::AbstractBasicFrames);
  2         6  
  2         880  
11              
12 2     2   18 use App::Pods2Site::Util qw(slashify);
  2         4  
  2         890  
13              
14             sub _getCategoryTOC
15             {
16 6     6   18 my $self = shift;
17 6         45 my $groupName = shift;
18 6         12 my $podInfo = shift;
19 6         17 my $sitedir = shift;
20            
21 6         13 my $toc = '';
22 6         11 my %tree;
23 6         40 foreach my $podName (sort(keys(%$podInfo)))
24             {
25 10         23 my $treeloc = \%tree;
26 10         37 for my $level (split(/::/, $podName))
27             {
28 12 100       61 $treeloc->{$level} = {} unless exists($treeloc->{$level});
29 12         34 $treeloc = $treeloc->{$level};
30             }
31             }
32 6         66 $self->_genRefs($sitedir, \$toc, $podInfo, \%tree);
33 6         23 chomp($toc);
34 6 50       27 $toc = qq($groupName

\n$toc

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