Created
November 25, 2009 05:16
-
-
Save dydx/242500 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; | |
;; Simple CD Database from PCL by Peter Siebel | |
;; Josh Sandlin <dydx@thenullbyte.org> | |
;; | |
(defvar *db* nil) | |
;; | |
;; functions for creating the database | |
;; | |
(defun make-cd (title artist rating ripped) | |
(list :title title :artist artist :rating rating :ripped ripped)) | |
(defun add-record (cd) (push cd *db*)) | |
(defun prompt-read (prompt) | |
(format *query-io* "~a: " prompt) | |
(force-output *query-io*) | |
(read-line *query-io*)) | |
(defun prompt-for-cd () | |
(make-cd | |
(prompt-read "Title") | |
(prompt-read "Artist") | |
(or (parse-integer (prompt-read "Rating") :junk-allowed t) 0) | |
(y-or-n-p "Ripped?"))) | |
(defun add-cds () | |
(loop (add-record (prompt-for-cd)) | |
(if (not (y-or-n-p "Another? ")) (return)))) | |
(defun save-db (filename) | |
(with-open-file (out filename | |
:direction :output | |
:if-exists :supersede) | |
(with-standard-io-syntax | |
(print *db* out)))) | |
(defun load-db (filename) | |
(with-open-file (in filename) | |
(with-standard-io-syntax | |
(setf *db* (read in))))) | |
;; | |
;; functions for querying the database | |
;; | |
(defun select (selector-fn) | |
(remove-if-not selector-fn *db*)) | |
(defun make-comparison-expr (field value) | |
`(equal (getf cd ,field) ,value)) | |
(defun make-comparisons-list (fields) | |
(loop while fields | |
collecting (make-comparison-expr (pop fields) (pop fields)))) | |
(defmacro where (&rest clauses) | |
`#'(lambda (cd) (and ,@(make-comparisons-list clauses)))) | |
(defun update (selector-fn &key title artist rating (ripped nil ripped-p)) | |
(setf *db* | |
(mapcar | |
#'(lambda (row) | |
(when (funcall selector-fn row) | |
(if title (setf (getf row :title) title)) | |
(if artist (setf (getf row :artist) artist)) | |
(if rating (setf (getf row :rating) rating)) | |
(if ripped-p (setf (getf row :ripped) ripped))) | |
row) *db*))) | |
(defun delete-rows (selector-fn) | |
(setf *db* (remove-if selector-fn *db*))) | |
;; | |
;; functions for displaying data | |
;; | |
(defun dump-db () | |
(format t "~{~{~a:~10t~a~%~}~%~}" *db*)) ;; outside ~{ and ~} are for looping | |
;; Usage: (parse-record (select (where :title "Fashion Nugget"))) | |
(defun parse-record (record) | |
(format t "~{~{~a:~10t~a~%~}~%~}" record)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment