├── .gitignore ├── .travis.yml ├── README.markdown ├── smart-buffer-test.asd ├── smart-buffer.asd ├── src └── smart-buffer.lisp └── t └── smart-buffer.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: common-lisp 2 | sudo: required 3 | 4 | env: 5 | global: 6 | - PATH=~/.roswell/bin:$PATH 7 | - ROSWELL_BRANCH=release 8 | - ROSWELL_INSTALL_DIR=$HOME/.roswell 9 | - COVERAGE_EXCLUDE=t 10 | matrix: 11 | - LISP=sbcl-bin COVERALLS=true 12 | - LISP=ccl-bin 13 | - LISP=abcl 14 | - LISP=clisp 15 | - LISP=ecl 16 | - LISP=allegro 17 | - LISP=cmucl 18 | 19 | install: 20 | - curl -L https://raw.githubusercontent.com/snmsts/roswell/$ROSWELL_BRANCH/scripts/install-for-ci.sh | sh 21 | - ros install prove 22 | 23 | script: 24 | - run-prove smart-buffer-test.asd 25 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | # smart-buffer 2 | 3 | [![Build Status](https://travis-ci.org/fukamachi/smart-buffer.svg?branch=master)](https://travis-ci.org/fukamachi/smart-buffer) 4 | [![Coverage Status](https://coveralls.io/repos/fukamachi/smart-buffer/badge.svg?branch=master)](https://coveralls.io/r/fukamachi/smart-buffer) 5 | 6 | Smart-buffer provides an output buffer which changes the destination depending on content size. 7 | 8 | * In-memory buffer for small data 9 | * Temporary files on disk for big data 10 | 11 | In-memory buffer is fast to read/write, however, it consumes much memory if the data can be large. On the other hand, files on disk are slower. Smart-buffer would be useful when the buffer must satisfy these two contradicting demands. 12 | 13 | ## Usage 14 | 15 | `with-smart-buffer` returns an in-memory stream or a file stream. 16 | 17 | ```common-lisp 18 | (with-smart-buffer (buffer) 19 | (write-to-buffer buffer (flex:string-to-octets "foobar"))) 20 | ;=> # 21 | 22 | (with-smart-buffer (buffer :memory-limit 3) 23 | (write-to-buffer buffer (flex:string-to-octets "foobar"))) 24 | ;=> # 25 | ``` 26 | 27 | ## Author 28 | 29 | * Eitaro Fukamachi (e.arrows@gmail.com) 30 | 31 | ## Copyright 32 | 33 | Copyright (c) 2015 Eitaro Fukamachi (e.arrows@gmail.com) 34 | 35 | ## License 36 | 37 | Licensed under the BSD 3-Clause License. 38 | -------------------------------------------------------------------------------- /smart-buffer-test.asd: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage smart-buffer-test-asd 3 | (:use :cl :asdf)) 4 | (in-package :smart-buffer-test-asd) 5 | 6 | (defsystem smart-buffer-test 7 | :depends-on (:smart-buffer 8 | :babel 9 | :prove) 10 | :components ((:module "t" 11 | :components 12 | ((:test-file "smart-buffer")))) 13 | 14 | :defsystem-depends-on (:prove-asdf) 15 | :perform (test-op :after (op c) 16 | (funcall (intern #.(string :run-test-system) :prove.asdf) c) 17 | (asdf:clear-system c))) 18 | -------------------------------------------------------------------------------- /smart-buffer.asd: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of smart-buffer project. 3 | Copyright (c) 2015 Eitaro Fukamachi (e.arrows@gmail.com) 4 | |# 5 | 6 | #| 7 | Author: Eitaro Fukamachi (e.arrows@gmail.com) 8 | |# 9 | 10 | (in-package :cl-user) 11 | (defpackage smart-buffer-asd 12 | (:use :cl :asdf)) 13 | (in-package :smart-buffer-asd) 14 | 15 | (defsystem smart-buffer 16 | :version "0.1" 17 | :author "Eitaro Fukamachi" 18 | :license "BSD 3-Clause" 19 | :depends-on (:xsubseq 20 | :flexi-streams 21 | :uiop) 22 | :components ((:module "src" 23 | :components 24 | ((:file "smart-buffer")))) 25 | :description "Smart octets buffer" 26 | :long-description 27 | #.(with-open-file (stream (merge-pathnames 28 | #p"README.markdown" 29 | (or *load-pathname* *compile-file-pathname*)) 30 | :if-does-not-exist nil 31 | :direction :input) 32 | (when stream 33 | (let ((seq (make-array (file-length stream) 34 | :element-type 'character 35 | :fill-pointer t))) 36 | (setf (fill-pointer seq) (read-sequence seq stream)) 37 | seq)))) 38 | -------------------------------------------------------------------------------- /src/smart-buffer.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage smart-buffer 3 | (:use #:cl 4 | #:xsubseq) 5 | (:export #:*default-memory-limit* 6 | #:*default-disk-limit* 7 | 8 | #:smart-buffer 9 | #:make-smart-buffer 10 | #:write-to-buffer 11 | #:finalize-buffer 12 | #:with-smart-buffer 13 | #:buffer-on-memory-p 14 | #:delete-stream-file 15 | #:delete-temporary-files 16 | 17 | #:buffer-limit-exceeded)) 18 | (in-package :smart-buffer) 19 | 20 | (defvar *default-memory-limit* (expt 2 20)) 21 | (defvar *default-disk-limit* (expt 2 30)) 22 | 23 | (defvar *temporary-directory* 24 | (uiop:ensure-directory-pathname 25 | (merge-pathnames (format nil "smart-buffer-~36R" (random (expt 36 #-gcl 8 #+gcl 5))) 26 | (uiop:default-temporary-directory)))) 27 | 28 | (defstruct (smart-buffer (:conc-name :buffer-) 29 | (:constructor %make-smart-buffer)) 30 | (memory-limit *default-memory-limit*) 31 | (disk-limit *default-disk-limit*) 32 | (current-len 0) 33 | (on-memory-p t) 34 | (memory-buffer (make-concatenated-xsubseqs)) 35 | (disk-buffer nil)) 36 | 37 | (defun make-smart-buffer (&rest initargs &key memory-limit disk-limit &allow-other-keys) 38 | (let ((buffer (apply #'%make-smart-buffer initargs))) 39 | (when (and memory-limit 40 | disk-limit 41 | (< disk-limit memory-limit)) 42 | (setf (buffer-memory-limit buffer) disk-limit)) 43 | buffer)) 44 | 45 | (define-condition buffer-limit-exceeded (error) 46 | ((limit :initarg :limit 47 | :initform nil)) 48 | (:report (lambda (condition stream) 49 | (format stream "Buffer exceeded the limit~:[~;~:*: ~A~]" 50 | (slot-value condition 'limit))))) 51 | 52 | (defun write-to-buffer (buffer seq &optional (start 0) (end (length seq))) 53 | (check-type seq (array (unsigned-byte 8) (*))) 54 | (incf (buffer-current-len buffer) (- end start)) 55 | (check-limit buffer) 56 | (if (buffer-on-memory-p buffer) 57 | (xnconcf (buffer-memory-buffer buffer) (xsubseq seq start end)) 58 | (with-open-file (out (buffer-disk-buffer buffer) 59 | :direction :output 60 | :element-type '(unsigned-byte 8) 61 | :if-exists :append) 62 | (write-sequence seq out :start start :end end)))) 63 | 64 | (defun check-limit (buffer) 65 | (cond 66 | ((and (buffer-on-memory-p buffer) 67 | (< (buffer-memory-limit buffer) 68 | (buffer-current-len buffer))) 69 | (when (< (buffer-disk-limit buffer) 70 | (buffer-current-len buffer)) 71 | (error 'buffer-limit-exceeded :limit (buffer-disk-limit buffer))) 72 | (setf (buffer-disk-buffer buffer) 73 | (uiop:with-temporary-file (:stream stream :pathname tmp 74 | :directory *temporary-directory* 75 | :direction :output 76 | :element-type '(unsigned-byte 8) 77 | :keep t) 78 | (typecase (buffer-memory-buffer buffer) 79 | (null-concatenated-xsubseqs) 80 | (t (write-sequence (coerce-to-sequence (buffer-memory-buffer buffer)) stream))) 81 | tmp) 82 | (buffer-on-memory-p buffer) nil 83 | (buffer-memory-buffer buffer) nil)) 84 | ((and (not (buffer-on-memory-p buffer)) 85 | (< (buffer-disk-limit buffer) 86 | (buffer-current-len buffer))) 87 | (error 'buffer-limit-exceeded :limit (buffer-disk-limit buffer))))) 88 | 89 | (defun finalize-buffer (buffer) 90 | (if (buffer-on-memory-p buffer) 91 | (flex:make-in-memory-input-stream 92 | (typecase (buffer-memory-buffer buffer) 93 | (null-concatenated-xsubseqs #()) 94 | (t (coerce-to-sequence (buffer-memory-buffer buffer))))) 95 | (open (buffer-disk-buffer buffer) :direction :input :element-type '(unsigned-byte 8)))) 96 | 97 | (defmacro with-smart-buffer ((buffer &key 98 | (memory-limit '*default-memory-limit*) 99 | (disk-limit '*default-disk-limit*)) 100 | &body body) 101 | `(let ((,buffer (make-smart-buffer :memory-limit ,memory-limit :disk-limit ,disk-limit))) 102 | ,@body 103 | (finalize-buffer ,buffer))) 104 | 105 | (defun delete-stream-file (stream) 106 | (when (typep stream 'file-stream) 107 | (ignore-errors (delete-file (pathname stream)))) 108 | (values)) 109 | 110 | (defun delete-temporary-files (&key (stale-seconds 0)) 111 | (let ((now (get-universal-time))) 112 | (mapc #'uiop:delete-file-if-exists 113 | (remove-if-not (lambda (file) 114 | (< stale-seconds (- now (file-write-date file)))) 115 | (uiop:directory-files *temporary-directory*))))) 116 | -------------------------------------------------------------------------------- /t/smart-buffer.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage smart-buffer-test 3 | (:use :cl 4 | :smart-buffer 5 | :prove) 6 | (:import-from :smart-buffer 7 | :buffer-on-memory-p 8 | :buffer-limit-exceeded)) 9 | (in-package :smart-buffer-test) 10 | 11 | (plan nil) 12 | 13 | (defun bv (object &key length) 14 | (flet ((to-bv (object) 15 | (etypecase object 16 | ((simple-array (unsigned-byte 8) (*)) object) 17 | (string (babel:string-to-octets object)) 18 | (vector (make-array (length object) 19 | :element-type '(unsigned-byte 8) 20 | :initial-contents object))))) 21 | (if length 22 | (let ((buf (make-array length :element-type '(unsigned-byte 8)))) 23 | (loop for i from 0 24 | for el across (to-bv object) 25 | do (setf (aref buf i) el)) 26 | buf) 27 | (to-bv object)))) 28 | 29 | (subtest "swithcing buffer" 30 | (let ((buffer (make-smart-buffer :memory-limit 10 :disk-limit 15))) 31 | (is (buffer-on-memory-p buffer) t "on memory") 32 | (write-to-buffer buffer (bv "Hello")) 33 | (is (buffer-on-memory-p buffer) t "still on memory") 34 | (write-to-buffer buffer (bv "World!")) 35 | (is (buffer-on-memory-p buffer) nil "on disk") 36 | (is-error (write-to-buffer buffer (bv "Hello!")) 37 | 'buffer-limit-exceeded 38 | "body buffer limit exceeded"))) 39 | 40 | (subtest "finalize-buffer" 41 | (let ((buffer (make-smart-buffer :memory-limit 10 :disk-limit 15))) 42 | (write-to-buffer buffer (bv "Hello!")) 43 | (let ((read-buf (make-array 6 :element-type '(unsigned-byte 8)))) 44 | (read-sequence read-buf (finalize-buffer buffer)) 45 | (is read-buf (bv "Hello!") :test #'equalp "on memory"))) 46 | 47 | (let ((buffer (make-smart-buffer :memory-limit 10 :disk-limit 15))) 48 | (write-to-buffer buffer (bv "Hello, World!")) 49 | (let ((read-buf (make-array 13 :element-type '(unsigned-byte 8)))) 50 | (read-sequence read-buf (finalize-buffer buffer)) 51 | (is read-buf (bv "Hello, World!") :test #'equalp "on disk")))) 52 | 53 | (finalize) 54 | --------------------------------------------------------------------------------