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))))