FEAT: Added ZIP encoder

Author: Oldes

src/mezz/codec-zip.reb

@@ -146,7 +146,158 @@ register-codec [
 		result
 	]
 
-	;encode: function [data [binary!]][	]
+	encode: wrap [
+		bin: dir: data: date: file: add-data: root: none
+		compressed-data: method:
+		compressed-size: size: crc: entries: filename-length: offset: 0
+
+		add-file: func[file [file!] /local dir spec][
+			try/except [
+				spec: query/mode file [type: date:]
+				either spec [
+					file-name: find/tail file root
+					either spec/type = 'dir [
+						dir: file
+						add-data file-name spec
+						foreach file read dir  [
+							add-file dir/:file
+						]
+					][
+						add-data file-name reduce [spec/date read file]
+					]
+				][
+					; wildcard?
+					dir: first split-path file
+					foreach file read file [
+						add-file dir/:file
+					]
+				]
+			][
+				sys/log/error 'ZIP ["Failed to add file:" as-green file]
+			]
+		]
+
+		add-data: func[file spec][
+			sys/log/info 'ZIP ["Adding:" as-green file]
+
+			any [file? file cause-error 'user 'message reduce [reform ["found" type? file "where file! expected"]]]
+			data: date: none
+			compressed-size: size: crc: filename-length: 0
+			any [
+				all [
+					block? spec 
+					parse spec [any [
+						spec:
+						  date!   (date: spec/1)
+						| string! (data: to binary! spec/1)
+						| binary! (data: spec/1)
+						| 1 skip
+					]]
+				]
+				all [binary? spec data: spec]
+				all [string? spec data: to binary! spec]
+				none? spec ; just a directory
+				spec = 'none
+				;else..
+				all [
+					sys/log/error 'ZIP ["Invalid zip file's data specification:" as-red mold/part spec 30]
+					continue
+				]
+			]
+			method: either any [
+				none? data
+				lesser-or-equal? size: length? data length? compressed-data: compress data
+			][
+				compressed-data: data
+				0 ;store
+			][
+				compressed-data: copy/part skip compressed-data 2 skip tail compressed-data -8 ;@@ FIXME once compress/zlib will be fixed!
+				8 ;deflate
+			]
+
+			either compressed-data [
+				crc: checksum data 'CRC32
+				compressed-size: length? compressed-data
+			][	compressed-data: #{}
+				compressed-size: 0
+			]
+			if any [
+				none? date
+				"?date?" = form date ; temp fix for invalid date!
+			][	date: now ]
+
+			filename-length: length? file
+			offset: -1 + index? bin/buffer-write
+
+			binary/write bin [
+				#{504B0304 1400 0000} ;signature / version / flags
+				UI16LE         :method
+				MSDOS-DATETIME :date
+				UI32LE         :crc
+				UI32LE         :compressed-size
+				UI32LE         :size
+				UI16LE         :filename-length
+				UI16LE         0 ; extra
+				BYTES          :file
+				BYTES          :compressed-data
+			]
+			binary/write dir [
+				#{504B0102 1400 1400 0000} ; signature / version made / version needed / flags
+				UI16LE         :method
+				MSDOS-DATETIME :date
+				UI32LE         :crc
+				UI32LE         :compressed-size
+				UI32LE         :size
+				UI16LE         :filename-length
+				UI16LE         0 ; Extra field length
+				UI16LE         0 ; File comment length
+				UI16LE         0 ; Disk number where file starts
+				UI16LE         0 ; Internal file attributes
+				UI32LE         0 ; External file attributes
+				UI32LE         :offset ; Relative offset of local file header
+				BYTES          :file
+				;#{} ; Extra field
+				;#{} ; File comment
+			]
+			++ entries
+		]
+
+		;- ENCODE:
+		func [
+			"Compress given block of files."
+			files [block! file!] "[file! binary! ..] or [file! [date! crc binary!] or [dir! none!] ..]"
+		][
+			bin: binary 10000
+			dir: binary 1000
+			entries: 0
+
+			either file? files [
+				root: first split-path files
+				add-file files
+			][
+				foreach [file spec] files [
+					add-data file spec
+				]
+			]
+
+			dir-size: length? dir/buffer
+			bin-size: length? bin/buffer
+
+			binary/write bin [
+				BYTES :dir/buffer
+				#{504B0506}      ; End of central directory signature
+				UI16LE 0         ; Number of this disk
+				UI16LE 0         ; Disk where central directory starts
+				UI16LE :entries  ; Number of central directory records on this disk
+				UI16LE :entries  ; Total number of central directory records
+				UI32LE :dir-size ; Size of central directory
+				UI32LE :bin-size ; Offset of start of central directory
+				UI16LE 0         ; Comment length
+				;#{}             ; Comment
+			]
+			bin/buffer
+		]
+	]
 
 	identify: function [data [binary!]][
 		all [

src/tests/units/codecs-test.r3

@@ -239,6 +239,41 @@ if find codecs 'zip [
 			data: codecs/zip/decompress-file at bin info/2/2 reduce [info/2/5 info/2/3 info/2/4]
 			--assert info/2/6 = checksum data 'crc32
 
+		--test-- "Encode ZIP using encode"
+			--assert binary? try [bin: encode 'ZIP [
+				%empty-folder/ none
+				%file-1 "Hello!"
+				%file-2 "Hello, Hello, Hello, Hello, Hello!"
+				%file-3 #{000102030400010203040001020304}
+				%folder/file-4 [1-Jan-2021 "This file is with date!"]
+			]]
+			data: decode 'ZIP bin
+			--assert all [
+				data/1 = %empty-folder/
+				data/3 = %file-1
+				data/4/3 = #{48656C6C6F21}
+				data/5 = %file-2
+				data/9 = %folder/file-4
+				data/10/1 = 1-Jan-2021/0:00
+			]
+
+		--test-- "Encode ZIP using directory"
+			--assert not error? try [save %ico.zip %units/files/ico/]
+			data: load %ico.zip
+			--assert 30 = length? data ; 14 files and 1 directory
+			--assert %ico/ = data/1
+			--assert %ico/icon_128.png = data/3
+			delete %ico.zip
+
+		--test-- "Encode ZIP using wildcard"
+			--assert not error? try [save %temp.zip %units/files/issue-2186*.txt]
+			data: load %temp.zip
+			--assert 8 = length? data ; 4 files
+			--assert %issue-2186-UTF16-BE.txt = data/1
+			--assert %issue-2186-UTF16-LE.txt = data/3
+			delete %temp.zip
+
+
 	===end-group===
 	system/options/log/zip: v
 ]