Update of /project/elephant/cvsroot/elephant/examples In directory common-lisp:/tmp/cvs-serv7130/examples

Added Files: index-tutorial.lisp sql-tutorial.lisp Log Message: See elephant-devel mail for changes...and take a big, deep breath...

--- /project/elephant/cvsroot/elephant/examples/index-tutorial.lisp 2006/02/19 04:52:58 NONE +++ /project/elephant/cvsroot/elephant/examples/index-tutorial.lisp 2006/02/19 04:52:58 1.1

(defpackage elephant-tutorial (:use :cl :elephant))

(in-package :elephant-tutorial)

(defclass simple-plog () ((timestamp :accessor plog-timestamp :initarg :timestamp :index t) (type :accessor plog-type :initarg :type :index t) (data :accessor plog-data :initarg :data) (user :accessor plog-user :initarg :user :index t)) (:metaclass persistent-metaclass) (:documentation "Simple persistent log"))

(defclass url-record () ((url :accessor url-record-url :initarg :url :initform "") (fetched :accessor url-record-fetched :initarg :fetched :initform nil) (analyzed :accessor url-record-analyzed :initarg :analyzed :initform nil)) (:documentation "An application object, declared persistent but not indexed"))

(defmethod print-object ((obj url-record) stream) "Pretty print program objects so they're easy to inspect" (format stream "<url: ~A ~A ~A>" (url-record-url obj) (url-record-fetched obj) (url-record-analyzed obj)))

(defclass url-log (simple-plog) () (:metaclass persistent-metaclass) (:documentation "This class tracks events that transform our program object state"))

(defmethod print-object ((obj url-log) stream) "Structured printing of log entries so they're easy to inspect at the repl" (format stream "#plog[~A :: ~A]" (plog-type obj) (plog-data obj)))

(defun log-event (user type data) "A helper function to generically log various events by user" (make-instance 'url-log :timestamp (get-universal-time) :type type :data data :user user))

(defun report-events-by-time (user start end) "A custom reporting function for our logs - pull out a time range. A real implementation might do it by dates or by dates + times using one of the lisp time libraries" (let ((entries1 (get-instances-by-range 'url-log 'timestamp start end)) (entries2 (get-instances-by-value 'url-log 'user user))) (format t "Event logs for ~A (~A range, ~A user):~%" user (length entries1) (length entries2)) (format t "~{~A~%~}" (nreverse (intersection entries1 entries2)))))

;; ;; This code is the skeleton of a program ;;

(defvar *start-timestamp* nil) (defvar *end-timestamp* nil)

(defun generate-events (user count &optional delay) (setf *start-timestamp* (get-universal-time)) (loop for i from 1 upto count do (let ((url (get-a-url user i))) (sleep delay) (fetch-url url user) (sleep delay) (analyze-url url user) (sleep delay))) (setf *end-timestamp* (get-universal-time)))

(defun get-a-url (user seq) (let ((url (make-instance 'url-record :url (format nil "http://www.common-lisp.net/~A/" seq)))) (log-event user :received-url url) url))

(defun fetch-url (url user) (setf (url-record-fetched url) t) (log-event user :fetched-url url))

(defun analyze-url (url user) (setf (url-record-analyzed url) t) (log-event user :analyzed-url url))

;; Top Level Test Code

(defun test-generate-and-report (name store-spec) (open-store store-spec) (generate-events name 10 0.2) (report-events name) (close-store)) (defun report-events (name) (let ((first-third-start *start-timestamp*) (first-third-end (+ *start-timestamp* (/ (- *end-timestamp* *start-timestamp*) 3)))) (report-events-by-time name first-third-start first-third-end)))

--- /project/elephant/cvsroot/elephant/examples/sql-tutorial.lisp 2006/02/19 04:52:58 NONE +++ /project/elephant/cvsroot/elephant/examples/sql-tutorial.lisp 2006/02/19 04:52:58 1.1 ;;; sql-tutorial.lisp ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Lesser GNU Public License ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.

(asdf:operate 'asdf:load-op :elephant) (asdf:operate 'asdf:load-op :ele-bdb) (asdf:operate 'asdf:load-op :elephant-tests) (in-package "ELEPHANT-TESTS") (open-store *testdb-path*) (add-to-root "my key" "my value") (get-from-root "my key")

(setq foo (cons nil nil))

(add-to-root "my key" foo) (add-to-root "my other key" foo) (eq (get-from-root "my key") (get-from-root "my other key"))

(setf (car foo) T)

(get-from-root "my key")

(defclass my-persistent-class () ((slot1 :accessor slot1) (slot2 :accessor slot2)) (:metaclass persistent-metaclass))

(setq foo (make-instance 'my-persistent-class))

(add-to-root "foo" foo)

(add-to-root "bar" foo)

(eq (get-from-root "foo") (get-from-root "bar"))

(get-from-root "foo") (setf (slot1 foo) "one")

(setf (slot2 foo) "two") (slot1 foo) (slot2 foo) (setf (slot1 foo) "three")

(slot1 (get-from-root "bar"))

(setq *auto-commit* nil) (with-transaction () (setf (slot1 foo) 123456789101112) (setf (slot2 foo) "onetwothree..."))

(defvar *friends-birthdays* (make-btree))

(add-to-root "friends-birthdays" *friends-birthdays*)

(setf (get-value "Andrew" *friends-birthdays*) (encode-universal-time 0 0 0 22 12 1976)) (setf (get-value "Ben" *friends-birthdays*) (encode-universal-time 0 0 0 14 4 1976))

(get-value "Andrew" *friends-birthdays*) (decode-universal-time *) (defvar curs (make-cursor *friends-birthdays*)) (cursor-close curs) (setq curs (make-cursor *friends-birthdays*)) (cursor-current curs) (cursor-first curs) (cursor-next curs) (cursor-next curs) (cursor-close curs) (with-transaction () (with-btree-cursor (curs *friends-birthdays*) (loop (multiple-value-bind (more k v) (cursor-next curs) (unless more (return nil)) (format t "~A ~A~%" k v)))))

(defclass appointment () ((date :accessor ap-date :initarg :date :type integer) (type :accessor ap-type :initarg :type :type string)) (:metaclass persistent-metaclass))

(defvar *appointments* (with-transaction () (make-indexed-btree *store-controller*)))

(defun add-appointment (date type) (with-transaction () (setf (get-value date *appointments*) (make-instance 'appointment :date date :type type))))

(add-appointment (encode-universal-time 0 0 0 22 12 2004) "Birthday") (add-appointment (encode-universal-time 0 0 0 14 4 2005) "Birthday") (add-appointment (encode-universal-time 0 0 0 1 1 2005) "Holiday") (defun key-by-type (secondary-db primary value) (declare (ignore secondary-db primary)) (let ((type (ap-type value))) (when type (values t type)))) (with-transaction () (add-index *appointments* :index-name 'by-type :key-form 'key-by-type :populate t)) (defvar *by-type* (get-index *appointments* 'by-type))

(decode-universal-time (ap-date (get-value "Holiday" *by-type*)))

(with-btree-cursor (curs *by-type*) (loop for (more? k v) = (multiple-value-list (cursor-set curs "Birthday")) then (multiple-value-list (cursor-next-dup curs)) do (unless more? (return t)) (multiple-value-bind (s m h d mo y) (decode-universal-time (ap-date v)) (declare (ignore s m h)) (format t "~A/~A/~A~%" mo d y))))