Index: openacs-4/packages/xowiki/tcl/xowiki-form-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-form-procs.tcl,v
diff -u -r1.147 -r1.148
--- openacs-4/packages/xowiki/tcl/xowiki-form-procs.tcl 27 Jun 2018 12:07:09 -0000 1.147
+++ openacs-4/packages/xowiki/tcl/xowiki-form-procs.tcl 3 Sep 2024 15:37:55 -0000 1.148
@@ -24,41 +24,43 @@
{f.description "="}
{f.nls_language "="}
{validate {
- {name {\[::xowiki::validate_name\]} {Another item with this name exists \
- already in this folder}}
+ {name {\[::xowiki::validate_name\]}
+ {Another item with this name exists already in this folder} }
+ {name {[string length \$name] < 4000}
+ {The name is too long. Please enter a value of at most 4000 characters long} }
{page_order {\[::xowiki::validate_form_field page_order\]} {Page Order invalid; \
- might only contain upper and lower case letters, underscore, digits and dots}}
+ might only contain upper and lowercase letters, underscore, digits and dots}}
}}
{with_categories true}
{submit_link "view"}
{folderspec ""}
{autoname 0}
} -ad_doc {
- Form Class for XoWiki Pages.
-
- You can manipulate the form elements shown by editing the field_list.
+ Form Class for XoWiki Pages.
+
+ You can manipulate the form elements shown by editing the field_list.
The following elements are mandatory in field_list
and should never be left out:
name
item_id
-
+
}
WikiForm instproc mkFields {} {
set __fields ""
set field_list [:field_list]
set show_page_order [[${:data} package_id] show_page_order]
- if {!$show_page_order} { :f.page_order "= hidden" }
+ if {!$show_page_order} { :f.page_order "= hidden" }
if {${:autoname}} { :f.name "= hidden,optional"}
set form_fields [list]
foreach __field $field_list {
# if there is no field spec, use the default from the slot definitions
set __spec [expr {[info exists :f.$__field] ? [set :f.$__field] : "="}]
set __wspec [lindex $__spec 0]
- #my msg "$__field: wspec=$__wspec, spec=$__spec"
+ #:msg "$__field: wspec=$__wspec, spec=$__spec"
# check first if we have widget_specs.
# TODO: this part is likely to be removed in the future.
@@ -89,7 +91,7 @@
set __spec $__newspec
}
} elseif {[lindex $__wspec 0] eq "="} {
- #
+ #
# Get the information from the attribute definitions and given
# specs.
#
@@ -119,7 +121,7 @@
}
if {[string first "richtext" $__wspec] > -1} {
- # ad_form does a subst, therefore escape esp. the JavaScript stuff
+ # ad_form does a subst, therefore, escape esp. the JavaScript stuff
set __spec [string map {\[ \\[ \] \\] \$ \\$ \\ \\\\} $__spec]
}
@@ -133,7 +135,7 @@
set :fields $__fields
}
- proc ::xowiki::locales {} {
+ ad_proc -private ::xowiki::locales {} {
set locales [lang::system::get_locales]
if {[ns_conn isconnected]} {
#
@@ -148,7 +150,7 @@
return $lpairs
}
- proc ::xowiki::page_templates {} {
+ ad_proc -private ::xowiki::page_templates {} {
set form ::xowiki::f1 ;# form has to be named this way for the time being
#set form [lindex [::xowiki::WikiForm info instances -closure] 0]
$form instvar folder_id
@@ -187,14 +189,14 @@
proc ::xowiki::guesstype {fn} {
set mime [ns_guesstype $fn]
- if {$mime eq "*/*"
- || $mime eq "application/octet-stream"
+ if {$mime eq "*/*"
+ || $mime eq "application/octet-stream"
|| $mime eq "application/force-download"} {
#
# ns_guesstype was failing, which should not be the case with
# recent versions of NaviServer
#
- switch [file extension $fn] {
+ switch [ad_file extension $fn] {
.xotcl {set mime text/plain}
.mp3 {set mime audio/mpeg}
.cdf {set mime application/x-netcdf}
@@ -213,12 +215,12 @@
upvar duration duration
set form ::xowiki::f1 ;# form has to be named this way for the time being
#set form [lindex [::xowiki::WikiForm info instances -closure] 0]
- $form instvar data
+ $form instvar data
$data instvar package_id
if {[$data istype ::xowiki::PodcastItem] && $duration eq "" && [$data exists import_file]} {
set filename [expr {[$data exists full_file_name] ? [$data full_file_name] : [$data set import_file]}]
- set ffmpeg [$package_id get_parameter "ffmpeg" "/usr/bin/ffmpeg"]
- if {[file exists $ffmpeg]} {
+ set ffmpeg [::$package_id get_parameter -check_query_parameter false "ffmpeg" "/usr/bin/ffmpeg"]
+ if {[ad_file exists $ffmpeg]} {
catch {exec $ffmpeg -i $filename} output
if {[info exists output]} {
regexp {Duration: +([0-9:.]+)[ ,]} $output _ duration
@@ -230,70 +232,125 @@
proc ::xowiki::validate_name {{data ""}} {
+ #
+ # This proc is not only a validator of the "name" attribute, but
+ # modifies "name" according to the value of the language settings,
+ # in case it is applied on non-file pages. In cases of data of the
+ # autonamed forms (i.e. for pages of type ::xowiki::PageInstance),
+ # it avoids name clashes as well.
+ #
upvar name name
if {$data eq ""} {
unset data
set form ::xowiki::f1 ;# form has to be named this way for the time being
# $form log "--F validate_name data=[$form exists data]"
$form instvar data
}
+ #$data log "validate_name: '$name'"
+
$data instvar package_id
- set cc [$package_id context]
+ set cc [::$package_id context]
- set old_name [$cc form_parameter __object_name ""]
+ set old_name [$cc form_parameter __object_name:signed,convert ""]
#$data msg "validate: old='$old_name', current='$name'"
- if {[$data istype ::xowiki::File] && [$data exists mime_type]} {
- #$data log "--mime validate_name MIME [$data set mime_type]"
+ if {[$data istype ::xowiki::File]
+ && [$data exists upload_file]
+ && [$data exists mime_type]} {
+ #$data log "validate_name: MIME [$data set mime_type]"
set name [$data build_name $name [$data set upload_file]]
- #
+ #
# Check, if the user is allowed to create a file with the specified
# name. Files ending in .css or .js might require special permissions.
# Caveat: the error message is always the same.
#
set package_id [$cc package_id]
- set computed_link [export_vars -base [$package_id package_url] {{edit-new 1} name
+ set computed_link [export_vars -base [::$package_id package_url] {{edit-new 1} name
{object_type ::xowiki::File}}]
- set granted [$package_id check_permissions -link $computed_link $package_id edit-new]
- #$data msg computed_link=$computed_link,granted=$granted
+ set granted [::$package_id check_permissions -link $computed_link $package_id edit-new]
+ #$data log "validate_name: computed_link=$computed_link,granted=$granted"
if {!$granted} {
util_user_message -message "User not authorized to create a file named $name"
return 0
}
} else {
+ if {![$data istype ::xowiki::File] && [regexp {^[a-zA-Z][a-zA-Z]:$} $name]} {
+ #
+ # The name looks like a language prefix followed by an empty
+ # name. Empty names are not allowed.
+ #
+ return 0
+ }
$data name $name
- set name [$data build_name -nls_language [$data form_parameter nls_language {}]]
+ #
+ # Try first to get the language from the form parameter
+ # "nls_language". If this fails, get it from "nls_language". If
+ # this fails as well, fall back to "en_US". Actually, one should
+ # consider parameterizing/refactoring validate_name which
+ # predates form-fields and follows ad_form conventions and uses
+ # upvar, etc.
+ #
+ set nls_language [$data form_parameter \
+ nls_language:token \
+ [$data form_parameter _nls_language:token]]
+ if {$nls_language eq ""} {
+ set nls_language en_US
+ } elseif {$nls_language ni [lang::system::get_locales]} {
+ #
+ # The locale does not belong to the enabled locales. This can
+ # be still wanted by the application, but we should provide a
+ # hint in the log file about this unusual situation.
+ #
+ if {$nls_language ni [lang::system::get_locales -all]} {
+ set message "'$nls_language' not defined in the system, call back to 'en_US'"
+ set severity warning
+ set nls_language en_US
+ } else {
+ set severity notice
+ set message "'$nls_language' not enabled in the system"
+ }
+ ns_log $severity "suspect content of form variable nls_language: $message"
+ }
+ set name [$data build_name -nls_language $nls_language]
}
if {$name ne ""} {
set prefixed_page_p [expr {![$data is_folder_page] && ![$data is_link_page]}]
set name [::$package_id normalize_name -with_prefix $prefixed_page_p $name]
}
- #$data msg "validate: old='$old_name', new='$name'"
+ #$data log "validate_name: old='$old_name', new='$name'"
if {$name eq $old_name && $name ne ""} {
# do not change names, which are already validated;
# otherwise, autonamed entries might get an unwanted en:prefix
return 1
}
# check, if we try to create a new item with an existing name
- #$data msg "validate: new=[$data form_parameter __new_p 0], eq=[expr {$old_name ne $name}]"
- if {[$data form_parameter __new_p 0]
+ #$data log "validate_name: new=[$data form_parameter __new_p 0], eq=[expr {$old_name ne $name}]"
+ if {[$data form_parameter __new_p:boolean 0]
|| $old_name ne $name
} {
if {[::xo::db::CrClass lookup -name $name -parent_id [$data parent_id]] == 0} {
# the provided name is really new
return 1
}
+ #$data log "validate_name: entry '$name' exists here already"
if {[$data istype ::xowiki::PageInstance]} {
+ #
# The entry might be autonamed. In case of imports from other
# xowiki instances, we might have name clashes. Therefore, we
# compute a fresh name here.
+ #
set anon_instances [$data get_from_template anon_instances f]
if {$anon_instances} {
set basename [::xowiki::autoname basename [[$data page_template] name]]
- $data name [::xowiki::autoname new -name $basename -parent_id [$data parent_id]]
- return 1
+ $data log "validate_name: have anon_instances basename '$basename' name '$name'"
+ if {[string match $basename* $name]} {
+ set name [::xowiki::autoname new -name $basename -parent_id [$data parent_id]]
+ $data name $name
+ $data log "validate_name: changed data name to '$name'"
+ return 1
+ }
}
}
return 0
@@ -309,17 +366,19 @@
# form_fields
#
upvar $field_name $field_name
- $form instvar data
+ set data [$form set data]
#
# Get the form-field and set its value....
#
set f [$data lookup_form_field -name $field_name [$form set form_fields]]
$f value [set $field_name]
+
set validation_error [$f validate $data]
#
# If we get an error, we report it as well via util-user message
- #
- #$form msg "***** field_name = $field_name, cls=[$f info class] validation_error=$validation_error"
+ #
+ #$form log "***** field_name = $field_name, validation_error=$validation_error"
+
if {$validation_error ne ""} {
util_user_message -message "Error in field [$f label]: $validation_error"
return 0
@@ -349,18 +408,20 @@
}
}
}
-
+
+ WikiForm instproc on_submit args {
+ #:log "--form on_submit $args <[${:data} info vars]> "
+ :var page_order [${:data} set page_order]
+ next
+ }
+
WikiForm instproc data_from_form {{-new 0}} {
- if {[${:data} exists_form_parameter text.format]} {
+ if {[${:data} exists_form_parameter text.format:graph]} {
${:data} set mime_type [${:data} form_parameter text.format]
}
- if {$new && [[${:data} set package_id] get_parameter production_mode 0]} {
+ if {$new && [[${:data} set package_id] get_parameter production_mode:boolean 0]} {
${:data} set publish_status production
}
- upvar #[template::adp_level] page_order page_order
- if {[info exists page_order] && $page_order ne ""} {
- set page_order [string trim $page_order " ."]
- }
:tidy
}
@@ -369,7 +430,7 @@
### danger: update references does an ad_eval, which breaks the [template::adp_level]
### ad_form! don't do it in pageinstanceforms.
${:data} render_adp false
- ${:data} render -update_references true
+ ${:data} render -update_references all
}
# Delete the link cache entries for this entry.
# The logic could be made more intelligent to delete entries is more rare cases, like
@@ -393,33 +454,33 @@
}
}
- #:log "v=[ad_acs_version] 5.2] compare: [apm_version_names_compare [ad_acs_version] 5.2]"
if {[apm_version_names_compare [ad_acs_version] 5.3.0d4] == 1} {
application_data_link::update_links_from \
-object_id [${:data} set item_id] \
-text [${:data} set text]
}
}
-
-
+
+
WikiForm instproc new_request {} {
#
- # get the defaults from the slots and set it in the data.
+ # Get the defaults from the slots and set it in the data.
# This should not be necessary with xotocl 1.6.*
#
foreach f [:field_list] {
- set s [${:data} find_slot $f]
+ set s [${:data} find_slot $f]
if {$s ne "" && [$s exists default] && [$s default] ne ""} {
#:msg "new_request $f default = '[$s default]'"
${:data} set $f [$s default]
}
}
- #
+ #
# set the following defaults manually
#
${:data} set creator [::xo::get_user_name [::xo::cc user_id]]
if {[${:data} name] eq ""} {
- ${:data} set nls_language [::xo::cc locale]
+ set nls_language [[${:data} package_id] default_locale]
+ ${:data} set nls_language $nls_language
}
next
}
@@ -432,7 +493,7 @@
}
WikiForm instproc new_data {} {
- :data_from_form -new 1
+ :data_from_form -new 1
${:data} set __autoname_prefix [string range [${:data} set nls_language] 0 1]:
set item_id [next]
${:data} set creation_user [::xo::cc user_id]
@@ -441,16 +502,18 @@
}
WikiForm instproc edit_data {} {
+ #:log "--form edit_data "
:data_from_form -new 0
set item_id [next]
:update_references
return $item_id
}
WikiForm instproc after_submit {item_id} {
+ #:log "--form after submit"
set link [:submit_link]
if {$link eq "."} {
- # we can determine submit link only after nls_language
+ # we can determine submit link only after nls_language
# is returned from the user
:submit_link [${:data} pretty_link]
}
@@ -478,14 +541,14 @@
{f.name "= optional,help_text=#xowiki.File-name-help_text#"}
{f.title "= optional"}
{f.text
- {upload_file:file(file)
+ {upload_file:file(file),optional
{label #xowiki.content#}
{html {size 30}} }}
{validate {
{upload_file {\[::xowiki::validate_file\]} {For new entries, \
a upload file must be provided}}
- {page_order {\[::xowiki::validate_form_field page_order\]} {Page Order invalid;
- might only contain upper and lower case letters, underscore, digits and dots}}
+ {page_order {\[::xowiki::validate_form_field page_order\]} {Page Order invalid;
+ might only contain upper and lowercase letters, underscore, digits and dots}}
{name {\[::xowiki::validate_name\]} {Another item with this name exists \
already in this folder}}
}}
@@ -504,8 +567,8 @@
set mime_type [${:data} form_parameter upload_file.content-type]
if {[::xo::dc 0or1row check_mimetype {
select 1 from cr_mime_types where mime_type = :mime_type
- }] == 0
- || $mime_type eq "application/octet-stream"
+ }] == 0
+ || $mime_type eq "application/octet-stream"
|| $mime_type eq "application/force-download"} {
set guessed_mime_type [::xowiki::guesstype $upload_file]
#:msg guess=$guessed_mime_type
@@ -524,55 +587,45 @@
${:data} set import_file [${:data} full_file_name]
# :log "--F upload_file $upload_file import_file [${:data} full_file_name]"
#:log " import_type=[${:data} set import_file]"
- }
+ }
} else {
# :log "--F no name and no upload file"
${:data} set upload_file ""
}
}
FileForm instproc new_data {} {
- #my get_uploaded_file
+ #:get_uploaded_file
return [next]
}
FileForm instproc edit_data {} {
- #my get_uploaded_file
+ #:get_uploaded_file
return [next]
}
- # {f.pub_date
- # {pub_date:date,optional {format "YYYY MM DD HH24 MI"} {html {id date}}
- # {after_html { Y-M-D}
- # }}
- # }
-
Class create PodcastForm -superclass FileForm \
-parameter {
{html { enctype multipart/form-data }} \
- {field_list {item_id name page_order text title subtitle creator pub_date duration keywords
+ {field_list {item_id name page_order text title subtitle creator pub_date duration keywords
description}}
{validate {
{upload_file {\[::xowiki::validate_file\]} {For new entries, \
a upload file must be provided}}
{name {\[::xowiki::validate_name\]} {Another item with this name exists \
already in this folder}}
- {page_order {\[::xowiki::validate_form_field page_order\]} {Page Order invalid;
- might only contain upper and lower case letters, underscore, digits and dots}}
+ {page_order {\[::xowiki::validate_form_field page_order\]} {Page Order invalid;
+ might only contain upper and lowercase letters, underscore, digits and dots}}
{duration {\[::xowiki::validate_duration\]} {Check duration and provide default}}
}}
}
- # {help_text {E.g. 9:16 means 9 minutes 16 seconds (if ffmpeg is installed and configured, it will get the value automatically)}}
-
PodcastForm instproc to_timestamp {widgetinfo} {
if {$widgetinfo ne ""} {
lassign $widgetinfo y m day hour min
set t [clock scan "${hour}:$min $m/$day/$y"]
#
# be sure to avoid bad side effects from LANG environment variable
#
- set ::env(LANG) en_US.UTF-8
+ set ::env(LANG) en_US.UTF-8
return [clock format $t]
#return [clock format $t -format "%y-%m-%d %T"]
}
@@ -636,7 +689,7 @@
}
ObjectForm instproc edit_request {item_id} {
- #my f.name {{name:text {label #xowiki.Page-name#}}}
+ #:f.name {{name:text {label #xowiki.Page-name#}}}
permission::require_permission \
-party_id [ad_conn user_id] -object_id [${:data} set parent_id] \
-privilege "admin"
@@ -654,7 +707,7 @@
Class create PageTemplateForm -superclass WikiForm \
-parameter {
{field_list {
- item_id name page_order title creator text anon_instances
+ item_id name page_order title creator text anon_instances
description nls_language
}}
}
@@ -678,11 +731,11 @@
}
PageInstanceForm instproc set_submit_link_edit {} {
set object_type [[${:data} info class] object_type]
- #:log "-- data=${:data} cl=[${:data} info class] ot=$object_type"
+ #:log "-- data=${:data} cl=[${:data} info class] object_type=$object_type"
set item_id [${:data} set item_id]
set page_template [${:data} form_parameter page_template]
if {[${:data} exists_query_parameter return_url]} {
- set return_url [${:data} query_parameter return_url]
+ set return_url [${:data} query_parameter return_url:localurl]
}
:submit_link [${:data} pretty_link -query [export_vars {
{m edit} page_template return_url item_id
@@ -717,7 +770,7 @@
PageInstanceEditForm instproc new_data {} {
set __vars {folder_id item_id page_template return_url}
set object_type [[${:data} info class] object_type]
- #:log "-- cl=[${:data} info class] ot=$object_type $__vars"
+ #:log "-- class=[${:data} info class] object_type=$object_type $__vars"
foreach __v $__vars {set $__v [${:data} from_parameter $__v] ""}
set item_id [next]
@@ -753,7 +806,7 @@
}
PageInstanceEditForm instproc init {} {
- set item_id [${:data} form_parameter item_id]
+ set item_id [${:data} form_parameter item_id:int32]
#
# make sure to have page template object loaded
#
@@ -780,7 +833,7 @@
set :field_list [concat [:field_list_top] ${:page_instance_form_atts} [:field_list_bottom]]
#
- # get widget specs from folder.
+ # get widget specs from folder.
# All other specs are taken form attributes or form constraints.
# The widget_spec functionality might be deprecated in the future.
#
@@ -800,53 +853,55 @@
upvar text text
if {$text eq ""} { return 1 }
if {[llength $text] != 2} { return 0 }
- regsub -all "" $text "" text ;# get rid of strange utf-8 characters hex C2AD (firefox bug?)
+ #regsub -all -- "" $text "" text ;# get rid of strange utf-8 characters hex C2AD (Firefox bug?)
lassign $text content mime
if {$content eq ""} {return 1}
#ns_log notice "VALUE='$content'"
set clean_content $content
- regsub -all " " $clean_content "" clean_content
- regsub -all "?p */?>" $clean_content "" clean_content
+ regsub -all -- " " $clean_content "" clean_content
+ regsub -all -- "?p */?>" $clean_content "" clean_content
#ns_log notice "--validate_form_content '$content' clean='$clean_content', \
# stripped='[string trim $clean_content]'"
- if {[string trim $clean_content] eq ""} { set text [list "" $mime]}
+ if {[string is space $clean_content]} {
+ set text [list "" $mime]
+ }
#:log "final text='$text'"
return 1
}
proc ::xowiki::validate_form_form {} {
upvar form form
if {$form eq ""} {return 1}
- dom parse -simple -html [lindex $form 0] doc
+ dom parse -simple -- [lindex $form 0] doc
$doc documentElement root
return [expr {$root ne "" && [$root nodeName] eq "form"}]
}
Class create FormForm -superclass ::xowiki::PageTemplateForm \
-parameter {
- {field_list {item_id name page_order title creator text form form_constraints
+ {field_list {item_id name page_order title creator text form form_constraints
anon_instances description nls_language}}
- {f.text "= richtext,height=150px,editor=xinha,label=#xowiki.Form-template#"}
- {f.form "= richtext,height=150px,editor=xinha"}
+ {f.text "= richtext,height=150px,label=#xowiki.Form-template#"}
+ {f.form "= richtext,editor=none,height=150px"}
{f.form_constraints "="}
{validate {
{name {\[::xowiki::validate_name\]} {Another item with this name exists \
already in this folder}}
{text {\[::xowiki::validate_form_text\]} {Form must contain a valid template}}
- {page_order {\[::xowiki::validate_form_field page_order\]} {Page Order invalid;
- might only contain upper and lower case letters, underscore, digits and dots}}
- {form {\[::xowiki::validate_form_form\]} {Form must contain a toplevel HTML form element}}
+ {page_order {\[::xowiki::validate_form_field page_order\]} {Page Order invalid;
+ might only contain upper and lowercase letters, underscore, digits and dots}}
+ {form {\[::xowiki::validate_form_form\]} {Form must contain a top-level HTML form element}}
{form_constraints {\[::xowiki::validate_form_field form_constraints\]} {Invalid form constraints}}
}}
}
-
+
FormForm instproc new_data {} {
set item_id [next]
-
+
# provide unique ids and names, if form is provided
# set form [${:data} set form]
# if {$form ne ""} {
- # dom parse -simple -html [lindex $form 0] doc
+ # dom parse -simple -- [lindex $form 0] doc
# $doc documentElement root
# set id ID$item_id
# $root setAttribute id $id
@@ -866,7 +921,7 @@
}
-::xo::library source_dependent
+::xo::library source_dependent
#
# Local variables: