Class ::xo::db::DB-postgresql (public)

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

Defined in

Testcases:

No testcase defined.

Source code:

namespace eval ::xo::db {}
::nsf::object::alloc ::xotcl::Class ::xo::db::DB-postgresql {set :__default_metaclass ::xotcl::Class
   set :__default_superclass ::xotcl::Object}
::xo::db::DB-postgresql instproc foreach {{-dbn ""} {-bind ""} -prepare qn sql body} {
    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.

      }
    }
  }
::xo::db::DB-postgresql instproc row_lock {{-dbn ""} {-bind ""} {-for "UPDATE"} -prepare qn sql} {
    set prepareOpt [expr {[info exists prepare] ? [list -prepare $prepare] : ""}]
    :uplevel [list ::xo::dc list -dbn $dbn -bind $bind {*}$prepareOpt $qn "$sql FOR $for"]
  }
::xo::db::DB-postgresql instproc generate_psql {package_name object_name} {
    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
  }
::xo::db::DB-postgresql instproc 0or1row {{-dbn ""} {-bind ""} -prepare qn sql} {
    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
  }
::xo::db::DB-postgresql instproc list {{-dbn ""} {-bind ""} -prepare qn sql} {
    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
  }
::xo::db::DB-postgresql instproc dml {{-dbn ""} {-bind ""} -prepare qn sql} {
    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]
  }
::xo::db::DB-postgresql instproc sets {{-dbn ""} {-bind ""} -prepare qn sql} {
    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
  }
::xo::db::DB-postgresql instproc 1row {{-dbn ""} {-bind ""} -prepare qn sql} {
    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"
  }
::xo::db::DB-postgresql instproc multirow {{-dbn ""} {-bind ""} {-local false} {-upvar_level 1} {-extend {}} -prepare var_name qn sql {body {}}} {
    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
    }
  }
::xo::db::DB-postgresql instproc insert-view-operation {} { return 0or1row }
::xo::db::DB-postgresql instproc get_value {{-dbn ""} {-bind ""} -prepare qn sql {default ""}} {
    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
  }
::xo::db::DB-postgresql instproc list_of_lists {{-dbn ""} {-bind ""} {-with_headers false} -prepare qn sql} {
    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
  }
::xo::db::DB-postgresql instproc prepare {-handle:required {-argtypes ""} sql} {
    #
    # 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
  }
::nsf::relation::set ::xo::db::DB-postgresql superclass {::xo::db::DB ::xo::db::postgresql}

XQL Not present:

Generic, PostgreSQL, Oracle