Coverage report: /home/ati/workspace/perec/persistence/object-cache.lisp

Kind	Covered	All	%
expression	56	65	86.2
branch	10	12	83.3

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;; -*- mode: Lisp; Syntax: Common-Lisp; -*-

2

;;;

3

4

;;;

5

;;; See LICENCE for details.

6

7

(in-package :cl-perec)

8

9

(defclass* object-cache ()

10

((objects

11

(make-hash-table :test #'eq)

12

:type hash-table

13

     :documentation "A map from oid values to persistent objects used to cache object identities and slot values during a transaction.")

14

(created-objects

15

(make-container 'set-container)

16

:type list)

17

(modified-objects

18

(make-container 'set-container)

19

:type list)

20

(deleted-objects

21

(make-container 'set-container)

22

:type list))

23

   (:documentation "Each transaction has its own transaction level object cache filled by the operations executed during that transaction. The cache is created empty when the transaction starts and it will be dropped when the transaction ends. Each object loaded during a transaction will be put here to keep the identity of the in-memory object throughout the transaction. Moreover the object cache is responsible to manage the list of created, modified and deleted objects during the transaction."))

24

25

(defclass* transaction-mixin ()

26

((object-cache

27

(make-instance 'object-cache)

28

:type object-cache)))

29

30

(defun current-object-cache ()

31

"Returns the object cache of the current transaction."

32

(object-cache-of *transaction*))

33

34

(defun cached-object-of (oid &optional (object-cache (current-object-cache)))

35

"Returns the object for the given oid from the current transaction's object cachce."

36

(gethash (oid-id oid) (objects-of object-cache)))

37

38

(defun (setf cached-object-of) (object oid &optional (object-cache (current-object-cache)))

39

   "Puts an object with the given oid into the current transaction's object cache and attaches it to the current transaction. The object must not be present in the cache before."

40

(assert (not (instance-in-transaction-p object)))

41

(assert (not (cached-object-of oid object-cache)))

42

(setf (transaction-of object) *transaction*)

43

(setf (gethash (oid-id oid) (objects-of object-cache)) object))

44

45

(defun remove-cached-object (object &optional (object-cache (current-object-cache)))

46

   "Removes an object from the current transaction's object cache and detaches it from the transaction."

47

(assert (instance-in-transaction-p object))

48

(assert (cached-object-of (oid-of object) object-cache))

49

(setf (transaction-of object) nil)

50

(remhash (oid-id (oid-of object)) (objects-of object-cache)))

51

52

(defun map-cached-objects (function &optional (object-cache (current-object-cache)))

53

"Maps the given one parameter function to all objects present in the cache."

54

(maphash #L(funcall function !2) (objects-of object-cache)))

55

56

(defun current-objects ()

57

"Returns the set of objects in the current transaction."

58

(objects-of (current-object-cache)))

59

60

(defun current-created-objects ()

61

"Returns the set of created objects in the current transaction."

62

(created-objects-of (current-object-cache)))

63

64

(defun current-modified-objects ()

65

"Returns the set of modified objects in the current transaction."

66

(modified-objects-of (current-object-cache)))

67

68

(defun current-deleted-objects ()

69

"Returns the set of deleted objects in the current transaction."

70

(deleted-objects-of (current-object-cache)))