Commit | Line | Data |
351625bd |
1 | |
2 | require 5; |
3 | package Pod::Simple::XMLOutStream; |
4 | use strict; |
5 | use Carp (); |
6 | use Pod::Simple (); |
7 | use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS); |
8 | $VERSION = '2.02'; |
9 | BEGIN { |
10 | @ISA = ('Pod::Simple'); |
11 | *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG; |
12 | } |
13 | |
14 | $ATTR_PAD = "\n" unless defined $ATTR_PAD; |
15 | # Don't mess with this unless you know what you're doing. |
16 | |
17 | $SORT_ATTRS = 0 unless defined $SORT_ATTRS; |
18 | |
19 | sub new { |
20 | my $self = shift; |
21 | my $new = $self->SUPER::new(@_); |
22 | $new->{'output_fh'} ||= *STDOUT{IO}; |
23 | #$new->accept_codes('VerbatimFormatted'); |
24 | return $new; |
25 | } |
26 | |
27 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
28 | |
29 | sub _handle_element_start { |
30 | # ($self, $element_name, $attr_hash_r) |
31 | my $fh = $_[0]{'output_fh'}; |
32 | my($key, $value); |
33 | DEBUG and print "++ $_[1]\n"; |
34 | print $fh "<", $_[1]; |
35 | if($SORT_ATTRS) { |
36 | foreach my $key (sort keys %{$_[2]}) { |
37 | unless($key =~ m/^~/s) { |
38 | next if $key eq 'start_line' and $_[0]{'hide_line_numbers'}; |
39 | _xml_escape($value = $_[2]{$key}); |
40 | print $fh $ATTR_PAD, $key, '="', $value, '"'; |
41 | } |
42 | } |
43 | } else { # faster |
44 | while(($key,$value) = each %{$_[2]}) { |
45 | unless($key =~ m/^~/s) { |
46 | next if $key eq 'start_line' and $_[0]{'hide_line_numbers'}; |
47 | _xml_escape($value); |
48 | print $fh $ATTR_PAD, $key, '="', $value, '"'; |
49 | } |
50 | } |
51 | } |
52 | print $fh ">"; |
53 | return; |
54 | } |
55 | |
56 | sub _handle_text { |
57 | DEBUG and print "== \"$_[1]\"\n"; |
58 | if(length $_[1]) { |
59 | my $text = $_[1]; |
60 | _xml_escape($text); |
61 | print {$_[0]{'output_fh'}} $text; |
62 | } |
63 | return; |
64 | } |
65 | |
66 | sub _handle_element_end { |
67 | DEBUG and print "-- $_[1]\n"; |
68 | print {$_[0]{'output_fh'}} "</", $_[1], ">"; |
69 | return; |
70 | } |
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::XMLOutStream -- turn Pod into XML |
95 | |
96 | =head1 SYNOPSIS |
97 | |
98 | perl -MPod::Simple::XMLOutStream -e \ |
99 | "exit Pod::Simple::XMLOutStream->filter(shift)->any_errata_seen" \ |
100 | thingy.pod |
101 | |
102 | =head1 DESCRIPTION |
103 | |
104 | Pod::Simple::XMLOutStream is a subclass of L<Pod::Simple> that parses |
105 | Pod and turns it into XML. |
106 | |
107 | Pod::Simple::XMLOutStream inherits methods from |
108 | L<Pod::Simple>. |
109 | |
110 | |
111 | =head1 SEE ALSO |
112 | |
113 | L<Pod::Simple::DumpAsXML> is rather like this class; see its |
114 | documentation for a discussion of the differences. |
115 | |
116 | L<Pod::Simple>, L<Pod::Simple::DumpAsXML>, L<Pod::SAX> |
117 | |
118 | L<Pod::Simple::Subclassing> |
119 | |
120 | The older (and possibly obsolete) libraries L<Pod::PXML>, L<Pod::XML> |
121 | |
122 | |
123 | =head1 ABOUT EXTENDING POD |
124 | |
125 | TODO: An example or two of =extend, then point to Pod::Simple::Subclassing |
126 | |
127 | |
128 | =head1 ASK ME! |
129 | |
130 | If you actually want to use Pod as a format that you want to render to |
131 | XML (particularly if to an XML instance with more elements than normal |
132 | Pod has), please email me (C<sburke@cpan.org>) and I'll probably have |
133 | some recommendations. |
134 | |
135 | For reasons of concision and energetic laziness, some methods and |
136 | options in this module (and the dozen modules it depends on) are |
137 | undocumented; but one of those undocumented bits might be just what |
138 | you're looking for. |
139 | |
140 | |
141 | =head1 COPYRIGHT AND DISCLAIMERS |
142 | |
143 | Copyright (c) 2002-4 Sean M. Burke. All rights reserved. |
144 | |
145 | This library is free software; you can redistribute it and/or modify it |
146 | under the same terms as Perl itself. |
147 | |
148 | This program is distributed in the hope that it will be useful, but |
149 | without any warranty; without even the implied warranty of |
150 | merchantability or fitness for a particular purpose. |
151 | |
152 | =head1 AUTHOR |
153 | |
154 | Sean M. Burke C<sburke@cpan.org> |
155 | |
156 | =cut |
157 | |