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