Move everything in CouchDB to CouchDB-Core, and add basic support for…

… attachments.

src/BaselineOfCouchDB/BaselineOfCouchDB.class.st

@@ -13,7 +13,12 @@ BaselineOfCouchDB >> baseline: spec [
 				baseline: 'NeoJSON'
 				with: [ spec repository: 'github://svenvc/NeoJSON/repository' ].
 			spec
-				package: #'CouchDB-Client'
+				package: #'CouchDB-Core'
 				with: [ spec requires: #('NeoJSON') ].
-			spec group: 'default' with: #(#'CouchDB-Client') ]
+			spec
+				package: #'CouchDB-Examples'
+				with: [ spec requires: #('CouchDB-Core') ].
+			spec group: 'default' with: #(#'CouchDB-Core' 'CouchDB-Examples').
+			spec group: 'core' with: #(#'CouchDB-Core').
+			 ]
 ]

src/CouchDB/Boolean.extension.st → src/CouchDB-Core/Boolean.extension.st

@@ -1,6 +1,6 @@
 Extension { #name : #Boolean }
 
-{ #category : #'*CouchDB' }
+{ #category : #'*CouchDB-Core' }
 Boolean >> couchWriteOn: aStream [
 	self printOn: aStream
 ]

src/CouchDB/Character.extension.st → src/CouchDB-Core/Character.extension.st

@@ -1,6 +1,6 @@
 Extension { #name : #Character }
 
-{ #category : #'*CouchDB' }
+{ #category : #'*CouchDB-Core' }
 Character >> couchWriteOn: aStream [
 
 	aStream nextPut: $".

src/CouchDB/Collection.extension.st → src/CouchDB-Core/Collection.extension.st

@@ -1,6 +1,6 @@
 Extension { #name : #Collection }
 
-{ #category : #'*CouchDB' }
+{ #category : #'*CouchDB-Core' }
 Collection >> couchWriteOn: aStream [
 	aStream nextPut: $[.
 	self

src/CouchDB-Core/CouchAttachment.class.st

@@ -0,0 +1,92 @@
+Class {
+	#name : #CouchAttachment,
+	#superclass : #CouchObject,
+	#instVars : [
+		'document',
+		'name',
+		'mimeType',
+		'stub',
+		'contents'
+	],
+	#category : #'CouchDB-Core-CouchDB-Core'
+}
+
+{ #category : #'instance creation' }
+CouchAttachment class >> delete: aCouchAttachment [
+
+	self request: [ :zn |
+		zn url: aCouchAttachment address.
+		zn headerAt: 'If-Match' put: aCouchAttachment  revision.
+		zn delete	
+	 ]
+]
+
+{ #category : #'instance creation' }
+CouchAttachment class >> name: aString mimeType: mimeType in: aCouchDocument [
+	"Creates a new instance of receiver belonging to aCouchDocument,
+	with name aString and a mimeType."
+
+	^self new 
+		setName: aString
+		mimeType: mimeType asZnMimeType 
+		document: aCouchDocument
+
+]
+
+{ #category : #'instance creation' }
+CouchAttachment class >> save: aCouchAttachment [
+
+	self request: [ :zn |
+		zn url: aCouchAttachment address.
+		zn headerAt: 'If-Match' put: aCouchAttachment document revision.
+		zn beBinary.
+		zn contents: aCouchAttachment contents.
+		zn contentType: aCouchAttachment mimeType.
+		zn put	
+	 ]
+]
+
+{ #category : #accessing }
+CouchAttachment >> address [
+
+	^address ifNil: [ address := self document address / self name ]
+]
+
+{ #category : #accessing }
+CouchAttachment >> contents [
+	^ contents
+]
+
+{ #category : #accessing }
+CouchAttachment >> contents: aByteArray [
+	contents := aByteArray
+]
+
+{ #category : #accessing }
+CouchAttachment >> document [
+	^ document
+]
+
+{ #category : #initialization }
+CouchAttachment >> isStub [
+
+	^contents isNil
+]
+
+{ #category : #accessing }
+CouchAttachment >> mimeType [
+	^ mimeType
+]
+
+{ #category : #accessing }
+CouchAttachment >> name [
+	^ name
+]
+
+{ #category : #initialization }
+CouchAttachment >> setName: aString mimeType: aZnMimeType document: aCouchDocument [
+
+	name := aString.
+	mimeType := aZnMimeType.
+	document := aCouchDocument
+]

src/CouchDB/CouchDBError.class.st → src/CouchDB-Core/CouchDBError.class.st

@@ -4,5 +4,5 @@ CouchDBError is raised whenever we get an error response from the CouchDB server
 Class {
 	#name : #CouchDBError,
 	#superclass : #Error,
-	#category : #CouchDB
+	#category : #'CouchDB-Core-CouchDB-Core'
 }

src/CouchDB/CouchDatabase.class.st → src/CouchDB-Core/CouchDatabase.class.st

@@ -4,7 +4,7 @@ Database provides an interface to a database running on a CouchDB server.
 Class {
 	#name : #CouchDatabase,
 	#superclass : #CouchObject,
-	#category : #CouchDB
+	#category : #'CouchDB-Core-CouchDB-Core'
 }
 
 { #category : #'api - database' }
@@ -44,6 +44,11 @@ CouchDatabase >> createAll: aCollectionOfObjects [
 	^documents
 ]
 
+{ #category : #'api - querying' }
+CouchDatabase >> delete [
+	^self class delete: self address
+]
+
 { #category : #'api - views' }
 CouchDatabase >> design: designName view: viewName [
 	^CouchView new

src/CouchDB/CouchDocument.class.st → src/CouchDB-Core/CouchDocument.class.st

@@ -3,9 +3,10 @@ Class {
 	#superclass : #CouchObject,
 	#instVars : [
 		'revision',
-		'object'
+		'object',
+		'attachments'
 	],
-	#category : #CouchDB
+	#category : #'CouchDB-Core-CouchDB-Core'
 }
 
 { #category : #'instance creation' }
@@ -15,18 +16,11 @@ CouchDocument class >> with: anObject [
 		yourself
 ]
 
-{ #category : #'instance creation' }
-CouchDocument class >> writeAttachment: uri contentType: aString bytes: aByteArray [
-	^self request: [:client | 
-		| request |
-		request := (client requestClass put: uri).
-		request contentType: aString.
-		request doNotChunk.
-		request contentLength: aByteArray size.
-		request byteSource: aByteArray readStream.
-		client request: request.
-		client  executeAndGetResponse
-	]
+{ #category : #accessing }
+CouchDocument >> attachments [
+
+	^attachments ifNil: [ attachments := OrderedCollection new ].
+
 ]
 
 { #category : #converting }
@@ -54,6 +48,15 @@ CouchDocument >> delete [
 	^response
 ]
 
+{ #category : #attachments }
+CouchDocument >> deleteAttachement: aCouchAttachment [
+	| response |
+	revision ifNil: [self refresh].
+	response := CouchAttachment delete: aCouchAttachment .
+	revision := response at: '_rev'.
+	^response
+]
+
 { #category : #accessing }
 CouchDocument >> id [
 	^ self address ifNotNil: [ :obj | obj lastPathSegment ]
@@ -90,6 +93,14 @@ CouchDocument >> refresh [
 	| response |
 	response := self information.
 	revision := response at: '_rev'.
+	attachments := Dictionary new.
+	(response includesKey: '_attachments')
+		ifTrue: [ 
+			 (response at: '_attachments') keysAndValuesDo: [ :key :value |
+				attachments at: key put: value 
+				 ]
+			].
+
 	object := response couchToObject.
 	^response
 ]
@@ -117,16 +128,17 @@ CouchDocument >> save [
 	^response
 ]
 
-{ #category : #'initialize-release' }
-CouchDocument >> undefined [
-	^ #_undefined
-]
-
-{ #category : #api }
-CouchDocument >> writeAttachment: nameString contentType: aString bytes: aByteArray [
+{ #category : #attachments }
+CouchDocument >> saveAttachment: aCouchAttachment [
 	| response |
 	revision ifNil: [self refresh].
-	response := self class writeAttachment: ((address asString, '/' , nameString) asUrl query: 'rev=', revision) contentType: aString bytes: aByteArray.
-	revision := response at: 'rev'.
+	response := CouchAttachment save: aCouchAttachment.
+	1 halt.
+	revision := response at: '_rev'.
 	^response
 ]
+
+{ #category : #'initialize-release' }
+CouchDocument >> undefined [
+	^ #_undefined
+]

src/CouchDB/CouchInterface.class.st → src/CouchDB-Core/CouchInterface.class.st

@@ -8,7 +8,7 @@ Class {
 	#classVars : [
 		'Default'
 	],
-	#category : #CouchDB
+	#category : #'CouchDB-Core-CouchDB-Core'
 }
 
 { #category : #api }
@@ -31,7 +31,7 @@ CouchInterface >> databases [
 
 { #category : #api }
 CouchInterface >> delete: databaseName [
-	^self client delete: self address / databaseName
+	^self class delete: self address / databaseName
 ]
 
 { #category : #api }

src/CouchDB-Core/CouchJSONWriter.class.st

@@ -0,0 +1,79 @@
+"
+I'm an utility class created with the purpose of not cluttering other classes with helper methods.
+"
+Class {
+	#name : #CouchJSONWriter,
+	#superclass : #Object,
+	#category : #'CouchDB-Core-CouchDB-Core'
+}
+
+{ #category : #'character-encoding' }
+CouchJSONWriter class >> doesCodePointNeedEscaping: code [
+	code < 32 ifTrue: [ ^ true ].
+	( code = 34 or: [ code = 92 ]) ifTrue: [ ^ true ].
+	^code > 126
+]
+
+{ #category : #'character-encoding' }
+CouchJSONWriter class >> escapeChar: codePoint on: writeStream [
+
+	codePoint = 34
+		ifTrue: [ ^ writeStream nextPutAll: '\"' ].
+	codePoint = 92
+		ifTrue: [ ^ writeStream nextPutAll: '\\' ].
+	codePoint = 47
+		ifTrue: [ ^ writeStream nextPutAll: '\/' ].
+	codePoint = 8
+		ifTrue: [ ^ writeStream nextPutAll: '\b' ].
+	codePoint = 12
+		ifTrue: [ ^ writeStream nextPutAll: '\f' ].		
+	codePoint = 10
+		ifTrue: [ ^ writeStream nextPutAll: '\n' ].		
+	codePoint = 13
+		ifTrue: [ ^ writeStream nextPutAll: '\r' ].		
+	codePoint = 9
+		ifTrue: [ ^ writeStream nextPutAll: '\t' ].	
+
+	self escapeUnicode: codePoint on: writeStream
+]
+
+{ #category : #'character-encoding' }
+CouchJSONWriter class >> escapeUnicode4: codePoint on: writeStream [
+	writeStream nextPutAll: '\u'.
+	codePoint printOn: writeStream base: 16 nDigits: 4
+]
+
+{ #category : #'character-encoding' }
+CouchJSONWriter class >> escapeUnicode: codePoint on: writeStream [
+
+	codePoint <= 16rFFFF
+		ifTrue: [ self escapeUnicode4: codePoint on: writeStream ]
+		ifFalse: [ 
+			codePoint <= 16r10FFFF
+				ifTrue: [ | leadSurrogate trailSurrogate shifted |
+					"Characters not in the Basic Multilingual Plane are encoded as a UTF-16 surrogate pair"
+					"See https://tools.ietf.org/html/rfc7159#section-7"
+					shifted := codePoint - 16r10000.
+					leadSurrogate := 16rD800 + (shifted // 16r400).
+					trailSurrogate := 16rDC00 + (shifted \\ 16r400).
+					self escapeUnicode4: leadSurrogate on: writeStream.
+					self escapeUnicode4: trailSurrogate on: writeStream]
+				ifFalse: [ self error: 'Character Unicode code point outside encoder range' ] ]
+]
+
+{ #category : #writing }
+CouchJSONWriter class >> writeChar: char on: writeStream [
+
+	| codePoint |
+	codePoint := char codePoint.
+	(self doesCodePointNeedEscaping: codePoint)
+		ifTrue: [ self escapeChar: codePoint on: writeStream ]
+		ifFalse: [ writeStream nextPut: char ]
+]
+
+{ #category : #writing }
+CouchJSONWriter class >> writeString: aString on: aStream [
+	aStream nextPut: $".
+	aString do: [ :char | self writeChar: char on: aStream ].
+	aStream nextPut: $"
+]