[Summary view] [Print] [Text view]

   1  # $Id: PerlSAX.pm,v 1.6 2000/02/28 10:40:21 matt Exp $
   2  
   3  package XML::XPath::PerlSAX;
   4  use XML::XPath::XMLParser;
   5  use strict;
   6  
   7  sub new {
   8      my $class = shift;
   9      my %args = @_;
  10      bless \%args, $class;
  11  }
  12  
  13  sub parse {
  14      my $self = shift;
  15  
  16      die "XML::XPath::PerlSAX: parser instance ($self) already parsing\n"
  17          if (defined $self->{ParseOptions});
  18  
  19      # If there's one arg and it's an array ref, assume it's a node we're parsing
  20      my $args;
  21      if (@_ == 1 && ref($_[0]) =~ /^(text|comment|element|namespace|attribute|pi)$/) {
  22  #        warn "Parsing node\n";
  23          my $node = shift;
  24  #        warn "PARSING: $node ", XML::XPath::XMLParser::as_string($node), "\n\n";
  25          $args = { Source => { Node => $node } };
  26      }
  27      else {
  28          $args = (@_ == 1) ? shift : { @_ };
  29      }
  30  
  31      my $parse_options = { %$self, %$args };
  32      $self->{ParseOptions} = $parse_options;
  33  
  34      # ensure that we have at least one source
  35      if (!defined $parse_options->{Source} ||
  36          !defined $parse_options->{Source}{Node}) {
  37          die "XML::XPath::PerlSAX: no source defined for parse\n";
  38      }
  39  
  40      # assign default Handler to any undefined handlers
  41      if (defined $parse_options->{Handler}) {
  42          $parse_options->{DocumentHandler} = $parse_options->{Handler}
  43              if (!defined $parse_options->{DocumentHandler});
  44      }
  45  
  46      # ensure that we have a DocumentHandler
  47      if (!defined $parse_options->{DocumentHandler}) {
  48          die "XML::XPath::PerlSAX: no Handler or DocumentHandler defined for parse\n";
  49      }
  50  
  51      # cache DocumentHandler in self for callbacks
  52      $self->{DocumentHandler} = $parse_options->{DocumentHandler};
  53  
  54      if ((ref($parse_options->{Source}{Node}) eq 'element') &&
  55              !($parse_options->{Source}{Node}->[node_parent])) {
  56          # Got root node
  57          $self->{DocumentHandler}->start_document( { } );
  58          $self->parse_node($parse_options->{Source}{Node});
  59          return $self->{DocumentHandler}->end_document( { } );
  60      }
  61      else {
  62          $self->parse_node($parse_options->{Source}{Node});
  63      }
  64  
  65      # clean up parser instance
  66      delete $self->{ParseOptions};
  67      delete $self->{DocumentHandler};
  68  
  69  }
  70  
  71  sub parse_node {
  72      my $self = shift;
  73      my $node = shift;
  74  #    warn "parse_node $node\n";
  75      if (ref($node) eq 'element' && $node->[node_parent]) {
  76          # bundle up attributes
  77          my @attribs;
  78          foreach my $attr (@{$node->[node_attribs]}) {
  79              if ($attr->[node_prefix]) {
  80                  push @attribs, $attr->[node_prefix] . ":" . $attr->[node_key];
  81              }
  82              else {
  83                  push @attribs, $attr->[node_key];
  84              }
  85              push @attribs, $attr->[node_value];
  86          }
  87          
  88          $self->{DocumentHandler}->start_element(
  89                  { Name => $node->[node_name],
  90                    Attributes => \@attribs,
  91                  }
  92              );
  93          foreach my $kid (@{$node->[node_children]}) {
  94              $self->parse_node($kid);
  95          }
  96          $self->{DocumentHandler}->end_element(
  97                  {
  98                      Name => $node->[node_name],
  99                  }
 100              );
 101      }
 102      elsif (ref($node) eq 'text') {
 103          $self->{DocumentHandler}->characters($node->[node_text]);
 104      }
 105      elsif (ref($node) eq 'comment') {
 106          $self->{DocumentHandler}->comment($node->[node_comment]);
 107      }
 108      elsif (ref($node) eq 'pi') {
 109          $self->{DocumentHandler}->processing_instruction(
 110                  {
 111                      Target => $node->[node_target],
 112                      Data => $node->[node_data]
 113                  }
 114              );
 115      }
 116      elsif (ref($node) eq 'element') { # root node
 117          # just do kids
 118          foreach my $kid (@{$node->[node_children]}) {
 119              $self->parse_node($kid);
 120          }
 121      }
 122      else {
 123          die "Unknown node type: '", ref($node), "' ", scalar(@$node), "\n";
 124      }
 125  }
 126  
 127  1;
 128  
 129  __END__
 130  
 131  =head1 NAME
 132  
 133  XML::XPath::PerlSAX - A PerlSAX event generator for my wierd node structure
 134  
 135  =head1 SYNOPSIS
 136  
 137      use XML::XPath;
 138      use XML::XPath::PerlSAX;
 139      use XML::DOM::PerlSAX;
 140      
 141      my $xp = XML::XPath->new(filename => 'test.xhtml');
 142      my $paras = $xp->find('/html/body/p');
 143      
 144      my $handler = XML::DOM::PerlSAX->new();
 145      my $generator = XML::XPath::PerlSAX->new( Handler => $handler );
 146      
 147      foreach my $node ($paras->get_nodelist) {
 148          my $domtree = $generator->parse($node);
 149          # do something with $domtree
 150      }
 151  
 152  =head1 DESCRIPTION
 153  
 154  This module generates PerlSAX events to pass to a PerlSAX handler such
 155  as XML::DOM::PerlSAX. It operates specifically on my wierd tree format.
 156  
 157  Unfortunately SAX doesn't seem to cope with namespaces, so these are
 158  lost completely. I believe SAX2 is doing namespaces.
 159  
 160  =head1 Other
 161  
 162  The XML::DOM::PerlSAX handler I tried was completely broken (didn't even
 163  compile before I patched it a bit), so I don't know how correct this
 164  is or how far it will work.
 165  
 166  This software may only be distributed as part of the XML::XPath package.