local-lib5/lib/perl5/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 = '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