view release on metacpan or  search on metacpan

lib/SGML/DTD.pm  view on Meta::CPAN

##---------------------------------------------------------------------------
sub is_group_connector {
    my $class = shift;
    my $str = shift;

    $str =~ /^\s*[$seq$and$or]\s*$/oi ? 1 : 0;
}

##---------------------------------------------------------------------------
##	is_tag_name() returns 1 if $word is a legal tag name.
##
sub is_tag_name {
    my $class = shift;
    my $word = shift;

    $word =~ /^\s*[$namechars]+\s*$/oi ? 1 : 0;
}

##---------------------------------------------------------------------------
##	print_tree() outputs the tree hierarchy of $elem to the
##	filehandle specified by $handle.  $depth specifies the maximum
##	depth of the tree.
##
##      The routine cuts at elements that exist at
##      higher (or equal) levels or if $MaxLevel has been reached.  The
##      string "..." is appended to an element if has been cut-off due
##      to pre-existance at a higher (or equal) level.
##
##      Cutting the tree at repeat elements is necessary to avoid
##      a combinatorical explosion with recursive element definitions.
##      Plus, it does not make much since to repeat information.
##
sub print_tree {
    my $this = shift;
    my($elem, $depth, $handle) = @_;
    local(%inc, %exc, %done, %open, @padlen);

    $MaxLevel = $depth if ($depth > 0);
    $TreeFile = $handle if $handle;
    &print_elem($elem, 1, 1);
    $elem =~ tr/A-Z/a-z/;

    ## The following subroutines rely on the dynamic scoping of
    ## local variables defined in this routine.
    ##
    $this->compute_levels($elem, 1);	# Compute prune values
    %inc = (); %exc = (); @padlen = (0);
    $this->print_sub_tree($elem, 2);	# Print tree
}

##---------------------------------------------------------------------------
##	reset() initializes all instance variables.
##
sub reset {
    my $this = shift;

    $this->{ParEntity} 		= {}; # Int parameter entities
    $this->{PubParEntity} 	= {}; # Ext public parameter entities
    $this->{SysParEntity} 	= {}; # Ext system parameter entities
    $this->{GenEntity} 		= {}; # (pcdata) general entities
    $this->{StartTagEntity} 	= {}; # Start tag entities (STARTTAG)
    $this->{EndTagEntity} 	= {}; # End tag entities (ENDTAG)
    $this->{MSEntity} 		= {}; # Marked section ents (MS)
    $this->{MDEntity} 		= {}; # Markup declaration ents (MD)
    $this->{PIEntity} 		= {}; # Processing instructions ents (PI)
    $this->{CDataEntity} 	= {}; # Character data entities (CDATA)
    $this->{SDataEntity} 	= {}; # System data ents (SDATA)

    ## Following ent structures currently not used.
    $this->{PubEntity} 		= {}; # External public ents (PUBLIC)
    $this->{SysEntity} 		= {}; # External system ents (SYSTEM)
    $this->{SysCDEntity} 	= {}; # Ext cdata ents (SYSTEM CDATA)
    $this->{SysNDEntity} 	= {}; # Ext non-SGML ents (SYSTEM NDATA)
    $this->{SysSDEntity} 	= {}; # Ext sdata ents (SYSTEM SDATA)
    $this->{SysSubDEntity} 	= {}; # Ext sub doc ents (SYSTEM SUBDOC)

    $this->{SysNotation} 	= {}; # Notations w/SYSTEM ids
    $this->{PubNotation} 	= {}; # Notations w/PUBLIC ids

    $this->{ShortRef} 		= {}; # Short ref mappings
    $this->{UseMap} 		= {}; # Maps in use (<!USEMAP ...)

    $this->{ElemCont} 		= {}; # Element base content model
    $this->{ElemInc} 		= {}; # Element inclusions
    $this->{ElemExc} 		= {}; # Element exclusions
    $this->{ElemTag} 		= {}; # Element tag minimization
    $this->{Attribute} 		= {}; # Element attributes
    $this->{ElemsOfAttr} 	= {}; # Elements that have attribute

    $this->{ParEntities}    	= []; # Order parameter ents declared
    $this->{GenEntities}    	= []; # Order general ents declared
    $this->{Elements}       	= []; # Order elements declared

    $this->{_DidParents}	= 0;  # Flag is parents computed
    $this->{Parents}		= {}; # Parents of an element
    $this->{TopElement}		= {}; # Top-most elements

    $this->{_AGE} 		= {}; # Internal ent tracking

    $this->{DocType}		= ""; # Document type (if declared)
}

##---------------------------------------------------------------------------##
##				PARSE METHODS				     ##
##---------------------------------------------------------------------------##
##  Notes:
##	The parsing routines have a specific calling sequence.  Many
##	of the routines rely on other routines updating the current
##	parsed line.  Many of them pass the current line by reference.
##	This may look ugly, but hey, it works.
##
##	See individual routine declaration for more information.
##---------------------------------------------------------------------------

##---------------------------------------------------------------------------
##	read_dtd() parses the contents of an open file specified by
##	$handle.  A 1 is returned on successful parsing, and a 0
##	is returned if failed.  The $include argument is for internal
##	use and not meant for external routines.
##
sub read_dtd {
    my $this = shift;

    my($handle, $include) = @_;
    my($line, $c);
    my($oldslash) = $/;
    my($old) = select($handle);

    ## Eval main loop to catch fatal errors
    eval {
      DTDBLK: {
	$include = $IncMS unless $include;

lib/SGML/DTD.pm  view on Meta::CPAN

	    $fh = $EntMan->open_entity("%ent", $pubid, $sysid);
	    last BLK;
	}
	&errMsg("Warning: Unable to resolve entity reference: $ent\n");
    }

    $fh;
}

##---------------------------------------------------------------------------
##	do_parm_entity() parses a parameter entity definition.
##
sub do_parm_entity {
    my $this = shift;
    my($line) = @_;
    my($name, $value);

    $$line =~ s/^\s*$pero?\s+//o;	  # Remove pero, '%'
    $$line =~ s/^(\S+)\s+//; $name = $1;   # Get entity name

    if ($$line =~ s/^$PUBLIC\s+//io) {	  	# PUBLIC external parm entity
	$this->{PubParEntity}{$name} = &get_next_group($line)
	    unless defined($this->{PubParEntity}{$name});

    } elsif ($$line =~ s/^$SYSTEM\s+//io) {	# SYSTEM external parm entity
	$this->{SysParEntity}{$name} = &get_next_group($line)
	    unless defined($this->{SysParEntity}{$name});

    } else {				  	# Regular parm entity
	if (!defined($this->{ParEntity}{$name})) {
	    $value = &get_next_group($line);
	    &del_comments(\$value);
	    $this->{ParEntity}{$name} = $value;
	    push(@{$this->{ParEntities}}, $name);
	}
    }
}

##---------------------------------------------------------------------------
##	do_gen_entity() parses a general entity definition.
##
sub do_gen_entity {
    my $this = shift;
    my($line) = @_;
    my($name, $tmp);

    $$line =~ s/^\s*(\S+)\s+//; $name = $1;   # Get entity name
    &debugMsg("$ENTITY $name\n");
    $tmp = &get_next_group($line);
    GENSW: {
	$this->do_ge_starttag($name, $line), last GENSW
	    if $tmp =~ /^\s*$STARTTAG\s*$/io;
	$this->do_ge_endtag($name, $line), last GENSW
	    if $tmp =~ /^\s*$ENDTAG\s*$/io;
	$this->do_ge_ms($name, $line), last GENSW
	    if $tmp =~ /^\s*$MS\s*$/io;
	$this->do_ge_md($name, $line), last GENSW
	    if $tmp =~ /^\s*$MD\s*$/io;
	$this->do_ge_pi($name, $line), last GENSW
	    if $tmp =~ /^\s*$PI\s*$/io;
	$this->do_ge_cdata($name, $line), last GENSW
	    if $tmp =~ /^\s*$CDATA\s*$/io;
	$this->do_ge_sdata($name, $line), last GENSW
	    if $tmp =~ /^\s*$SDATA\s*$/io;
	$this->do_ge_public($name, $line), last GENSW
	    if $tmp =~ /^\s*$PUBLIC\s*$/io;
	$this->do_ge_system($name, $line), last GENSW
	    if $tmp =~ /^\s*$SYSTEM\s*$/io;
	$this->{_AGE}{$name} = $this->{GenEntity}{$name} = $tmp;
    }
    push(@{$this->{GenEntities}}, $name);
}

##---------------------------------------------------------------------------
sub do_ge_starttag {
    my $this = shift;
    my($name, $line) = @_;
    my($tmp);

    $tmp = &get_next_group($line);
    $this->{StartTagEntity}{$name} = $tmp;
}

sub do_ge_endtag {
    my $this = shift;
    my($name, $line) = @_;
    my($tmp);

    $tmp = &get_next_group($line);
    $this->{EndTagEntity}{$name} = $tmp;
}

sub do_ge_ms {
    my $this = shift;
    my($name, $line) = @_;
    my($tmp);

    $tmp = &get_next_group($line);
    $this->{MSEntity}{$name} = $tmp;
    $this->{_AGE}{$name} = $mdo_ . $dso_ . $tmp . $msc_ . $mdc_;
}

sub do_ge_md {
    my $this = shift;
    my($name, $line) = @_;
    my($tmp);

    $tmp = &get_next_group($line);
    $this->{MDEntity}{$name} = $tmp;
    $this->{_AGE}{$name} = $mdo_ . $tmp . $mdc_;
}

sub do_ge_pi {
    my $this = shift;
    my($name, $line) = @_;
    my($tmp);

    $tmp = &get_next_group($line);
    $this->{PIEntity}{$name} = $tmp;
    $this->{_AGE}{$name} = $pio_ . $tmp . $pic_;
}

sub do_ge_cdata {
    my $this = shift;
    my($name, $line) = @_;
    my($tmp);

    $tmp = &get_next_group($line);
    $this->{CDataEntity}{$name} = $tmp;
}

sub do_ge_sdata {
    my $this = shift;
    my($name, $line) = @_;
    my($tmp);

    $tmp = &get_next_group($line);
    $this->{SDataEntity}{$name} = $tmp;
}

sub do_ge_public {
    my $this = shift;
    my($name, $line) = @_;
    &errMsg("Warning: General $PUBLIC entity skipped\n");
}

sub do_ge_system {
    my $this = shift;
    my($name, $line) = @_;
    &errMsg("Warning: General $SYSTEM entity skipped\n");
}

##---------------------------------------------------------------------------
##	compute_parents() generates the %Parents and %TopElement arrays.
##
sub compute_parents {
    my $this = shift;

    return  if $this->{_DidParents};

    my($elem, %exc, @array);

    foreach $elem ($this->get_elements()) {
        foreach (&extract_elem_names($this->{ElemExc}{$elem})) {
	    $exc{$_} = 1;
	}

	@array = (&extract_elem_names($this->{ElemCont}{$elem}),
		  &extract_elem_names($this->{ElemInc}{$elem}));
	&remove_dups(\@array);

	foreach (@array) {
	    push(@{$this->{Parents}{$_}}, $elem)
		unless $exc{$_} || !$this->is_element($_);
	}
        %exc = ();
    }
    foreach (keys %{$this->{ElemCont}}) {
	$this->{TopElement}{$_} = 1
	    if !$this->{Parents}{$_} or $this->{Parents}{$_} eq $_;
    }
    $this->{_DidParents} = 1;
}