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.35';
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 STDERR "++ $_[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 STDERR "== \"$_[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 STDERR "-- $_[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    if ($] ge 5.007_003) {
80      $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(utf8::native_to_unicode(ord($1))).';'/eg;
81    } else { # Is broken for non-ASCII platforms on early perls
82      $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg;
83    }
84    # Yes, stipulate the list without a range, so that this can work right on
85    #  all charsets that this module happens to run under.
86  }
87  return;
88}
89
90#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
911;
92
93__END__
94
95=head1 NAME
96
97Pod::Simple::XMLOutStream -- turn Pod into XML
98
99=head1 SYNOPSIS
100
101  perl -MPod::Simple::XMLOutStream -e \
102   "exit Pod::Simple::XMLOutStream->filter(shift)->any_errata_seen" \
103   thingy.pod
104
105=head1 DESCRIPTION
106
107Pod::Simple::XMLOutStream is a subclass of L<Pod::Simple> that parses
108Pod and turns it into XML.
109
110Pod::Simple::XMLOutStream inherits methods from
111L<Pod::Simple>.
112
113
114=head1 SEE ALSO
115
116L<Pod::Simple::DumpAsXML> is rather like this class; see its
117documentation for a discussion of the differences.
118
119L<Pod::Simple>, L<Pod::Simple::DumpAsXML>, L<Pod::SAX>
120
121L<Pod::Simple::Subclassing>
122
123The older (and possibly obsolete) libraries L<Pod::PXML>, L<Pod::XML>
124
125
126=head1 ABOUT EXTENDING POD
127
128TODO: An example or two of =extend, then point to Pod::Simple::Subclassing
129
130=head1 SEE ALSO
131
132L<Pod::Simple>, L<Pod::Simple::Text>, L<Pod::Spell>
133
134=head1 SUPPORT
135
136Questions or discussion about POD and Pod::Simple should be sent to the
137pod-people@perl.org mail list. Send an empty email to
138pod-people-subscribe@perl.org to subscribe.
139
140This module is managed in an open GitHub repository,
141L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
142to clone L<git://github.com/perl-pod/pod-simple.git> and send patches!
143
144Patches against Pod::Simple are welcome. Please send bug reports to
145<bug-pod-simple@rt.cpan.org>.
146
147=head1 COPYRIGHT AND DISCLAIMERS
148
149Copyright (c) 2002-2004 Sean M. Burke.
150
151This library is free software; you can redistribute it and/or modify it
152under the same terms as Perl itself.
153
154This program is distributed in the hope that it will be useful, but
155without any warranty; without even the implied warranty of
156merchantability or fitness for a particular purpose.
157
158=head1 AUTHOR
159
160Pod::Simple was created by Sean M. Burke <sburke@cpan.org>.
161But don't bother him, he's retired.
162
163Pod::Simple is maintained by:
164
165=over
166
167=item * Allison Randal C<allison@perl.org>
168
169=item * Hans Dieter Pearcey C<hdp@cpan.org>
170
171=item * David E. Wheeler C<dwheeler@cpan.org>
172
173=back
174
175=cut
176