1 "{ Package: 'stx:goodies/xmlsuite/relaxng' }"

     2 

     3 "{ NameSpace: RNG }"

     4 

     5 XMLv2::ContentHandler subclass:#Validator

     6 	instanceVariableNames:'schema contextStack pendingTextStream'

     7 	classVariableNames:''

     8 	poolDictionaries:''

     9 	category:'Relax NG-Validation'

    10 !

    11 

    12 

    13 !Validator class methodsFor:'instance creation'!

    14 

    15 for:aSchema

    16 

    17     ^self new schema:aSchema

    18 

    19     "Created: / 01-05-2005 / 15:54:46 / janfrog"

    20 ! !

    21 

    22 !Validator methodsFor:'SAX2 interface'!

    23 

    24 characters:aString

    25 

    26     pendingTextStream ifNil:[

    27         pendingTextStream := (aString species new:aString size) writeStream.

    28     ].

    29     pendingTextStream nextPutAll:aString.

    30 

    31     "Created: / 02-05-2005 / 11:30:50 / janfrog"

    32     "Modified: / 07-06-2005 / 15:35:32 / masca"

    33 !

    34 

    35 endElement:localName namespace:namespace prefix:prefix

    36 

    37     "first, process pending text"

    38     pendingTextStream ifNotNil:[

    39         self processCharacters:pendingTextStream contents.

    40     ].

    41     pendingTextStream := nil.

    42 

    43 

    44     contextStack top tryToFinish.

    45 

    46     contextStack top finished ifFalse:[

    47         self validationError:'Incomplete content of <',localName,'>; '

    48             ,'Expecting: ',(contextStack top automaton

    49                 expectedTokensStringFromState:contextStack top currentPattern)

    50     ].

    51 

    52     "Transcript showCR:'End: ',localName, ' '

    53         , documentLocator getLineNumber printString

    54             ,' pop: ',contextStack top printString."

    55 

    56     contextStack pop.

    57 

    58     "Created: / 01-05-2005 / 16:15:56 / janfrog"

    59     "Modified: / 14-05-2005 / 11:31:18 / janfrog"

    60     "Modified: / 14-06-2005 / 12:19:44 / masca"

    61 !

    62 

    63 startDocument

    64 

    65     contextStack := Stack new.

    66     contextStack push:

    67         ((self newContextFor:schema rootPattern)

    68             attributes:#();

    69             yourself)

    70 

    71     "Created: / 01-05-2005 / 15:57:52 / janfrog"

    72     "Modified: / 01-05-2005 / 18:46:38 / janfrog"

    73 !

    74 

    75 startElement:localName namespace:namespace prefix:qName attributes:anAttributes

    76 

    77     | pattern newContext expandedName |

    78 

    79     "first, process pending text"

    80     pendingTextStream ifNotNil:[

    81         self processCharacters:pendingTextStream contents.

    82     ].

    83     pendingTextStream := nil.

    84 

    85 

    86     expandedName := (self ns:namespace name:localName).

    87     pattern := contextStack top nextPutElement:expandedName.

    88 

    89     newContext := self newContextFor:pattern.

    90     newContext attributes:anAttributes asArray asOrderedCollection.

    91     contextStack push:newContext

    92 

    93     "Created: / 01-05-2005 / 16:14:05 / janfrog"

    94     "Modified: / 02-05-2005 / 12:25:38 / janfrog"

    95     "Modified: / 07-06-2005 / 15:34:58 / masca"

    96 ! !

    97 

    98 !Validator methodsFor:'accessing'!

    99 

   100 newContextFor:aPattern

   101 

   102     ^aPattern newValidatorContext

   103         validator:self;

   104         yourself

   105 

   106     "Created: / 01-05-2005 / 15:58:39 / janfrog"

   107     "Modified: / 02-05-2005 / 12:23:19 / janfrog"

   108 !

   109 

   110 result

   111 

   112     ^true

   113 

   114     "Created: / 14-05-2005 / 11:05:15 / janfrog"

   115 !

   116 

   117 schema:aSchema

   118 

   119     schema := aSchema

   120 

   121     "Created: / 01-05-2005 / 15:55:09 / janfrog"

   122 ! !

   123 

   124 !Validator methodsFor:'error reporting'!

   125 

   126 validationError:aString

   127 

   128     ValidationError raiseErrorString:aString

   129 

   130     "Created: / 01-05-2005 / 16:20:22 / janfrog"

   131 ! !

   132 

   133 !Validator methodsFor:'processing extras'!

   134 

   135 processAttribute:attr usingPattern:pattern

   136 

   137 

   138     contextStack push:(self newContextFor:pattern).

   139     contextStack top nextPutText:attr value.

   140     contextStack pop.

   141 

   142     "Created: / 02-05-2005 / 12:38:43 / janfrog"

   143     "Modified: / 02-05-2005 / 15:00:47 / janfrog"

   144     "Modified: / 19-05-2005 / 10:48:04 / masca"

   145 !

   146 

   147 processCharacters:aString 

   148     contextStack top nextPutText:aString

   149 

   150     "Created: / 07-06-2005 / 15:28:51 / masca"

   151 ! !

   152 

   153 !Validator methodsFor:'utilities'!

   154 

   155 ns:ns name:name

   156 

   157     ^ns isEmpty ifTrue:[name] ifFalse:[ns , '#' , name]"

   158     ^ns , '#' , name   "

   159 

   160     "Created: / 01-05-2005 / 16:17:44 / janfrog"

   161     "Modified: / 14-05-2005 / 11:34:57 / janfrog"

   162 ! !

   163 

   164 !Validator class methodsFor:'documentation'!

   165 

   166 version

   167     ^ '$Header: /opt/data/cvs/stx/goodies/xmlsuite/relaxng/RNG__Validator.st,v 1.1.1.1 2005-11-01 22:07:16 vranyj1 Exp $'

   168 ! !