Class ::xo::Context (public)

 ::xotcl::Class ::xo::Context

Defined in /var/www/openacs.org/packages/xotcl-core/tcl/context-procs.tcl

This class provides a context for evaluation, somewhat similar to an activation record in programming languages. It combines the parameter declaration (e.g. of a page, an includelet) with the actual parameters (specified in an includelet) and the provided query values (from the url). The parameter decaration are actually XOTcl's non positional arguments.

Testcases:

No testcase defined.

Source code:

namespace eval ::xo {}
::nsf::object::alloc ::xotcl::Class ::xo::Context {set :__default_metaclass ::xotcl::Class
   set :__default_superclass ::xotcl::Object}
::xo::Context instproc set_query_parameter {name value} {
    set :queryparm($name) $value
  }
::xo::Context instproc get_parameters {} {
    set source [expr {[info exists :__caller_parameters]
                      ? [self] : [:info parent]}]
    $source instvar __caller_parameters

    #set n [expr {[info exists :name] ? ${:name} : "NONE"}]
    #ns_log notice "$n: GET PARAMETERS source <$source> have [info exists __caller_parameters]"
    if {![info exists :__including_page]} {
      #
      # An includelet is called from the top-level. The actual_query
      # might be cached, so we reset it here.
      #
      set :actual_query [::xo::cc actual_query]
    }

    if {[info exists __caller_parameters]} {
      :process_query_parameter -all_from_query false -caller_parameters $__caller_parameters
    } else {
      :process_query_parameter -all_from_query false
    }
    :export_vars -level 2
  }
::xo::Context instproc unset_query_parameter name {
    unset -nocomplain :queryparm($name)
  }
::xo::Context instproc export_vars {-all:switch {-level 1}} {

    if {$all} {
      foreach p [array names :queryparm] {
        regsub -all : $p _ varName
        uplevel $level [list set $varName [set :queryparm($p)]]
      }
    } else {
      #
      # Export only declared parameters (coming from the package
      # initialization or from the includelet definition).
      #
      foreach p [array names :queryparm] {
        if {$p in ${:declared_parameters}} {
          #ns_log notice "=== export <$p>"
          uplevel $level [list set $p [set :queryparm($p)]]
        }
      }
    }
    #
    # Set always variable package_id
    #
    uplevel $level [list set package_id ${:package_id}]
  }
::xo::Context instproc get_all_query_parameter {} {
    return [array get :queryparm]
  }
::xo::Context instproc query_parameter {name {default {}}} {
    if {[info exists :queryparm($name)]} {
      return [set :queryparm($name)]
    }
    return $default
  }
::xo::Context instproc initialize {{-parameter ""}} {
    set :parameter_declaration $parameter
  }
::xo::Context instproc process_query_parameter {{-all_from_query:boolean true} {-all_from_caller:boolean true} -caller_parameters} {
    set declared_parameters [lmap v ${:parameter_declaration} {
      string range [lindex [split [lindex $v 0] :] 0] 1 end
    }]

    if {${:actual_query} eq " "} {
      if {[ns_conn isconnected]} {
        set :actual_query [ns_conn query]
      }
      #:log "--P actual_query <${:actual_query}> url [ns_conn url] q [ns_conn query]"
    }
    set passed_args ""
    #:log "--P processing actual query '${:actual_query}'"
    try {
      set paramset [ns_parsequery ${:actual_query}]
      foreach {att_name att_value} [ns_set array $paramset] {
        if {$att_name eq ""} continue
        if {$att_name in $declared_parameters} {
          dict lappend passed_args -$att_name $att_value
        } elseif {$all_from_query} {
          set :queryparm($att_name) $att_value
        }
      }
    } on error {errorMsg} {
      ad_log warning "process_query_parameter: $errorMsg"
      ad_return_complaint 1 "invalid characters in HTTP query parameters"
    }

    # get the query parameters (from the form if necessary)
    if {[:istype ::xo::ConnectionContext]} {
      foreach name $declared_parameters {
        set param -$name
        #:log "--cc check $param [dict exists $passed_args $param]"
        if {![dict exists $passed_args $param]
            && [:exists_form_parameter $name]
          } {
          #:log "--cc adding passed_args(-$name) [:form_parameter $name]"
          dict set passed_args $param [:form_parameter $name]
        }
      }
    }

    # get the caller parameters (e.g. from the includelet call)
    if {[info exists caller_parameters]} {
      #:log "--cc caller_parameters=$caller_parameters"

      foreach param [dict keys $caller_parameters] {
        set name [string range $param 1 end]
        if {$name in $declared_parameters} {
          dict set passed_args $param [dict get $caller_parameters $param]
        } elseif {$all_from_caller} {
          set :queryparm($name) [dict get $caller_parameters $param]
          lappend declared_parameters $name
        }
      }
    }

    if {[::acs::icanuse "nsf::parseargs -asdict"]} {
      # OLD {64.347249 microseconds per iteration}
      # NEW {17.132942 microseconds per iteration}
      try {
        foreach {k v} [nsf::parseargs -asdict ${:parameter_declaration} $passed_args] {
          set :queryparm($k) $v
        }
      } on error {errorMsg} {
        ad_return_complaint 1 [ns_quotehtml $errorMsg]
        ad_script_abort
      }
    } else {
      #:log "--cc calling parser eval [self] __parse <${:parameter_declaration}> <$passed_args>"

      :proc __parse ${:parameter_declaration} {
        foreach v [info vars] {
          :log "--cc uplevel [list set :queryparm($v) [set $v]]"
          uplevel [list set :queryparm($v) [set $v]]
        }
      }

      if {[catch {[self] __parse {*}$passed_args} errorMsg]} {
        ad_return_complaint 1 [ns_quotehtml $errorMsg]
        ad_script_abort
      }
    }
    set :declared_parameters $declared_parameters
    #:log "--cc qp [array get :queryparm] // ${:actual_query}"
  }
::xo::Context instproc exists_query_parameter name {
    #:log "--qp exists $name => [info exists :queryparm($name)]"
    info exists :queryparm($name)
  }
::xo::Context instproc original_url_and_query args {
    if {[llength $args] == 1} {
      set :original_url_and_query [lindex $args 0]
    } elseif {[info exists :original_url_and_query]} {
      return ${:original_url_and_query}
    } else {
      return ${:url}?${:actual_query}
    }
  }
::xo::Context instparametercmd invoke_object
::xo::Context instparametercmd locale
::xo::Context instparametercmd package_id
::xo::Context instparametercmd parameter_declaration
::xo::Context instparametercmd actual_query

::nx::slotObj -container slot ::xo::Context
::xo::Context::slot eval {set :__parameter {
    {parameter_declaration ""}
    {actual_query " "}
    {package_id 0}
    {invoke_object}
    locale
  }}

::nsf::object::alloc ::xotcl::Attribute ::xo::Context::slot::parameter_declaration {set :accessor public
   set :configurable true
   set :convert false
   set :default {}
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::Context
   set :incremental 0
   set :manager ::xo::Context::slot::parameter_declaration
   set :methodname parameter_declaration
   set :multiplicity 1..1
   set :name parameter_declaration
   set :parameterSpec {-parameter_declaration:substdefault {}}
   set :per-object false
   set :position 0
   set :required false
   set :substdefault 0b111
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xo::Context::slot::invoke_object {set :accessor public
   set :configurable true
   set :convert false
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::Context
   set :incremental 0
   set :manager ::xo::Context::slot::invoke_object
   set :methodname invoke_object
   set :multiplicity 1..1
   set :name invoke_object
   set :parameterSpec -invoke_object
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xo::Context::slot::actual_query {set :accessor public
   set :configurable true
   set :convert false
   set :default { }
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::Context
   set :incremental 0
   set :manager ::xo::Context::slot::actual_query
   set :methodname actual_query
   set :multiplicity 1..1
   set :name actual_query
   set :parameterSpec {-actual_query:substdefault { }}
   set :per-object false
   set :position 0
   set :required false
   set :substdefault 0b111
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xo::Context::slot::package_id {set :accessor public
   set :configurable true
   set :convert false
   set :default 0
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::Context
   set :incremental 0
   set :manager ::xo::Context::slot::package_id
   set :methodname package_id
   set :multiplicity 1..1
   set :name package_id
   set :parameterSpec {-package_id:substdefault 0}
   set :per-object false
   set :position 0
   set :required false
   set :substdefault 0b111
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xo::Context::slot::locale {set :accessor public
   set :configurable true
   set :convert false
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::Context
   set :incremental 0
   set :manager ::xo::Context::slot::locale
   set :methodname locale
   set :multiplicity 1..1
   set :name locale
   set :parameterSpec -locale
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}

XQL Not present:

Generic, PostgreSQL, Oracle