cpan/Pod-Simple/lib/Pod/Simple/XMLOutStream.pm

   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 = '3.13';
   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 =head1 SEE ALSO
 141
 142 L<Pod::Simple>, L<Pod::Simple::Text>, L<Pod::Spell>
 143
 144 =head1 SUPPORT
 145
 146 Questions or discussion about POD and Pod::Simple should be sent to the
 147 pod-people@perl.org mail list. Send an empty email to
 148 pod-people-subscribe@perl.org to subscribe.
 149
 150 This module is managed in an open GitHub repository,
 151 L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
 152 to clone L<git://github.com/theory/pod-simple.git> and send patches!
 153
 154 Patches against Pod::Simple are welcome. Please send bug reports to
 155 <bug-pod-simple@rt.cpan.org>.
 156
 157 =head1 COPYRIGHT AND DISCLAIMERS
 158
 159 Copyright (c) 2002-2004 Sean M. Burke.
 160
 161 This library is free software; you can redistribute it and/or modify it
 162 under the same terms as Perl itself.
 163
 164 This program is distributed in the hope that it will be useful, but
 165 without any warranty; without even the implied warranty of
 166 merchantability or fitness for a particular purpose.
 167
 168 =head1 AUTHOR
 169
 170 Pod::Simple was created by Sean M. Burke <sburke@cpan.org>.
 171 But don't bother him, he's retired.
 172
 173 Pod::Simple is maintained by:
 174
 175 =over
 176
 177 =item * Allison Randal C<allison@perl.org>
 178
 179 =item * Hans Dieter Pearcey C<hdp@cpan.org>
 180
 181 =item * David E. Wheeler C<dwheeler@cpan.org>
 182
 183 =back
 184
 185 =cut