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

 ::xotcl::Class ::xo::db::postgresql

Defined in

Testcases:

No testcase defined.

Source code:

namespace eval ::xo::db {}
::nsf::object::alloc ::xotcl::Class ::xo::db::postgresql {set :__default_metaclass ::xotcl::Class
   set :__default_superclass ::xotcl::Object}
::xo::db::postgresql instproc select {-vars:required -from:required {-where ""} {-groupby ""} {-limit ""} {-offset ""} {-start ""} {-orderby ""} {-map_function_names false}} {
    set where_clause  [expr {$where   ne "" ? "WHERE $where" : ""}]
    set offset_clause [expr {$offset  ne "" ? "OFFSET $offset" : ""}]
    set limit_clause  [expr {$limit   ne "" ? "LIMIT $limit" : ""}]
    set order_clause  [expr {$orderby ne "" ? "ORDER BY $orderby" : ""}]
    set group_clause  [expr {$groupby ne "" ? "GROUP BY $groupby" : ""}]
    return "SELECT $vars FROM $from $where_clause $group_clause $order_clause $limit_clause $offset_clause"
  }
::xo::db::postgresql instproc date_trunc_expression {field date date_string} {
    if {![string match :* $date_string]} {set date_string "'$date_string'"}
    return "date_trunc('$field',$date) = $date_string"
  }
::xo::db::postgresql instproc has_hstore {} {
    ::xo::xotcl_package_cache eval [self]::has_hstore {
      if {[:get_value check_ltree "select count(*) from pg_proc where proname = 'hstore_in'"] > 0} {
        return 1
      }
      return 0
    }
  }
::xo::db::postgresql instproc map_datatype type {
    switch -- $type {
      string    { set type text }
      long_text { set type text }
      date      { set type "timestamp with timezone" }
      ltree     { set type [expr {[::xo::dc has_ltree] ? "ltree" : "text" }] }
      default   { return [next] }
    }
    return $type
  }
::xo::db::postgresql instproc date_trunc {field date} {
    return "date_trunc('$field',$date)"
  }
::xo::db::postgresql instproc get_function_args {package_name object_name} {
    set key [string toupper ${package_name}__${object_name}]
    #
    # If we have function definitions already loaded, there is nothing
    # to do.
    #
    if {[info exists ::xo::db::fnargs($key)]} {
      return $::xo::db::fnargs($key)
    }

    ns_log notice "obtain fnargs for $key from PostgreSQL via parsing function definition"

    #
    # Get function_args for a single sql-function from PostgreSQL
    # system catalogs by retrieving the function source code and
    # passing it. We retrieve always the function with the longest
    # argument list for our definition, since we use an interface with
    # non positional arguments, where in most situations, many
    # arguments are optional.  In cases, where more function with the
    # same number of arguments are available, we sort by the type as
    # well to obtain a predictable ordering and to give string
    # interfaces (text, varchar) a higher priority than integer or
    # boolean arguments (e.g. int4, int8m bool).
    #
    # Note: based on the ordering, char has lower priority over int*
    # which is probably a bug, but is not a problem in OpenACS.
    #
    # Note that we can as well get the type in future versions.
    #
    ::xo::dc foreach get_function_params {
      select proname, pronargs, proargtypes, prosrc
      from pg_proc
      where proname = lower(:package_name) || '__' || lower(:object_name)
      order by pronargs desc, proargtypes desc
    } {
      set n 1
      set function_args [list]
      foreach line [split $prosrc \n] {
        if {[regexp -nocase "alias +for +\\\$$n" $line]} {
          if {![regexp {^[^a-zA-Z]+([a-zA-Z0-9_]+)\s} $line _ fq_name]} {
            #ns_log notice "proname $proname line <$line> fq_name <$fq_name>"
            ns_log notice "--***** Could not retrieve argument name for $proname argument $n from line '$line' i    n $prosrc'"
              set fq_name arg$n
          }
          set name $fq_name
          set default ""
          if {![regexp {^.+__(.+)$} $fq_name _ name]} {
            regexp {^[vp]_(.+)$} $fq_name _ name
          }
          if {[regexp {^.*-- default +([^, ]+) *$} $line _ default]} {
            set default [string trim $default '\n\r]
          }
          lappend function_args [list [string toupper $name] $default]
          if {[incr n]>$pronargs} break
        }
      }
      if {$n == 1 && $pronargs > 0} {
        set comment [string map [list \n "\n----\t"] $prosrc]
        ns_log notice "---- no aliases for $proname/$pronargs $comment"
        #continue
      }
      #break
    }
    return $function_args
  }
::xo::db::postgresql instproc nextval sequence {
    if {![info exists ::db::sequences]} {
      ns_log notice "-- creating per thread sequence table"
      foreach s [::xo::dc list relnames "select relname from pg_class where relkind = 'S'"] {
        set ::db::sequences($s) 1
      }
    }
    if {[info exists ::db::sequences(t_$sequence)]} {
      #ns_log notice "-- found t_$sequence"
      set sequenceName t_$sequence
      set nextval [::xo::dc get_value nextval "select nextval(:sequenceName)"]
    } elseif {[info exists ::db::sequences($sequence)]} {
      #ns_log notice "-- found $sequence"
      set sequenceName $sequence
      set nextval [::xo::dc get_value nextval "select nextval(:sequenceName)"]
    } elseif { [::xo::dc 0or1row nextval_sequence {
      select nextval(:sequence) as nextval
      where (select relkind
             from pg_class
             where relname = :sequence) = 'S'
    }]} {
      #
      # We do not have an according sequence-table. Use the system catalog to check
      # for the sequence
      #
      # ... the query sets nextval if it succeeds
      #
    } else {
      #
      # finally, there might be a view with a nextval
      #
      ns_log debug "db_nextval: sequence($sequence) is not a real sequence.  Perhaps it uses the view hack."
      set nextval [::xo::dc get_value nextval "select nextval from :sequence"]
    }
    return $nextval
  }
::xo::db::postgresql instproc has_ltree {} {
    ::xo::xotcl_package_cache eval [self]::has_ltree {
      if {[:get_value check_ltree "select count(*) from pg_proc where proname = 'ltree_in'"] > 0} {
        return 1
      }
      return 0
    }
  }
::xo::db::postgresql instproc get_all_package_functions {} {
    #
    # Load definitions in one step from function args; only for
    # those definitions where we do not have function args, we parse
    # the function arg aliases.
    #
    set definitions [::xo::dc list_of_lists get_all_package_functions0 {
      select
      args.function,
      args.arg_name,
      args.arg_default
      from acs_function_args args
      order by function, arg_seq
    }]
    set last_function ""
    set function_args {}
    foreach definition $definitions {
      lassign $definition function arg_name default
      if {$last_function ne "" && $last_function ne $function} {
        set ::xo::db::fnargs($last_function) $function_args
        #puts stderr "$last_function [list $function_args]"
        set function_args {}
      }
      lappend function_args [list $arg_name $default]
      set last_function $function
    }
    set ::xo::db::fnargs($last_function) $function_args
    #puts stderr "$last_function [list $function_args]"
    ns_log notice "loaded [array size ::xo::db::fnargs] definitions from function args"
    #ns_log notice "... [lsort [array names ::xo::db::fnargs *__*]]"

    #
    # Get all package functions (package name, object name) from PostgreSQL
    # system catalogs.
    #
    return [::xo::dc list_of_lists [self proc] {
      select distinct
      upper(substring(proname from 0 for position('__' in proname))) as package_name,
      upper(substring(proname from position('__' in proname)+2)) as object_name
      from pg_proc
      where strpos(proname,'__') > 1
    }]
  }
::nsf::relation::set ::xo::db::postgresql superclass ::xo::db::SQL

XQL Not present:

Generic, PostgreSQL, Oracle