Object ::xo::db::require (public)

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

Defined in

Testcases:

No testcase defined.

Source code:

namespace eval ::xo::db {}
::nsf::object::alloc ::xotcl::Object ::xo::db::require {}
::xo::db::require proc table {name definition {populate {}}} {
    #: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]"
        }
      }
    }
  }
::xo::db::require proc index {-table -col -expression -expression_name {-using ""} {-unique false}} {
    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)"
    }
  }
::xo::db::require proc view {name definition {-rebuild_p false}} {
    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"
    }
  }
::xo::db::require proc package package_key {
    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]]
    }
  }
::xo::db::require proc default {-table -col -value} {
    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"
      }
    }
  }
::xo::db::require proc exists_table name {
    ::db_table_exists $name
  }
::xo::db::require proc sequence {-name -start_with -increment_by -minvalue -maxvalue {-cycle false} {-cache 1}} {
    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]"
  }
::xo::db::require proc function_args {-kernel_older_than -package_key_and_version_older_than -check_function sql_file} {
    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
  }
::xo::db::require proc references {-table -col -ref} {
    # 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"
  }
::xo::db::require proc not_null {-table -col} {
    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"
    }
  }
::xo::db::require proc exists_column {table_name column_name} {

    #
    # 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
      }
    }
  }
::xo::db::require proc unique {-table -col} {
    # 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)"
    }
  }

XQL Not present:

Generic, PostgreSQL, Oracle