X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base%2Floop-extension.lisp;h=3c334b0b5433d665c5b531c05f87caa1313b6ce4;hb=e17f07ac3185371f7d2c989c9780f70767296a54;hp=f8129b53cf527d5438ccf20bdb4e1245a38d8bd9;hpb=9bbed78051e80e6ab76ae47834136035602bbbf1;p=clsql.git diff --git a/base/loop-extension.lisp b/base/loop-extension.lisp index f8129b5..3c334b0 100644 --- a/base/loop-extension.lisp +++ b/base/loop-extension.lisp @@ -2,22 +2,16 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: loop-extension.lisp -;;;; Purpose: Extensions to the Loop macro for CMUCL -;;;; Programmer: Pierre R. Mai +;;;; Name: loop-extension.lisp +;;;; Purpose: Extensions to the Loop macro for CLSQL ;;;; -;;;; Copyright (c) 1999-2001 Pierre R. Mai +;;;; Copyright (c) 2001-2004 Kevin Rosenberg and (c) 1999-2001 Pierre R. Mai ;;;; ;;;; $Id$ -;;;; -;;;; The functions in this file were orignally distributed in the -;;;; MaiSQL package in the file sql/sql.cl ;;;; ************************************************************************* (in-package #:cl-user) -;;;; MIT-LOOP extension - #+(or allegro sbcl) (eval-when (:compile-toplevel :load-toplevel :execute) (defpackage #:ansi-loop @@ -56,6 +50,14 @@ (unless from-phrase (setq from-phrase '(clsql-base:*default-database*))) (cond + ;; Object query resulting in a list of returned object instances + ((and (consp in-phrase) + (consp (car in-phrase)) + (consp (second (car in-phrase))) + (eq 'quote (first (second (car in-phrase)))) + (symbolp (second (second (car in-phrase))))) + (ansi-loop::loop-error "object query not yet supported")) + ((consp variable) (let ((query-var (ansi-loop::loop-gentemp 'loop-record-)) (db-var (ansi-loop::loop-gentemp 'loop-record-database-)) @@ -71,7 +73,7 @@ (,result-set-var nil) (,step-var nil)) ((multiple-value-bind (%rs %cols) - (clsql-base:database-query-result-set ,query-var ,db-var) + (clsql-base:database-query-result-set ,query-var ,db-var :result-types :auto) (setq ,result-set-var %rs ,step-var (make-list %cols)))) () () @@ -94,7 +96,7 @@ (,db-var ,(first from-phrase)) (,result-set-var nil)) ((multiple-value-bind (%rs %cols) - (clsql-base:database-query-result-set ,query-var ,db-var) + (clsql-base:database-query-result-set ,query-var ,db-var :result-types :auto) (setq ,result-set-var %rs ,variable (make-list %cols)))) () () @@ -147,7 +149,16 @@ (error "Missing OF or IN iteration path.")) (unless from-phrase (setq from-phrase '(clsql-base:*default-database*))) + (cond + ;; Object query resulting in a list of returned object instances + ((and (consp in-phrase) + (consp (car in-phrase)) + (consp (second (car in-phrase))) + (eq 'quote (first (second (car in-phrase)))) + (symbolp (second (second (car in-phrase))))) + (loop-error "object query not yet supported")) + ((consp iter-var) (let ((query-var (gensym "LOOP-RECORD-")) (db-var (gensym "LOOP-RECORD-DATABASE-")) @@ -162,7 +173,7 @@ (,result-set-var nil) (,step-var nil)) `((multiple-value-bind (%rs %cols) - (clsql-base:database-query-result-set ,query-var ,db-var) + (clsql-base:database-query-result-set ,query-var ,db-var :result-types :auto) (setq ,result-set-var %rs ,step-var (make-list %cols)))) () () @@ -189,7 +200,7 @@ (,db-var ,(first from-phrase)) (,result-set-var nil)) `((multiple-value-bind (%rs %cols) - (clsql-base:database-query-result-set ,query-var ,db-var) + (clsql-base:database-query-result-set ,query-var ,db-var :result-types :auto) (setq ,result-set-var %rs ,iter-var (make-list %cols)))) () ()