File Coverage

blib/lib/Pod/POM/View/Pod.pm
Criterion Covered Total %
statement 51 59 86.4
branch 10 20 50.0
condition n/a
subroutine 18 19 94.7
pod 13 13 100.0
total 92 111 82.8


line stmt bran cond sub pod time code
1             #============================================================= -*-Perl-*-
2             #
3             # Pod::POM::View::Pod
4             #
5             # DESCRIPTION
6             # Pod view of a Pod Object Model.
7             #
8             # AUTHOR
9             # Andy Wardley
10             #
11             # COPYRIGHT
12             # Copyright (C) 2000 Andy Wardley. All Rights Reserved.
13             #
14             # This module is free software; you can redistribute it and/or
15             # modify it under the same terms as Perl itself.
16             #
17             # REVISION
18             # $Id: Pod.pm 77 2009-08-20 20:44:14Z ford $
19             #
20             #========================================================================
21              
22             package Pod::POM::View::Pod;
23             $Pod::POM::View::Pod::VERSION = '0.30';
24             require 5.006;
25 18     18   76 use strict;
  18         28  
  18         380  
26 18     18   74 use warnings;
  18         26  
  18         427  
27              
28 18     18   72 use Pod::POM::Nodes;
  18         24  
  18         613  
29 18     18   6704 use Pod::POM::View;
  18         37  
  18         485  
30 18     18   120 use parent qw( Pod::POM::View );
  18         29  
  18         79  
31 18     18   862 use vars qw( $DEBUG $ERROR $AUTOLOAD $MARKUP );
  18         27  
  18         15987  
32              
33             $DEBUG = 0 unless defined $DEBUG;
34              
35             # create reverse lookup table mapping method name to original sequence
36             $MARKUP = {
37             map { ( $Pod::POM::Node::Sequence::NAME{ $_ } => $_ ) }
38             keys %Pod::POM::Node::Sequence::NAME,
39             };
40              
41              
42             sub view {
43 318     318 1 467 my ($self, $type, $item) = @_;
44              
45             # my ($pkg, $file, $line) = caller;
46             # print STDERR "called view ($type) from $file line $line\n";
47              
48 318 100       839 if ($type =~ s/^seq_//) {
    50          
    50          
49 317 100       735 if ($type eq 'text') {
50 264         1036 return "$item";
51             }
52 53 50       160 if ($type = $MARKUP->{ $type }) {
53 53 100       117 if ($item =~ /[<>]/) {
54 10         52 return "$type<< $item >>";
55             }
56             else {
57 43         189 return "$type<$item>";
58             }
59             }
60             }
61             elsif (ref $item eq 'HASH') {
62 0 0       0 if (defined $item->{ content }) {
    0          
63 0         0 return $item->{ content }->present($self);
64             }
65             elsif (defined $item->{ text }) {
66 0         0 my $text = $item->{ text };
67 0 0       0 return ref $text ? $text->present($self) : $text;
68             }
69             else {
70 0         0 return '';
71             }
72             }
73             elsif (! ref $item) {
74 1         4 return $item;
75             }
76             else {
77 0         0 return '';
78             }
79             }
80              
81              
82             sub view_pod {
83 12     12 1 22 my ($self, $pod) = @_;
84             # return "=pod\n\n" . $pod->content->present($self) . "=cut\n\n";
85 12         88 return $pod->content->present($self);
86             }
87              
88              
89             sub view_head1 {
90 34     34 1 56 my ($self, $head1) = @_;
91 34         187 return '=head1 '
92             . $head1->title->present($self)
93             . "\n\n"
94             . $head1->content->present($self);
95             }
96              
97              
98             sub view_head2 {
99 8     8 1 14 my ($self, $head2) = @_;
100 8         39 return '=head2 '
101             . $head2->title->present($self)
102             . "\n\n"
103             . $head2->content->present($self);
104             }
105              
106              
107             sub view_head3 {
108 5     5 1 34 my ($self, $head3) = @_;
109 5         25 return '=head3 '
110             . $head3->title->present($self)
111             . "\n\n"
112             . $head3->content->present($self);
113             }
114              
115              
116             sub view_head4 {
117 7     7 1 10 my ($self, $head4) = @_;
118 7         37 return '=head4 '
119             . $head4->title->present($self)
120             . "\n\n"
121             . $head4->content->present($self);
122             }
123              
124              
125             sub view_over {
126 10     10 1 18 my ($self, $over) = @_;
127 10         49 return '=over '
128             . $over->indent()
129             . "\n\n"
130             . $over->content->present($self)
131             . "=back\n\n";
132             }
133              
134              
135             sub view_item {
136 16     16 1 23 my ($self, $item) = @_;
137              
138 16         74 my $title = $item->title();
139 16 50       62 $title = $title->present($self) if ref $title;
140 16         81 return "=item $title\n\n"
141             . $item->content->present($self);
142             }
143              
144              
145             sub view_for {
146 1     1 1 3 my ($self, $for) = @_;
147 1         8 return '=for '
148             . $for->format . ' '
149             . $for->text()
150             . "\n\n"
151             . $for->content->present($self);
152             }
153            
154              
155             sub view_begin {
156 4     4 1 6 my ($self, $begin) = @_;
157 4         25 return '=begin '
158             . $begin->format()
159             . "\n\n"
160             . $begin->content->present($self)
161             . "=end "
162             . $begin->format()
163             . "\n\n";
164             }
165            
166              
167             sub view_textblock {
168 92     92 1 117 my ($self, $text) = @_;
169 92         395 return "$text\n\n";
170             }
171              
172              
173             sub view_verbatim {
174 6     6 1 9 my ($self, $text) = @_;
175 6         25 return "$text\n\n";
176             }
177              
178              
179             sub view_meta {
180 0     0 1   my ($self, $meta) = @_;
181 0           return '=meta '
182             . $meta->name()
183             . "\n\n"
184             . $meta->content->present($self)
185             . "=end\n\n";
186             }
187              
188              
189             1;
190              
191             =head1 NAME
192              
193             Pod::POM::View::Pod
194              
195             =head1 DESCRIPTION
196              
197             Pod view of a Pod Object Model.
198              
199             =head1 METHODS
200              
201             =over 4
202              
203             =item C
204              
205             =item C
206              
207             =item C
208              
209             =item C
210              
211             =item C
212              
213             =item C
214              
215             =item C
216              
217             =item C
218              
219             =item C
220              
221             =item C
222              
223             =item C
224              
225             =item C
226              
227             =item C
228              
229             =back
230              
231             =head1 AUTHOR
232              
233             Andy Wardley Eabw@kfs.orgE
234              
235             =head1 COPYRIGHT AND LICENSE
236              
237             Copyright (C) 2000 Andy Wardley. All Rights Reserved.
238              
239             This module is free software; you can redistribute it and/or
240             modify it under the same terms as Perl itself.
241              
242             =cut