FEAT: implemented read/seek on url!

Oldes · Oldes · commit 74f3df0327cc · 2022-07-18T14:42:53.000+02:00
diff --git a/src/mezz/prot-http.reb b/src/mezz/prot-http.reb
@@ -733,15 +733,28 @@ sys/make-scheme [
 	actor: [
 		read: func [
 			port [port!]
-			/binary
-			/part length [number!]
-			/lines
+			/part {Partial read a given number of units (source relative)}
+				length [integer!]
+			/seek {Read from a specific position (source relative)}
+				index  [integer!] "zero-based!"
+			/string {Convert UTF and line terminators to standard text string}
+			/binary {Preserves contents exactly}
+			/lines  {Convert to block of strings (implies /string)}
 			/local result
 		][
 			sys/log/debug 'HTTP "READ"
+			if lines [
+				if binary [cause-error 'Script 'bad-refine /binary ]
+				seek: part: none
+			]
+			if all [string binary] [cause-error 'Script 'bad-refines none]
+
 			unless port/state [open port port/state/close?: yes]
-			if all [part binary length > 0] [
-				append port/spec/headers compose [Range: (join "bytes=0-" (to integer! length) - 1)]
+
+			if all [any [part seek] not string] [
+				either seek [ binary: true assert [index >= 0]][ index: 0 ]
+				length: either part [ assert [length > 0] length + index][ none ]
+				put port/spec/headers quote Range: ajoin ["bytes=" index #"-" any [all [length length - 1] ""]]
 			]
 			either any-function? :port/awake [
 				unless open? port [cause-error 'Access 'not-open port/spec/ref]
@@ -750,11 +763,19 @@ sys/make-scheme [
 				do-request port
 			][
 				result: sync-op port []
-				unless binary [decode-result result]
-				if result/2 [
+				either binary [
+					unless find result/1 'Accept-Ranges [
+						case/all [
+							seek  [ result/2: at result/2 index  if part [length: length - index]]
+							part  [ clear skip result/2 length]
+						]
+					]
+				][
+					decode-result result
 					case/all [
-						lines [ result/2: split-lines result/2 ]
-						part  [ clear skip result/2 length ]
+						lines  [ result/2: split-lines result/2 ]
+						index  [ result/2: skip result/2 index ]
+						length [ clear skip result/2 length]
 					]
 				]
 				result/2
diff --git a/src/tests/units/port-test.r3 b/src/tests/units/port-test.r3
@@ -554,6 +554,30 @@ if system/platform = 'Windows [
 		--assert error? try [query https://www]
 		--assert object? query https://www.google.com
 
+	--test-- "read/seek/part"
+		; first results without read/part
+		--assert "<!doctype html>" = copy/part str: read/string http://example.com 15
+		--assert "<!doctype html>" = copy/part skip str 0 15
+		--assert   "doctype html>" = copy/part skip str 2 13
+		; using read/part
+		--assert "<!doctype html>" = read/part http://example.com 15
+		--assert "<!doctype html>" = read/seek/part/string http://example.com 0 15
+		--assert   "doctype html>" = read/seek/part/string http://example.com 2 13
+		; when used /seek without /string, than result is always binary!
+		--assert #{3C21646F63747970652068746D6C3E} = read/seek/part http://example.com 0 15
+		--assert     #{646F63747970652068746D6C3E} = read/seek/part http://example.com 2 13
+
+	--test-- "read/lines/seek/part"
+		--assert ["<!doctype html>" "<html>" "<head>"] = read/lines/part http://example.com 3
+		--assert ["<!doctype html>" "<html>" "<head>"] = read/lines/seek/part http://example.com 0 3
+		--assert                   ["<html>" "<head>"] = read/lines/seek/part http://example.com 1 2
+		; using /lines with /binary is not allowed
+		--assert all [error? e: try [read/lines/binary http://example.com] e/id = 'bad-refine]
+		--assert all [block? b: try [read/lines/seek http://example.com 2] b/1 = "<head>"]
+
+	--test-- "read/string/binary"
+		--assert all [error? e: try [read/string/binary http://example.com] e/id = 'bad-refines]
+
 ===end-group===
 
 
