Commit | Line | Data |
3fea05b9 |
1 | |
2 | require 5; |
3 | package Pod::Simple::DumpAsXML; |
4 | $VERSION = '2.02'; |
5 | use Pod::Simple (); |
6 | BEGIN {@ISA = ('Pod::Simple')} |
7 | |
8 | use strict; |
9 | |
10 | use Carp (); |
11 | |
12 | BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG } |
13 | |
14 | sub new { |
15 | my $self = shift; |
16 | my $new = $self->SUPER::new(@_); |
17 | $new->{'output_fh'} ||= *STDOUT{IO}; |
18 | $new->accept_codes('VerbatimFormatted'); |
19 | return $new; |
20 | } |
21 | |
22 | #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ |
23 | |
24 | sub _handle_element_start { |
25 | # ($self, $element_name, $attr_hash_r) |
26 | my $fh = $_[0]{'output_fh'}; |
27 | my($key, $value); |
28 | DEBUG and print "++ $_[1]\n"; |
29 | |
30 | print $fh ' ' x ($_[0]{'indent'} || 0), "<", $_[1]; |
31 | |
32 | foreach my $key (sort keys %{$_[2]}) { |
33 | unless($key =~ m/^~/s) { |
34 | next if $key eq 'start_line' and $_[0]{'hide_line_numbers'}; |
35 | _xml_escape($value = $_[2]{$key}); |
36 | print $fh ' ', $key, '="', $value, '"'; |
37 | } |
38 | } |
39 | |
40 | |
41 | print $fh ">\n"; |
42 | $_[0]{'indent'}++; |
43 | return; |
44 | } |
45 | |
46 | sub _handle_text { |
47 | DEBUG and print "== \"$_[1]\"\n"; |
48 | if(length $_[1]) { |
49 | my $indent = ' ' x $_[0]{'indent'}; |
50 | my $text = $_[1]; |
51 | _xml_escape($text); |
52 | $text =~ # A not-totally-brilliant wrapping algorithm: |
53 | s/( |
54 | [^\n]{55} # Snare some characters from a line |
55 | [^\n\ ]{0,50} # and finish any current word |
56 | ) |
57 | \x20{1,10}(?!\n) # capture some spaces not at line-end |
58 | /$1\n$indent/gx # => line-break here |
59 | ; |
60 | |
61 | print {$_[0]{'output_fh'}} $indent, $text, "\n"; |
62 | } |
63 | return; |
64 | } |
65 | |
66 | sub _handle_element_end { |
67 | DEBUG and print "-- $_[1]\n"; |
68 | print {$_[0]{'output_fh'}} |
69 | ' ' x --$_[0]{'indent'}, "</", $_[1], ">\n"; |
70 | return; |
71 | } |
72 | |
73 | # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . |
74 | |
75 | sub _xml_escape { |
76 | foreach my $x (@_) { |
77 | # Escape things very cautiously: |
78 | $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg; |
79 | # Yes, stipulate the list without a range, so that this can work right on |
80 | # all charsets that this module happens to run under. |
81 | # Altho, hmm, what about that ord? Presumably that won't work right |
82 | # under non-ASCII charsets. Something should be done about that. |
83 | } |
84 | return; |
85 | } |
86 | |
87 | #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ |
88 | 1; |
89 | |
90 | __END__ |
91 | |
92 | =head1 NAME |
93 | |
94 | Pod::Simple::DumpAsXML -- turn Pod into XML |
95 | |
96 | =head1 SYNOPSIS |
97 | |
98 | perl -MPod::Simple::DumpAsXML -e \ |
99 | "exit Pod::Simple::DumpAsXML->filter(shift)->any_errata_seen" \ |
100 | thingy.pod |
101 | |
102 | =head1 DESCRIPTION |
103 | |
104 | Pod::Simple::DumpAsXML is a subclass of L<Pod::Simple> that parses Pod |
105 | and turns it into indented and wrapped XML. This class is of |
106 | interest to people writing Pod formatters based on Pod::Simple. |
107 | |
108 | Pod::Simple::DumpAsXML inherits methods from |
109 | L<Pod::Simple>. |
110 | |
111 | |
112 | =head1 SEE ALSO |
113 | |
114 | L<Pod::Simple::XMLOutStream> is rather like this class. |
115 | Pod::Simple::XMLOutStream's output is space-padded in a way |
116 | that's better for sending to an XML processor (that is, it has |
117 | no ignoreable whitespace). But |
118 | Pod::Simple::DumpAsXML's output is much more human-readable, being |
119 | (more-or-less) one token per line, with line-wrapping. |
120 | |
121 | L<Pod::Simple::DumpAsText> is rather like this class, |
122 | except that it doesn't dump with XML syntax. Try them and see |
123 | which one you like best! |
124 | |
125 | L<Pod::Simple>, L<Pod::Simple::DumpAsXML> |
126 | |
127 | The older libraries L<Pod::PXML>, L<Pod::XML>, L<Pod::SAX> |
128 | |
129 | |
130 | =head1 COPYRIGHT AND DISCLAIMERS |
131 | |
132 | Copyright (c) 2002 Sean M. Burke. All rights reserved. |
133 | |
134 | This library is free software; you can redistribute it and/or modify it |
135 | under the same terms as Perl itself. |
136 | |
137 | This program is distributed in the hope that it will be useful, but |
138 | without any warranty; without even the implied warranty of |
139 | merchantability or fitness for a particular purpose. |
140 | |
141 | =head1 AUTHOR |
142 | |
143 | Sean M. Burke C<sburke@cpan.org> |
144 | |
145 | =cut |
146 | |