db-oracle/oracle-objects.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name: oracle-objects.lisp
   6 ;;;;
   7 ;;;; $Id$
   8 ;;;;
   9 ;;;; This file is part of CLSQL.
  10 ;;;;
  11 ;;;; CLSQL users are granted the rights to distribute and use this software
  12 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  13 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  14 ;;;; *************************************************************************
  15
  16 (in-package #:clsql-oracle)
  17
  18 (defparameter *oracle-default-varchar2-length* "512")
  19
  20 (defmethod database-get-type-specifier (type args (database oracle-database))
  21   (declare (ignore type args))
  22   (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")"))
  23
  24 (defmethod database-get-type-specifier ((type (eql 'integer)) args (database oracle-database))
  25   (if args
  26       (format nil "NUMBER(~A,~A)"
  27               (or (first args) 38) (or (second args) 0))
  28     "INTEGER"))
  29
  30 (defmethod database-get-type-specifier ((type (eql 'bigint)) args (database oracle-database))
  31   (if args
  32       (format nil "NUMBER(~A,~A)"
  33               (or (first args) 38) (or (second args) 0))
  34     "NUMBER(38,0)"))
  35
  36 (defmethod database-get-type-specifier ((type (eql 'simple-base-string)) args (database oracle-database))
  37   (if args
  38       (format nil "VARCHAR2(~A)" (car args))
  39     (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")")))
  40
  41 (defmethod database-get-type-specifier ((type (eql 'simple-string)) args (database oracle-database))
  42   (if args
  43       (format nil "VARCHAR2(~A)" (car args))
  44     (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")")))
  45
  46 (defmethod database-get-type-specifier ((type (eql 'string)) args (database oracle-database))
  47   (if args
  48       (format nil "VARCHAR2(~A)" (car args))
  49     (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")")))
  50
  51 (defmethod database-get-type-specifier ((type (eql 'raw-string)) args (database oracle-database))
  52   (if args
  53       (format nil "VARCHAR2(~A)" (car args))
  54     (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")")))
  55
  56 (defmethod database-get-type-specifier ((type (eql 'float)) args (database oracle-database))
  57   (if args
  58       (format nil "NUMBER(~A,~A)" (or (first args) 38) (or (second args) 38))
  59     "double precision"))
  60
  61 (defmethod database-get-type-specifier ((type (eql 'long-float)) args (database oracle-database))
  62   (if args
  63       (format nil "NUMBER(~A,~A)"
  64               (or (first args) 38) (or (second args) 38))
  65     "double precision"))
  66
  67 (defmethod database-get-type-specifier ((type (eql 'boolean)) args (database oracle-database))
  68   (declare (ignore args))
  69   "CHAR(1)")
  70
  71 (defmethod read-sql-value (val type (database oracle-database))
  72   ;;(format t "value is \"~A\" of type ~A~%" val (type-of val))
  73   (declare (ignore type))
  74   (etypecase val
  75     (string
  76      (read-from-string val))
  77     (symbol
  78      nil)))
  79
  80 (defmethod read-sql-value
  81   (val (type (eql 'integer)) (database oracle-database))
  82   val)
  83
  84 (defmethod read-sql-value (val (type (eql 'float)) (database oracle-database))
  85   val)
  86
  87 (defmethod read-sql-value (val (type (eql 'boolean)) (database oracle-database))
  88   (when (char-equal #\t (schar val 0))
  89     t))
  90
  91 (defmethod database-get-type-specifier ((type (eql 'wall-time)) args (database oracle-database))
  92   (declare (ignore args))
  93   "DATE")
  94
  95 (defmethod database-get-type-specifier ((type (eql 'duration)) args (database oracle-database))
  96   (declare (ignore args))
  97   "NUMBER(38)")