MetacelloSemanticVersionNumber.st
changeset 1 9e312de5f694
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/MetacelloSemanticVersionNumber.st	Mon Sep 03 11:13:41 2012 +0000
@@ -0,0 +1,397 @@
+"{ Package: 'stx:goodies/metacello' }"
+
+Magnitude subclass:#MetacelloSemanticVersionNumber
+	instanceVariableNames:'normalVersion preReleaseVersion buildVersion'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Metacello-Core-Model'
+!
+
+
+!MetacelloSemanticVersionNumber class methodsFor:'instance creation'!
+
+fromString: aString
+    ^ self fromString: aString forPattern: false
+!
+
+fromString: aString forPattern: forPattern
+    | new tokens preRelease build versionString identifierCount normalEnd preReleaseEnd normalComponents preReleaseComponents buildComponents |
+    normalComponents := OrderedCollection new.
+    preReleaseComponents := OrderedCollection new.
+    buildComponents := OrderedCollection new.
+    preRelease := aString indexOf: $- startingAt: 1.
+    build := aString indexOf: $+ startingAt: 1.
+    (build > 0 and: [ preRelease > build ])
+        ifTrue: [ preRelease := 0 ].
+    normalEnd := preRelease = 0
+        ifTrue: [ 
+            build = 0
+                ifTrue: [ aString size ]
+                ifFalse: [ build - 1 ] ]
+        ifFalse: [ preRelease - 1 ].
+    versionString := aString copyFrom: 1 to: normalEnd.
+    identifierCount := 0.
+    (versionString findTokens: '.')
+        do: [ :subString | 
+            | integer |
+            forPattern
+                ifTrue: [ integer := subString ]
+                ifFalse: [ 
+                    integer := subString asInteger.
+                    integer < 0
+                        ifTrue: [ self error: 'invalid version number: normal version component must be integer ' , subString printString ] ].
+            normalComponents add: integer.
+            identifierCount := identifierCount + 1 ].
+    (forPattern not and: [ identifierCount ~= 3 ])
+        ifTrue: [ self error: 'invalid version number: normal version must have only 3 components' ].
+    preReleaseEnd := build = 0
+        ifTrue: [ aString size ]
+        ifFalse: [ build - 1 ].
+    preRelease > 0
+        ifTrue: [ 
+            versionString := aString copyFrom: preRelease + 1 to: preReleaseEnd.
+            (versionString findTokens: '.')
+                do: [ :subString | 
+                    (forPattern or: [ self isSemanticIdentifier: subString ])
+                        ifFalse: [ self error: 'invalid version number: preRelease version component must be one of [0-9A-Za-z-]' ].
+                    preReleaseComponents add: (self extractNumericComponent: subString forPattern: forPattern) ] ].
+    build > 0
+        ifTrue: [ 
+            versionString := aString copyFrom: build + 1 to: aString size.
+            (versionString findTokens: '.')
+                do: [ :subString | 
+                    (forPattern or: [ self isSemanticIdentifier: subString ])
+                        ifFalse: [ self error: 'invalid version number: build version component must be one of [0-9A-Za-z-]' ].
+                    buildComponents add: (self extractNumericComponent: subString forPattern: forPattern) ] ].
+    ^ self new
+        normalVersion: normalComponents;
+        preReleaseVersion: preReleaseComponents;
+        buildVersion: buildComponents;
+        yourself
+! !
+
+!MetacelloSemanticVersionNumber class methodsFor:'private'!
+
+extractNumericComponent: subString forPattern: forPattern
+    "$. separated components are integers"
+
+    | number |
+    forPattern
+        ifTrue: [ ^ subString ].
+    number := [ subString asNumber ]
+        on: Error
+        do: [ :ex | ex return: subString ].
+    ^ number asString = subString
+        ifTrue: [ number ]
+        ifFalse: [ subString ]
+!
+
+isSemanticIdentifier: aString
+    "whether the receiver is composed entirely of alphanumerics"
+
+    aString
+        do: [ :c | 
+            c isAlphaNumeric
+                ifFalse: [ 
+                    c = $-
+                        ifFalse: [ ^ false ] ] ].
+    ^ true
+! !
+
+!MetacelloSemanticVersionNumber methodsFor:'accessing'!
+
+approximateBase
+
+	| base |
+	base := self copyFrom: 1 to: self size - 1.
+	base at: base size put: (base at: base size) + 1.
+	^base
+!
+
+buildVersion
+    buildVersion ifNil: [ buildVersion := #() ].
+    ^ buildVersion
+!
+
+buildVersion: anObject
+	buildVersion := anObject
+!
+
+normalVersion
+    normalVersion ifNil: [ normalVersion := #() ].
+    ^ normalVersion
+!
+
+normalVersion: anObject
+	normalVersion := anObject
+!
+
+preReleaseVersion
+    preReleaseVersion ifNil: [ preReleaseVersion := #() ].
+    ^ preReleaseVersion
+!
+
+preReleaseVersion: anObject
+	preReleaseVersion := anObject
+!
+
+versionString
+
+	| strm |
+	strm := WriteStream on: String new.
+	self printOn: strm.
+	^strm contents
+! !
+
+!MetacelloSemanticVersionNumber methodsFor:'comparing'!
+
+< aMetacelloVersionNumber
+    aMetacelloVersionNumber species = self species
+        ifFalse: [ ^ false ].
+    ^ self compareLessThan: aMetacelloVersionNumber
+!
+
+= aMetacelloVersionNumber
+    aMetacelloVersionNumber species = self species
+        ifFalse: [ ^ false ].
+    ^ self compareEqualTo: aMetacelloVersionNumber
+!
+
+hash
+    ^ self versionComponents hash
+!
+
+match: aVersionPattern
+    "Answer whether the version number of the receiver matches the given pattern string.
+
+	 A Metacello version number is made up of version sequences delimited by the characters $. and $-.
+	 The $. introduces a numeric version sequence and $- introduces an alphanumeric version sequence.
+	 
+	 A version pattern is made up of version pattern match sequences. also delimited by the characters $. 
+	 and $-.. Each pattern match sequence is tested against the corresponding version sequence of the 
+	 receiver, using the 'standard' pattern matching rules. All sequences must answer true for a match.
+	
+	 The special pattern sequence '?' is a match for the corresponding version sequence and all subsequent 
+	 version sequences. '?' as the version pattern matches all versions. No more version pattern 
+	 sequences are permitted once the '?' sequence is used. If used, it is the last version pattern
+	 sequence. "
+
+    | patternVersion mySize patternSize components |
+    patternVersion := (self class fromString: aVersionPattern forPattern: true) versionComponents.
+    components := self versionComponents.
+    mySize := components size.
+    patternSize := patternVersion size.
+    mySize = patternSize
+        ifFalse: [ 
+            mySize < patternSize
+                ifTrue: [ ^ false ].
+            (patternVersion at: patternSize) ~= '?'
+                ifTrue: [ ^ false ].
+            mySize := patternSize ].
+    1 to: mySize do: [ :i | 
+        | pattern |
+        pattern := (patternVersion at: i) asString.
+        pattern = '?'
+            ifTrue: [ 
+                i = mySize
+                    ifFalse: [ ^ self error: 'Invalid version match pattern: ' , aVersionPattern printString ] ]
+            ifFalse: [ 
+                (pattern match: (components at: i) asString)
+                    ifFalse: [ ^ false ] ] ].
+    ^ true
+!
+
+~> aMetacelloVersionNumber
+
+	aMetacelloVersionNumber size == 1 ifTrue: [ ^false ].
+	^self >= aMetacelloVersionNumber and: [ self < aMetacelloVersionNumber approximateBase ]
+! !
+
+!MetacelloSemanticVersionNumber methodsFor:'converting'!
+
+asMetacelloSemanticVersionNumber
+    ^ self
+! !
+
+!MetacelloSemanticVersionNumber methodsFor:'copying'!
+
+copyFrom: start to: stop 
+	"Answer a copy of a subset of the receiver, starting from element at 
+	index start until element at index stop."
+
+	| newSize new j |
+	newSize := stop - start + 1.
+	new := self species new: newSize.
+	j := 0.
+	start to: stop do: [:i |
+		new at: j + 1 put: (self at: i).
+		j := j + 1 ].
+	^new
+! !
+
+!MetacelloSemanticVersionNumber methodsFor:'enumerating'!
+
+do: aBlock 
+	"Refer to the comment in Collection|do:."
+	1 to: self size do:
+		[:index | aBlock value: (self at: index)]
+!
+
+do: elementBlock separatedBy: separatorBlock
+	"Evaluate the elementBlock for all elements in the receiver,
+	and evaluate the separatorBlock between."
+
+	| beforeFirst | 
+	beforeFirst := true.
+	self do:
+		[:each |
+		beforeFirst
+			ifTrue: [beforeFirst := false]
+			ifFalse: [separatorBlock value].
+		elementBlock value: each]
+! !
+
+!MetacelloSemanticVersionNumber methodsFor:'operations'!
+
+decrementMinorVersionNumber
+	| int |
+	self size to: 1 by: -1 do: [ :index | 
+		(int := self at: index) isString
+			ifFalse: [ 
+				int > 0
+					ifTrue: [ self at: index put: int - 1 ].
+				^ self ] ]
+!
+
+incrementMinorVersionNumber
+
+	| int |
+	self size to: 1 by: -1 do: [:index | 
+		(int := self at: index) isString 
+			ifFalse: [ 
+				self at: index put: int + 1.
+				^self ]].
+! !
+
+!MetacelloSemanticVersionNumber methodsFor:'printing'!
+
+asString
+	"Answer a string that represents the receiver."
+
+	^ self printString
+!
+
+print: components prefix: prefixChar on: aStream
+    | beforeFirst |
+    beforeFirst := true.
+    components
+        do: [ :component | 
+            beforeFirst
+                ifTrue: [ 
+                    beforeFirst := false.
+                    prefixChar ifNotNil: [ aStream nextPut: prefixChar ] ]
+                ifFalse: [ aStream nextPut: $. ].
+            aStream nextPutAll: component asString ]
+!
+
+printOn: aStream
+    self print: self normalVersion prefix: nil on: aStream.
+    self print: self preReleaseVersion prefix: $- on: aStream.
+    self print: self buildVersion prefix: $+ on: aStream
+! !
+
+!MetacelloSemanticVersionNumber methodsFor:'private'!
+
+compareEqualTo: aMetacelloVersionNumber
+    aMetacelloVersionNumber species = self species
+        ifFalse: [ ^ false ].
+    (self compareEqualTo: self normalVersion other: aMetacelloVersionNumber normalVersion)
+        ifFalse: [ ^ false ].
+    (self compareEqualTo: self preReleaseVersion other: aMetacelloVersionNumber preReleaseVersion)
+        ifFalse: [ ^ false ].
+    ^ self compareEqualTo: self buildVersion other: aMetacelloVersionNumber buildVersion
+!
+
+compareEqualTo: myComponents other: otherComponents
+    | mySize |
+    mySize := myComponents size.
+    mySize = otherComponents size
+        ifFalse: [ ^ false ].
+    1 to: mySize do: [ :i | 
+        (myComponents at: i) = (otherComponents at: i)
+            ifFalse: [ ^ false ] ].
+    ^ true
+!
+
+compareLessThan: aMetacelloVersionNumber
+    | myComponents otherComponents defaultResult |
+    aMetacelloVersionNumber species = self species
+        ifFalse: [ ^ false ].
+    myComponents := self normalVersion.
+    otherComponents := aMetacelloVersionNumber normalVersion.
+    defaultResult := true.
+    (self compareEqualTo: myComponents other: otherComponents)
+        ifTrue: [ defaultResult := false ]
+        ifFalse: [ 
+            (self compareLessThan: myComponents other: otherComponents version: #'normal')
+                ifFalse: [ ^ false ] ].
+    myComponents := self preReleaseVersion.
+    otherComponents := aMetacelloVersionNumber preReleaseVersion.
+    (self compareEqualTo: myComponents other: otherComponents)
+        ifTrue: [ 
+            myComponents size > 0
+                ifTrue: [ defaultResult := false ] ]
+        ifFalse: [ ^ self compareLessThan: myComponents other: otherComponents version: #'preRelease' ].
+    myComponents := self buildVersion.
+    otherComponents := aMetacelloVersionNumber buildVersion.
+    ^ (self compareEqualTo: myComponents other: otherComponents)
+        ifTrue: [ defaultResult ]
+        ifFalse: [ self compareLessThan: myComponents other: otherComponents version: #'build' ]
+!
+
+compareLessThan: myComponents other: otherComponents version: version
+    | mySize aSize commonSize count more |
+    mySize := myComponents size.
+    aSize := otherComponents size.
+    commonSize := mySize min: aSize.
+    count := 0.
+    more := true.
+    [ more and: [ count < commonSize ] ]
+        whileTrue: [ 
+            (myComponents at: count + 1) = (otherComponents at: count + 1)
+                ifTrue: [ count := count + 1 ]
+                ifFalse: [ more := false ] ].
+    count < commonSize
+        ifTrue: [ ^ (myComponents at: count + 1) metacelloSemanticVersionComponentLessThan: (otherComponents at: count + 1) ].
+    mySize < aSize
+        ifTrue: [ 
+            mySize = 0
+                ifTrue: [ 
+                    #'preRelease' == version
+                        ifTrue: [ ^ false ].
+                    ^ true ].
+            (myComponents at: commonSize) = (otherComponents at: commonSize)
+                ifFalse: [ ^ true ].
+            ^ true ]
+        ifFalse: [ 
+            mySize = aSize
+                ifTrue: [ ^ false ].
+            aSize = 0
+                ifTrue: [ 
+                    #'build' == version
+                        ifTrue: [ ^ false ].
+                    ^ true ].
+            (myComponents at: commonSize) = (otherComponents at: commonSize)
+                ifFalse: [ ^ false ].
+            ^ true ]
+!
+
+versionComponents
+    ^ self normalVersion , self preReleaseVersion , self buildVersion
+! !
+
+!MetacelloSemanticVersionNumber class methodsFor:'documentation'!
+
+version_SVN
+    ^ '$Id::                                                                                                                        $'
+! !