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
|
