---

Class ::xo::db::DB-postgresql

::xo::db::DB-postgresql create ...

Defined in

Class Relations

• class: ::xotcl::Class
• superclass: ::xo::db::DB, ::xo::db::postgresql

::xotcl::Class create ::xo::db::DB-postgresql \
     -superclass {::xo::db::DB ::xo::db::postgresql}

Methods (to be applied on instances)

• 0or1row (scripted)

   <instance of xo::db::DB-postgresql> 0or1row

  Testcases:

  test_xo_db_object, xotcl-core, test_cr_items, xowiki_test_cases

  if {$sql eq ""} {set sql [:get_sql $qn]}
  set prepOpt [expr {[info exists prepare] ? [list -prepare $prepare] : ""}]
  set answers [uplevel [list [self] exec_0or1row -dbn $dbn {*}$prepOpt -bind $bind $sql]]
  if {$answers ne ""} {
    foreach {att val} [ns_set array $answers] { uplevel [list set $att $val] }
    ns_set free $answers
    return 1
  }
  return 0

• 1row (scripted)

   <instance of xo::db::DB-postgresql> 1row

  Testcases:

  xotcl_core_tutorial_3, xotcl-core, test_xo_db_object, test_cr_items

  if {$sql eq ""} {set sql [:get_sql $qn]}
  set prepOpt [expr {[info exists prepare] ? [list -prepare $prepare] : ""}]
  set answers [uplevel [list [self] exec_0or1row -dbn $dbn {*}$prepOpt -bind $bind $sql]]
  if {$answers ne ""} {
    foreach {att val} [ns_set array $answers] { uplevel [list set $att $val] }
    ns_set free $answers
    return 1
  }
  error "query $sql did not return an answer"

• dml (scripted)

   <instance of xo::db::DB-postgresql> dml

  Testcases:

  xotcl_core_tutorial_2, xotcl-core, xotcl_core_tutorial_4, test_cr_items, xowiki_test_cases, slot_interactions

  if {$sql eq ""} {set sql [:get_sql $qn]}
  if {$bind ne ""} {set bindOpt [list -bind $bind]} {set bindOpt ""}
  set bind $bindOpt
  db_with_handle -dbn [:map_default_dbn $dbn] db {
    if {[info exists prepare]} {set sql [:prepare -handle $db -argtypes $prepare $sql]}
    ::db_exec dml $db [uplevel [list [self] qn $qn]] $sql 2
  }
  return [db_resultrows]

• foreach (scripted)

  set prepare [expr {[info exists prepare] ? [list -prepare $prepare] : ""}]
  set rows [uplevel 1 [list ::xo::dc list_of_lists -with_headers true -dbn $dbn -bind $bind {*}$prepare $qn $sql]]
  set headers [lindex $rows 0]
  foreach row [lrange $rows 1 end] {
    foreach att $headers value $row {
      uplevel 1 [list set $att $value]
    }
  
    try {
  
      uplevel 1 $body
  
    } on error {errMsg} {
  
      error $errMsg $::errorInfo $::errorCode
  
    } on return {} {
  
      error "Cannot return from inside a ::xo::dc foreach loop"
  
    } on break {} {
  
      break
  
    } on continue {} {
  
      # Just ignore and continue looping.
  
    }
  }

• generate_psql (scripted)

   <instance of xo::db::DB-postgresql> generate_psql

  Testcases:

  xotcl_core_tutorial_2, xotcl-core

  set function_args [:get_function_args $package_name $object_name]
  set function_args [:fix_function_args $function_args $package_name $object_name]
  set sql_info [:sql_arg_info $function_args $package_name $object_name]
  #ns_log notice "-- select ${package_name}__${object_name} ($psql_args)"
  set sql_suffix [:psql_statement_suffix ${package_name} ${object_name}]
  set sql [subst {
    select ${package_name}__${object_name}([dict get $sql_info psql_args]) $sql_suffix
  }]
  set sql_cmd {ns_set value [ns_pg_bind 0or1row $db $sql] 0}
  dict set sql_info body [subst {
    #function_args: $function_args
    foreach var \[list [dict get $sql_info arg_order]\]  {
      set varname \[string tolower \$var\]
      if {\[info exists \$varname\]} {
        set \$var \[set \$varname\]
        set _\$var :\$var
      } else {
        set _\$var null
      }
    }
    set sql "$sql"
    db_with_handle -dbn \$dbn db {
      #ns_log notice "--sql=\$sql"
      return \[ $sql_cmd \]
    }
  }]
  return $sql_info

• get_value (scripted)

   <instance of xo::db::DB-postgresql> get_value

  Testcases:

  xotcl_core_tutorial_1, xotcl-core, xotcl_core_tutorial_2, xotcl_core_tutorial_4, test_xo_db_object, test_cr_items, xowiki_test_cases, path_resolve

  if {$sql eq ""} {set sql [:get_sql $qn]}
  set prepOpt [expr {[info exists prepare] ? [list -prepare $prepare] : ""}]
  set answers [uplevel [list [self] exec_0or1row -dbn $dbn {*}$prepOpt -bind $bind $sql]]
  if {$answers ne ""} {
    set result [ns_set value $answers 0]
    ns_set free $answers
    return $result
  }
  return $default

• insert-view-operation (scripted)

   <instance of xo::db::DB-postgresql> insert-view-operation

  Testcases:

  xotcl_core_tutorial_4, xotcl-core, test_cr_items

  return 0or1row

• list (scripted)

   <instance of xo::db::DB-postgresql> list

  Testcases:

  xotcl_core_tutorial_2, xotcl-core, xowiki_test_cases

  if {$sql eq ""} {set sql [:get_sql $qn]}
  if {$bind ne ""} {set bindOpt [list -bind $bind]} {set bindOpt ""}
  db_with_handle -dbn [:map_default_dbn $dbn] db {
    if {[info exists prepare]} {set sql [:prepare -handle $db -argtypes $prepare $sql]}
    set result {}
    set answers [uplevel [list ns_pg_bind select $db {*}$bindOpt $sql]]
    while { [::db_getrow $db $answers] } {
      lappend result [ns_set value $answers 0]
    }
    ns_set free $answers
  }
  return $result

• list_of_lists (scripted)

   <instance of xo::db::DB-postgresql> list_of_lists

  Testcases:

  xotcl_core_tutorial_2, xotcl-core, xotcl_core_tutorial_3

  if {$sql eq ""} {set sql [:get_sql $qn]}
  if {$bind ne ""} {set bindOpt [list -bind $bind]} {set bindOpt ""}
  db_with_handle -dbn [:map_default_dbn $dbn] db {
    if {[info exists prepare]} {set sql [:prepare -handle $db -argtypes $prepare $sql]}
    set result {}
    set answers [uplevel [list ns_pg_bind select $db {*}$bindOpt $sql]]
    if {$with_headers} {
      if {[acs::icanuse "ns_set keys"]} {
        set headers [ns_set keys $answers]
      } else {
        set headers [dict keys [ns_set array $answers]]
      }
      set result [list $headers]
    }
    while { [db_getrow $db $answers] } {
      set row [list]
      foreach {att value} [ns_set array $answers] {lappend row $value}
      lappend result $row
    }
    ns_set free $answers
  }
  return $result

• multirow (scripted)

  set prepare [expr {[info exists prepare] ? [list -prepare $prepare] : ""}]
  set rows [uplevel 1 [list ::xo::dc list_of_lists -with_headers true -dbn $dbn -bind $bind {*}$prepare $qn $sql]]
  set headers [lindex $rows 0]
  
  if { $local } {
    set level_up [expr {$upvar_level + 1}]
  } else {
    set level_up \#[::template::adp_level]
  }
  
  set cols [concat $headers $extend]
  if {[::template::multirow -local -ulevel $level_up exists $var_name]} {
    #
    # We enforce here, that appending to an existing multirow
    # can only happen when we are extracting the same columns.
    #
    set existing_cols [::template::multirow -local -ulevel $level_up columns $var_name]
    if {$cols ne $existing_cols} {
      error "Cannot append to a multirow with different columns"
    }
  } else {
    ::template::multirow -local -ulevel $level_up create $var_name {*}$cols
  }
  
  foreach values [lrange $rows 1 end] {
    if {[string length $body] > 0} {
      #
      # We have a code to execute. Bring all of the multirow
      # variables in scope.
      #
  
      #
      # Vars from the query
      #
      foreach att $headers value $values {
        uplevel 1 [list set $att $value]
      }
  
      #
      # Extended variables, initialized to empty.
      #
      foreach att $extend {
        uplevel 1 [list set $att ""]
      }
  
      #
      # Run the code and trap any exception.
      #
      try {
  
        uplevel 1 $body
  
      } on error {errMsg} {
  
        error $errMsg $::errorInfo $::errorCode
  
      } on return {} {
  
        error "Cannot return from inside a ::xo::dc multirow loop"
  
      } on break {} {
  
        break
  
      } on continue {} {
  
        continue
  
      }
  
      #
      # Collect the values after the code has been executed.
      #
      set values [lmap att $cols {
        if {[uplevel 1 [list info exists $att]]} {
          uplevel 1 [list set $att]
        }
      }]
    } else {
      #
      # No code to execute. We can just bulk append the values
      # from the row.
      #
    }
    ::template::multirow -local -ulevel $level_up append $var_name {*}$values
  }

• prepare (scripted)

  #
  # Define a md5 key for the prepared statement in nsv based on the
  # SQL statement.
  #
  set key [ns_md5 $sql]
  
  #
  # Get local variables "prepare", "execute", "prepName", and "sql"
  # keeping the relevant prepared statement context.
  #
  set per_interp_cache ::xo::prepared($key)
  if {[info exists $per_interp_cache]} {
    #
    # The prepared statement exists in the per-interp cache, get the
    # values from there.
    #
    lassign [set $per_interp_cache] prepare execute prepName sql
  
  } elseif {[nsv_exists prepared_statement $key]} {
    #
    # The prepared statement exists already in the nsv-cache.
    set nsv_cached_value [nsv_get prepared_statement $key]
    #
    # Save the nsv-cached value as well in the per-interpreter cache
    # and set the output variables.
    #
    set $per_interp_cache $nsv_cached_value
    lassign $nsv_cached_value prepare execute prepName sql
  
  } else {
    #
    # Compute a PREPARE statement and an EXECUTE statement on the
    # fly. Notice, that the incoming SQL statement must not have Tcl
    # vars, but has to use bind vars.
    #
    set d [ns_pg_prepare $sql]
    set execArgs [dict get $d args]
    set prepArgs [lrepeat [llength $execArgs] unknown]
    set preparedSQL [dict get $d sql]
  
    set argtypes [split $argtypes ,]
    if {[llength $argtypes] == [llength $prepArgs]} {
      set prepArgs $argtypes
    }
  
    if {[llength $prepArgs] > 0} {
      set prepArgs ([join $prepArgs ,])
    }
    if {[llength $execArgs] > 0} {
      set execArgs ([join $execArgs ,])
    }
  
    set c [nsv_incr prepared_statement count]
    set prepName __p$c
    set prepare [ns_trim -delimiter | [subst {
      |DO \$\$ DECLARE found boolean;
      |BEGIN
      |SELECT exists(select 1 from pg_prepared_statements where name = '$prepName') into found;
      |if found IS FALSE then
      |    PREPARE $prepName $prepArgs AS $preparedSQL;
      |end if;
      |END\$\$;
    }]]
    set execute "EXECUTE $prepName $execArgs"
    #
    # Save the values for this statement in the nsv-cache. This does
    # not mean that the prepared statement exists for the SQL
    # session already.
    #
    nsv_set prepared_statement $key [list $prepare $execute $prepName $sql]
  }
  
  #
  # Now determine, whether the prepared statement was already
  # defined for the current SQL session.  Depending on the version
  # of the driver, we can obtain a session_id from the db driver on
  # different preciseness levels. If we can't get the SQL session_id
  # from the driver, fall back to a per-request cache (via top-level
  # variable).
  #
  try {
    if {[::acs::icanuse "ns_pg pid"]} {
      set session_id [ns_pg pid $handle]
      #ns_log notice "=== ns_pg pid -> '$session_id'"
    } else {
      set session_id [ns_db session_id $handle]
    }
  } on ok {_} {
    #ns_log notice "=== $handle $session_id"
    set varName ::xo::prepared($session_id,$key)
  } on error {errorMsg} {
    #
    # Could not determine SQL session_id, fall back to per-request
    # cache.
    #
    set session_id "-"
    set varName __prepared($key)
  }
  
  if {![info exists $varName]} {
    #
    # We have to check for the prepared statement in the current
    # session and we have to create it if necessary there.
    #
    ns_log notice "=== new prepared statement $prepName for SQL session $session_id: $sql"
    ::db_exec dml $handle dbqd..create_preapared $prepare
    #
    # Save the fact that we have a new preparted statement for this
    # SQL session_id in the current interpreter.
    #
    set $varName 1
  
  } else {
    #ns_log notice "=== prepare reuses handle $handle execute $execute session_id $session_id"
  }
  #ns_log notice "=== prepare done, handle $handle execute $execute session_id $session_id"
  return $execute

• row_lock (scripted)

   <instance of xo::db::DB-postgresql> row_lock

  Testcases:

  xotcl_core_tutorial_4, xotcl-core, test_cr_items

  set prepareOpt [expr {[info exists prepare] ? [list -prepare $prepare] : ""}]
  :uplevel [list ::xo::dc list -dbn $dbn -bind $bind {*}$prepareOpt $qn "$sql FOR $for"]

• sets (scripted)

  if {$sql eq ""} {set sql [:get_sql $qn]}
  if {$bind ne ""} {set bindOpt [list -bind $bind]} {set bindOpt ""}
  
  db_with_handle -dbn $dbn db {
    if {[info exists prepare]} {set sql [:prepare -handle $db -argtypes $prepare $sql]}
    set result [list]
  
    set answers [uplevel [list ns_pg_bind select $db {*}$bindOpt $sql]]
    while { [::db_getrow $db $answers] } {
      lappend result [ns_set copy $answers]
    }
    ns_set free $answers
  }
  return $result

---