home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / XMLOutStream.pm < prev    next >
Encoding:
Text File  |  2003-11-01  |  3.4 KB  |  138 lines
  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>
  117.  
  118. The older libraries L<Pod::PXML>, L<Pod::XML>, L<Pod::SAX>
  119.  
  120.  
  121. =head1 COPYRIGHT AND DISCLAIMERS
  122.  
  123. Copyright (c) 2002 Sean M. Burke.  All rights reserved.
  124.  
  125. This library is free software; you can redistribute it and/or modify it
  126. under the same terms as Perl itself.
  127.  
  128. This program is distributed in the hope that it will be useful, but
  129. without any warranty; without even the implied warranty of
  130. merchantability or fitness for a particular purpose.
  131.  
  132. =head1 AUTHOR
  133.  
  134. Sean M. Burke C<sburke@cpan.org>
  135.  
  136. =cut
  137.  
  138.