XML::Doctype::ElementDecl - A class representing an <!ELEMENT> tag

   $elt = $dtd->element( 'foo' ) ;
   $elt->name() ;
   $elt->attr( 'foo' ) ;

package XML::Doctype::ElementDecl ;

use strict ;
use vars qw( $VERSION %_default_dtds ) ;
use fields (
   'ATTDEFS',
   'CONTENT',   # 'EMPTY', 'ANY' or a regexp.  undef if ! is_declared().
   'DECLARED',
   'NAME',
   'NAMES',
   'PATHS',     # A hash which XML::ValidWriter uses to cache the paths
                # it finds from this element name to possible child elements.
   'TODO',      # A list of children that XML::ValidWriter has not yet
                # explored for possible inclusion in PATHS.
) ;

use Carp ;
use UNIVERSAL qw( isa ) ;

$VERSION = 0.1 ;

sub _assemble_re {
   ## Convert the tree of XML::Parser::ContentModel instances to a
   ## regular expression and accumulate a HASH of element names in
   ## NAMES.  This hash is later converted to an ARRAY.
   my XML::Doctype::ElementDecl $self = shift ;
   my ( $cp ) = @_ ;

   if ( $cp->isname ) {
      return '(?:#PCDATA)*' if $cp->name eq '#PCDATA' ;
      ${$self->{NAMES}->{$cp->name}} = 1 ;
      return join( '', '<', quotemeta $cp->name, '>' ) unless $cp->quant ;
   }
   
   return join( '', map $self->_assemble_re( $_ ), $cp->children )
      if $cp->isseq && ! $cp->quant ;

   return join( '',
      '(?:',
      $cp->isname
         ? ( '<', quotemeta( $cp->name ), '>' )
      : $cp->isseq
         ? join( '',  map $self->_assemble_re( $_ ), $cp->children )
      : $cp->ischoice
         ? join( '|', map $self->_assemble_re( $_ ), $cp->children )
      : $cp->ismixed
         ? join(
	    '|',
	    '(?:#PCDATA)?',
	    map(
	       defined $_ ? $self->_assemble_re( $_ ) : (),
	       $cp->children
	    )
	 )
      : (),
      ')',
      $cp->quant || ()
   ) ;

}

sub new {
   my XML::Doctype::ElementDecl $self = fields::new( shift );

   my $cm ; # The XML::Expat::ContentModel object for this DECL.
   ( $self->{NAME}, $cm, $self->{ATTDEFS} ) = @_ ;

   if ( $cm ) {
      if ( $cm->isany ) {
	 $self->{CONTENT} = 'ANY' ;
	 $self->{NAMES} = [] ;
      }
      elsif ( $cm->isempty ) {
	 $self->{CONTENT} = 'EMPTY' ;
	 $self->{NAMES} = [] ;
      }
      elsif ( $cm->ismixed || $cm->isseq || $cm->ischoice ) {
	 $self->{NAMES} = {} ;
	 my $re = $self->_assemble_re( $cm ) ;
	 $self->{CONTENT} = "^$re\$" ; # qr/^$re$/ ;
	 $self->{NAMES} = [ $self->{NAMES} ? keys %{$self->{NAMES}} : () ] ;
      }
      else {
	 croak "'$cm' passed for a content model" ;
      }
   }
   else {
      $self->{NAMES} = [] ;
   }

   return $self ;
}


sub _freeze {
   my $self = shift ;
   if ( defined $self->{CONTENT} && ref $self->{CONTENT} eq 'Regexp' ) {
      ## need two assigns to really, really divorce the SV from the
      ## quircky-half-object RegExp type.
      $self->{CONTENT} = '' ;
      $self->{CONTENT} = "$self->{CONTENT}" ;
   }
}

sub add_attdef {
   my XML::Doctype::ElementDecl $self = shift ;
   my ( $attdef ) = @_ ;
   $self->{ATTDEFS}->{$attdef->name} = $attdef ;
}
  

sub attdef {
   my XML::Doctype::ElementDecl $self = shift ;
   my ( $name ) = @_ ;

   return $self->{ATTDEFS}->{$name} if exists $self->{ATTDEFS}->{$name} ;
   return ;
}

sub attdefs {
   my XML::Doctype::ElementDecl $self = shift ;
   my ( $name ) = @_ ;

   return $self->{ATTDEFS} ? values %{$self->{ATTDEFS}} : () ;
}

sub attribute_names {
   my XML::Doctype::ElementDecl $self = shift ;

   return $self->{ATTDEFS} ? keys %{$self->{ATTDEFS}} : () ;
}

sub child_names {
   my XML::Doctype::ElementDecl $self = shift ;

   return @{$self->{NAMES}} ;
}

sub is_declared {
   my XML::Doctype::ElementDecl $self = shift ;

   $self->{DECLARED} = shift if @_ ;

   return $self->{DECLARED} || defined $self->{CONTENT} ;
}

sub is_empty {
   my XML::Doctype::ElementDecl $self = shift ;

   return $self->{CONTENT} && $self->{CONTENT} eq 'EMPTY' ;
}

sub is_any {
   my XML::Doctype::ElementDecl $self = shift ;

   return $self->{CONTENT} && $self->{CONTENT} eq 'ANY' ;
}

sub is_mixed {
   my XML::Doctype::ElementDecl $self = shift ;

   return $self->{CONTENT} && $self->{CONTENT} =~ /#PCDATA/ ;
}

sub can_contain_pcdata {
   my XML::Doctype::ElementDecl $self = shift ;

   return $self->{CONTENT}
      && (
	 $self->{CONTENT} eq 'ANY'
	 || return $self->{CONTENT} =~ /#PCDATA/
      ) ;
}

sub name {
   my XML::Doctype::ElementDecl $self = shift ;

   return $self->{NAME} ;
}

sub validate_content {
   my XML::Doctype::ElementDecl $self = shift ;
   my ( $c ) = @_ ;

   return 1     if ! defined $self->{CONTENT} || $self->{CONTENT} eq 'ANY' ;
   return ! @$c if $self->{CONTENT} eq 'EMPTY' ;

   ## Must be mixed.  If this elt can have no kids, the test
   ## is quick.  Otherwise we need to validate agains the content
   ## model tree.
   my $content_desc = join(
      '',
      map $_ eq '#PCDATA' ? $_ : "<$_>",
      @$c
   ) ;

# print STDERR "$content_desc\n$self->{CONTENT}\n" ;

#print $self->{CONTENT}, "\n" ;

   return $content_desc =~ $self->{CONTENT} ;
}

1 ;