xowiki::Page instproc get_form

xowiki::Page instproc get_form_data (public)

 <instance of xowiki::Page> get_form_data \
    [ -field_names field_names ] form_fields

Defined in /var/www/openacs.org/packages/xowiki/tcl/xowiki-www-procs.tcl

Get the values from the form and store it in the form fields and finally as instance attributes. If the field names are not specified, all form parameters are used.

Switches:

-field_names (optional)

Parameters:

form_fields (required)

Testcases:

create_form_with_form_instance

Source code:

#:log "===== Page get_form_data"

set validation_errors 0
set category_ids [list]
array set containers [list]
set cc [::${:package_id} context]

if {![info exists field_names]} {
  #
  # Field names might come directly from the POST request payload
  # and need to be validated: enforce that field names are made
  # only by alphanumeric characters and dots, with the exception
  # of file related fields, where either .tmpfile or .content-type
  # will be appended.
  #
  #:log "===== Page get_form_data RAW field_names from form data: [$cc array names form_parameter *_.*]"

  set field_names [list]
  foreach att [$cc array names form_parameter] {
    if {[regexp {^[\w.]+(\.(tmpfile|content-type))?$} $att]} {
      lappend field_names $att
    } else {
      #
      # We might decide to return a 403 here instead...
      #
      ad_log warning "Page get_form_data: field name '$att' was skipped. Received field names: [$cc array names form_parameter]"
    }
  }
}

#:msg "fields $field_names // $form_fields"
#foreach f $form_fields { :msg "... $f [$f name]" }
#
# We have the form data and get all form_parameters into the
# form-field objects.
#
foreach att $field_names {
  #:msg "getting att=$att"
  set processed($att) 1
  switch -glob -- $att {
    __category_* {
      set f [:lookup_form_field -name $att $form_fields]
      if {![$f is_disabled]} {
        set value [$f value [$cc form_parameter $att]]
        foreach v $value {lappend category_ids $v}
      }
    }
    __* {
      #
      # Other internal variables (like __object_name) are ignored
      #
    }
    _* {
      #
      # CR fields
      #
      set f [:lookup_form_field -name $att $form_fields]
      if {![$f is_disabled]} {
        set value [$f value [string trim [$cc form_parameter $att]]]
        set varname [string range $att 1 end]
        if {[string first . $att] == -1} {
          set :$varname $value
        }
      }
    }
    default {
      #
      # Application form content fields.
      #
      if {[regexp {^(.+)[.](tmpfile|content-type)} $att _ file field]} {
        #
        # File related fields.
        #
        set f [:lookup_form_field -name $file $form_fields]
        if {![$f is_disabled]} {
          $f $field [string trim [$cc form_parameter $att]]
        }
        #:msg "[$f name]: [list $f $field [string trim [$cc form_parameter $att]]]"

      } else {
        #
        # Fields related to instance variables.
        #
        #:log "===== Page get_form_data calls lookup_form_field -name $att"
        set f [:lookup_form_field -name $att $form_fields]
        if {![$f is_disabled]} {
          set value [$f value [string trim [$cc form_parameter $att]]]
          #:log "===== Page get_form_data calls lookup_form_field -name $att -> $f -> '$value'"
          if {[string first . $att] == -1} {
            #
            # If the field is not a compound field, put the received
            # value into the instance attributes. The containerized
            # input values from compound fields are processed below.
            #
            dict set :instance_attributes $att $value
          }
          if {[$f exists is_category_field]} {
            foreach v $value {
              lappend category_ids $v
            }
          }
        }
      }
    }
  }
  if {[string first . $att] > -1} {
    lassign [split $att .] container component
    lappend containers($container) $component
  }
}

#
# The first round was a processing based on the transmitted input
# fields of the forms. Now we use the formfields to complete the
# data and to validate it.
#
set leaf_components {}
set container_fields {}
foreach f $form_fields {
  if {[$f istype ::xowiki::formfield::CompoundField]} {
    #ns_log notice "TOP call leaf_components for [$f info class]"
    lappend leaf_components {*}[$f leaf_components]
    lappend container_fields $f
    set processed([$f name]) 1
  }
}

#ns_log notice "PROCESSED <[lsort [array names processed]]>"
#ns_log notice "LEAF COMPONENTS <[lsort [lmap f $leaf_components {$f name}]]>"
#ns_log notice "FORM_FIELDS [lsort [lmap f $form_fields {$f name}]]"
#ns_log notice "CONTAINER   [lsort [array names containers]] + [lsort [lmap f $container_fields {$f name}]]"

#
# Certain HTML form field types are not transmitted by the browser
# (e.g. unchecked checkboxes). Therefore, we have not processed
# these fields above and have to do it now.
#
foreach f [concat $form_fields $leaf_components] {
  #:log "check processed $f [$f name] [info exists processed([$f name])] disabled=[$f is_disabled]"
  set att [$f name]

  if {![info exists processed($att)]
      && ![$f exists is_repeat_template]
      && ![$f is_disabled]
    } {
    #ns_log notice "==== form field $att [$f info class] not yet processed"

    switch -glob -- $att {
      __* {
        # other internal variables (like __object_name) are ignored
      }
      _* {
        # instance attribute fields
        set varname [string range $att 1 end]
        set default ""
        if {[info exists :$varname]} {set default [set :$varname]}
        set v [$f value_if_nothing_is_returned_from_form $default]
        #ns_log notice "===== value_if_nothing_is_returned_from_form [$f name] '$default' => '$v' (type=[$f info class])"
        set value [$f value $v]
        if {$v ne $default} {
          if {[string first . $att] == -1} {
            set :$varname $value
          }
        }
      }
      default {
        # user form content fields
        set default ""
        #
        # The reason, why we set in the next line the default to
        # the old value is due to "show-solution" in the qti
        # use-case. Maybe one should alter this use-case to
        # simplify the semantics here.
        #
        if {[dict exists ${:instance_attributes} $att]} {
          set default [dict get ${:instance_attributes} $att]
        }
        set v [$f value_if_nothing_is_returned_from_form $default]
        #ns_log notice "===== value_if_nothing_is_returned_from_form [$f name] '$default' => '$v' (type=[$f info class])"

        set value [$f value $v]
        if {[string first . $att] == -1} {
          dict set :instance_attributes $att $value
        }
      }
    }
  }
}

#
# In the third iteration, combine the values from the components
# of a container to the value of the container.
#
foreach f $container_fields {
  set name [$f name]
  #:log "container $name: compute value for [$f info class]"
  if {![$f is_disabled]} {
    dict set :instance_attributes $name [$f value]
    #:log "container $name: is set to '[dict get ${:instance_attributes} $name]'"
  } elseif {[dict exists ${:instance_attributes} $name]} {
    $f value [dict get ${:instance_attributes} $name]
  }
}

#
# Finally run the validator on the top-level fields
#
foreach f [concat $form_fields] {
  #
  # Run validator on every field
  #
  #:log "validate [$f name] ([$f info class]) with value '[$f value]'"
  set validation_error [$f validate [self]]
  if {$validation_error ne ""} {
    #:log "validation of $f [$f name] with value '[$f value]' returns '$validation_error'"
    $f error_msg $validation_error
    incr validation_errors
  }
}

#:msg "validation returns $validation_errors errors"
set current_revision_id [$cc form_parameter __current_revision_id ""]
if {$validation_errors == 0
    && $current_revision_id ne ""
    && $current_revision_id != ${:revision_id}
  } {
  set validation_errors [:mutual_overwrite_occurred]
  ad_log warning "mutual_overwrite occurred, current_revision_id <$current_revision_id> my ${:revision_id}"
}

if {[:validate=form_input_fields $form_fields] == 0} {
  incr validation_errors
  #:log "validation error due validate=form_input_fields"
}

if {$validation_errors == 0} {
  #
  # Postprocess based on form fields based on form-fields methods.
  #
  foreach f $form_fields {
    if {![$f is_disabled]} {
      $f convert_to_internal
    }
  }
} else {
  :log validation_errors=$validation_errors
  #
  # There were validation errors. Reset the value of form-fields
  # which have to be reset on validation errors due to browser
  # semantics.
  #
  foreach f $form_fields {
    $f reset_on_validation_error
  }
}

#:log "=== get_form_data has validation_errors $validation_errors, instance_attributes: ${:instance_attributes}"

return [list $validation_errors [lsort -unique $category_ids]]

XQL Not present:

Generic, PostgreSQL, Oracle

[ hide source ] | [ make this the default ]