SystemOrganization addCategory: #'PetitXml-Core'!
SystemOrganization addCategory: #'PetitXml-Nodes'!
SystemOrganization addCategory: #'PetitXml-Tests'!
TestCase subclass: #PPXmlGrammarTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Tests'!
!PPXmlGrammarTest class methodsFor: 'accessing' stamp: 'lr 1/7/2010 13:40'!
packageNamesUnderTest
^ #('PetitXml')! !
!PPXmlGrammarTest class methodsFor: 'accessing' stamp: 'lr 3/29/2010 15:18'!
resources
^ Array with: PPXmlResource! !
!PPXmlGrammarTest methodsFor: 'utilities' stamp: 'lr 3/29/2010 11:13'!
assertCopyInvariant: aNode
"Assert that the copy is equivalent to the original."
| copy |
copy := aNode copy.
self deny: aNode == copy.
self assert: aNode = copy.
self assert: copy = aNode! !
!PPXmlGrammarTest methodsFor: 'utilities' stamp: 'lr 3/29/2010 11:13'!
assertEquivalentInvariant: aNode
"Assert that each node is equivalent to itself."
aNode nodesDo: [ :node |
self assert: node = node.
self assert: node hash = node hash ]! !
!PPXmlGrammarTest methodsFor: 'utilities' stamp: 'lr 3/29/2010 11:25'!
assertInvariants: aDocumentNode
"Assert that anXmlNode is properly setup.."
self assertCopyInvariant: aDocumentNode.
self assertEquivalentInvariant: aDocumentNode.
self assertRootInvariant: aDocumentNode.
self assertParentInvariant: aDocumentNode.
self assertNavigationInvariant: aDocumentNode.
self assertTypeInvariant: aDocumentNode! !
!PPXmlGrammarTest methodsFor: 'utilities' stamp: 'lr 3/29/2010 11:15'!
assertNavigationInvariant: aXmlNode
"Asswer that the firstChild, lastChild, previousSibling, nextSibling are properly setup."
| current children |
aXmlNode nodesDo: [ :node |
" forward "
current := node firstChild.
children := OrderedCollection withAll: node children.
[ current isNil ] whileFalse: [
self assert: children notEmpty.
self assert: children removeFirst == current.
current := current nextSibling ].
self assert: children isEmpty.
" backward "
current := node lastChild.
children := OrderedCollection withAll: node childNodes.
[ current isNil ] whileFalse: [
self assert: children notEmpty.
self assert: children removeLast == current.
current := current previousSibling ].
self assert: children isEmpty ]! !
!PPXmlGrammarTest methodsFor: 'utilities' stamp: 'lr 3/29/2010 11:12'!
assertParentInvariant: anXmlNode
"Assert that the children-parent relationship is properly set."
anXmlNode nodesDo: [ :node |
node children
do: [ :child | self assert: child parent == node ].
node isDocument
ifTrue: [ self assert: node parent isNil ].
node isElement ifTrue: [
node attributes
do: [ :child | self assert: child parent == node ] ] ]! !
!PPXmlGrammarTest methodsFor: 'utilities' stamp: 'lr 3/29/2010 11:30'!
assertParseInvariant: aString
"Assert that aString can be parsed, serialized and parsed again to the same tree."
| tree string |
tree := self parse: aString.
self
deny: tree isPetitFailure
description: tree printString.
string := String
streamContents: [ :out | tree printXmlOn: out ].
self
assert: (self parse: string) = tree
description: 'Parse invariant not satisifed'.
self assertInvariants: tree! !
!PPXmlGrammarTest methodsFor: 'utilities' stamp: 'lr 4/6/2010 20:07'!
assertRootInvariant: aDocumentNode
"Assert that anXmlNode is the root of the tree."
self assert: (aDocumentNode childNodes includes: aDocumentNode rootElement).
aDocumentNode nodesDo: [ :node |
self assert: node root == aDocumentNode.
aDocumentNode isDocument
ifTrue: [ self assert: node document == aDocumentNode ] ]! !
!PPXmlGrammarTest methodsFor: 'utilities' stamp: 'lr 3/29/2010 11:25'!
assertTypeInvariant: aNode
"Assert that each node is one of the standard types."
| types |
aNode nodesDo: [ :node |
types := Set new.
#(isAttribute isComment isDoctype isDocument isElement isProcessing isText) do: [ :each |
(node perform: each)
ifTrue: [ types add: each ] ].
self assert: types size = 1 ]! !
!PPXmlGrammarTest methodsFor: 'parsing' stamp: 'lr 2/1/2010 11:15'!
parse: aString
^ self parse: aString rule: #start! !
!PPXmlGrammarTest methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:51'!
parse: aString rule: aSymbol
| production |
production := self parser.
aSymbol = #start
ifFalse: [ production := production instVarNamed: aSymbol ].
^ production end parse: aString! !
!PPXmlGrammarTest methodsFor: 'accessing' stamp: 'lr 1/7/2010 13:56'!
parser
^ self resource parserAt: self parserClass! !
!PPXmlGrammarTest methodsFor: 'accessing' stamp: 'lr 3/28/2010 10:59'!
parserClass
^ PPXmlParser! !
!PPXmlGrammarTest methodsFor: 'accessing' stamp: 'lr 3/29/2010 15:17'!
resource
^ PPXmlResource current! !
!PPXmlGrammarTest methodsFor: 'testing' stamp: 'lr 3/26/2010 17:46'!
testParseAllXml
self resource allXmlDefinitions
do: [ :each | self assertParseInvariant: each ]! !
!PPXmlGrammarTest methodsFor: 'testing-specific' stamp: 'lr 3/26/2010 17:46'!
testParseComment
self assertParseInvariant: '' ! !
!PPXmlGrammarTest methodsFor: 'testing-specific' stamp: 'lr 3/26/2010 17:46'!
testParseCommentWithXml
self assertParseInvariant: ' -->' ! !
!PPXmlGrammarTest methodsFor: 'testing-specific' stamp: 'lr 3/26/2010 17:46'!
testParseComplicated
self assertParseInvariant: '
' ! !
!PPXmlGrammarTest methodsFor: 'testing-specific' stamp: 'lr 3/26/2010 17:46'!
testParseDoctype
self assertParseInvariant: '
[ ] >
'! !
!PPXmlGrammarTest methodsFor: 'testing-specific' stamp: 'lr 3/26/2010 17:46'!
testParseEmptyElement
self assertParseInvariant: '' ! !
!PPXmlGrammarTest methodsFor: 'testing-specific' stamp: 'lr 3/26/2010 17:46'!
testParseNamespace
self assertParseInvariant: '' ! !
!PPXmlGrammarTest methodsFor: 'testing-specific' stamp: 'lr 3/26/2010 17:46'!
testParseSimple
self assertParseInvariant: '' ! !
!PPXmlGrammarTest methodsFor: 'testing-specific' stamp: 'lr 3/26/2010 17:46'!
testParseSimpleAttribute
self assertParseInvariant: '' ! !
!PPXmlGrammarTest methodsFor: 'testing-specific' stamp: 'lr 3/26/2010 17:46'!
testParseWithWhitsepaceAfterProlog
self assertParseInvariant: '
' ! !
PPParserResource subclass: #PPXmlResource
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Tests'!
!PPXmlResource methodsFor: 'accessing' stamp: 'lr 2/4/2010 14:12'!
allXmlDefinitions
^ (Pragma allNamed: #xml: in: self class) collect: [ :each | self perform: each selector ]! !
!PPXmlResource methodsFor: 'accessing' stamp: 'lr 2/4/2010 14:10'!
allXsdDefinitions
^ (Pragma allNamed: #xsd in: self class) collect: [ :each | self perform: each selector ]! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
elementFormXsd
^ '
-->
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
elementReferencesXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
externalAttributesXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
forwardRefXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
getBalanceXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
groupXsd
^ '
A price is any one of the following:
* Full Price (with amount)
* Sale Price (with amount and authorization)
* Clearance Price (with amount and authorization)
* Free (with authorization)
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
importAuxXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
importBaseXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
includeWithNamespaceXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
includeWithoutNamespaceXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
listXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
mixedContentXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
notationXsd
^ '
Location of the corporate logo.
Location of the corporate mascot.
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
restrictionXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xml' stamp: 'lr 2/4/2010 14:09'!
shiporderXml
^ '
Alice Smith
123 Maple Street
Mill Valley
CA
90952
Robert Smith
8 Oak Avenue
Old Town
PA
95819
Hurry, my lawn is going wild!!
-
Lawnmower
1
148.95
Confirm this is electric
-
Baby Monitor
1
39.98
1999-05-21
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:11'!
shiporderXsd
^ '
Purchase order schema for Example.com.
Copyright 2000 Example.com. All rights reserved.
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:12'!
simpleContentExtensionXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:12'!
subgroupXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:12'!
unionXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:12'!
unqualifiedTypesXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 2/4/2010 14:12'!
xsdXsd
^ '
]>
The schema corresponding to this document is normative,
with respect to the syntactic constraints it expresses in the
XML Schema Definition Language. The documentation (within <documentation> elements)
below, is not normative, but rather highlights important aspects of
the W3C Recommendation of which this is a part.
See below (at the bottom of this document) for information about
the revision and namespace-versioning policy governing this
schema document.
The simpleType element and all of its members are defined
in datatypes.xsd
Get access to the xml: attribute groups for xml:lang
as declared on ''schema'' and ''documentation'' below
This type is extended by almost all schema types
to allow attributes from other namespaces to be
added to user schemas.
This type is extended by all types which allow annotation
other than <schema> itself
This group is for the
elements which occur freely at the top level of schemas.
All of their types are based on the "annotated" type by extension.
This group is for the
elements which can self-redefine (see <redefine> below).
A utility type, not for public use
A utility type, not for public use
A utility type, not for public use
#all or (possibly empty) subset of {extension, restriction}
A utility type, not for public use
A utility type, not for public use
#all or (possibly empty) subset of {extension, restriction, list, union}
for maxOccurs
for all particles
for element, group and attributeGroup,
which both define and reference
''complexType'' uses this
This branch is short for
<complexContent>
<restriction base="xs:anyType">
...
</restriction>
</complexContent>
Will be restricted to required or prohibited
Not allowed if simpleContent child is chosen.
May be overridden by setting on complexContent child.
This choice is added simply to
make this a valid restriction per the REC
Overrides any setting on complexType parent.
This choice is added simply to
make this a valid restriction per the REC
No typeDefParticle group reference
A utility type, not for public use
#all or (possibly empty) subset of {substitution, extension,
restriction}
The element element can be used either
at the top level to define an element-type binding globally,
or within a content model to either reference a globally-defined
element or type or declare an element-type binding locally.
The ref form is not allowed at the top level.
This type is used for ''alternative'' elements.
group type for explicit groups, named top-level groups and
group references
group type for the three kinds of group
This choice with min/max is here to
avoid a pblm with the Elt:All/Choice/Seq
Particle derivation constraint
Only elements allowed inside
simple type for the value of the ''namespace'' attr of
''any'' and ''anyAttribute''
Value is
##any - - any non-conflicting WFXML/attribute at all
##other - - any non-conflicting WFXML/attribute from
namespace other than targetNS
##local - - any unqualified non-conflicting WFXML/attribute
one or - - any non-conflicting WFXML/attribute from
more URI the listed namespaces
references
(space separated)
##targetNamespace or ##local may appear in the above list, to
refer to the targetNamespace of the enclosing
schema or an absent targetNamespace respectively
A utility type, not for public use
A utility type, not for public use
A utility type, not for public use
A utility type, not for public use
A utility type, not for public use
A subset of XPath expressions for use
in selectors
A utility type, not for public
use
A subset of XPath expressions for use
in fields
A utility type, not for public
use
The three kinds of identity constraints, all with
type of or derived from ''keybase''.
A utility type, not for public use
A public identifier, per ISO 8879
notations for use within schema documents
Not the real urType, but as close an approximation as we can
get in the XML representation
In keeping with the XML Schema WG''s standard versioning policy,
this schema document will persist at the URI
http://www.w3.org/2009/12/XMLSchema.xsd.
At the date of issue it can also be found at the URI
http://www.w3.org/2009/XMLSchema/XMLSchema.xsd.
The schema document at that URI may however change in the future,
in order to remain compatible with the latest version of XSD
and its namespace. In other words, if XSD or the XML Schema
namespace change, the version of this document at
http://www.w3.org/2009/XMLSchema/XMLSchema.xsd will change accordingly;
the version at http://www.w3.org/2009/12/XMLSchema.xsd will not change.
Previous dated (and unchanging) versions of this schema document
include:
http://www.w3.org/2009/04/XMLSchema.xsd
(XSD 1.1 Candidate Recommendation)
http://www.w3.org/2004/10/XMLSchema.xsd
(XSD 1.0 Recommendation, Second Edition)
http://www.w3.org/2001/05/XMLSchema.xsd
(XSD 1.0 Recommendation, First Edition)
'! !
PPCompositeParser subclass: #PPXmlGrammar
instanceVariableNames: 'comment whitespace processing nameStartChar nameChar nameToken misc document element attributes content characterData attribute doctype attributeValue qualified'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Core'!
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 3/28/2010 11:01'!
attribute
"[41] Attribute ::= Name Eq AttValue"
^ qualified , whitespace optional , $= asParser , whitespace optional , attributeValue
==> [ :nodes | Array with: nodes first with: nodes fifth ]! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 3/28/2010 11:17'!
attributeValue
"[10] AttValue ::= '""' ([^<&""] | Reference)* '""' | ""'"" ([^<&'] | Reference)* "
^ ($" asParser , $" asParser negate star flatten , $" asParser)
/ ($' asParser , $' asParser negate star flatten , $' asParser)
==> #second! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 3/28/2010 10:52'!
attributes
"[40] STag ::= '<' Name (S Attribute)* S? '>' "
^ ((whitespace , attribute) ==> #second) star! !
!PPXmlGrammar methodsFor: 'grammar-character' stamp: 'lr 6/26/2010 14:39'!
characterData
"[14] CharData ::= [^<&]* - ([^<&]* ']]>' [^<&]*)"
^ $< asParser negate plus flatten! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 3/28/2010 11:15'!
comment
"[15] Comment ::= ''"
^ '' asParser negate star flatten , '-->' asParser ==> #second! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 3/28/2010 11:12'!
content
"[43] content ::= CharData? ((element | Reference | CDSect | PI | Comment) CharData?)*"
^ characterData optional , ((element / processing / comment) , characterData optional) star ==> [ :nodes |
| result |
result := OrderedCollection new.
nodes first isNil
ifFalse: [ result addLast: nodes first ].
nodes second do: [ :each |
result addLast: each first.
each second isNil
ifFalse: [ result addLast: each second ] ].
result asArray ]! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 3/29/2010 11:43'!
doctype
"[28] doctypedecl ::= ''"
^ ' asParser ==> #third! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 3/28/2010 11:12'!
document
"[1] document ::= prolog element Misc*"
"[22] prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?"
^ processing optional , misc , doctype optional , misc , element , misc
==> [ :nodes | Array with: nodes first with: nodes third with: nodes fifth ]! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 5/5/2010 14:44'!
element
"[39] element ::= EmptyElemTag | STag content ETag"
^ $< asParser , qualified , attributes , whitespace optional , ('/>' asParser / ($> asParser , content , [ :stream | stream position ] asParser , '' asParser , qualified , whitespace optional , $> asParser)) ==> [ :nodes |
nodes fifth = '/>'
ifTrue: [ Array with: nodes second with: nodes third with: #() ]
ifFalse: [
nodes second = nodes fifth fifth
ifTrue: [ Array with: nodes second with: nodes third with: nodes fifth second ]
ifFalse: [ PPFailure message: 'Expected ' , nodes second qualifiedName , '>' at: nodes fifth third ] ] ]! !
!PPXmlGrammar methodsFor: 'grammar-character' stamp: 'lr 1/26/2010 09:08'!
misc
"[27] Misc ::= Comment | PI | S"
^ (whitespace / comment / processing) star! !
!PPXmlGrammar methodsFor: 'token-characters' stamp: 'lr 6/12/2010 09:06'!
nameChar
"[4a] NameChar ::= NameStartChar | ""-"" | ""."" | [0-9] | #xB7 | [#x0300-#x036F] | [#x203F-#x2040]"
^ PPPredicateObjectParser on: [ :char | char = $- or: [ char = $. or: [ char = $: or: [ char = $_ or: [ char isAlphaNumeric ] ] ] ] ] message: 'name expected'! !
!PPXmlGrammar methodsFor: 'token-characters' stamp: 'lr 6/12/2010 09:06'!
nameStartChar
"[4] NameStartChar ::= "":"" | [A-Z] | ""_"" | [a-z] | [#xC0-#xD6] | [#xD8-#xF6] | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF] | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF] | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF]"
^ PPPredicateObjectParser on: [ :char | char = $: or: [ char = $_ or: [ char isLetter ] ] ] message: 'name expected'! !
!PPXmlGrammar methodsFor: 'token' stamp: 'lr 1/26/2010 09:15'!
nameToken
"[5] Name ::= NameStartChar (NameChar)*"
^ (nameStartChar , nameChar star) flatten! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 4/6/2010 19:44'!
processing
"[16] PI ::= '' PITarget (S (Char* - (Char* '?>' Char*)))? '?>'
[17] PITarget ::= Name - (('X' | 'x') ('M' | 'm') ('L' | 'l'))"
^ '' asParser , nameToken , (whitespace , '?>' asParser negate star) optional flatten, '?>' asParser
==> [ :nodes | Array with: nodes second with: nodes third ]! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 3/28/2010 10:45'!
qualified
^ nameToken! !
!PPXmlGrammar methodsFor: 'accessing' stamp: 'lr 1/26/2010 09:25'!
start
^ document end! !
!PPXmlGrammar methodsFor: 'grammar-character' stamp: 'lr 1/26/2010 08:46'!
whitespace
"[3] S ::= (#x20 | #x9 | #xD | #xA)+"
^ #space asParser plus! !
PPXmlGrammar subclass: #PPXmlParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Core'!
!PPXmlParser methodsFor: 'grammar' stamp: 'lr 3/28/2010 11:02'!
attribute
^ super attribute ==> [ :nodes | PPXmlAttribute name: nodes first value: nodes second ]! !
!PPXmlParser methodsFor: 'grammar' stamp: 'lr 3/28/2010 10:53'!
attributes
^ super attributes ==> [ :nodes |
nodes
inject: OrderedCollection new
into: [ :result :each | result addLast: each; yourself ] ]! !
!PPXmlParser methodsFor: 'grammar-character' stamp: 'lr 6/26/2010 14:39'!
characterData
^ super characterData ==> [ :nodes | PPXmlText data: nodes ]! !
!PPXmlParser methodsFor: 'grammar' stamp: 'lr 3/28/2010 11:16'!
comment
"[15] Comment ::= ''"
^ super comment ==> [ :node | PPXmlComment data: node ]! !
!PPXmlParser methodsFor: 'grammar' stamp: 'lr 3/28/2010 11:21'!
doctype
^ super doctype ==> [ :node | PPXmlDoctype data: node ]! !
!PPXmlParser methodsFor: 'grammar' stamp: 'lr 3/28/2010 11:13'!
document
^ super document ==> [ :nodes | PPXmlDocument children: (nodes reject: [ :each | each isNil ]) ]! !
!PPXmlParser methodsFor: 'grammar' stamp: 'lr 3/28/2010 11:13'!
element
^ super element ==> [ :nodes | PPXmlElement name: nodes first attributes: nodes second children: nodes third ]! !
!PPXmlParser methodsFor: 'grammar' stamp: 'lr 3/28/2010 11:15'!
processing
^ super processing ==> [ :nodes | PPXmlProcessing target: nodes first data: nodes second ]! !
!PPXmlParser methodsFor: 'grammar' stamp: 'lr 3/28/2010 11:10'!
qualified
^ super qualified ==> [ :token | PPXmlName name: token ]! !
Object subclass: #PPXmlName
instanceVariableNames: 'prefix local uri'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Nodes'!
!PPXmlName class methodsFor: 'instance creation' stamp: 'lr 3/27/2010 09:42'!
name: aString
^ self name: aString uri: nil! !
!PPXmlName class methodsFor: 'instance creation' stamp: 'lr 3/27/2010 09:42'!
name: aString uri: anUrl
^ self basicNew initializeName: aString uri: anUrl! !
!PPXmlName methodsFor: 'comparing' stamp: 'lr 3/27/2010 09:41'!
= anXmlName
self == anXmlName
ifTrue: [ ^ true ].
self class = anXmlName class
ifFalse: [ ^ false ].
^ self namespacePrefix = anXmlName namespacePrefix
and: [ self localName = anXmlName localName ]! !
!PPXmlName methodsFor: 'comparing' stamp: 'lr 3/27/2010 09:41'!
hash
^ self namespacePrefix hash bitXor: self localName hash! !
!PPXmlName methodsFor: 'initialization' stamp: 'lr 3/27/2010 09:42'!
initializeName: aString uri: anUrl
| index |
(index := aString indexOf: $:) = 0
ifTrue: [
prefix := nil.
local := aString ]
ifFalse: [
prefix := aString copyFrom: 1 to: index - 1.
local := aString copyFrom: index + 1 to: aString size ].
uri := anUrl! !
!PPXmlName methodsFor: 'accessing' stamp: 'lr 3/27/2010 09:33'!
localName
"Answer the local name fo the receiver."
^ local! !
!PPXmlName methodsFor: 'accessing' stamp: 'lr 3/27/2010 09:36'!
namespacePrefix
"Answer the prefix of the receiver or nil."
^ prefix! !
!PPXmlName methodsFor: 'printing' stamp: 'lr 3/27/2010 09:36'!
printOn: aStream
super printOn: aStream.
aStream nextPutAll: ' ('.
self printXmlOn: aStream.
aStream nextPut: $)! !
!PPXmlName methodsFor: 'printing' stamp: 'lr 3/27/2010 09:39'!
printXmlOn: aStream
prefix isNil
ifFalse: [ aStream nextPutAll: prefix; nextPut: $: ].
aStream nextPutAll: local! !
!PPXmlName methodsFor: 'accessing' stamp: 'lr 3/27/2010 09:40'!
qualifiedName
"Answer the qualified name fo the receiver."
| stream |
stream := WriteStream on: (String new: 20).
self printXmlOn: stream.
^ stream contents! !
!PPXmlName methodsFor: 'accessing' stamp: 'lr 3/28/2010 11:26'!
uri
^ uri! !
Object subclass: #PPXmlNode
instanceVariableNames: 'parent'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Nodes'!
!PPXmlNode commentStamp: 'lr 2/4/2010 13:27' prior: 0!
An abstract XML node.!
PPXmlNode subclass: #PPXmlAttribute
instanceVariableNames: 'name value'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Nodes'!
!PPXmlAttribute class methodsFor: 'instance creation' stamp: 'lr 3/28/2010 10:27'!
name: anXmlName value: aString
^ self basicNew
setName: anXmlName;
setValue: aString;
yourself! !
!PPXmlAttribute methodsFor: 'comparing' stamp: 'lr 3/27/2010 09:43'!
= anXmlNode
self == anXmlNode
ifTrue: [ ^ true ].
self class = anXmlNode class
ifFalse: [ ^ false ].
^ self name = anXmlNode name
and: [ self value = anXmlNode value ]! !
!PPXmlAttribute methodsFor: 'comparing' stamp: 'lr 3/27/2010 09:43'!
hash
^ self name hash bitXor: self value hash! !
!PPXmlAttribute methodsFor: 'testing' stamp: 'lr 3/28/2010 09:56'!
isAttribute
^ true! !
!PPXmlAttribute methodsFor: 'accessing' stamp: 'lr 3/27/2010 09:43'!
name
^ name! !
!PPXmlAttribute methodsFor: 'printing' stamp: 'lr 3/28/2010 11:09'!
printXmlOn: aStream
name printXmlOn: aStream.
aStream nextPutAll: '="'; nextPutAll: value; nextPut: $"! !
!PPXmlAttribute methodsFor: 'initialization' stamp: 'lr 3/28/2010 10:28'!
setName: anXmlName
name := anXmlName! !
!PPXmlAttribute methodsFor: 'initialization' stamp: 'lr 3/28/2010 10:28'!
setValue: aString
value := aString! !
!PPXmlAttribute methodsFor: 'accessing' stamp: 'lr 3/27/2010 09:15'!
value
^ value! !
PPXmlNode subclass: #PPXmlData
instanceVariableNames: 'data'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Nodes'!
!PPXmlData commentStamp: 'lr 2/4/2010 13:27' prior: 0!
An abstract XML data node.!
PPXmlData subclass: #PPXmlComment
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Nodes'!
!PPXmlComment commentStamp: 'lr 2/4/2010 13:27' prior: 0!
An XML comment node.!
!PPXmlComment methodsFor: 'testing' stamp: 'lr 3/28/2010 09:56'!
isComment
^ true! !
!PPXmlComment methodsFor: 'printing' stamp: 'lr 1/29/2010 14:02'!
printXmlOn: aStream
aStream nextPutAll: ''! !
!PPXmlData class methodsFor: 'instance creation' stamp: 'lr 3/28/2010 10:18'!
data: aString
^ self basicNew setData: aString! !
!PPXmlData methodsFor: 'comparing' stamp: 'lr 2/1/2010 11:11'!
= anXmlNode
self == anXmlNode
ifTrue: [ ^ true ].
self class = anXmlNode class
ifFalse: [ ^ false ].
^ self data = anXmlNode data! !
!PPXmlData methodsFor: 'accessing' stamp: 'lr 1/29/2010 14:01'!
data
^ data! !
!PPXmlData methodsFor: 'comparing' stamp: 'lr 3/26/2010 17:25'!
hash
^ self data hash! !
!PPXmlData methodsFor: 'initialization' stamp: 'lr 3/28/2010 10:19'!
setData: aString
data := aString! !
PPXmlData subclass: #PPXmlDoctype
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Nodes'!
!PPXmlDoctype methodsFor: 'testing' stamp: 'lr 3/28/2010 11:29'!
isDoctype
^ true! !
!PPXmlDoctype methodsFor: 'printing' stamp: 'lr 3/28/2010 11:22'!
printXmlOn: aStream
aStream nextPutAll: '! !
PPXmlData subclass: #PPXmlProcessing
instanceVariableNames: 'target'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Nodes'!
!PPXmlProcessing commentStamp: 'lr 2/4/2010 13:27' prior: 0!
An XML processing instruction.!
!PPXmlProcessing class methodsFor: 'instance creation' stamp: 'lr 3/28/2010 10:22'!
target: aTargetString data: aString
^ self basicNew
setTarget: aTargetString;
setData: aString;
yourself! !
!PPXmlProcessing methodsFor: 'comparing' stamp: 'lr 2/1/2010 11:12'!
= anXmlNode
^ super = anXmlNode and: [ self target = anXmlNode target ]! !
!PPXmlProcessing methodsFor: 'comparing' stamp: 'lr 3/28/2010 10:20'!
hash
^ super hash bitXor: self target hash! !
!PPXmlProcessing methodsFor: 'testing' stamp: 'lr 3/28/2010 09:56'!
isProcessing
^ true! !
!PPXmlProcessing methodsFor: 'printing' stamp: 'lr 1/29/2010 14:00'!
printXmlOn: aStream
aStream nextPutAll: ''; nextPutAll: target; nextPutAll: data; nextPutAll: '?>'! !
!PPXmlProcessing methodsFor: 'initialization' stamp: 'lr 3/28/2010 10:20'!
setTarget: aString
target := aString! !
!PPXmlProcessing methodsFor: 'accessing' stamp: 'lr 1/29/2010 14:00'!
target
^ target! !
PPXmlData subclass: #PPXmlText
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Nodes'!
!PPXmlText commentStamp: 'lr 2/4/2010 13:27' prior: 0!
An XML text node.!
!PPXmlText methodsFor: 'testing' stamp: 'lr 3/28/2010 09:55'!
isText
^ true! !
!PPXmlText methodsFor: 'printing' stamp: 'lr 1/29/2010 13:58'!
printXmlOn: aStream
aStream nextPutAll: data! !
!PPXmlNode class methodsFor: 'instance creation' stamp: 'lr 3/28/2010 10:18'!
new
self error: 'Use a constructor method to instantiate ' , self name! !
!PPXmlNode methodsFor: 'accessing' stamp: 'lr 3/28/2010 18:29'!
attributes
"Answer the attribute nodes of the receiver."
^ #()! !
!PPXmlNode methodsFor: 'accessing-dom' stamp: 'lr 3/28/2010 09:51'!
childNodes
"Answer the child nodes of the receiver or nil."
^ self children! !
!PPXmlNode methodsFor: 'accessing' stamp: 'lr 3/28/2010 18:29'!
children
"Answer the child nodes of the receiver."
^ #()! !
!PPXmlNode methodsFor: 'accessing' stamp: 'lr 3/27/2010 13:53'!
document
"Answer the document that contains this node, or nil if this node is not currently part of a document."
^ parent isNil ifFalse: [ parent document ]! !
!PPXmlNode methodsFor: 'accessing-dom' stamp: 'lr 2/4/2010 13:25'!
firstChild
"Answer the first child of the receiver or nil."
^ self childNodes isEmpty ifFalse: [ self childNodes first ]! !
!PPXmlNode methodsFor: 'testing' stamp: 'lr 3/28/2010 09:56'!
isAttribute
^ false! !
!PPXmlNode methodsFor: 'testing' stamp: 'lr 3/28/2010 09:56'!
isComment
^ false! !
!PPXmlNode methodsFor: 'testing' stamp: 'lr 3/28/2010 11:29'!
isDoctype
^ false! !
!PPXmlNode methodsFor: 'testing' stamp: 'lr 2/4/2010 13:44'!
isDocument
^ false! !
!PPXmlNode methodsFor: 'testing' stamp: 'lr 3/26/2010 18:14'!
isElement
^ false! !
!PPXmlNode methodsFor: 'testing' stamp: 'lr 3/28/2010 09:56'!
isProcessing
^ false! !
!PPXmlNode methodsFor: 'testing' stamp: 'lr 3/28/2010 09:57'!
isText
^ false! !
!PPXmlNode methodsFor: 'accessing-dom' stamp: 'lr 2/4/2010 13:25'!
lastChild
"Answer the first child of the receiver or nil."
^ self childNodes isEmpty ifFalse: [ self childNodes last ]! !
!PPXmlNode methodsFor: 'accessing-dom' stamp: 'lr 3/28/2010 09:58'!
nextSibling
"Answer the next sibling of the receiver or nil."
| index children |
self parentNode isNil ifTrue: [ ^ nil ].
children := self parentNode childNodes.
index := children identityIndexOf: self ifAbsent: [ ^ nil ].
^ children at: index + 1 ifAbsent: [ nil ]! !
!PPXmlNode methodsFor: 'enumerating' stamp: 'lr 3/29/2010 11:27'!
nodesDo: aBlock
"Recursively enumerate over the receiver, all arguments and children."
aBlock value: self.
self attributes
do: [ :each | each nodesDo: aBlock ].
self children
do: [ :each | each nodesDo: aBlock ]! !
!PPXmlNode methodsFor: 'accessing' stamp: 'lr 3/27/2010 13:53'!
parent
"Answer the parent node of the receiver or nil if there is none."
^ parent! !
!PPXmlNode methodsFor: 'accessing-dom' stamp: 'lr 3/28/2010 09:52'!
parentNode
"Answer the parent node of the receiver or nil."
^ self parent! !
!PPXmlNode methodsFor: 'copying' stamp: 'lr 2/4/2010 13:54'!
postCopy
super postCopy.
self setParent: nil! !
!PPXmlNode methodsFor: 'accessing-dom' stamp: 'lr 3/28/2010 09:58'!
previousSibling
"Answer the previous sibling of the receiver or nil."
| index children |
self parentNode isNil ifTrue: [ ^ nil ].
children := self parentNode childNodes.
index := children identityIndexOf: self ifAbsent: [ ^ nil ].
^ children at: index - 1 ifAbsent: [ nil ]! !
!PPXmlNode methodsFor: 'printing' stamp: 'lr 2/19/2010 07:31'!
printOn: aStream
super printOn: aStream.
aStream nextPutAll: ' ('.
self printXmlOn: aStream.
aStream nextPut: $)! !
!PPXmlNode methodsFor: 'printing' stamp: 'lr 1/26/2010 16:45'!
printXmlOn: aStream
self subclassResponsibility! !
!PPXmlNode methodsFor: 'accessing' stamp: 'lr 3/26/2010 17:57'!
root
"Answer the root of the subtree in which this node is found, whether that's a document or an element."
^ parent isNil
ifTrue: [ self ]
ifFalse: [ parent root ]! !
!PPXmlNode methodsFor: 'initialization' stamp: 'lr 3/27/2010 14:00'!
setParent: aNode
parent := aNode! !
PPXmlNode subclass: #PPXmlParent
instanceVariableNames: 'children'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Nodes'!
PPXmlParent subclass: #PPXmlDocument
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Nodes'!
!PPXmlDocument commentStamp: 'lr 2/4/2010 13:27' prior: 0!
An XML root node.!
!PPXmlDocument methodsFor: 'accessing' stamp: 'lr 3/26/2010 17:56'!
document
^ self! !
!PPXmlDocument methodsFor: 'testing' stamp: 'lr 2/4/2010 13:44'!
isDocument
^ true! !
!PPXmlDocument methodsFor: 'accessing' stamp: 'lr 3/28/2010 11:28'!
rootElement
"Answer the root element of the receiving document."
^ self children
detect: [ :each | each isElement ]
ifNone: [ nil ]! !
PPXmlParent subclass: #PPXmlElement
instanceVariableNames: 'name attributes'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Nodes'!
!PPXmlElement commentStamp: 'lr 2/4/2010 13:27' prior: 0!
An XML element node.!
!PPXmlElement class methodsFor: 'instance creation' stamp: 'lr 3/28/2010 10:23'!
name: anXmlName attributes: anAttributeArray children: aChildrenArray
^ self basicNew
setName: anXmlName;
setAttributes: anAttributeArray;
setChildren: aChildrenArray;
yourself! !
!PPXmlElement methodsFor: 'comparing' stamp: 'lr 3/28/2010 09:53'!
= anXmlNode
super = anXmlNode
ifFalse: [ ^ false ].
self name = anXmlNode name
ifFalse: [ ^ false ].
self attributes size = anXmlNode attributes size
ifFalse: [ ^ false ].
self attributes with: anXmlNode attributes do: [ :first :second |
first = second
ifFalse: [ ^ false ] ].
^ true! !
!PPXmlElement methodsFor: 'accessing' stamp: 'lr 1/26/2010 16:39'!
attributes
^ attributes! !
!PPXmlElement methodsFor: 'comparing' stamp: 'lr 3/27/2010 18:18'!
hash
^ super hash bitXor: self name hash! !
!PPXmlElement methodsFor: 'testing' stamp: 'lr 3/26/2010 18:14'!
isElement
^ true! !
!PPXmlElement methodsFor: 'accessing' stamp: 'lr 3/27/2010 09:57'!
name
^ name! !
!PPXmlElement methodsFor: 'copying' stamp: 'lr 3/28/2010 09:52'!
postCopy
super postCopy.
self setAttributes: (self attributes
collect: [ :each | each copy ])! !
!PPXmlElement methodsFor: 'printing' stamp: 'lr 3/28/2010 09:54'!
printXmlOn: aStream
aStream nextPut: $<.
name printXmlOn: aStream.
self attributes do: [ :each |
aStream nextPut: $ .
each printXmlOn: aStream ].
self children isEmpty
ifTrue: [ aStream nextPutAll: ' />' ]
ifFalse: [
aStream nextPut: $>.
super printXmlOn: aStream.
aStream nextPutAll: ''.
name printXmlOn: aStream.
aStream nextPut: $> ]! !
!PPXmlElement methodsFor: 'initialization' stamp: 'lr 3/28/2010 10:27'!
setAttributes: aCollection
attributes := aCollection asArray
collect: [ :each | each setParent: self ]! !
!PPXmlElement methodsFor: 'initialization' stamp: 'lr 3/27/2010 09:59'!
setName: anXmlName
name := anXmlName! !
!PPXmlParent class methodsFor: 'instance creation' stamp: 'lr 3/28/2010 10:22'!
children: anArray
^ self basicNew
setChildren: anArray;
yourself! !
!PPXmlParent methodsFor: 'comparing' stamp: 'lr 3/28/2010 09:49'!
= anXmlNode
self == anXmlNode
ifTrue: [ ^ true ].
self class = anXmlNode class
ifFalse: [ ^ false ].
self children size = anXmlNode children size
ifFalse: [ ^ false ].
self children with: anXmlNode children do: [ :first :second |
first = second
ifFalse: [ ^ false ] ].
^ true! !
!PPXmlParent methodsFor: 'accessing' stamp: 'lr 3/28/2010 09:46'!
children
^ children! !
!PPXmlParent methodsFor: 'comparing' stamp: 'lr 3/28/2010 10:21'!
hash
^ self children size hash! !
!PPXmlParent methodsFor: 'copying' stamp: 'lr 3/28/2010 09:49'!
postCopy
super postCopy.
self setChildren: (self children
collect: [ :each | each copy ])! !
!PPXmlParent methodsFor: 'printing' stamp: 'lr 3/28/2010 09:49'!
printXmlOn: aStream
self children
do: [ :each | each printXmlOn: aStream ]! !
!PPXmlParent methodsFor: 'initialization' stamp: 'lr 3/28/2010 10:26'!
setChildren: aCollection
children := aCollection asArray
collect: [ :each | each setParent: self ]! !