Source file database.icn
#<p>
# Support for SQL database access
#</p>
#<p>
#  Normal use is to create class instance with DSN and table name
#    as parameters and then open database with open(user,password)
#    method call...
#</p>
#<p>
# <b>Author:</b> Steve Wampler (<i>sbw@tapestry.tucson.az.us</i>)
#</p>
#<p>
#  This file is in the <i>public domain</i>.
#</p>

package database
import lang
link "db_util"


#<p>
# Encapsulates an ODBC accessible database.
#</p>
class Database : Object (dsn, db_table, db, dbu, blockDepth)

   #<p>
   # Open a database with automatic access to a specific table
   # <[returns a database access]>
   # <[fails if unable to open database]>
   #</p>
   method open(user,      # Valid database user id
	       password)   # Password for that user.
      static real_open
      initial real_open := ::proc("open")
      return \accessDb(real_open(dsn,"o",db_table,user,password))
   end

   #<p>
   # Access the underlying database.
   #    <[param newdb if present, database to associate with this object]>
   #    <[returns current database, which will be <tt>newdb</tt> if non-null]>
   #</p>
   method accessDb(newdb)   # Name of database to start accessing
      db := \newdb
      return db
   end

   #<p>
   # Change the name of the table to access.
   #    <[param newTable if present, table to associate with this object]>
   #    <[returns current table, which will be <tt>newTable</tt> if non-null]>
   #</p>
   method accessTable(newTable)  # Name of table to start accessing
      db_table := \newTable
      return db_table
   end

   #<p>
   # Fetch selected rows from the database.
   #    Note that, unlike the native 'fetch(db)' procedure, this
   #       method is a generator.
   #  <[generates rows that have been selected from the database]>
   #</p>
   method fetch()
      static real_fetch := ::proc("fetch")
      suspend |real_fetch(\accessDb())
   end

   #<p>
   # Close the database.
   #  <[returns nothing useful]>
   #  <[fails if cannot close the database]>
   #</p>
   method close()
      static real_close := ::proc("close")
      return real_close(\accessDb())
   end

   #<p>
   # Execute an arbitrary SQL command/query on the database
   #   <[returns result of executing <tt>sqlstatement</tt>]>
   #</p>
   method sql(sqlstatement)  # Arbitrary SQL statement
      static real_sql := ::proc("sql")
      return real_sql(\accessDb(), sqlstatement)
   end

   ### unfinished implementations of former built-ins below here

   #<p>
   # Delete entries from the database table based on some filter.
   #   e.g. <tt>db.delete("name = 'fred'")</tt> would remove all
   #  data base entries whose name field is <tt>fred</tt>.
   #  <i>Note that calling <tt>delete</tt> with no argument
   #  deletes all entries in the table!</i>
   #</p>
   method delete(filter)
      filterClause := " WHERE " || ("" ~== \filter)
      return sql("DELETE FROM "||db_table||filterClause)
   end

   #<p>
   # Insert the contents of the parameter (a table or record)
   #    into the currently active database table.
   # <[returns result of doing the insert]>
   #</p>
   method insert(rec) # table of fields (key is field name,
                      #    entry is new field value) to update
                      # <i>(Can also be a record)</i>
      s := "INSERT INTO " || db_table || "("
      every k := ::key(rec) do { s ||:= k; s||:= "," }
      s := s[1:-1] # delete trailing comma?
      s ||:= ") VALUES ("
      every k := ::key(rec) do { s ||:= "'"||dbu.escape(rec[k])||"'," }
      s := s[1:-1] # delete trailing comma?
      s ||:= ")"
      return sql(s)
   end

   #<p>
   # Select rows from the currently active database table.
   #   <[returns result of performing query]>
   #</p>
   method select(cols:"*", # Columns to display (default is <b>"*"</b>)
                 filter,   # SQL where clause (w/o the 'WHERE')
                           #   that identifies rows to display
                 order     # SQL order clause (w/o the 'ORDER BY')
                 )
      s := "SELECT " || cols || " FROM " || db_table
      if *\filter > 0 then
         s ||:= " WHERE " || filter
      # ok to omit order
      if *\order > 0 then
         s ||:= " ORDER BY " || order
      return sql(s)
   end

   #<p>
   # Update rows in the currently active database table.
   #  <[returns result of updating rows]>
   #</p>
   method update(rec,          # table of fields (key is field name,
                               #    entry is new field value) to update
                               # <i>(Can also be a record)</i>
		 whereClause   # SQL where clause (w/o the 'WHERE')
                               #    that identifies rows to modify
                 )
      s := "UPDATE " || db_table || " SET "
      every k := ::key(rec) do {
	 s ||:= k ||"="||"'"||dbu.escape(rec[k])||"',"
	 }
      s := s[1:-1]  # delete trailing comma?
      s ||:= " WHERE "||\whereClause
      return sql(s)
   end

   #<p>
   # Get record of database metadata.
   #   <[returns database metadata record]>
   #</p>
   method product()
      return ::dbproduct(accessDb())
   end

   #<p>
   # Get record of database odbc driver metadata
   #  <[returns database driver metadata record]>
   #</p>
   method driver()
      return ::dbdriver(accessDb())
   end

   #<p>
   # Get record of database limits
   #  <[returns database limits]>
   #</p>
   method limits()
      return ::dblimits(accessDb())
   end

   #<p>
   # Start a block transaction if not in one already.
   # Counts nested blocks to ensure correct handling
   #   of block ends.
   #</p>
   method startBlock()
      if blockDepth = 0 then {
	 sql("BEGIN")
	 }
      blockDepth +:= 1
   end

   #<p>
   # Terminate a block transaction.  Correctly handles
   #   nested blocks by only terminating when leaving
   #   outermost block.
   #</p>
   method endBlock()
      if blockDepth > 0 then {
	 blockDepth -:= 1
	 if blockDepth = 0 then {
	    sql("COMMIT")
	    }
	 }
   end

   #<p>
   #  Abort a block transaction.
   #</p>
   method abortBlock()
      if blockDepth > 0 then {
	 sql("ROLLBACK")
	 }
      blockDepth := 0
   end

initially(DSN,          # Data store name (odbc)
	  DB_TABLE)     # Table to access at that DSN
   dsn        := DSN
   db_table   := DB_TABLE
   dbu        := DButils()
   blockDepth := 0
end

This page produced by UniDoc on 2021/04/15 @ 23:59:44.