File Coverage

blib/lib/Pod/PseudoPod/XHTML.pm
Criterion Covered Total %
statement 41 41 100.0
branch 9 12 75.0
condition n/a
subroutine 16 16 100.0
pod 3 10 30.0
total 69 79 87.3


line stmt bran cond sub pod time code
1             package Pod::PseudoPod::XHTML;
2              
3             # ABSTRACT: format PseudoPod as valid XHTML
4              
5 2     2   50376 use warnings;
  2         4  
  2         82  
6 2     2   12 use strict;
  2         4  
  2         73  
7              
8 2     2   13 use base qw( Pod::PseudoPod::HTML );
  2         3  
  2         2023  
9              
10 2     2   121863 use Carp;
  2         7  
  2         1182  
11              
12             our $VERSION = '1.02'; # VERSION
13              
14             sub new {
15              
16 30     30 1 19663 my $self = shift;
17 30         135 my $new = $self->SUPER::new( @_ );
18              
19 30         4473 $new->accept_targets( 'xhtml', 'XHTML' );
20 30         404 $new->dtd_strict;
21              
22 30         67 return $new;
23              
24             }
25              
26             { # These definitions are found at http://www.w3.org/TR/xhtml1/#strict
27              
28             my %dtd = (
29              
30             # XHTML 1.0 - Strict
31              
32             'strict' => q{<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
33             "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
34             },
35              
36             # XHTML 1.0 - Transitional
37              
38             'transitional' => q{<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
39             "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
40             },
41             );
42              
43             sub _set_dtd {
44              
45 33     33   45 my ( $self, $type ) = @_;
46              
47 33 50       84 croak "unknown dtd ($type)" unless exists $dtd{ $type };
48              
49 33         73 $self->{ 'dtd' } = $type;
50              
51             }
52              
53             sub _get_dtd {
54              
55 5     5   6 my $self = shift;
56              
57 5 50       15 croak "unknown dtd ($self->{ 'dtd' })" unless exists $self->{ 'dtd' };
58              
59 5         12 return $dtd{ $self->{ 'dtd' } };
60              
61             }
62             };
63              
64 31     31 1 124 sub dtd_strict { $_[ 0 ]->_set_dtd( 'strict' ) }
65 2     2 1 115 sub dtd_transitional { $_[ 0 ]->_set_dtd( 'transitional' ) }
66              
67             sub start_Document {
68              
69 29     29 0 11239 my $self = shift;
70              
71 29 100       104 if ( $self->{ 'body_tags' } ) {
72              
73 5         10 my $dtd = $self->_get_dtd;
74              
75 5         16 $self->{ 'scratch' } .= qq{<?xml version="1.0" encoding="UTF-8"?>
76             $dtd
77             <html xmlns="http://www.w3.org/1999/xhtml">
78             <head>
79             };
80 5 100       14 $self->{ 'scratch' } .= "<link rel='stylesheet' href='style.css' type='text/css' />\n" if $self->{ 'css_tags' };
81 5         8 $self->{ 'scratch' } .= q{</head><body>};
82              
83 5         15 $self->emit( 'nowrap' );
84              
85             }
86             } ## end sub start_Document
87              
88             # Override inherited functions to handle self-contained tags and proper closing of tags.
89              
90 22     22 0 5541 sub start_Para { $_[ 0 ]{ 'scratch' } .= '<p>' }
91              
92             sub start_item_text {
93              
94 2 100   2 0 617 $_[ 0 ]{ 'scratch' } .= "</li>\n"
95             if exists $_[ 0 ]{ 'li_opened' };
96              
97 2         4 $_[ 0 ]{ 'li_opened' }++;
98 2         6 $_[ 0 ]{ 'scratch' } .= "<li>";
99              
100             }
101              
102 2     2 0 42 sub end_item_text { }
103 1     1 0 130 sub end_over_text { $_[ 0 ]{ 'scratch' } .= "</li>\n</ul>"; $_[ 0 ]->emit( 'nowrap' ) }
  1         4  
104              
105 1 50   1 0 56 sub end_F { $_[ 0 ]{ 'scratch' } .= ( $_[ 0 ]{ 'in_figure' } ) ? '" />' : '</em>' }
106 1     1 0 51 sub end_Z { $_[ 0 ]{ 'scratch' } .= '" />' }
107              
108             1; # End of Pod::PseudoPod::XHTML
109              
110              
111             __END__
112             =pod
113              
114             =head1 NAME
115              
116             Pod::PseudoPod::XHTML - format PseudoPod as valid XHTML
117              
118             =head1 VERSION
119              
120             version 1.02
121              
122             =head1 SYNOPSIS
123              
124             use Pod::PseudoPod::XHTML;
125              
126             my $parser = Pod::PseudoPod::XHTML->new();
127             $parser->parse_file('path/to/file.pod');
128              
129             =head1 DESCRIPTION
130              
131             This class is a formatter that takes PseudoPod and renders it as
132             valid XHTML.
133              
134             This is a subclass of L<Pod::PseudoPod::HTML>, and from there
135             L<Pod::PseudoPod>, and inherits all their methods.
136              
137             This code has been shamelessly ripped off from L<Pod::PseudoPod::HTML> and
138             jmcnamara's work on the Modern Perl epub book generator and massaged to work.
139              
140             =head1 NAME
141              
142             =head1 EXPORT
143              
144             Nothing is exported.
145              
146             =head1 METHODS
147              
148             =head2 dtd_strict
149              
150             Use the Strict DTD. (Default)
151              
152             =head2 dtd_transitional
153              
154             Use the Transitional DTD.
155              
156             =head1 SEE ALSO
157              
158             L<Pod::PseudoPod::HTML>, L<Pod::PseudoPod>, L<Pod::Simple>
159              
160             =head1 AUTHOR
161              
162             Alan Young, C<< <harleypig at gmail.com> >>
163              
164             =head1 BUGS
165              
166             This project is hosted on github
167             (L<http://github.com/harleypig/Pod-PseudoPod-XHTML>). I'll see any issues
168             submitted there much faster than anywhere else.
169              
170             You may also report any bugs or feature requests to C<bug-pod-pseudopod-xhtml at
171             rt.cpan.org>, or through the web interface at
172             L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Pod-PseudoPod-XHTML>. I will
173             be notified, and then you'll automatically be notified of progress on your bug
174             as I make changes.
175              
176             =head1 SUPPORT
177              
178             You can find documentation for this module with the perldoc command.
179              
180             perldoc Pod::PseudoPod::XHTML
181              
182             You can also look for information at:
183              
184             =over 4
185              
186             =item * github
187              
188             L<http://github.com/harleypig/Pod-PseudoPod-XHTML>
189              
190             =item * RT: CPAN's request tracker
191              
192             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Pod-PseudoPod-XHTML>
193              
194             =item * AnnoCPAN: Annotated CPAN documentation
195              
196             L<http://annocpan.org/dist/Pod-PseudoPod-XHTML>
197              
198             =item * CPAN Ratings
199              
200             L<http://cpanratings.perl.org/d/Pod-PseudoPod-XHTML>
201              
202             =item * Search CPAN
203              
204             L<http://search.cpan.org/dist/Pod-PseudoPod-XHTML/>
205              
206             =back
207              
208             =head1 ACKNOWLEDGEMENTS
209              
210             jmcnamara, Allison Randall, Larry Wall, the whole perl community
211              
212             =head1 LICENSE AND COPYRIGHT
213              
214             Copyright 2010 Alan Young.
215              
216             This program is free software; you can redistribute it and/or modify it
217             under the terms of either: the GNU General Public License as published
218             by the Free Software Foundation; or the Artistic License.
219              
220             See http://dev.perl.org/licenses/ for more information.
221              
222             =for Pod::Coverage end_F end_Z end_item_text end_over_text start_Document start_Para start_item_text
223              
224             =head1 AUTHOR
225              
226             Alan Young <harleypig@gmail.com>
227              
228             =head1 COPYRIGHT AND LICENSE
229              
230             This software is copyright (c) 2010 by Alan Young.
231              
232             This is free software; you can redistribute it and/or modify it under
233             the same terms as the Perl 5 programming language system itself.
234              
235             =cut
236