view release on metacpan or  search on metacpan

lib/XML/AutoWriter.pm  view on Meta::CPAN

If start tag autogeneration fails, then end tag autogeneration is attempted.
startTag() scans the stack of currently open tags trying to close as few as
possible before start tag autogeneration suceeds.

Explicit end tags may be emitted to prevent unwanted automatic start
tags, and, in the future, warnings or errors will be available in place
of automatic start and end tag creation.


=head1 METHODS AND FUNCTIONS

All of the routines in this module can be called as either functions
or methods unless otherwise noted.

To call these routines as functions use either the DOCTYPE or
:dtd_tags options in the parameters to the use statement:

   use XML::AutoWriter DOCTYPE => XML::Doctype->new( ... ) ;
   use XML::AutoWriter qw( :dtd_tags ) ;

This associates an XML::AutoWriter and an XML::Doctype with the
package.  These are used by the routines when called as functions.

=over

=cut

=item new

   $writer = XML::AutoWriter->new( DTD => $dtd, OUTPUT => \*FH ) ;

Creates an XML::AutoWriter.

All other parameters are passed to
the XML::ValidWriter base class constructor.

=cut

#sub new is inherited

sub _find_path {
   ## Find a path from $root to $dest by doing a breadth-first
   ## search.  Cache the results as we go to speed us up next time.
   my XML::Doctype $doctype ;
   my ( $root, $dest ) ;
   ( $doctype, $root, $dest ) = @_ ;

   ## Break encapsulation on XML::Doctype for speed.
   my $elts = $doctype->{ELTS} ;
   croak "Unknown tag '$root'" unless exists $elts->{$root} ;
   croak "Unknown tag '$dest'"
      unless $dest eq '#PCDATA' || exists $elts->{$dest} ;

   require XML::Doctype::ElementDecl;
   my XML::Doctype::ElementDecl $root_elt = $elts->{$root} ;
   # print STDERR "searching for $root ... $dest\n" ;

   return []
      if $root_elt->is_any
         || ( $dest eq '#PCDATA' && $root_elt->can_contain_pcdata ) ;

   my $paths = $root_elt->{PATHS} ;
   unless ( $paths ) {
      ## Init the cache
      $paths = $root_elt->{PATHS} = {
         map {( $_ => [] )} $root_elt->child_names
      } ;
      $root_elt->{TODO} = [ $root_elt->child_names ] ;
   }

   ## Check the cache
   return $root_elt->{PATHS}->{$dest}
      if exists $root_elt->{PATHS}->{$dest} ;

   ## Do the search, starting where we left off.  @todo is a list of known
   ## descendant names.  We scan each such name looking for more descendants
   ## until we exhaust the tree or we find the one we're looking for.  We
   ## avoid loops.
   my $todo = $root_elt->{TODO} ;
   while ( @$todo ) {
      # print STDERR "todo: ", join( ' ', @$todo ), "\n" ;

      my $gkid = shift @$todo ;
      # print STDERR "doing $gkid\n" ;
      push @$todo, $elts->{$gkid}->child_names ;

      my $gkid_path = $paths->{$gkid} ;

      if ( $elts->{$gkid}->can_contain_pcdata() ) {
	 $paths->{'#PCDATA'} = [ @$gkid_path, $gkid ]
	    unless exists $paths->{'#PCDATA'} ;
	 # print STDERR "checking (pcdata) ",
	 # join( '', map "<$_>", @{$paths->{'#PCDATA'}} ), "\n" ;
	 if ( $dest eq '#PCDATA' ) {
	    # print STDERR "Yahoo!\n" ;
	    return $paths->{'#PCDATA'} ;
	 }
      }

      for my $ggkid ( $elts->{$gkid}->child_names ) {
	 next if exists $paths->{$ggkid} ;

	 $paths->{$ggkid} = [ @$gkid_path, $gkid ] ;
	 # print STDERR "checking ",
	 # join( '', map "<$_>", @{$paths->{$ggkid}}, $ggkid ), " ($dest)\n" ;
	 if ( $ggkid eq $dest ) {
	    # print STDERR "Yahoo!\n" ;
	    return $paths->{$ggkid}
	 }
      }
   }
   # print STDERR "rats...\n" ;
   return ;
}


=item characters

   characters( 'yabba dabba dooo' ) ;
   $writer->characters( 'yabba dabba dooo' ) ;

If the currently open tag cannot contain #PCDATA, then start tag autogeneration
will be attempted, followed by end tag autogeneration.

Start tag autogeneration takes place even if you pass in only '', or even (),
the empty list.

=cut

sub characters {
   my XML::AutoWriter $self = &XML::ValidWriter::_self ;

   my $stack = $self->{STACK} ;
   my $doctype = $self->{DOCTYPE} ;

   ## Don't re-emit root if it's been emitted, so that the error message
   ## will be about emitting our $tag, not the root tag.
   $self->startTag( $doctype->name )
      if ! @$stack && ! defined $self->{EMITTED_ROOT} ;

   for ( my $i = $#$stack ; $i >= 0 ; --$i ) {
      my XML::VWElement $elt = $stack->[$i];
      my $path = _find_path( $doctype, $elt->{NAME}, '#PCDATA' ) ;

      if ( defined $path ) {
         while ( $#$stack > $i ) {
	    my XML::VWElement $end_elt = $stack->[-1];
	    $self->endTag( $end_elt->{NAME} )
         }
	 $self->SUPER::startTag( $_ ) for @$path ;
	 last ;
      }