DbObjectOra(3NS)

DbObjectOra::BuildUpdate

proc DbObjectOra::BuildUpdate {class objref} {
     upvar $objref obj

     logEntryLS DbgEntryExit "Entering DbObjectOra::BuildUpdate"

     set updateClause {}

        #This prepares the update list for an update 

          #Skip the mdt, dt 

     if { [info exists obj(mdt)] } { set tmp_oid $obj(mdt); unset obj(mdt) }
     if { [info exists obj(dt)] }  { set tmp_oid $obj(dt); unset obj(dt) }

     foreach attr [array names obj] {

           #Retrieve the attribute column name and remove the alias 
      set column [Entity::GetAttribute $class $attr column]
      #set column [lindex [split $column .] 1]

      set type [Entity::GetAttribute $class $attr type]

      if {[string compare $updateClause {}] == 0} {
         set updateClause "$column = [DbObjectOra::BuildType $type $obj($attr)]"
      } else {
         set updateClause [cconcat $updateClause ", $column = [DbObjectOra::BuildType $type $obj($attr)]"]
      }
   }

   if { [info exists tmp_mdt] } { set $obj(oid) $tmp_mdt}
   if { [info exists tmp_dt] }  { set $obj(oid) $tmp_dt}

   logEntryLS DbgAll "DbObjectOra::BuildUpdate updateClause: $updateClause"
   logEntryLS DbgEntryExit "Exiting DbObjectOra::BuildUpdate"

   return $updateClause
}

DbObjectOra::BuildWhere

proc DbObjectOra::BuildWhere {class where} {
     upvar #0 $class\::this this

     logEntryLS DbgEntryExit "Entering DbObjectOra::BuildWhere"

          #This builds the where clause for the Query 
     if {[string compare $this(where) {}] != 0} {
        if {[string compare $where {}] == 0} {
           return $this(where)
        } else {
           return "$this(where) and $where"
        }
     }

     logEntryLS DbgAll "DbObjectOra::BuildWhere whereClause: $where"
     logEntryLS DbgEntryExit "Exiting DbObjectOra::BuildWhere" 

     return $where
}

DbObjectOra::BuildSelect

proc DbObjectOra::BuildSelect {class objref} {
     upvar $objref obj
     variable sth

     set selectClause {}

     logEntryLS DbgEntryExit "Entering DbObjectOra::BuildSelect"

     foreach attr [array names obj] {
           #Skip the oid 
        if {[string compare oid $attr] == 0} {continue}

        if {[string match $selectClause {} ]} {
	   set selectClause [Entity::GetAttribute $class $attr column]
        } else {
           set selectClause [cconcat $selectClause ", [Entity::GetAttribute $class $attr column]"]
        }
     }

     logEntryLS DbgAll "DbObjectOra::BuildSelect selectClause: $selectClause"
     logEntryLS DbgEntryExit "Exiting DbObjectOra::BuildSelect"

     return $selectClause
}

DbObjectOra::BuildInsert

proc DbObjectOra::BuildInsert {class objref} {
     upvar $objref obj
     upvar #0 $class\::attr classAttr

     logEntryLS DbgEntryExit "Entering DbObjectOra::BuildInsert"

        #This builds the select clause for both select and insert 
     foreach attr [array names obj] {
          #Retrieve the attribute column name and remove the alias 
        set column [Entity::GetAttribute $class $attr column]
        set column [lindex [split $column .] 1]
        if {[info exists insertClause] == 0} {
           set insertClause $column
        } else {
           set insertClause [cconcat $insertClause ", $column"]
        }
     }

     logEntryLS DbgAll "DbObjectOra::BuildInsert insertClause: $insertClause"
     logEntryLS DbgEntryExit "Exiting DbObjectOra::BuildInsert"

     return $insertClause
}

DbObjectOra::Query

proc DbObjectOra::Query { class objref {where {}} {order {}} } {
     variable waitInterval
     variable tranflag 
     upvar $objref obj
     upvar #0 $class\::this this
     upvar #0 $class\::attr attr
     variable sth

     logEntryLS DbgEntryExit "Entering DbObjectOra::Query"

     set oidColumn [Entity::GetAttribute $class oid column]

       #filter out any attributes not belonging to this class 
     array set filteredObj [Entity::ArrayCopy $class obj] 

     set selectString [DbObjectOra::BuildSelect $class filteredObj]

     if [string match $selectString {} ] {
        set sqlString "select $oidColumn"
     } else {
        set sqlString "select $oidColumn, $selectString"
     }

     set sqlString [cconcat $sqlString " from $this(from)"]
     set where [DbObjectOra::BuildWhere $class $where]

     if {[string compare $where {}] != 0} {set sqlString [cconcat $sqlString " where $where"]}
     if {[string compare $order {}] != 0} {set sqlString [cconcat $sqlString " order by $order"]}

     logEntryLS DbgMsg "DbObjectOra::Query SqlString: $sqlString"

     if [catch {DbObjectOra::Sql $sqlString $waitInterval} result] {
        error "DbObjectOra::Query: $result  "
     }
}

DbObjectOra::GetListOf

proc DbObjectOra::GetListOf { class attr {where {}} {order {}} } {
     variable waitInterval
     variable sth 

     upvar #0 $class\::this this
 
     logEntryLS DbgEntryExit "Entering DbObjectOra::GetListOf"

     set valueList {}
     set selectString [Entity::GetAttribute $class $attr column]
     set sqlString "select distinct $selectString"
     set sqlString [cconcat $sqlString " from $this(from)"]
     set where [DbObjectOra::BuildWhere $class $where]

     if {[string compare $where {}] != 0} {set sqlString [cconcat $sqlString " where $where"]}
     if {[string compare $order {}] != 0} {set sqlString [cconcat $sqlString " order by $order"]}

     logEntryLS DbgMsg "DbObjectOra::Count SqlString: $sqlString"

     if [catch {
        DbObjectOra::Sql $sqlString $waitInterval
        set option -datavariable
        set row [DbObjectOra::Orafetch $sth $option] 

        while {[llength $row] > 0} {
           lappend valueList [lindex $row 0]
	   set row [DbObjectOra::Orafetch $sth $option]
        }
     } result] {
        error "DbObjectOra::GetListOf: $result: $result"
     }

     return $valueList
}

DbObjectOra::Count

proc DbObjectOra::Count { class {where {}} {distinct *} } {
     variable waitInterval
     upvar #0 $class\::this this

     logEntryLS DbgEntryExit "Entering DbObjectOra::Count"

     if {[string match $distinct *]} {
        set sqlString "select count(*)"
     } else {
        set sqlString "select count(distinct $distinct)"
     }

     set sqlString [cconcat $sqlString " from $this(from)"]
     set where [DbObjectOra::BuildWhere $class $where]

     if {[string compare $where {}] != 0} {set sqlString [cconcat $sqlString " where $where"]}

     logEntryLS DbgMsg "DbObjectOra::Count SqlString: $sqlString"

     if [catch {
        DbObjectOra::Sql $sqlString $waitInterval
        set count [DbObjectOra::Nextrow]
     } result] {
        error "DbObjectOra::Count: $result: "
     }

     return $count 
}

DbObjectOra::Next

proc DbObjectOra::Next { class objref } {
     upvar $objref obj
     variable handle 
     variable handleIndex 
     variable sth

     logEntryLS DbgEntryExit "Entering DbObjectOra::Next"

        #filter out any attributes not belonging to this class 
     array set filteredObj [Entity::ArrayCopy $class obj] 


        #Do the initial fetch.
     set option -datavariable
     set row [DbObjectOra::Orafetch $sth $option] 

     logEntryLS DbgMsg "Returned Row: $row"

        # Determine if you are at the end of the file. 
     if {![cequal [oramsg $sth rc] 1403]} {
        foreach rowIn $row {
           set obj(oid) [lindex $rowIn 0]
           set i 1
           foreach attr [array names filteredObj] {
                 # Skip the oid 
              if {[string compare oid $attr] == 0} {continue}
                   # Check for binary 
              switch -- [Entity::GetAttribute $class $attr type] {
                 Binary { set obj($attr) [join [list 0x [string trim [lindex $row $i]]] {}] }
                 EnumText -
                 EnumInt { set obj($attr) [Entity::EnumValue [Entity::GetAttribute $class $attr enum] [lindex $row $i]] }
                default { set obj($attr) [lindex $row $i] }
              }
              incr i
           }

           logEntryLS DbgEntryExit "Exiting DbObjectOra::Next after retrieving oid, $obj(oid) "
           return 1
       }
     } else {
        logEntryLS DbgEntryExit "Exiting DbObjectOra::Next: No row retrieved"
        return 0 
     }
}

DbObjectOra::Oraparse

proc DbObjectOra::Oraparse { stmHandle sqlString } {
     variable handle
     variable handleIndex

     catch { [oraparse $stmHandle $sqlString] } 
     if {![oramsg $handle($handleIndex) rc] == 0} {
          error "DbObjectOra::Oraparse: $error $sqlString "
     } 
}

DbObjectOra::Orafetch

proc DbObjectOra::Orafetch { stmHandle {option {}} } {
     variable handle
     variable handleIndex

     set rowsRtn {}

     if {[cequal $option {}]} {
         catch {orafetch $stmHandle}
     } else { 
         catch {orafetch $stmHandle $option rowsRtn}
     }

     if {!([oramsg $handle($handleIndex) rc] == 0 || [ormsg $handle($handleIndex) rc] == 1403)} {
        error "DbObjectOra::Orafetch: $error "
     } 

     return $rowsRtn
}

DbObjectOra::Oraexec

proc DbObjectOra::Oraexec { stmHandle } {
     variable handle
     variable handleIndex

     catch {oraexec $stmHandle}
     if {![oramsg $handle($handleIndex) rc] == 0} {
	 DbObjectOra::Rollback 
        error "DbObjectOra::Oraexec: $error $stmHandle"
     } else {
         DbObjectOra::Commit 
     }
}

DbObjectOra::Cancel

proc DbObjectOra::Cancel {} {
     variable handle
     variable handleIndex
     variable numHandles

     if {$numHandles != 0} {
        oracancel $handle($handleIndex)
     }
}

DbObjectOra::Insert

proc DbObjectOra::Insert { class objref } {
     variable handle
     variable handleIndex
     variable waitInterval
     variable sth
     variable sqlString

     upvar $objref obj
     upvar #0 $class\::this this

     logEntryLS DbgEntryExit "Entering DbObjectOra::Insert"

     set attrList [DbObjectOra::BuildInsert $class obj]
     set sqlString "select ip_oid.nextval from DUAL " 

     DbObjectOra::Oraparse $sth $sqlString
     DbObjectOra::Oraexec $sth

     set option -datavariable
     set obj(oid) [DbObjectOra::Orafetch $sth $option] 

       # Because you have to do a nextval to make currval work, the nextval
          # must be decremented by 1 to reflect the currval. 
     set obj(oid) [incr obj(oid) -1]

     set valueList [DbObjectOra::BuildValue $class obj]

     set sqlString "insert into [lindex $this(table) 0] ($attrList) values ($valueList)"

     logEntryLS DbgMsg "DbObjectOra::Insert SqlString: $sqlString"
     if [ catch { DbObjectOra::Sql $sqlString $waitInterval } result ] { 
         error "DbObjectOra::Insert: $result: "
     }

     logEntryLS DbgEntryExit "Exiting DbObjectOra::Insert with oid, $obj(oid)"
     return $obj(oid) 
}

DbObjectOra::Update

proc DbObjectOra::Update {class objref} {
     variable waitInterval
     variable sth 
     upvar $objref obj
     upvar #0 $class\::this this

     logEntryLS DbgEntryExit "Entering DbObjectOra::Update"

     set setList [DbObjectOra::BuildUpdate $class obj]

        #If there is no setlist, we are done 
     if {[string compare $setList {}] == 0} { return }

     set where "[Entity::GetAttribute $class oid column] = $obj(oid)"
     set sqlString "update $this(table) set $setList where $where"

     logEntryLS DbgMsg "DbObjectOra::Update SqlString: $sqlString"

     if [ catch { DbObjectOra::Sql $sqlString $waitInterval} result ] { 
         error "DbObjectOra::Update: $result: "
     }

     logEntryLS DbgEntryExit "Exiting DbObjectOra::Update"
}

DbObjectOra::Delete

proc DbObjectOra::Delete {class objref} {
     variable waitInterval
     variable sth 

     upvar $objref obj
     upvar #0 $class\::this this

     logEntryLS DbgEntryExit "Entering DbObjectOra::Delete"

     set where "[Entity::GetAttribute $class oid column] = $obj(oid)"
     set sqlString "delete from $this(table) where $where"

     logEntryLS DbgMsg "DbObjectOra::Delete SqlString: $sqlString"

     if [ catch { DbObjectOra::Sql $sqlString $waitInterval} result ] { 
         error "DbObjectOra::Delete: $result: "
     }

     logEntryLS DbgEntryExit "Exiting DbObjectOra::Delete"
}

DbObjectOra::Begin

proc DbObjectOra::Begin {} {
     variable waitInterval
     variable tranflag
     variable handleIndex
     variable sth

     logEntryLS DbgEntryExit "Entering DbObjectOra::Begin"

     set sqlStatement "set transaction use rollback segment " 

     if {$tranflag($handleIndex) == 0} {
        if [catch {DbObjectOra::Sql $sqlStatement $waitInterval} result] {
           error "DbObjectOra::Begin: $result: "
	   return
        }
     }

    incr tranflag($handleIndex)
  
    logEntryLS DbgMsg "Begin Transaction"
    logEntryLS DbgEntryExit "Exiting DbObjectOra::Begin"
}

DbObjectOra::Commit

proc DbObjectOra::Commit {} {
     variable waitInterval
     variable tranflag
     variable handleIndex
     variable handle
     variable this 

     logEntryLS DbgEntryExit "Entering DbObjectOra::Commit"


     if {$tranflag($handleIndex) == 1} {
        catch {oracommit $handle($handleIndex)}
         if {![oramsg $handle($handleIndex) rc] == 0} {
             error "DbObjectOra::Insert oracommit: $rc "
             error "DbObjectOra::Insert Commit table: [lindex $this(table) 0] "
         } 
     }

     if {$tranflag($handleIndex) > 0 } {
        incr tranflag($handleIndex) -1
     }
   
     logEntryLS DbgMsg "Commit Transaction"
     logEntryLS DbgEntryExit "Exiting DbObjectOra::Commit"
}

DbObjectOra::Rollback

proc DbObjectOra::Rollback {} {
     variable waitInterval
     variable tranflag
     variable handleIndex
     variable handle
     variable sth 
     variable this 

     logEntryLS DbgEntryExit "Entering DbObjectOra::Rollback"

     if {$tranflag($handleIndex) > 0} {
         catch {oraroll $handle($handleIndex)}
         if {![oramsg $handle($handleIndex) rc] == 0} {
            error "DbObjectOra::Oraroll: $error "
	    return
         } 
         set tranflag($handleIndex) 0
     }

     logEntryLS DbgMsg "Rollback Transaction"
     logEntryLS DbgEntryExit "Exiting DbObjectOra::Rollback"
}

DbObjectOra::Sql

proc DbObjectOra::Sql {sqlString {timeout -1}} {
     variable handle
     variable handleIndex
     variable minSleepInterval
     variable sth 

     logEntryLS DbgEntryExit "Entering DbObjectOra::Sql $sqlString, $timeout"
     logEntryLS DbgMsg "DbObjectOra::Sql SqlString: $sqlString"

     set start [clock seconds]
     set numDeadlocks 0

       #A timeout of -1 is equivalent to synchronous
          #If not -1, it is a timeout in seconds 
     if {[string compare $timeout -1] != 0} {
        set msInterval [expr $timeout * 1000]
     } else {set msInterval -1}

     catch { [orasql $sth $sqlString] } 

     if {[oramsg $handle($handleIndex) rc] == 00500} {
          set deadlockFlag 1
          set tranflag($handleIndex) 0 
          logEntryLS Error "DbObjectOra::Sql: Encountered Oracle deadlock error ORA-0050"                 
          error "DbObjectOra::OraSql: $rc $sqlString "
     }

     DbObjectOra::Oraparse $sth $sqlString
     DbObjectOra::Oraexec $sth

   logEntryLS DbgEntryExit "Exiting DbObjectOra::Sql $sqlString, $timeout"
}

DbObjectOra::Nextrow

proc DbObjectOra::Nextrow {} {
     variable handle
     variable sth 
     variable handleIndex
     global oramsg
     set option -datavariable

     set row [DbObjectOra::Orafetch $DbObjectOra::sth $option]
     return $row
}

EXAMPLES

NOTES

WARNINGS

SEE ALSO

AUTHORS

by Timothy L. Eshelman