::xotcl::Object ::xo::db::require

Methods: All Methods Documented Methods Hide Methods
Source: Display Source Hide Source
Variables: Show Variables Hide Variables

Defined in

Class Relations

class: ::xotcl::Object

::xotcl::Object create ::xo::db::require

Methods (to be applied on the object)

default (scripted)

 xo::db::require default

Testcases:
xotcl_core_tutorial_2, xotcl-core

set default [::acs::dc call util get_default -table $table -column $col]

if {[db_driverkey ""] eq "oracle"} {
  #
  # Oracle behaves differently: one needs the "modify"
  # subcommand, the stunt with the case below raises exceptions
  # of several reasons (cast needs length, boolean value in
  # coalesce, ...). Furthermore, Oracle does not allow a bind
  # variable for the default value.
  #
  set default [string trim $default]
  if {$default ne $value} {
    ::xo::dc dml alter-table-$table  "alter table $table modify $col default [ns_dbquotevalue $value]"
  }
  return
}
#
# Newer versions of PostgreSQL return default values with type
# casts (e.g. 'en_US'::character varying). In these cases, we
# remove the type cast from the returned default value before
# comparison.
#
# Depending on the generation and real datatype of the DBMS,
# certain datatype values are reported differently from the
# DBMS. Therefore, we use a type cast to check whether
# specified default value (e.g. '1900-01-01') is in fact
# equivalent to default stored in db (e.g. '1900-01-01
# 00:00:00+01'::timestamp with timezone).
#
# Booleans can be normalized in advance without involving the
# database
if {
    ($default eq "f" && $value eq "false")
    || ($default eq "t" && $value eq "true")
  } {
  set value $default
}
if {$default ne $value} {
  if {[regexp {^'(.*)'::(.*)$} $default match default_value default_datatype]} {
    set clause "$default <> cast(:value as $default_datatype)"
  } else {
    set datatype [db_column_type $table $col]
    set clause "cast(:default as $datatype) <> cast(:value as $datatype)"
  }
  # This last coalesce is in case one of the compared values
  # was null: as we know they were different, this is
  # certainly a new default
  if {[::xo::dc get_value check_default "
               select coalesce($clause, true) from dual"]} {
    ::xo::dc dml alter-table-$table  "alter table $table alter column $col set default :value"
  }
}

exists_column (scripted)

 xo::db::require exists_column

Testcases:
xotcl_core_tutorial_2, xotcl-core


#
# The following "try" operation is a transitional code: When
# someone upgrades from OpenACS 5.9.1 to OpenACS 5.10, and the
# upgrade script of 5.10 were not yet executed, the SQL function
# definition is still the one of 5.9.1 have no -p_table and
# p_column attributes defined (still the old names). A end user is
# lost in this situation. Therefore, we provide as a fallback the
# interface to the 5.9.1 parameter names. The situation is still a
# problem in OpenACS 5.10, since the Oracle code has still the old
# names. Therefore, for OpenACS 5.10.1, the names are made more
# consistent, using "table_name" (abbreviated as table) and
# "column" as on several other occasions.
#

try {
  ::acs::dc call util table_column_exists  -table $table_name  -column $column_name
} on error {errorMsg} {
  try {
    ::acs::dc call util table_column_exists  -t_name $table_name  -c_name $column_name
  } on error {errorMsg} {
    ::acs::dc call util table_column_exists  -p_table $table_name  -p_column $column_name
  }
}

exists_table (scripted)
```
::db_table_exists $name
```

function_args (scripted, public)

 xo::db::require function_args [ -kernel_older_than kernel_older_than ] \
    [ -package_key_and_version_older_than package_key_and_version_older_than ] \
    [ -check_function check_function ] sql_file

Load the SQL file, if the kernel is older than the specified version, and the version of the specified package is older, and the check_function does not exist in function_args.
Sample usage: ::xo::db::require function_args \ -kernel_older_than 5.5.0 \ -older_than_package_key_and_version "xowiki 0.50" \ -check_function "acs_object_type__create_type" \ [acs_package_root_dir xotcl-request-broker]/patches/funcs-1.sql

Switches:

-kernel_older_than (optional)
-package_key_and_version_older_than (optional)
-check_function (optional)

Parameters:

sql_file (required)

Testcases:
No testcase defined.

if {[db_driverkey ""] eq "postgresql"} {
  # only necessary with PostgreSQL
  if {[info exists kernel_older_than]} {
    if {[apm_version_names_compare  $kernel_older_than [ad_acs_version]] < 1} {
      # nothing to do
      return
    }
  }
  if {[info exists package_key_and_version_older_than]} {
    set p [split $package_key_and_version_older_than]
    if {[llength $p] != 2} {
      error "package_key_and_version_older_than should be of the form 'package_key version'"
    }
    lassign $p package_key version
    set installed_version [apm_highest_version_name $package_key]
    if {[apm_version_names_compare $installed_version $version] > -1} {
      # nothing to do
      return
    }
  }
  if {[info exists check_function]} {
    set check_function [string toupper $check_function]
    set function_exists [::xo::dc 0or1row function_exists {
      select 1 from dual where exists
      (SELECT 1 FROM acs_function_args WHERE function = :check_function)
    }]
    if {$function_exists} {
      # nothing to do
      return
    }
  }

  if {[ad_file readable $sql_file]} {
    :log "Sourcing '$sql_file'"
    db_source_sql_file $sql_file
    ::xo::db::Class create_all_functions
    return 1
  } else {
    :log "Could not source '$sql_file'"
  }
}
return 0

index (scripted)

 xo::db::require index

Testcases:
xotcl_core_tutorial_2, xotcl-core

if {![info exists col] && ![info exists expression]} {
  error "Neither col nor expression were provided"
}
if { [info exists col] &&  [info exists expression]} {
  error "Please provide either col or expression"
}

if {[info exists col]} {
  set colExpSQL $col
  regsub -all -- ", *" $col _ colExpName
} else {
  set colExpSQL ($expression)
  if {[info exists expression_name]} {
    set colExpName $expression_name
  } else {
    regsub -all -- {[^[:alnum:]]} $expression "" colExpName
  }
}
set suffix [expr {$unique ? "un_idx" : "idx"}]
set uniquepart [expr {$unique ? "UNIQUE" : ""}]
set name [::xo::dc mk_sql_constraint_name $table $colExpName $suffix]
if {![::acs::dc call util index_exists -name $name]} {
  if {[db_driverkey ""] eq "oracle"} {set using ""}
  set using [expr {$using ne "" ? "using $using" : ""}]
  ::xo::dc dml create-index-$name  "create $uniquepart index $name ON $table $using ($colExpSQL)"
}

not_null (scripted)

 xo::db::require not_null

Testcases:
xotcl_core_tutorial_2, xotcl-core

set exists_p [::acs::dc call util not_null_exists -table $table -column $col]
if {!$exists_p} {
  ::xo::dc dml alter-table-$table  "alter table $table alter column $col set not null"
}

package (scripted)

foreach path [apm_get_package_files  -package_key $package_key  -file_types tcl_procs] {
  ::xo::library require -package $package_key  [file rootname [file tail $path]]
}

references (scripted)

 xo::db::require references

Testcases:
xotcl_core_tutorial_2, xotcl-core

# Check for already existing foreign keys.
set ref [string trim $ref]
# try to match the full reftable(refcol) syntax...
if {![regexp {^(\w*)\s*\(\s*(\w*)\s*\)\s*(.*)$} $ref match reftable refcol rest]} {
  # if fails only table was given, assume refcol is reftable's
  # primary key
  set reftable [lindex $ref 0]
  set refcol [::acs::dc call util get_primary_keys -table $reftable]
  # only one primary key is supported for the table
  if {[llength $refcol] != 1} {
    return
  }
}

set exists_p [::acs::dc call util foreign_key_exists  -table $table  -column $col  -reftable $reftable  -refcolumn $refcol]
if {$exists_p} {
  ns_log debug "foreign key already exists for table $table column $col"  "to ${reftable}(${refcol})"
  return
}
::xo::dc dml alter-table-$table  "alter table $table add foreign key ($col) references $ref"

sequence (scripted)

if {[db_driverkey ""] eq "oracle"} {
  set name [string toupper $name]
  # sequences have a unique name, no "exists" necessary
  if {[::xo::dc 0or1row exists {
    SELECT 1 FROM user_sequences WHERE sequence_name = :name
  }]} return
} else {
  #
  # PostgreSQL could avoid this check and use 'if not exists' in
  # versions starting with 9.5.
  #
  if {[::xo::dc 0or1row exists "
     SELECT 1 FROM information_schema.sequences
      WHERE sequence_schema = 'public'
        AND sequence_name = :name"]} return
}

set clause {}
if {[info exists start_with]} {
  lappend clause "START WITH $start_with"
}
if {[info exists increment_by]} {
  lappend clause "INCREMENT BY $increment_by"
}
if {[info exists minvalue]} {
  lappend clause "MINVALUE $minvalue"
}
if {[info exists maxvalue]} {
  lappend clause "MAXVALUE $maxvalue"
}
if {!$cycle} {
  lappend clause "NO"
}
lappend clause "CYCLE"
lappend clause "CACHE $cache"
::xo::dc dml create-seq "
   CREATE SEQUENCE $name [join $clause]"

table (scripted)

 xo::db::require table

Testcases:
xotcl_core_tutorial_2, xotcl-core

#:log "==== require table $name exists: [:exists_table $name]\n$definition"
if {![:exists_table $name]} {
  set lines {}
  foreach col [dict keys $definition] {lappend lines "$col [dict get $definition $col]"}
  set definition [join $lines ",\n"]
  # :log "--table $name does not exist, creating with definition: $definition"
  ::xo::dc dml create-table-$name "create table $name ($definition)"
  if {$populate ne ""} {
    ::xo::dc dml populate-table-$name $populate
  }
} else {
  # The table exists already. Check the columns, whether we have to
  # add columns. We do not alter attribute types, and we do not
  # delete columns.
  foreach col [dict keys $definition] {
    if {![:exists_column $name $col]} {
      ns_log notice "xodb: adding column <alter table $name add column $col [dict get $definition $col]>"
      ::xo::dc dml alter-table-$name  "alter table $name add column $col [dict get $definition $col]"
    }
  }
}

unique (scripted)

 xo::db::require unique

Testcases:
xotcl_core_tutorial_2, xotcl-core

# Unique could be there by an index too
set idxname [::xo::dc mk_sql_constraint_name $table $col un_idx]
if {[::acs::dc call util index_exists -name $idxname]} return
if {![::acs::dc call util unique_exists -table $table -column $col]} {
  ::xo::dc dml alter-table-$table  "alter table $table add unique ($col)"
}

view (scripted)

if {[db_driverkey ""] eq "oracle"} {set name [string toupper $name]}
if {$rebuild_p} {
  ::xo::dc dml drop-view-$name "drop view if exists $name"
}
if {![::acs::dc call util view_exists -name $name]} {
  ::xo::dc dml create-view-$name "create view $name AS $definition"
}

Methods: All Methods Documented Methods Hide Methods
Source: Display Source Hide Source
Variables: Show Variables Hide Variables

Class Relations

Methods (to be applied on the object)

default (scripted)

exists_column (scripted)

exists_table (scripted)

function_args (scripted, public)

index (scripted)

not_null (scripted)

package (scripted)

references (scripted)

sequence (scripted)

table (scripted)

unique (scripted)

view (scripted)