Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

trying to get clsql-orm to not be dependant on adwcodebase/arnesi, so…

… that it can be released
  • Loading branch information...
commit 7c8871140dd4e3a930d4bc59900c0901e33a4ae2 1 parent ff445c0
@bobbysmith007 bobbysmith007 authored
View
0  README → README.clsql-postgres-introspect
File renamed without changes
View
78 README.mediawiki
@@ -0,0 +1,78 @@
+= CLSQL-ORM =
+Use this package to help with introspective operations against
+databases that support information_schema . It supports generating
+view-class definitions from the database schema
+
+This was originally clsql-postgres-introspect, though this is a bit far removed from that.
+
+I have used this to successfully generate view-classes for PostgreSQL,
+MSSQL (through freetds and unixodbc), and mysql (though with minor
+bugs in mysql).
+
+This project does not attempt to be a persistence layer. It also makes quite a few assumptions
+about what should be generated and with what types that may not match your desires or existing
+notions. As such this code might only be useful as a jumping off point for creating your own
+custom clsql ORM.
+
+== Examples ==
+
+<code>
+(with-a-database (*application*) ;; a private macro that sets up clsql:*default-database*
+ (clsql-orm:gen-view-classes
+ :inherits-from '(pg-db-obj) ;; a class I have that I want all my pg-db-objects to inherit from
+ :classes
+ ;; The tables I want to turn into classes
+ '(users user_districts_and_counties titles salaries roles fiscal-years expenses budgets counties
+ districts counties-with-districts reports data-entry-finalizations
+ specialties bad-state-salary-input races)))
+</code>
+<code>
+(clsql-orm:gen-view-classes
+ :inherits-from '(pg-db-obj) ;; a class I have that I want all my pg-db-objects to inherit from
+ :classes
+ ;; The tables I want to turn into classes
+ '(users))
+
+;;; Results in the following class definition being evaled:
+(def-view-class user (pg-db-obj)
+ ((date-entered column date_entered accessor date-entered
+ db-constraints nil type wall-time initarg
+ date-entered)
+ (deleted column deleted accessor deleted db-constraints nil
+ type boolean initarg deleted)
+ (email column email accessor email db-constraints (not-null)
+ type (varchar 128) initarg email)
+ (enabled column enabled accessor enabled db-constraints
+ (not-null) initform t type boolean initarg enabled)
+ (first-name column first_name accessor first-name
+ db-constraints nil initform nil type varchar
+ initarg first-name)
+ (id column id accessor id db-kind key db-constraints
+ (not-null) type integer initarg id)
+ (last-name column last_name accessor last-name db-constraints
+ nil initform nil type varchar initarg last-name)
+ (password column password accessor password db-constraints
+ (not-null) type (varchar 32) initarg password)
+ (role-id column role_id accessor role-id db-constraints
+ (not-null) type integer initarg role-id)
+ (role-join accessor role-join db-kind join db-info
+ (join-class role home-key role-id foreign-key id
+ set nil))
+ (salt column salt accessor salt db-constraints (not-null) type
+ (varchar 4) initarg salt))
+ (base-table users))
+
+</code>
+
+== Authors of this Branch ==
+
+Acceleration.NET employees Russ Tyndall, Nathan Bird and Ryan Davis
+
+== Original Author information ==
+
+Alan Shields<br />
+Alan-Shields@omrf.ouhsc.edu<br />
+
+This work was made possible by the Centola Lab of the Oklahoma Medical Research Foundation
+
+License information is in the file LICENSE (LLGPL)
View
2  clsql-orm.asd
@@ -2,7 +2,7 @@
; For those who like that sort of thing: an ASDF package
(defsystem clsql-orm
- :depends-on (:clsql :cl-ppcre :adwcodebase :cl-interpol)
+ :depends-on (:clsql :cl-ppcre :cl-interpol :vana-inflector :symbol-munger)
:version "0.2"
:components
((:file "package")
View
44 main.lisp
@@ -7,6 +7,9 @@
(defvar *db-model-package* *package*)
;;;;; Utilities
+(defmacro awhen (cond &body body)
+ `(let ((it ,cond)) (when it ,@body)))
+
(defmacro ensure-strings ((&rest vars) &body body)
`(let ,(loop for var in vars
collect `(,var (if (stringp ,var)
@@ -23,20 +26,17 @@
(defun intern-normalize-for-lisp (me &optional (package *db-model-package*))
"Interns a string after uppercasing and flipping underscores to hyphens"
- (internup (substitute #\- #\_ me) package))
+ (symbol-munger:underscores->lisp-symbol me package))
(defun singular-intern-normalize-for-lisp (me &optional (package *db-model-package*))
"Interns a string after uppercasing and flipping underscores to hyphens"
(let ((words (reverse (cl-ppcre:split "-|_" (string me))))
(cl-interpol:*list-delimiter* "-"))
- (setf (first words) (adwutils:singularize (first words)))
+ (setf (first words) (vana-inflector:singular-of (first words)))
(internup #?"@{ (reverse words) }" package)))
(defun normalize-for-sql (s)
- (substitute #\_ #\- (typecase s
- (string s)
- (symbol (string-downcase
- (symbol-name s))))))
+ (symbol-munger:lisp->underscores s :capitalize nil))
(defun clsql-join-column-name (table ref-table colname)
(declare (ignorable table)
@@ -55,7 +55,14 @@
default-sym)))
(defclass column-def ()
- #.(adwutils:slot-defs '(column db-type col-length is-null default constraints fkey-table fkey-col)))
+ ((column :accessor column :initform nil :initarg :column)
+ (db-type :accessor db-type :initform nil :initarg :db-type)
+ (col-length :accessor col-length :initform nil :initarg :col-length)
+ (is-null :accessor is-null :initform nil :initarg :is-null)
+ (default :accessor default :initform nil :initarg :default)
+ (constraints :accessor constraints :initform nil :initarg :constraints)
+ (fkey-table :accessor fkey-table :initform nil :initarg :fkey-table)
+ (fkey-col :accessor fkey-col :initform nil :initarg :fkey-col)))
(defun column-def (column db-type col-length is-null default constraints fkey-table fkey-col)
(make-instance 'column-def
@@ -75,8 +82,9 @@ translate its type, and declare an initarg"
Are you sure you correctly spelled the table name?"
table schema))
(iter (for col in cols)
- (adwutils:bind ((:accessors (column db-type col-length is-null default constraints fkey-table fkey-col)
- col))
+ (with-accessors ((column column) (db-type db-type) (col-length col-length)
+ (is-null is-null) (default default) (constraints constraints)
+ (fkey-table fkey-table) (fkey-col fkey-col)) col
(when (and is-null default)
(warn "CLSQL-ORM: The column ~a.~a.~a should not be null and have a default value (~a)"
schema table column default))
@@ -88,13 +96,13 @@ translate its type, and declare an initarg"
'(:db-kind :key))
:db-constraints
(
- ,@(unless is-null '(:not-null))
- ,@(when (and (member :primary-key constraints)
- (identity-column-p table column))
- '(:identity))
- )
+ ,@(unless is-null '(:not-null))
+ ,@(when (and (member :primary-key constraints)
+ (identity-column-p table column))
+ '(:identity))
+ )
,@(cond
- (;; its null with no default
+ ( ;; its null with no default
(and is-null (null default))
'(:initform nil))
@@ -226,14 +234,14 @@ ORDER BY cols.column_name, cols.data_type
(for row = (apply #'column-def l-row))
(cond
((not (and prev-row (string-equal (column row) (column prev-row))))
- (setf (db-type row) (adwutils:symbolize-string (db-type row) :keyword))
+ (setf (db-type row) (symbol-munger:english->keyword (db-type row)))
(setf (is-null row) (string-equal (is-null row) "YES"))
- (setf (constraints row) (list (adwutils:symbolize-string (constraints row) :keyword)))
+ (setf (constraints row) (list (symbol-munger:english->keyword (constraints row))))
(collect row)
(setf prev-row row))
(T ;; if we got a second row it means the column has more than one constraint
;; we should put that in the constraints list
- (push (adwutils:symbolize-string (constraints row) :keyword)
+ (push (symbol-munger:english->keyword (constraints row))
(constraints prev-row))
(awhen (fkey-table row)
(setf (fkey-table prev-row) it))
View
4 package.lisp
@@ -1,5 +1,5 @@
(defpackage #:clsql-orm
- (:use "CL" "CLSQL" :iterate :arnesi :adwutils)
+ (:use :cl :clsql :iterate)
(:shadow #:list-tables )
(:shadowing-import-from :adwutils :join-strings)
(:export :gen-view-class
@@ -11,5 +11,5 @@
:primary-key-p
:clsql-type-for-pg-type
:user-columns)
- (:documentation "This package provides methods to introspect a postgres database
+ (:documentation "This package provides methods to introspect a database
Providing features such as generating a CLSQL class based on a table name"))
Please sign in to comment.
Something went wrong with that request. Please try again.