File Coverage

blib/lib/Pod/Abstract/Filter/summary.pm
Criterion Covered Total %
statement 9 41 21.9
branch 0 8 0.0
condition n/a
subroutine 3 5 60.0
pod 1 2 50.0
total 13 56 23.2


line stmt bran cond sub pod time code
1             package Pod::Abstract::Filter::summary;
2 1     1   1045 use strict;
  1         1  
  1         32  
3              
4 1     1   5 use base qw(Pod::Abstract::Filter);
  1         1  
  1         76  
5 1     1   5 use Pod::Abstract::BuildNode qw(node);
  1         2  
  1         537  
6              
7             our $VERSION = '0.20';
8              
9             =head1 NAME
10              
11             Pod::Abstract::Filter::summary - paf command to show document outline,
12             with short examples.
13              
14             =cut
15              
16             sub filter {
17 0     0 1   my $self = shift;
18 0           my $pa = shift;
19            
20 0           my $summary = node->root;
21 0           my $summ_block = node->head1('Summary');
22 0           $summary->nest($summ_block);
23            
24 0           $self->summarise_headings($pa,$summ_block);
25 0           $summ_block->nest(node->text("\n"));
26 0           $summ_block->coalesce_body(':text');
27            
28 0           return $summary;
29             }
30              
31             sub summarise_headings {
32 0     0 0   my $self = shift;
33 0           my $pa = shift;
34 0           my $summ_block = shift;
35 0           my $depth = shift;
36 0 0         $depth = 1 unless defined $depth;
37            
38 0           my @headings = $pa->select('/[@heading]');
39 0           my @items = $pa->select('/over/item[@label =~ {[a-zA-Z]+}]'); # Labels that have strings
40            
41 0           unshift @headings, @items;
42            
43 0           foreach my $head (@headings) {
44 0           my ($hdg) = $head->select('@heading');
45 0 0         if($head->type eq 'item') {
46 0           ($hdg) = $head->select('@label');
47             }
48 0           my $hdg_text = $hdg->text;
49 0           $summ_block->push(
50             node->text((" " x $depth) . $hdg_text . "\n")
51             );
52 0 0         if($hdg_text =~ m/^[0-9a-zA-Z_ ]+$/) {
53 0           my ($synopsis) = $head->select("//:verbatim[. =~ {$hdg_text}](0)");
54 0 0         if($synopsis) {
55 0           my $synop_body = $synopsis->body;
56 0           $synop_body =~ s/[\r\n]//sg;
57 0           $synop_body =~ s/[\t ]+/ /g;
58 0           $synop_body =~ s/^ //g;
59            
60 0           $summ_block->push(
61             node->text(
62             (" " x $depth) . " \\ " . $synop_body . "\n"
63             )
64             );
65             }
66             }
67            
68 0           $self->summarise_headings($head, $summ_block, $depth + 1);
69             }
70             }
71              
72             =head1 AUTHOR
73              
74             Ben Lilburne
75              
76             =head1 COPYRIGHT AND LICENSE
77              
78             Copyright (C) 2009 Ben Lilburne
79              
80             This program is free software; you can redistribute it and/or modify
81             it under the same terms as Perl itself.
82              
83             =cut
84              
85             1;