examples/compress.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          compress.cl
   6 ;;;; Purpose:       UFFI Example file for zlib compression
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Feb 2002
   9 ;;;;
  10 ;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
  11 ;;;;
  12 ;;;; *************************************************************************
  13
  14 (in-package :cl-user)
  15
  16 (eval-when (:load-toplevel :execute)
  17   (unless (uffi:load-foreign-library
  18            #-(or macosx darwin)
  19            (uffi:find-foreign-library
  20             "libz"
  21             '("/usr/local/lib/" "/usr/lib/" "/zlib/")
  22             :types '("so" "a"))
  23            #+(or macosx darwin)
  24            (uffi:find-foreign-library "z"
  25                                       `(,(pathname-directory *load-pathname*)))
  26            :module "zlib"
  27            :supporting-libraries '("c"))
  28     (warn "Unable to load zlib")))
  29
  30 (uffi:def-function ("compress" c-compress)
  31     ((dest (* :unsigned-char))
  32      (destlen (* :long))
  33      (source :cstring)
  34      (source-len :long))
  35   :returning :int
  36   :module "zlib")
  37
  38 (defun compress (source)
  39   "Returns two values: array of bytes containing the compressed data
  40  and the numbe of compressed bytes"
  41   (let* ((sourcelen (length source))
  42          (destsize (+ 12 (ceiling (* sourcelen 1.01))))
  43          (dest (uffi:allocate-foreign-string destsize :unsigned t))
  44          (destlen (uffi:allocate-foreign-object :long)))
  45     (setf (uffi:deref-pointer destlen :long) destsize)
  46     (uffi:with-cstring (source-native source)
  47       (let ((result (c-compress dest destlen source-native sourcelen))
  48             (newdestlen (uffi:deref-pointer destlen :long)))
  49         (unwind-protect
  50             (if (zerop result)
  51                 (values (uffi:convert-from-foreign-string
  52                          dest
  53                          :length newdestlen
  54                          :null-terminated-p nil)
  55                         newdestlen)
  56               (error "zlib error, code ~D" result))
  57           (progn
  58             (uffi:free-foreign-object destlen)
  59             (uffi:free-foreign-object dest)))))))
  60
  61 (uffi:def-function ("uncompress" c-uncompress)
  62     ((dest (* :unsigned-char))
  63      (destlen (* :long))
  64      (source :cstring)
  65      (source-len :long))
  66   :returning :int
  67   :module "zlib")
  68
  69 (defun uncompress (source)
  70   (let* ((sourcelen (length source))
  71          (destsize 200000)  ;adjust as needed
  72          (dest (uffi:allocate-foreign-string destsize :unsigned t))
  73          (destlen (uffi:allocate-foreign-object :long)))
  74     (setf (uffi:deref-pointer destlen :long) destsize)
  75     (uffi:with-cstring (source-native source)
  76       (let ((result (c-uncompress dest destlen source-native sourcelen))
  77             (newdestlen (uffi:deref-pointer destlen :long)))
  78         (unwind-protect
  79              (if (zerop result)
  80                  (uffi:convert-from-foreign-string
  81                   dest
  82                   :length newdestlen
  83                   :null-terminated-p nil)
  84                  (error "zlib error, code ~D" result))
  85           (progn
  86             (uffi:free-foreign-object destlen)
  87             (uffi:free-foreign-object dest)))))))
  88
  89 #+examples-uffi
  90 (progn
  91   (flet ((print-results (str)
  92            (multiple-value-bind (compressed len) (compress str)
  93              (let ((*print-length* nil))
  94                (format t "~&(compress ~S) => " str)
  95                (format t "~S~%" (map 'list #'char-code compressed))))))
  96     (print-results "")
  97     (print-results "test")
  98     (print-results "test2")))
  99
 100 #+test-uffi
 101 (progn
 102   (flet ((test-compress (str)
 103            (multiple-value-bind (compressed len) (compress str)
 104              (multiple-value-bind (uncompressed len2) (uncompress compressed)
 105                (util.test:test str uncompressed :test #'string=
 106                                :fail-info "Error uncompressing a compressed string")))))
 107     (test-compress "")
 108     (test-compress "test")
 109     (test-compress "test2")))
 110
 111 ;; Results of the above on my system:
 112 ;; (compress "") => 789c300001,8
 113 ;; (compress "test") => 789c2b492d2e1045d1c1,12
 114 ;; (compress "test2") => 789c2b492d2e31206501f3,13