diff options
Diffstat (limited to 'Master/texmf-dist/source/latex/stex/bin/rng2dot/ModelRNC.pm')
-rw-r--r-- | Master/texmf-dist/source/latex/stex/bin/rng2dot/ModelRNC.pm | 770 |
1 files changed, 0 insertions, 770 deletions
diff --git a/Master/texmf-dist/source/latex/stex/bin/rng2dot/ModelRNC.pm b/Master/texmf-dist/source/latex/stex/bin/rng2dot/ModelRNC.pm deleted file mode 100644 index 53673e37dc8..00000000000 --- a/Master/texmf-dist/source/latex/stex/bin/rng2dot/ModelRNC.pm +++ /dev/null @@ -1,770 +0,0 @@ -# anything that starts with # is removed until \n (considered as a comment) -# except in literals; -# -# NCName is limited to a-zA-Z0-9.-_ -# -# no proper support for except nameClass -# no support for exceptPatterns - -package ModelRNC; - -use strict; -use File::Basename; - -my $DOCUMENT = '_Document_'; - -sub new{ - my ($class) = @_; - my $self = {}; - $self->{literalCount} = 0; - bless($self, $class); -} - -# this is the main method of the package -# it should be called right after new -sub process{ - my ($self, $filename) = @_; - $self->readfile($filename); - $self->clean_rnc; - $self->read_topLevel; - $self->build_info; - # free some memory - $self->{DATA} = ''; $self->{FILEPATH} = ''; $self->{GRAPH} = ''; -} - -sub Error{ - my ($self, $msg) = @_; - print "'$self->{DATA}'\n"; - die $msg."\n"; -} - -# read a file into $storage; -# or $self->{DATA} if $storage not given -sub readfile{ - my ($self, $filename, $storage) = @_; - - # NOTE: this is not exactly perfect - if ($self->{FILEPATH}){ - $filename = $self->{FILEPATH}.$filename unless -e $filename; } - my $basepath = dirname($filename); - $basepath .= '/' if ($basepath && $basepath !~ m|/$|); - $self->{FILEPATH} = $basepath; - - open(FIN, $filename) or $self->Error("Cout not open '$filename'"); - my @data = <FIN>; - close(FIN); - - # for use in namespace set selection - push(@{$self->{LOADEDFILES}}, $filename); - - if (defined $storage){ $$storage = join('',@data); } - else { $self->{DATA} = join('',@data); } -} - -# remove lines after ## -sub remove_annotations{ - my ($self, $data) = @_; - $data = \$self->{DATA} unless $data; - do {} while ($$data =~ s/\[[^\]\[]*\]//g); - $$data =~ s/\#\#[^\n]*//g; -} - -# remove all lines that start with # except -# the ones that start with ## -sub remove_comments{ - my ($self, $data) =@_; - $data = \$self->{DATA} unless $data; - $$data =~ s/\#[^\#\n][^\n]*//g; - $$data =~ s/\#\n/\n/g; -} - -sub scan_literals{ - my ($self, $data) = @_; - my @litseg; my $seg = 0; - $data = \$self->{DATA} unless $data; - while ($$data =~ s/\"\"\"((\"{0,2}[^\"])*)\"\"\"/_LITSEG$seg/) { $litseg[$seg++] = $1; } - while ($$data =~ s/\'\'\'((\'{0,2}[^\'])*)\'\'\'/_LITSEG$seg/) { $litseg[$seg++] = $1; } - while ($$data =~ s/\"([^\"\n]*)\"/_LITSEG$seg/) { $litseg[$seg++] = $1; } - while ($$data =~ s/\'([^\'\n]*)\'/_LITSEG$seg/) { $litseg[$seg++] = $1; } - - while ($$data =~ s/_LITSEG(\d+)\s*~\s*_LITSEG(\d+)/_LITSEG$seg/) - { $litseg[$seg++] = $litseg[$1].$litseg[$2]; } - - while ($$data =~ s/_LITSEG(\d+)/!LIT$self->{literalCount}/) - { $self->{literals}[$self->{literalCount}++] = $litseg[$1]; } -} - -# remove \x{N} sections -sub special_chars{ - my ($self, $data) = @_; - $data = \$self->{DATA} unless $data; - while ($$data =~ m/\\x\{([a-fA-F0-9x]+)\}/g){ - my $lng = length($&); my $p = pos($$data) - $lng; - substr($$data, $p, $lng) = chr(hex($1)); - pos($$data) = $p + 1; - } -} - -# remove redundant data from loaded file -sub clean_rnc{ - my ($self, $data) = @_; - $data = \$self->{DATA} unless $data; - $self->scan_literals($data); - $self->special_chars($data); - $self->remove_annotations($data); - $self->remove_comments($data); - # add a newline, just in case the last word is a keyword - # and for nice printing; - $$data.="\n"; -} - -# in the processing of the data, the data is destroyed -# provide two methods for resolving that -sub backup{ - my ($self) = @_; - $self->{BACKUP_DATA} = $self->{DATA}; -} - -sub restore{ - my ($self) = @_; - $self->{DATA} = $self->{BACKUP_DATA} if defined $self->{BACKUP_DATA}; -} - -# set or retrieve stored data -sub data{ - my ($self, $newdata) = @_; - if (defined $newdata){ $self->{DATA} = $newdata; } - else { return $self->{DATA}; } -} - -# put back some extracted string from DATA -sub put_back{ - my ($self, $back) = @_; - substr($self->{DATA}, 0, 0) = $back; -} - -# try to match a keyword; return 1 on success; 0 on failure -# NOTE: this implies that the used keywords should be followed by -# some non alphanumeric or space character -sub read_keyword{ - my ($self, $keyword) = @_; - return 0 if ($self->{DATA} !~ /^\s*\Q$keyword\E\s*[^a-zA-Z0-9_\-\.]/); - substr($self->{DATA}, 0, length($&)-1) = ''; - return 1; -} - -# same as read_keyword, except it dies not expect a non-word character -# after the word it searches -sub read_controlword{ - my ($self, $controlword) = @_; - return 0 if ($self->{DATA} !~ /^\s*\Q$controlword\E\s*/); - substr($self->{DATA},0,length($&)) = ''; - return 1; -} - -# expect a keyword; if the word is found, it is extracted -# otherwise, the program dies (the grammar is incorrect) -sub expect_keyword{ - my ($self, $keyword) = @_; - $self->Error("Expected keyword '$keyword' was not found") - if ($self->{DATA} !~ /^\s*\Q$keyword\E\s*/); - substr($self->{DATA}, 0, length($&)) = ''; -} - - -# Does not include Extender and CombiningChar -# (as in XML Namespaces: http://www.w3.org/TR/REC-xml/) -sub read_NCName{ - my ($self, $terminators) = @_; - my $termin_exists = 1; - if (defined $terminators) { $terminators = "[$terminators]"; } - else { $terminators = ''; $termin_exists = 0; } - if ($self->{DATA} =~ /^\s*([_a-zA-Z][_a-zA-Z0-9\.\-]*)\s*$terminators/){ - substr($self->{DATA}, 0, length($&)-$termin_exists) = ''; - return $1; - } - return undef; -} - -# try to match an identifierOrKeyword; return it in case -# of success; return undef in case of failure; -sub read_identifierOrKeyword{ - my ($self, $terminators) = @_; - $self->read_controlword('\\'); - return $self->read_NCName($terminators); -} - -# see if the argument is in the set of defined keyword of RelaxNG -sub isRNCKeyword{ - my ($word) = @_; - return ($word =~ /^\s*(attribute|default|datatypes|div|element|empty|external|grammar|include|inherit|list|mixed|namespace|notAllowed|parent|start|string|text|token)\s*$/); -} - -# read an identifier; return undef if no identifier can be read -sub read_identifier{ - my ($self, $terminators) = @_; - my $quote = $self->read_controlword('\\'); - my $ident = $self->read_NCName($terminators); - if (!$quote && $ident && isRNCKeyword($ident)){ - $self->put_back($ident); - return undef; - } - return $ident; -} - -# read a literal in any form given; -# segments are taken into account -sub read_literal{ - my ($self) = @_; - if ($self->{DATA} =~ /^\s*!LIT(\d+)\s*/){ - substr($self->{DATA}, 0, length($&)) = ''; - return $self->{literals}[$1]; - } - return undef; -} - -# read a namespace URI literal -sub read_namespaceURILiteral{ - my ($self, $inherited_namespace) = @_; - return $inherited_namespace if $self->read_keyword('inherit'); - return $self->read_literal; -} - -# read any URI literal -sub read_anyURILiteral{ - my ($self) = @_; - $self->read_literal; } - -sub getNS{ - my ($self, $nspref) = @_; - $self->{${$self->{LOADEDFILES}}[$#{$self->{LOADEDFILES}}]}->{NAMESPACE}{$nspref}; } - -sub setNS{ - my ($self, $nspref, $nsval) = @_; - $self->{${$self->{LOADEDFILES}}[$#{$self->{LOADEDFILES}}]}->{NAMESPACE}{$nspref} = $nsval; } - -# read all declarations, until none can be read -sub read_decl{ - my ($self, $inherited_namespace) = @_; - $inherited_namespace = '' unless defined $inherited_namespace; - $self->setNS('default',$inherited_namespace) unless $self->getNS('default'); - my $found = 1; - while ($found){ - if ($self->read_keyword('namespace')){ - my $namespace_name = $self->read_identifierOrKeyword('='); - $self->Error('Undefined namespace name') unless $namespace_name; - $self->expect_keyword('='); - my $namespace_value = - $self->read_namespaceURILiteral($inherited_namespace); - $self->Error('Undefined namespace URI') - unless defined $namespace_value; - $self->setNS($namespace_name, $namespace_value); - } - elsif ($self->read_keyword('default') && - $self->read_keyword('namespace')){ - my $namespace_name = undef; - if (!$self->read_controlword('=')){ - $namespace_name = $self->read_identifierOrKeyword('='); - $self->Error('Undefined namespace name') - unless $namespace_name; - $self->expect_keyword('='); - } - my $namespace_value = - $self->read_namespaceURILiteral($inherited_namespace); - $self->Error('Undefined namespace URI') - unless defined $namespace_value; - $self->setNS('default', $namespace_value); - $self->setNS($namespace_name, $namespace_value) - if $namespace_name; - } - elsif ($self->read_keyword('datatypes')){ - my $datatype_name = $self->read_identifierOrKeyword('='); - $self->Error('Undefined datatype name') unless $datatype_name; - $self->expect_keyword('='); - my $datatype_value = $self->read_literal; - $self->Error('Undefined datatype value') - unless defined $datatype_value; - } - else { $found = 0; } - } -} - -# ignore an annotation definition; -# (assumes annotation content does not exist) -# (it has been removed by clean_rnc) -sub ignore_annotation{ - my ($self) = @_; - $self->read_CName; } - -# read a name (CName) of the form NCName:NCName -sub read_CName{ - my ($self, $terminators) = @_; - $terminators = '\s' unless defined $terminators; - my $name = $self->read_NCName(':'); - if ($name){ - $self->expect_keyword(':'); - my $part2 = $self->read_NCName($terminators); - $self->Error('Incomplete CName definition') unless $part2; - $name .= ":$part2"; - } - return $name; -} - -# read a datatype name -sub read_datatypeName{ - my ($self, $terminators) = @_; - $terminators = '\s' unless defined $terminators; - if ($self->{DATA} =~ /^\s*string\s*[$terminators]/){ - substr($self->{DATA},0,length($&)-1) = ''; - return 'string'; - } - elsif ($self->{DATA} =~ /^\s*token\s*[$terminators]/){ - substr($self->{DATA},0,length($&)-1) = ''; - return 'token'; - } else { - return $self->read_CName($terminators); - } -} - -# read a datatype value -sub read_datatypeValue{ - my ($self) = @_; - return $self->read_literal; -} - -# return the set of names an element or an attribute can have -# this does not work well on complicated name classes -sub read_nameClassEx{ - my ($self, $terminators) = @_; - - my @result; - - if ($self->read_controlword('(')){ - @result = $self->read_nameClassEx($terminators.'\)'); - $self->expect_keyword(')'); - } else { - - #anyName - if ($self->read_controlword('*')){ - push(@result, '*'); - if ($self->read_controlword('-')){ - print STDERR "Warning: USE OF EXCEPT NAMECLASS NOT IMPLEMENTED\n"; - push(@result, $self->read_nameClassEx($terminators)); - } - } - # nsName or name(CName) - elsif (my $part1 = $self->read_NCName(':')){ - $self->expect_keyword(':'); - if ($self->read_controlword('*')){ - push(@result, "$part1:*"); - if ($self->read_controlword('-')){ - print STDERR - "Warning: USE OF EXCEPT NAMECLASS NOT IMPLEMENTED\n"; - push(@result, '-', - $self->read_nameClassEx($terminators)); - } - } else { - push(@result, $part1.':'.$self->read_NCName($terminators.'\|')); - } - } - # name(identifierOrKeyword) - else { - my $name = $self->read_identifierOrKeyword($terminators.'\|'); - $self->Error('Incomplete name class given') unless $name; - push(@result, $name); - } - } - - $self->Error('No name class provided') unless @result; - - # see if we have more possible names: - push(@result, $self->read_nameClassEx($terminators)) - if ($self->read_controlword('|')); - - return @result; -} - -sub read_nameClass{ - my ($self, $terminators, @parents) = @_; - $terminators = '\s' unless defined $terminators; - my @result = $self->read_nameClassEx($terminators); - my @finalRes; - - if (@parents && @result){ - - my @nsList, my %saw = (); - foreach (@parents){ - if (/\{(.*)\}:.+/){ - next if $saw{$1}; - push(@nsList, $1); $saw{$1} = 1; } - else { - next if $saw{'default'}; - push(@nsList, $self->getNS('default')); $saw{'default'} = 1; } - } - - foreach my $res(@result){ - if ($res =~ /(.+):(.+)/){ - push(@finalRes, $self->ns_prepend($2, $1)); } - else { - map(push(@finalRes, "{$_}:$res"), @nsList); } - } - } else { - map(push(@finalRes, (/(.+):(.+)/)? - $self->ns_prepend($2, $1):$self->ns_prepend($_)), @result); - } - return @finalRes; -} - - -# read a parameter declaration, if one exists -sub read_param{ - my ($self) = @_; - my $id = $self->read_identifierOrKeyword('='); - return (undef, undef) unless $id; - $self->expect_keyword('='); - my $val = $self->read_literal; - $self->Error('No parameter value specified') unless defined $val; - return ($id, $val); -} - -sub begin_read_newfile{ - my ($self) = @_; - my $file = $self->read_anyURILiteral; - my $inherit = 'default'; - if ($self->read_keyword('inherit')){ - $self->expect_keyword('='); - $inherit = $self->read_identifierOrKeyword; } - $inherit = $self->getNS($inherit); - my $newdata = ''; - $self->readfile($file, \$newdata); - $self->clean_rnc(\$newdata); - $self->put_back($newdata.'#'); - $self->read_decl($inherit); } - -sub end_read_newfile{ - my ($self) = @_; - pop(@{$self->{LOADEDFILES}}); - $self->expect_keyword('#'); } - -# read a pattern -sub read_pattern{ - my ($self, $grammarPath, $grammarIdent, @parentElements) = @_; - my $found = 1; my $grammarCount = 0; - my $DEF = $grammarPath.':'.$grammarIdent; - - if ($self->read_keyword('element')){ - my @elementNames = $self->read_nameClass('{', @parentElements); - $self->Error('Unspecified element name') unless @elementNames; - map(push(@{$self->{GRAPH}->{$DEF}->{$_}{ELEMENTS}}, - @elementNames), @parentElements); - $self->expect_keyword('{'); - $self->read_pattern($grammarPath, $grammarIdent, @elementNames); - $self->expect_keyword('}'); - } - elsif ($self->read_keyword('attribute')){ - my @attributeNames = $self->read_nameClass('{'); - $self->Error('Unspecified attribute name') unless @attributeNames; - map(push(@{$self->{GRAPH}->{$DEF}->{$_}{ATTRIBUTES}}, - @attributeNames), @parentElements); - $self->expect_keyword('{'); - $self->read_pattern($grammarPath, $grammarIdent, @parentElements); - $self->expect_keyword('}'); - } - elsif ($self->read_keyword('list') || $self->read_keyword('mixed')){ - $self->expect_keyword('{'); - $self->read_pattern($grammarPath, $grammarIdent, @parentElements); - $self->expect_keyword('}'); - } - elsif ($self->read_controlword('(')){ - $self->read_pattern($grammarPath, $grammarIdent, @parentElements); - $self->expect_keyword(')'); - } - elsif (my $datatypeValue = - $self->read_datatypeValue){ - # do nothing - } - elsif (my $datatypeName = - $self->read_datatypeName('\s\{\}\-!')){ - my $datatypeValue = $self->read_datatypeValue; - - # read parameters; ignore them for now - if ($self->read_controlword('{')){ - my ($ident, $val); - do{ - ($ident, $val) = $self->read_param; - } while ($ident && $val); - $self->expect_keyword('}'); - } - # read possible exceptPattern - if ($self->read_controlword('-')){ - print STDERR "Warning: USE OF EXCEPT PATTERN NOT IMPLEMENTED\n"; - $self->Error('exceptPattern expected but not found') - unless $self->read_pattern($grammarPath, $grammarIdent, - @parentElements); - } - } - elsif ($self->read_keyword('external')){ - $self->begin_read_newfile; - $self->read_pattern($grammarPath, $grammarIdent, @parentElements); - $self->end_read_newfile; - } - elsif ($self->read_keyword('grammar')){ - my $ident = $DEF.$grammarCount++; - $self->expect_keyword('{'); - $self->read_grammarContent($ident, @parentElements); - $ident .= ':start'; - map(push(@{$self->{GRAPH}->{$DEF}->{$_}{REFS}}, - $ident), @parentElements); - $self->expect_keyword('}'); - } - elsif ($self->read_keyword('parent')){ - my $ident = $self->read_identifier; - if ($grammarPath =~ /^([.]+:)[^:]+$/){ - $ident = $1.$ident; - map(push(@{$self->{GRAPH}->{$DEF}->{$_}{REFS}}, - $ident), @parentElements); - } - } - elsif ($self->read_keyword('empty') || $self->read_keyword('text') - || $self->read_keyword('notAllowed')){ - # do nothing - } - elsif (my $ident = $self->read_identifier){ - # check if we did not enter a grammar by mistake: - my $asg = $self->read_assignMethod(1); - if ($ident && $asg){ - $self->put_back($ident.$asg); - } else { - $ident = $grammarPath.':'.$ident; - map(push(@{$self->{GRAPH}->{$DEF}->{$_}{REFS}}, - $ident), @parentElements); - } - - } else { $found = 0; } - - if ($self->read_controlword('?') || $self->read_controlword('*') - || $self->read_controlword('+')){ - # ignore - } - - if ($self->read_controlword(',') || $self->read_controlword('|') - || $self->read_controlword('&')){ - Error('Pattern expected') unless - $self->read_pattern($grammarPath, $grammarIdent, @parentElements); - } - - return $found; -} - -sub read_assignMethod{ - my ($self, $asString) = @_; - if ($asString){ - return '&=' if ($self->read_controlword('&=')); - return '|=' if ($self->read_controlword('|=')); - return '=' if ($self->read_controlword('=')); - return undef; - } - return 3 if ($self->read_controlword('&=')); - return 2 if ($self->read_controlword('|=')); - return 1 if ($self->read_controlword('=')); - return 0; -} - -# read a grammar pattern -sub read_grammarPattern{ - my ($self, $DEF, @parentElements) = @_; - if ($self->read_keyword('grammar')){ - $self->expect_keyword('{'); - $self->read_grammarContent($DEF, @parentElements); - $self->expect_keyword('}'); } - else{ - $self->read_grammarContent($DEF, @parentElements);} -} - -# read all possible grammar contents -sub read_grammarContent{ - my ($self, $DEF, @parentElements) = @_; - my ($div, $found) = (0, 1); - - while ($found){ - if ($self->read_keyword('div')){ - $div++; - $self->expect_keyword('{'); - $self->read_grammarContent($DEF.':_G'.$div, @parentElements); - $self->expect_keyword('}'); - } - elsif ($self->read_keyword('include')){ - $self->begin_read_newfile; - $self->read_grammarPattern($DEF, @parentElements); - $self->end_read_newfile; - if ($self->read_controlword('{')){ - $self->read_grammarContent($DEF, @parentElements); - $self->expect_keyword('}'); } - } - elsif ($self->read_keyword('start')){ - my $asg = $self->read_assignMethod; - $self->Error('Invalid assign method') unless $asg; - @{$self->{GRAPH}->{$DEF.':start'}->{PARENTS}} = @parentElements; - $self->read_pattern($DEF, 'start', @parentElements); - } - elsif (my $ident = $self->read_identifier('=\|\&')){ - my $asg = $self->read_assignMethod; - $self->Error('Invalid assign method') unless $asg; - my $ref = $DEF.':'.$ident; - %{$self->{GRAPH}->{$ref}} = () if $asg == 1; - @{$self->{GRAPH}->{$ref}->{PARENTS}} = @parentElements; - $self->read_pattern($DEF, $ident, @parentElements); - } - elsif ($self->ignore_annotation) {} - else { $found = 0; } - } -} - -sub ns_prepend{ - my ($self, $tag, $ns_pref) = @_; - my $ns = $ns_pref?$self->getNS($ns_pref):undef; - $ns = $self->getNS('default') unless $ns; - return "{$ns}:$tag"; -} - -# this should match the whole file -sub read_topLevel{ - my ($self) = @_; - $self->read_decl; - $self->read_pattern($DOCUMENT, 'start', $DOCUMENT); - - my ($after, $before) = (0, 1); - while ($before != $after){ - $before = length($self->{DATA}); - $self->read_grammarContent($DOCUMENT, $DOCUMENT); - $after = length($self->{DATA}); - } - $self->{DATA} = trim($self->{DATA}); - $self->Error('Unable to completely process data') - unless $self->{DATA} eq ''; -} - -# remove leading and trailing white space -sub trim{ - my ($arg) = @_; - $arg =~ s/^\s+//; - $arg =~ s/\s+$//; - return $arg; -} - -sub build_info{ - my ($self) = @_; - - my %seen = (); - local *go = sub { - my ($reference, $node) = @_; - - my $ident = $reference.'#'.$node; - return if defined $seen{$ident}; - $seen{$ident} = 1; - - map($self->{ATTR}->{$node}{$_} = 1, - @{$self->{GRAPH}->{$reference}->{$node}{ATTRIBUTES}}) - if defined $self->{GRAPH}->{$reference}->{$node}{ATTRIBUTES}; - - my @sons; - map(push(@sons, ($reference, $_)), - @{$self->{GRAPH}->{$reference}->{$node}{ELEMENTS}}) - if defined $self->{GRAPH}->{$reference}->{$node}{ELEMENTS}; - - if (defined $self->{GRAPH}->{$reference}->{$node}{REFS}){ - my @refs = @{$self->{GRAPH}->{$reference}->{$node}{REFS}}; - foreach my $ref(@refs){ - next unless $self->{GRAPH}->{$ref}->{PARENTS}; - foreach my $son(@{$self->{GRAPH}->{$ref}->{PARENTS}}){ - map(push(@sons, ($ref, $_)), - @{$self->{GRAPH}->{$ref}->{$son}{ELEMENTS}}) - if defined $self->{GRAPH}->{$ref}->{$son}{ELEMENTS}; - push(@refs, @{$self->{GRAPH}->{$ref}->{$son}{REFS}}) - if defined $self->{GRAPH}->{$ref}->{$son}{REFS}; - # if a reference has attributes defined, - # they will appear as attributes to $DOCUMENT - # if the reference is not defined within some element - map($self->{ATTR}->{$node}{$_} = 1, - @{$self->{GRAPH}->{$ref}->{$son}{ATTRIBUTES}}) - if ($self->{GRAPH}->{$ref}->{$son}{ATTRIBUTES} && - ($son eq $DOCUMENT)); - } - } - } - my $sonCount = ($#sons+1)/2; - for (my $i = 0; $i < $sonCount; $i++){ - my ($ref, $son) = ($sons[2*$i], $sons[2*$i+1]); - go($sons[2*$i], $sons[2*$i+1]); - $self->{NODES}->{$node}{$son} = 1; - } - }; - - go($DOCUMENT.':start', $DOCUMENT); - - %seen = (); - local *gnodes = sub { - my ($node) = @_; - return if $seen{$node}; - $seen{$node} = 1; - foreach my $son(keys %{$self->{NODES}->{$node}}){ - map($self->{GNODES}->{$node}{$_} = $son, - keys %{$self->{NODES}->{$son}}); - gnodes($son); } - }; - - gnodes($DOCUMENT); - @{$self->{TAGLIST}} = keys %seen; -} - -sub getTagList { - my ($self) = @_; - return @{$self->{TAGLIST}}; -} - -sub tagChildren { - my ($self, $tag) = @_; - keys %{$self->{NODES}->{$tag}}; } - -# given a tag and a childtag, return whether -# tag can contain childtag -sub canContain() -{ - my ($self, $tag, $childtag) = @_; - return ($self->{NODES}->{$tag}{$childtag} || - $self->{NODES}->{$tag}{'*'})?1:0; -} - -# there can be more results: list ? -# there can be no result, but a class of results.. like a nsName -# choose representative? -sub canContainIndirect() -{ - my ($self, $tag, $childtag) = @_; - return $self->{GNODES}->{$tag}{$childtag} if - $self->{GNODES}->{$tag}{$childtag}; - - if ($self->{NODES}->{$tag}{'*'}){ - foreach (@{$self->{TAGLIST}}){ - return $_ if $self->{NODES}->{$_}{$childtag}; - } - } -} - -# given a tag and an attribute return whether -# the tag can have that attribute -sub canHaveAttribute() -{ - my ($self, $tag, $attr) = @_; - return ($self->{ATTR}->{$tag}{$attr} || - $self->{ATTR}->{$tag}{'*'})?1:0; -} - -sub canContainSomehow() -{ - my ($self, $tag, $childtag) = @_; - return ($self->canContain($tag, $childtag) || - $self->canContainIndirect($tag, $childtag)); -} - -1; |