dan
/
cl-pack
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fixed https://github.com/dballard/cl-pack/issues/4 ; version bump to 1.0

This commit is contained in:
Dan Ballard 2018-04-10 16:52:15 -07:00
parent f079626bcb
commit 8e68493603
4 changed files with 55 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
README.md
View File

@ -3,7 +3,7 @@ cl-pack
[www.cliki.net/cl-pack](http://www.cliki.net/cl-pack)
cl-pack supplies Perl/PHP/Ruby/Python compatible `pack()` and `unpack()` functions to allow easy use of (binary format) protocols and files with the above mentioned languages and C. cl-pack was released by Dan Ballard under the BSD-3-Clause license.
cl-pack supplies Perl/PHP/Ruby/Python compatible `pack()` and `unpack()` functions to allow easy use of (binary format) protocols and files with the above mentioned languages and C. cl-pack was released by Dan Ballard <dan@mindstab.net> under the BSD-3-Clause license.
The purpose of cl-pack is to take native Lisp data like numbers, floats, and strings and encode it in a safe binary format in string that can then be written to a file or exchanged with another program while unpack can extract data from binary formats and protocols.
@ -30,6 +30,6 @@ cl-pack is available in [QuickLisp](https://www.quicklisp.org/beta/)
Nearly every feature except a few esoteric ones are supported, check the documentation inside cl-pack.lisp if in doubt and if a feature you need isn't currently supported feel free to contact me and I'll see if I can add it.
**Note** I think the 0.2 release is about as feature complete as I feel I need to get at the moment so I'm pushing it out. If there are not major complaints, then in a bit it will be re-released as 1.0, and if there are complaints, well more code and another pre-1.0 release :smile:
**Note** I think the this release is about as feature complete as I feel I need to get at the moment so I'm pushing it out.
**Cavets** cl-pack was developed on an x86 running Ubuntu with SBCL. It should be endian safe where required and conform to host CPU endianness where required but I haven't been able to test on anything but x86. I would hope that it would work with most Lisps out there. Please feel free to get a hold of me if you have issues that need fixing.

2
cl-pack.asd
View File

@ -21,7 +21,7 @@
(defsystem #:cl-pack
:name "cl-pack"
:author "Dan Ballard <dan@mindstab.net>"
:version "0.2"
:version "1.0"
:licence "BSD-3-Clause"
:description "Perl compatible binary pack() and unpack() library"
:depends-on (:ieee-floats)

59
cl-pack.lisp
View File

@ -380,7 +380,7 @@
(let ((offset 1)
(inner-length 0)
(repeater-star nil)
(repeater 0)
(repeater nil)
(mod-! nil)
(mod-> nil)
(mod-< nil)
@ -403,8 +403,8 @@
(multiple-value-bind (repeater-count repeater-chars)
(if (>= (length str) 1)
(parse-integer str :junk-allowed t)
(values 0 0))
(if (eql repeater-count nil)
(values nil 0))
(if (and (>= (length str) 1) (eql repeater-count nil))
;; no repeater #, check for other modifiers ( * ! < > )
(case (char str 0)
(#\! (progn (setf mod-! t) (incf offset)))
@ -419,10 +419,8 @@
))
)
(progn ; repeater-count == #
(if (> repeater-count 0) (setf repeater repeater-count))
(if repeater-count (setf repeater repeater-count))
(incf offset repeater-chars))
)))
@ -430,7 +428,7 @@
(let ((new-form form))
(inc-form)
(if (or repeater-star (> repeater 1))
(if (or repeater-star (and repeater (> repeater 1)))
(setf new-form (concatenate 'string
(subseq form 0 (if (> inner-length 0) (+ 2 inner-length) 1))
(if mod-! "!" "")
@ -441,7 +439,8 @@
(write-to-string (1- repeater)))
(subseq form offset))))
(progn ,@body))))))
(progn
,@body))))))
(defmacro gen-modifiers-list ()
@ -478,7 +477,6 @@
(second rest)
"")
;;; BODY
;; Extra optional keyed parameters
;; :result result is the result so far of the pack operation
@ -504,15 +502,13 @@
(setf rest (rest (rest rest)))))
(otherwise (setf end? t))))
;; Instead of passing a series of arguments, you can call it with a destructable list of arguments
(let ((dlist-arg-style nil))
(if (and (>= 1 (length rest)) (listp (first rest)))
(progn
(setf dlist-arg-style t)
(setf rest (first rest))))
(setf rest (first rest))
))
;; second end test (redundant a little, can we merge?
(if (and (or (eql nil rest) (equal '(nil) rest)) (and (not (eql (strhead form) #\x)) (not (eql (strhead form) #\X))))
@ -522,15 +518,23 @@
;; set up of required endian functions
(let ((bytes-to-string-fn #'bytes-to-string-rev) ; LITTLE ENDIAN
(item (first rest))
(new-rest (rest rest))) ; default rest for numbers
(new-result nil)
(new-rest rest))
#+big-endian(setf bytes-to-string-fn #'bytes-to-string) ; BIG ENDIAN
(if mod->
(setf bytes-to-string-fn #'bytes-to-string))
(if mod-<
(setf bytes-to-string-fn #'bytes-to-string-rev))
(if (or (not repeater) (> repeater 0))
(progn
(if (not repeater) (setf repeater 0))
(setf new-rest (rest rest)) ;consume here - default rest for numbers
;; pack case satement
(let ((new-result
(setf new-result
;; FORM of: sequence length / sequence items
(if (> /-pos 0)
@ -556,7 +560,6 @@
(inc-form)
(concatenate 'string (pack (subseq form 0 /-pos) consumed-length) ret)))
;; ALL other FORMS
(case (strhead form)
(#\n ;Unsigned Short 16bit Big Endian AB=AB
@ -585,7 +588,6 @@
;; crash :(
;; (string (code-char item )))
((#\s #\S) ;signed/unsigned short 16bit
(pack-int 2 :native))
@ -682,14 +684,10 @@
(setf new-rest rest) ; for dlist-style carry on
ret))
(otherwise (progn
(setf new-rest rest) ; didn't do anything, don't consume anything
"")))))
) ;; let ()
;(format t "~a~%" new-result)
""))))
) ;; (setf new-result)
;; if using a descructable arg list
(if dlist-arg-style
@ -700,10 +698,10 @@
(setf (car rest) (second rest))
(setf (cdr rest) (rest (rest rest)))))
;; regardless, continue using the dlist style
(setf new-rest (list rest))))
(setf new-rest (list rest))))))
;; Recursion for the rest of pack
(apply #'pack (append (list new-form :result (concatenate 'string result new-result) :modifiers modifiers) new-rest)))))))))
(apply #'pack (append (list new-form :result (concatenate 'string result new-result) :modifiers modifiers) new-rest))))))))
;; macro for unpack.
;; cuts out and returns part of a string to be used for processing while setting
@ -718,7 +716,7 @@
;;; form: a string of characters corresonding to decodings
;;; string: a string of binary data to be decoded
;;; consumed: optional key parameter. If nil (default) nothing happens
;;; if an integer, ever byte consumed increments consumed
;;; if an integer, every byte consumed increments consumed
;;; and it is the last value return in the values list
;;; returns: the decoded data in specified format
(def-form-parser unpack (string &key (consumed nil) (modifiers nil))
@ -742,11 +740,14 @@
(if mod-<
(setf string-to-bytes-fn #'string-to-bytes-rev))
;; pack case statement and recursive call to unpack
;; unpack case statement and recursive call to unpack
;; note: not tail optiomized :fix ?
(apply #'values
(remove nil (append
(if (or (not repeater) (> repeater 0))
(progn
(if (not repeater) (setf repeater 0))
(if (> /-pos 0)
(progn
@ -803,7 +804,6 @@
(coerce '(#\null #\space) 'string)
"")))
(unpack-string (repeater repeater-star)
(string-trim special-chars (cut-str string (length string) new-str))
(string-trim special-chars (cut-str string (min repeater (length string)) new-str))
@ -835,8 +835,7 @@
)
(otherwise nil)
)))
)))))
;; result of recursion
(multiple-value-list (unpack new-form new-str :consumed consumed :modifiers modifiers))) :from-end t :count 1))))

5
tests.lisp
View File

@ -164,6 +164,10 @@
(equal (multiple-value-list (unpack "c*" "ABC")) '(#x41 #x42 #x43)) ; basic * repeater
(equal (multiple-value-list (unpack "c3" "AB")) '(#x41 #x42)) ; only use avail data -- ! should ERROR be raised?
(equal (multiple-value-list (unpack "c2N" "ABCDEF")) '(#x41 #x42 #x43444546)) ; pick up after repeater
(equal (multiple-value-list (unpack "aa0aa" "ABCD")) '("A" "B" "C")) ; 0 means it skips
; https://github.com/dballard/cl-pack/issues/4
; test that unpack 0 consume 0
(equal (multiple-value-list (unpack "a0" "abc" :consumed 0)) '(0))
))
(deftest unpack-strings ()
@ -269,5 +273,4 @@
(equal (multiple-value-list (unpack "a/c" "3AB")) '(65 66))
(equal (multiple-value-list (unpack "n/c" (concatenate 'string (string #\null) (string (code-char 3)) "ABC"))) '(65 66 67))
(equal (multiple-value-list (unpack "a/ac" "2ABC")) '("AB" 67))
))