[Summary view] [Print] [Text view]

   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