/usr/share/common-lisp/source/pg/large-object.lisp is in cl-pg 1:20061216-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | ;;; large-object.lisp -- support for BLOBs
;;;
;;; Author: Eric Marsden <eric.marsden@free.fr>
;;
;;
;; Sir Humphrey: Who is Large and to what does he object?
;;
;; Large objects are the PostgreSQL way of doing what most databases
;; call BLOBs (binary large objects). In addition to being able to
;; stream data to and from large objects, PostgreSQL's
;; object-relational capabilities allow the user to provide functions
;; which act on the objects.
;;
;; For example, the user can define a new type called "circle", and
;; define a C or Tcl function called `circumference' which will act on
;; circles. There is also an inheritance mechanism in PostgreSQL.
;;
;; The PostgreSQL large object interface is similar to the Unix file
;; system, with open, read, write, lseek etc.
;;
;; Implementation note: the network protocol for large objects changed
;; around version 6.5 to use network order for integers.
;; =====================================================================
(in-package :postgresql)
(defconstant +INV_ARCHIVE+ #x10000) ; fe-lobj.c
(defconstant +INV_WRITE+ #x20000)
(defconstant +INV_READ+ #x40000)
(defconstant +LO_BUFSIZ+ 1024)
(defvar *lo-initialized* nil)
(defvar *lo-functions* '())
(defun lo-init (connection)
(let ((res (pg-exec connection
"SELECT proname, oid from pg_proc WHERE "
"proname = 'lo_open' OR "
"proname = 'lo_close' OR "
"proname = 'lo_creat' OR "
"proname = 'lo_unlink' OR "
"proname = 'lo_lseek' OR "
"proname = 'lo_tell' OR "
"proname = 'loread' OR "
"proname = 'lowrite'")))
(setq *lo-functions* '())
(dolist (tuple (pg-result res :tuples))
(push (cons (car tuple) (cadr tuple)) *lo-functions*))
(unless (= 8 (length *lo-functions*))
(error "Couldn't find OIDs for all the large object functions"))
(setq *lo-initialized* t)))
;; returns an OID
(defun pglo-create (connection &optional (modestr "r"))
(let* ((mode (cond ((integerp modestr) modestr)
((string= "r" modestr) +INV_READ+)
((string= "w" modestr) +INV_WRITE+)
((string= "rw" modestr) (logior +INV_READ+ +INV_WRITE+))
(t (error "Bad mode ~s" modestr))))
(oid (fn connection "lo_creat" t mode)))
(unless (integerp oid)
(error 'backend-error :reason "Didn't return an OID"))
(when (zerop oid)
(error 'backend-error :reason "Can't create large object"))
oid))
;; args = modestring (default "r", or "w" or "rw")
;; returns a file descriptor for use in later lo-* procedures
(defun pglo-open (connection oid &optional (modestr "r"))
(let* ((mode (cond ((integerp modestr) modestr)
((string= "r" modestr) +INV_READ+)
((string= "w" modestr) +INV_WRITE+)
((string= "rw" modestr) (logior +INV_READ+ +INV_WRITE+))
(t (error 'program-error (format nil "Bad mode ~s" modestr)))))
(fd (fn connection "lo_open" t oid mode)))
(assert (integerp fd))
fd))
(defun pglo-close (connection fd)
(fn connection "lo_close" t fd))
;; pglo-read has moved to v2-protocol.lisp and v3-protocol.lisp
;;
;; the difference between the v3 and v2 protocols is that in the former case
;; data is read in binary format, whereas in the latter data is read as text.
(defun pglo-write (connection fd buf)
(fn connection "lowrite" t fd buf))
(defun pglo-lseek (connection fd offset whence)
(fn connection "lo_lseek" t fd offset whence))
(defun pglo-tell (connection fd)
(fn connection "lo_tell" t fd))
(defun pglo-unlink (connection oid)
(fn connection "lo_unlink" t oid))
(defun pglo-import (connection filename)
(let ((buf (make-array +LO_BUFSIZ+ :element-type '(unsigned-byte 8)))
(oid (pglo-create connection "rw")))
(with-open-file (in filename :direction :input
:element-type '(unsigned-byte 8))
(loop :with fdout = (pglo-open connection oid "w")
:for bytes = (read-sequence buf in)
:until (< bytes +LO_BUFSIZ+)
:do (pglo-write connection fdout buf)
:finally
(pglo-write connection fdout (subseq buf 0 bytes))
(pglo-close connection fdout)))
oid))
(defun pglo-export (connection oid filename)
(with-open-file (out filename :direction :output
:element-type '(unsigned-byte 8))
(loop :with fdin = (pglo-open connection oid "r")
:for str = (pglo-read connection fdin +LO_BUFSIZ+)
:until (zerop (length str))
:do (write-sequence str out)
:finally (pglo-close connection fdin))))
;; EOF
|