xref: /openbsd-src/gnu/usr.bin/perl/cpan/Pod-Simple/lib/Pod/Simple/XMLOutStream.pm (revision 91f110e064cd7c194e59e019b83bb7496c1c84d4)
1
2require 5;
3package Pod::Simple::XMLOutStream;
4use strict;
5use Carp ();
6use Pod::Simple ();
7use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS);
8$VERSION = '3.28';
9BEGIN {
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
19sub new {
20  my $self = shift;
21  my $new = $self->SUPER::new(@_);
22  $new->{'output_fh'} ||= *STDOUT{IO};
23  $new->keep_encoding_directive(1);
24  #$new->accept_codes('VerbatimFormatted');
25  return $new;
26}
27
28#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
29
30sub _handle_element_start {
31  # ($self, $element_name, $attr_hash_r)
32  my $fh = $_[0]{'output_fh'};
33  my($key, $value);
34  DEBUG and print "++ $_[1]\n";
35  print $fh "<", $_[1];
36  if($SORT_ATTRS) {
37    foreach my $key (sort keys %{$_[2]}) {
38      unless($key =~ m/^~/s) {
39        next if $key eq 'start_line' and $_[0]{'hide_line_numbers'};
40        _xml_escape($value = $_[2]{$key});
41        print $fh $ATTR_PAD, $key, '="', $value, '"';
42      }
43    }
44  } else { # faster
45    while(($key,$value) = each %{$_[2]}) {
46      unless($key =~ m/^~/s) {
47        next if $key eq 'start_line' and $_[0]{'hide_line_numbers'};
48        _xml_escape($value);
49        print $fh $ATTR_PAD, $key, '="', $value, '"';
50      }
51    }
52  }
53  print $fh ">";
54  return;
55}
56
57sub _handle_text {
58  DEBUG and print "== \"$_[1]\"\n";
59  if(length $_[1]) {
60    my $text = $_[1];
61    _xml_escape($text);
62    print {$_[0]{'output_fh'}} $text;
63  }
64  return;
65}
66
67sub _handle_element_end {
68  DEBUG and print "-- $_[1]\n";
69  print {$_[0]{'output_fh'}} "</", $_[1], ">";
70  return;
71}
72
73# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
74#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
75
76sub _xml_escape {
77  foreach my $x (@_) {
78    # Escape things very cautiously:
79    $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg;
80    # Yes, stipulate the list without a range, so that this can work right on
81    #  all charsets that this module happens to run under.
82    # Altho, hmm, what about that ord?  Presumably that won't work right
83    #  under non-ASCII charsets.  Something should be done about that.
84  }
85  return;
86}
87
88#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
891;
90
91__END__
92
93=head1 NAME
94
95Pod::Simple::XMLOutStream -- turn Pod into XML
96
97=head1 SYNOPSIS
98
99  perl -MPod::Simple::XMLOutStream -e \
100   "exit Pod::Simple::XMLOutStream->filter(shift)->any_errata_seen" \
101   thingy.pod
102
103=head1 DESCRIPTION
104
105Pod::Simple::XMLOutStream is a subclass of L<Pod::Simple> that parses
106Pod and turns it into XML.
107
108Pod::Simple::XMLOutStream inherits methods from
109L<Pod::Simple>.
110
111
112=head1 SEE ALSO
113
114L<Pod::Simple::DumpAsXML> is rather like this class; see its
115documentation for a discussion of the differences.
116
117L<Pod::Simple>, L<Pod::Simple::DumpAsXML>, L<Pod::SAX>
118
119L<Pod::Simple::Subclassing>
120
121The older (and possibly obsolete) libraries L<Pod::PXML>, L<Pod::XML>
122
123
124=head1 ABOUT EXTENDING POD
125
126TODO: An example or two of =extend, then point to Pod::Simple::Subclassing
127
128
129=head1 ASK ME!
130
131If you actually want to use Pod as a format that you want to render to
132XML (particularly if to an XML instance with more elements than normal
133Pod has), please email me (C<sburke@cpan.org>) and I'll probably have
134some recommendations.
135
136For reasons of concision and energetic laziness, some methods and
137options in this module (and the dozen modules it depends on) are
138undocumented; but one of those undocumented bits might be just what
139you're looking for.
140
141=head1 SEE ALSO
142
143L<Pod::Simple>, L<Pod::Simple::Text>, L<Pod::Spell>
144
145=head1 SUPPORT
146
147Questions or discussion about POD and Pod::Simple should be sent to the
148pod-people@perl.org mail list. Send an empty email to
149pod-people-subscribe@perl.org to subscribe.
150
151This module is managed in an open GitHub repository,
152L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
153to clone L<git://github.com/theory/pod-simple.git> and send patches!
154
155Patches against Pod::Simple are welcome. Please send bug reports to
156<bug-pod-simple@rt.cpan.org>.
157
158=head1 COPYRIGHT AND DISCLAIMERS
159
160Copyright (c) 2002-2004 Sean M. Burke.
161
162This library is free software; you can redistribute it and/or modify it
163under the same terms as Perl itself.
164
165This program is distributed in the hope that it will be useful, but
166without any warranty; without even the implied warranty of
167merchantability or fitness for a particular purpose.
168
169=head1 AUTHOR
170
171Pod::Simple was created by Sean M. Burke <sburke@cpan.org>.
172But don't bother him, he's retired.
173
174Pod::Simple is maintained by:
175
176=over
177
178=item * Allison Randal C<allison@perl.org>
179
180=item * Hans Dieter Pearcey C<hdp@cpan.org>
181
182=item * David E. Wheeler C<dwheeler@cpan.org>
183
184=back
185
186=cut
187