Index: openacs-4/packages/oacs-dav/tcl/oacs-dav-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/oacs-dav/tcl/oacs-dav-procs.tcl,v diff -u -r1.16.2.1 -r1.16.2.2 --- openacs-4/packages/oacs-dav/tcl/oacs-dav-procs.tcl 26 Aug 2013 07:57:13 -0000 1.16.2.1 +++ openacs-4/packages/oacs-dav/tcl/oacs-dav-procs.tcl 11 Oct 2013 18:19:56 -0000 1.16.2.2 @@ -72,19 +72,19 @@ -password $password \ -authority_id $authority_id \ -no_cookie] - if {![string equal $auth(auth_status) "ok"]} { + if {$auth(auth_status) ne "ok" } { array set auth [auth::authenticate \ -email $user \ -password $password \ -authority_id $authority_id \ -no_cookie] } - if {[string equal $auth(auth_status) "ok"]} { + if {$auth(auth_status) eq "ok"} { # we can stop checking break } } - if {![string equal $auth(auth_status) "ok"]} { + if {$auth(auth_status) ne "ok" } { ns_log debug "\nTDAV 5.0 auth status $auth(auth_status)" ns_returnunauthorized return 0 @@ -121,8 +121,8 @@ ns_log debug "\nOACS-DAV oacs_dav::authorize user_id $user_id method $method item_id $item_id" set authorized_p 0 # if item doesn't exist don't bother checking.... - if {[empty_string_p $item_id]} { - if {![string equal "put" $method] && ![string equal "mkcol" $method] && ![string equal "lock" $method]} { + if {$item_id eq ""} { + if {"put" ne $method && "mkcol" ne $method && "lock" ne $method } { ns_log debug "\noacs_dav::authorize file not found" ns_return 404 text/plain "File Not Found" return filter_return @@ -143,7 +143,7 @@ -privilege "delete"] } lock { - if {![empty_string_p $item_id]} { + if {$item_id ne ""} { set authorized_p [permission::permission_p \ -object_id $item_id \ -party_id $user_id \ @@ -180,7 +180,7 @@ -privilege "write"]] } propfind { - if {[empty_string_p $user_id]} { + if {$user_id eq ""} { ns_returnunauthorized } else { set authorized_p [permission::permission_p \ @@ -198,7 +198,7 @@ -privilege "read"] } } - if {![string equal $authorized_p 1]} { + if {$authorized_p ne "1" } { ns_returnunauthorized return filter_return } @@ -212,7 +212,7 @@ } { global tdav_conn set flag [lindex $args 0] - if { [string index $flag 0] != "-" } { + if { [string index $flag 0] ne "-" } { set var $flag set flag "-get" } else { @@ -281,12 +281,12 @@ set root_folder_id [oacs_dav::request_folder_id $node_id] set urlv [split [string trimright [string range $uri [string length $sn(url)] end] "/"] "/"] if {[llength $urlv] >1} { - set parent_name [join [lrange $urlv 0 [expr [llength $urlv] -2 ] ] "/" ] + set parent_name [join [lrange $urlv 0 [llength $urlv]-2] "/" ] } else { set parent_name "/" } ns_log debug "\nparent_folder_id urlv $urlv parent_name $parent_name uri $uri" - if {[string equal [string trimright $parent_name "/"] [string trimright $sn(url) "/"]]} { + if {[string trimright $parent_name "/"] eq [string trimright $sn(url) "/"]} { # content_item__get_id can't resolve "/" # because it strips the leading and trailing / # from the url you pass in, and cr_items.name of the folder @@ -314,7 +314,7 @@ ns_log debug "\nconn_setp uri \"$uri\" " set dav_url_regexp "^[oacs_dav::uri_prefix]" regsub $dav_url_regexp $uri {} uri - if {[empty_string_p $uri]} { + if {$uri eq ""} { set uri "/" } oacs_dav::conn -set uri $uri @@ -336,7 +336,7 @@ oacs_dav::conn -set oacs_destination $dest - if {![empty_string_p $dest]} { + if {$dest ne ""} { oacs_dav::conn -set dest_parent_id [oacs_dav::item_parent_folder_id $dest] } @@ -345,13 +345,13 @@ # have time to resolve the issues that raises right now # a full-featured, consistently used tcl api for CR will fix that if {[llength $urlv] > 2} { - set parent_url [join [lrange $urlv 0 [expr [llength $urlv] -2 ] ] "/" ] + set parent_url [join [lrange $urlv 0 [llength $urlv]-2] "/" ] } else { set parent_url "/" } ns_log debug "\noacs_dav::conn_setup: handle request parent_url $parent_url length urlv [llength $urlv] urlv $urlv" set item_name [lindex $urlv end] - if {[empty_string_p $item_name]} { + if {$item_name eq ""} { # for propget etc we need the name of the folder # the last element in urlv for a folder is an empty string set item_name [lindex [split [string trimleft $parent_url "/"] "/"] end] @@ -362,7 +362,7 @@ set item_id [oacs_dav::conn -set item_id [db_exec_plsql get_item_id ""]] ns_log debug "\noacs_dav::conn_setup: uri $uri parent_url $parent_url folder_id $folder_id" - if {[string equal [string trimright $uri "/"] [string trimright $sn(url) "/"]]} { + if {[string trimright $uri "/"] eq [string trimright $sn(url) "/"]} { set item_id [oacs_dav::conn -set item_id $folder_id] } @@ -385,8 +385,8 @@ ns_log notice "\n ----- \n oacs_dav::children_have_permission_p \n child_count = $child_count \n ----- \n" incr child_count [db_string revision_perms ""] ns_log notice "\n ----- \n oacs_dav::children_have_permission_p \n child_count = $child_count \n ----- \n" - ns_log notice "\n ----- \n oacs_dav::children_have_permission_p \n return [expr $child_count == 0] \n ----- \n" - return [expr $child_count == 0] + ns_log notice "\n ----- \n oacs_dav::children_have_permission_p \n return [expr {$child_count == 0}] \n ----- \n" + return [expr {$child_count == 0}] } ad_proc -public oacs_dav::handle_request { uri method args } { @@ -403,7 +403,7 @@ set package_key [apm_package_key_from_id $package_id] ns_log debug "\noacs_dav::handle_request item_id is $item_id" - if {[empty_string_p $item_id]} { + if {$item_id eq ""} { ns_log debug "\noacs_dav::handle_request item_id is empty" # set this to null if nothing exists, only valid on PUT or MKCOL # to create a new item, otherwise we bail @@ -537,10 +537,10 @@ set item_id [oacs_dav::conn item_id] set fname [oacs_dav::conn item_name] set parent_id [oacs_dav::item_parent_folder_id $uri] - if {[empty_string_p $parent_id]} { + if {$parent_id eq ""} { return [list 409] } - if { ![empty_string_p $item_id]} { + if { $item_id ne ""} { return [list 405] } @@ -578,12 +578,12 @@ # when depth is 0 copy just the folder # when depth is 1 copy contents ns_log debug "\nDAV Folder Copy dest $target_uri parent_id $new_parent_folder_id" - if {[empty_string_p $new_parent_folder_id]} { + if {$new_parent_folder_id eq ""} { return [list 409] } set dest_item_id [db_string get_dest_id "" -default ""] - if {![empty_string_p $dest_item_id]} { + if {$dest_item_id ne ""} { ns_log debug "\n ----- \n DAV Folder Copy Folder Exists item_id $dest_item_id overwrite $overwrite \n ----- \n" if {![string equal -nocase $overwrite "T"]} { return [list 412] @@ -599,7 +599,7 @@ if {!$children_permission_p} { return [list 409] } - if {![string equal "unlocked" [tdav::check_lock $target_uri]]} { + if {"unlocked" ne [tdav::check_lock $target_uri] } { return [list 423] } db_exec_plsql delete_for_copy "" @@ -644,19 +644,19 @@ set new_name [lindex $turlv end] set overwrite [oacs_dav::conn overwrite] - if {![string equal "unlocked" [tdav::check_lock $uri]]} { + if {"unlocked" ne [tdav::check_lock $uri] } { return [list 423] } - if {[empty_string_p $new_parent_folder_id]} { + if {$new_parent_folder_id eq ""} { set response [list 412] return $response } set dest_item_id [db_string get_dest_id "" -default ""] ns_log debug "\n@DAV@@ folder move new_name $new_name dest_id $dest_item_id new_folder_id $new_parent_folder_id \n" - if {![empty_string_p $dest_item_id]} { + if {$dest_item_id ne ""} { if {![string equal -nocase $overwrite "T"]} { return [list 412] @@ -668,7 +668,7 @@ } # according to the spec move with overwrite means # delete then move - if {![string equal "unlocked" [tdav::check_lock $target_uri]]} { + if {"unlocked" ne [tdav::check_lock $target_uri] } { return [list 423] } # TODO check if we have permission over everything inside @@ -685,20 +685,20 @@ # don't let anyone move root DAV folders in the # dav_site_node_folder_map - if {![string equal [db_string site_node_folder ""] 0]} { + if {[db_string site_node_folder ""] ne "0" } { return [list 403] } set err_p 0 db_transaction { - if {![string equal $cur_parent_folder_id $new_parent_folder_id]} { + if {$cur_parent_folder_id ne $new_parent_folder_id } { ns_log debug "\n@@DAV@@ move folder $move_folder_id" db_exec_plsql move_folder "" # change label if name is different - if {![string equal $new_name $item_name]} { + if {$new_name ne $item_name } { db_dml update_label "" } - } elseif {![empty_string_p $new_name]} { + } elseif {$new_name ne ""} { ns_log debug "\n@@DAV@@ move folder rename $move_folder_id to $new_name" db_exec_plsql rename_folder "" } @@ -726,7 +726,7 @@ set item_id [oacs_dav::conn item_id] set uri [oacs_dav::conn uri] - if {![string equal "unlocked" [tdav::check_lock $uri]]} { + if {"unlocked" ne [tdav::check_lock $uri] } { return [list 423] } set children_permission_p [oacs_dav::children_have_permission_p -item_id $item_id -user_id $user_id -privilege "delete"] @@ -764,7 +764,7 @@ # with a trailing slash, sometimes (but not always) it will # get confused and show the collection as a member of itself regsub {/$} $folder_uri {} folder_uri - if {[empty_string_p $depth]} { + if {$depth eq ""} { set depth 0 } @@ -831,7 +831,7 @@ } { set uri [oacs_dav::conn uri] - if {![string equal "unlocked" [tdav::check_lock $uri]]} { + if {"unlocked" ne [tdav::check_lock $uri] } { return [list 423] } @@ -847,14 +847,14 @@ set scope [oacs_dav::conn lock_scope] set type [oacs_dav::conn lock_type] - if {![string equal "unlocked" [tdav::check_lock $uri]]} { + if {"unlocked" ne [tdav::check_lock $uri] } { set ret_code 423 set response [list $ret_code] } else { set depth [tdav::conn depth] set timeout [tdav::conn lock_timeout] - if {[empty_string_p $timeout]} { + if {$timeout eq ""} { set timeout [parameter::get_from_package_key -parameter "DefaultLockTimeout" -package_key "oacs-dav" -default "300"] } set token [tdav::set_lock $uri $depth $type $scope $owner $timeout] @@ -869,7 +869,7 @@ } { set uri [oacs_dav::conn uri] - if {![string equal unlocked [tdav::check_lock_for_unlock $uri]]} { + if {"unlocked" ne [tdav::check_lock_for_unlock $uri] } { set ret_code 423 set body "Resource is locked." } else { @@ -923,7 +923,7 @@ set root_folder_id [oacs_dav::conn folder_id] set uri [oacs_dav::conn uri] - if {![string equal "unlocked" [tdav::check_lock $uri]]} { + if {"unlocked" ne [tdav::check_lock $uri] } { return [list 423] } @@ -938,15 +938,15 @@ set name [oacs_dav::conn item_name] set parent_id [oacs_dav::item_parent_folder_id $uri] - if {[empty_string_p $parent_id]} { + if {$parent_id eq ""} { set response [list 409] return $response } # create new item if necessary db_transaction { set mime_type [cr_filename_to_mime_type $name] - if {[empty_string_p $item_id]} { + if {$item_id eq ""} { # this won't really work very nicely if we support # abstract url type names... maybe chop off the extension # when we name the object? @@ -1036,7 +1036,7 @@ # get the properties out of the list set uri [oacs_dav::conn uri] - if {![string equal "unlocked" [tdav::check_lock $uri]]} { + if {"unlocked" ne [tdav::check_lock $uri] } { return [list 423] } @@ -1055,7 +1055,7 @@ set peer_addr [oacs_dav::conn peeraddr] set item_id [oacs_dav::conn item_id] set uri [oacs_dav::conn uri] - if {![string equal "unlocked" [tdav::check_lock $uri]]} { + if {"unlocked" ne [tdav::check_lock $uri] } { return [list 423] } if {[catch {db_exec_plsql delete_item ""} errmsg]} { @@ -1083,12 +1083,12 @@ set turlv [split $target_uri "/"] set new_name [lindex $turlv end] set new_parent_folder_id [oacs_dav::conn dest_parent_id] - if {[empty_string_p $new_parent_folder_id]} { + if {$new_parent_folder_id eq ""} { return [list 409] } set dest_item_id [db_string get_dest_id "" -default ""] ns_log debug "\nDAV Revision Copy dest $target_uri parent_id $new_parent_folder_id" - if {![empty_string_p $dest_item_id]} { + if {$dest_item_id ne ""} { ns_log debug "\n ----- \n DAV Revision Copy Folder Exists item_id $dest_item_id overwrite $overwrite \n ----- \n" if {![string equal -nocase $overwrite "T"]} { return [list 412] @@ -1101,7 +1101,7 @@ # according to the spec copy with overwrite means # delete then copy ns_log debug "\noacs_dav::revision::copy checking for lock on target" - if {![string equal "unlocked" [tdav::check_lock $target_uri]]} { + if {"unlocked" ne [tdav::check_lock $target_uri] } { return [list 423] } @@ -1145,16 +1145,16 @@ set turlv [split $target_uri "/"] set new_name [lindex $turlv end] set overwrite [oacs_dav::conn overwrite] - if {[empty_string_p $new_parent_folder_id]} { + if {$new_parent_folder_id eq ""} { return [list 409] } - if {![string equal "unlocked" [tdav::check_lock $uri]]} { + if {"unlocked" ne [tdav::check_lock $uri] } { return [list 423] } ns_log debug "\nDAV Revision move dest $target_uri parent_id $new_parent_folder_id" set dest_item_id [db_string get_dest_id "" -default ""] - if {![empty_string_p $dest_item_id]} { + if {$dest_item_id ne ""} { ns_log debug "\n ----- \n DAV Revision move Folder Exists item_id $dest_item_id overwrite $overwrite \n ----- \n" if {![string equal -nocase $overwrite "T"]} { return [list 412] @@ -1164,7 +1164,7 @@ -privilege "write"]} { return [list 401] } - if {![string equal "unlocked" [tdav::check_lock $target_uri]]} { + if {"unlocked" ne [tdav::check_lock $target_uri] } { return [list 423] } @@ -1177,13 +1177,13 @@ set err_p 0 db_transaction { - if {![string equal $cur_parent_folder_id $new_parent_folder_id]} { + if {$cur_parent_folder_id ne $new_parent_folder_id } { db_exec_plsql move_item "" - } elseif {![empty_string_p $new_name] } { + } elseif {$new_name ne "" } { db_exec_plsql rename_item "" } - if {![string equal $item_name $new_name]} { + if {$item_name ne $new_name } { db_dml update_title "" } } on_error { @@ -1219,14 +1219,14 @@ set scope [oacs_dav::conn lock_scope] set type [oacs_dav::conn lock_type] - if {![string equal "unlocked" [tdav::check_lock $uri]]} { + if {"unlocked" ne [tdav::check_lock $uri] } { set ret_code 423 set response [list $ret_code] } else { set depth [tdav::conn depth] set timeout [tdav::conn lock_timeout] - if {[empty_string_p $timeout]} { + if {$timeout eq ""} { set timeout 300 } set token [tdav::set_lock $uri $depth $type $scope $owner $timeout] @@ -1241,7 +1241,7 @@ } { set uri [oacs_dav::conn uri] - if {![string equal unlocked [tdav::check_lock_for_unlock $uri]]} { + if {"unlocked" ne [tdav::check_lock_for_unlock $uri] } { set ret_code 423 set body "Resource is locked." } else { Index: openacs-4/packages/oacs-dav/tcl/tDAV-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/oacs-dav/tcl/tDAV-procs.tcl,v diff -u -r1.12 -r1.12.2.1 --- openacs-4/packages/oacs-dav/tcl/tDAV-procs.tcl 12 Apr 2013 16:12:57 -0000 1.12 +++ openacs-4/packages/oacs-dav/tcl/tDAV-procs.tcl 11 Oct 2013 18:19:56 -0000 1.12.2.1 @@ -114,7 +114,7 @@ proc tdav::read_xml {} { set fp "" - while {$fp == ""} { + while {$fp eq ""} { set tmpfile [ns_tmpnam] set fp [ns_openexcl $tmpfile] } @@ -172,7 +172,7 @@ # log this for failed config section set name [ns_config "ns/server/[ns_info server]/tdav" propdir] - if {[string equal "" $name]} { + if {$name eq ""} { set name [file join $::acs::pageroot "../propdir/${uri}"] } else { set name [file join $name $uri] @@ -204,7 +204,7 @@ # log this for failed config section set name [ns_config "ns/server/[ns_info server]/tdav" lockdir] - if {[string equal "" $name]} { + if {$name eq ""} { set name [file join $::acs::pageroot "../lockdir/${uri}"] } else { set name [file join $name $uri] @@ -344,7 +344,7 @@ proc tdav::lock_timeout_left { timeout locktime } { set locktime [clock scan $locktime] set lockexpiretime [clock scan "$timeout seconds" -base $locktime] - set timeout_left [expr $lockexpiretime - [clock seconds]] + set timeout_left [expr {$lockexpiretime - [clock seconds]}] if {$timeout_left < 0} { set timeout_left 0 } @@ -391,7 +391,7 @@ regexp {(]+)>\s+)?\(<([^>]+)>\)} $hdr nil maybe hdr_uri token set ftk [lindex $lockinfo 3] - if {![info exists token] || ![string equal $token $ftk]} { + if {![info exists token] || $token ne $ftk } { ns_log Debug "tdav::check_lock: token mismatch $ftk expected hdr: $hdr token: $token" ns_return 423 {text/plain} {} return filter_return @@ -427,7 +427,7 @@ if {[info exists hdr] && [string length $hdr]} { regexp {<([^>]+)>} $hdr nil token set ftk [lindex [tdav::read_lock $uri] 3] - if {[info exists token] && [string equal $token $ftk]} { + if {[info exists token] && $token eq $ftk} { # it's good, the tokens match. carry on. } else { return filter_return @@ -540,7 +540,7 @@ # we use localname because we always resolve the URI namespace # for the tag name set ns [$p namespaceURI] - if {[string equal "" $ns]} { + if {$ns eq ""} { set name [$p nodeName] } else { set name [$p localName] @@ -556,7 +556,7 @@ # we use localname because we always resolve the URI namespace # for the tag name set ns [$p namespaceURI] - if {[string equal "" $ns]} { + if {$ns eq ""} { set name [$p nodeName] } else { set name [$p localName] @@ -597,7 +597,7 @@ if {![file exists $filename]} { set ret_code 404 } else { - if {![string equal unlocked [tdav::check_lock $uri]]} { + if {"unlocked" ne [tdav::check_lock $uri] } { set ret_code 423 set response "The resource is locked" } else { @@ -751,22 +751,22 @@ regsub {^/} [ns_conn url] {} uri set entry [file join $::acs::pageroot $uri] # parse the xml body to check if its valid - if {![string equal "" $xml] && [catch {dom parse $xml} xd]} { + if {"" ne $xml && [catch {dom parse $xml} xd]} { ns_return 400 text/plain "XML request not well-formed." return filter_return } set xml_prop_list [list] - if {[info exists xd] && ![string equal "" $xd]} { + if {[info exists xd] && "" ne $xd } { set prop [$xd getElementsByTagNameNS "DAV:" "prop"] # if element doesn't exist we return all properties - if {![string equal "" $prop]} { + if {$prop ne ""} { set xml_prop_list [$prop childNodes] } foreach node $xml_prop_list { set ns [$node namespaceURI] - if {[string equal $ns ""]} { + if {$ns eq ""} { set name [$node nodeName] } else { set name [$node localName] @@ -823,7 +823,7 @@ set ret_code 500 set body "" if {[file exists $entry]} { - if {![string equal "unlocked" [tdav::check_lock $uri]]} { + if {"unlocked" ne [tdav::check_lock $uri] } { set ret_code 423 set body "Resource is locked." } else { @@ -879,7 +879,7 @@ if {[file exists $entry]} { # 423's and returns: - if {[string equal unlocked [tdav::check_lock $uri]]} { + if {"unlocked" eq [tdav::check_lock $uri]} { file delete -force -- $entry tdav::delete_props $uri tdav::remove_lock $uri @@ -912,7 +912,7 @@ # registered procedure. proc tdav::filter_webdav_mkcol {args} { - if [ns_conn contentlength] { + if {[ns_conn contentlength]} { set ret_code 415 set html_response "" tdav::respond [list 415] @@ -941,9 +941,9 @@ set filename [lindex [file split $entry] end] regsub {/[^/]*/*$} $entry {} parent_dir - if ![file exists $parent_dir] { + if {![file exists $parent_dir]} { set ret_code 409 - } elseif ![file exists $entry] { + } elseif {![file exists $entry]} { file mkdir $entry file mkdir [file join $::acs::pageroot "../props/" $uri] set ret_code 201 @@ -989,12 +989,12 @@ set ret_code 404 } else { if {[file exists $local_dest]} { - if {![string equal "unlocked" [tdav::check_lock $dest]]} { + if {"unlocked" ne [tdav::check_lock $dest] } { # ns_return 423 {text/plain} {Resource is locked.} set ret_code 423 set body "Resource is locked." } else { - if [string equal -nocase $overwrite "F"] { + if {[string equal -nocase $overwrite "F"]} { set ret_code 412 } else { set ret_code 204 @@ -1046,12 +1046,12 @@ if {![file exists $entry]} { set ret_code 404 } else { - if {![string equal "unlocked" [tdav::check_lock $uri]]} { + if {"unlocked" ne [tdav::check_lock $uri] } { # ns_return 423 {text/plain} {Resource is locked.} set ret_code 423 set body "Resource is locked." - } elseif [file exists $local_dest] { - if [string equal -nocase $overwrite "F"] { + } elseif {[file exists $local_dest]} { + if {[string equal -nocase $overwrite "F"]} { set ret_code 412 } else { set ret_code 204 @@ -1090,7 +1090,7 @@ set timeout [ns_set iget [ns_conn headers] Timeout] regsub {^Second-} $timeout {} timeout tdav::conn -set lock_timeout $timeout - if {![string length $depth]} { + if {$depth eq ""} { set depth 0 } tdav::conn -set depth $depth @@ -1104,10 +1104,10 @@ } proc tdav::set_lock {uri depth type scope owner {timeout ""} {locktime ""} } { - if {[string equal "" $timeout]} { + if {$timeout eq ""} { set timeout [ns_config "ns/server/[ns_info server]/tdav" "defaultlocktimeout" "300"] } - if {[string equal "" $locktime]} { + if {$locktime eq ""} { set locktime [clock format [clock seconds] -format "%T %D"] } set token "opaquelocktoken:[ns_rand 2147483647]" @@ -1129,17 +1129,17 @@ # if {![file exists $entry]} { # set ret_code 404 # } else - if {![string equal "unlocked" [tdav::check_lock $uri]]} { + if {"unlocked" ne [tdav::check_lock $uri] } { set ret_code 423 tdav::respond [list $ret_code] } else { set depth [tdav::conn depth] set timeout [tdav::conn lock_timeout] - if {[string equal "" $timeout]} { + if {$timeout eq ""} { #probably make this a paramter? set timeout 180 } - if {![string equal "" $existing_lock_token] && [file exists [tdav::get_lock_file $uri]} { + if {"" ne $existing_lock_token && [file exists [tdav::get_lock_file $uri]} { set old_lock [tdav::read_lock $uri] set new_lock [list [lindex $old_lock 0] [lindex $old_lock 1] [lindex $old_lock 2] [lindex $old_lock 3] $timeout [clock format [clock seconds]]] @@ -1171,7 +1171,7 @@ if {![file exists $entry]} { set ret_code 404 set body {} - } elseif {![string equal unlocked [tdav::check_lock_for_unlock $uri]]} { + } elseif {"unlocked" ne [tdav::check_lock_for_unlock $uri] } { set ret_code 423 set body "Resource is locked." } else { @@ -1204,14 +1204,14 @@ proc tdav::respond { response } { set response_code [lindex $response 0] - if {[string equal "423" $response_code]} { + if {"423" eq $response_code} { set response_body "The resource is locked" set mime_type "text/plain" } else { set response_list [tdav::respond::[string tolower [ns_conn method]] $response] set response_body [lindex $response_list 0] set mime_type [lindex $response_list 1] - if {[string equal "" $mime_type]} { + if {$mime_type eq ""} { set mime_type "text/plain" } if {[string match "text/xml*" $mime_type]} { @@ -1281,8 +1281,8 @@ foreach res [lindex $response 1] { set status [lindex $res 0] - set ns [lindex [lindex $res 1] 0] - set name [lindex [lindex $res 1] 1] + set ns [lindex $res 1 0] + set name [lindex $res 1 1] append body [subst { <$name xmlns='$ns'/> $status @@ -1361,10 +1361,10 @@ # interestingly enough, adding the namespace here to the prop is fine set name [lindex $i 1] set ns [lindex $i 0] - if {![string equal "D" $ns] && ![string equal "ns0" $ns]} { + if {"D" ne $ns && "ns0" ne $ns } { # for user properties set the namespace explicitly in # the tag - if {![string equal "" $ns]} { + if {$ns ne ""} { set pnode [$d createElementNS $ns $name] } else { set pnode [$d createElement $name] @@ -1373,19 +1373,19 @@ set pnode [$d createElement ${ns}:${name}] } - if {[string equal "creationdate" $name]} { + if {"creationdate" eq $name} { $pnode setAttribute "b:dt" "dateTime.tz" } - if {[string equal "getlastmodified" $name]} { + if {"getlastmodified" eq $name} { $pnode setAttribute "b:dt" "dateTime.rfc1123" } - if {[string equal "D:collection" $j]} { + if {"D:collection" eq $j} { $pnode appendChild [$d createElement $j] @@ -1477,7 +1477,7 @@ proc tdav::conn {args} { global tdav_conn set flag [lindex $args 0] - if { [string index $flag 0] != "-" } { + if { [string index $flag 0] ne "-" } { set var $flag set flag "-get" } else { @@ -1508,7 +1508,7 @@ set required_options [list OPTIONS PROPFIND PROPPATCH MKCOL GET HEAD POST] foreach required_option $required_options { - if {[lsearch -exact [string toupper $options] $required_option] < 0} { + if {$required_option ni [string toupper $options]} { ns_log error "Required option $required_option missing from tDAV options for URI '$uri'. Required web dav options are: '$required_options'." return @@ -1530,7 +1530,7 @@ # url matching for registered filters set filter_uri "[string trimright $uri /*]*" foreach option $options { - if {[lsearch -exact [list GET POST HEAD] $option] < 0} { + if {$option ni [list GET POST HEAD]} { ns_log debug "tDAV registering filter for $filter_uri on $option" ns_register_filter postauth [string toupper $option] "${filter_uri}" tdav::filter_webdav_[string tolower $option] } @@ -1540,10 +1540,10 @@ # Register procedures for selected tDAV options. Do not register a # proc for OPTIONS, GET, POST or HEAD. - if {[string equal "true" $enable_filesystem]} { + if {"true" eq $enable_filesystem} { foreach option $options { - if {[lsearch -exact [list OPTIONS GET POST HEAD] $option] < 0} { + if {$option ni [list OPTIONS GET POST HEAD]} { ns_log debug "tDAV registering proc for $uri on $option" ns_register_proc [string toupper $option] "${uri}" tdav::webdav_[string tolower $option] } @@ -1639,7 +1639,7 @@ # ns_perm addgroup tdav tdav tdav1 set tdav_shares [ns_configsection "ns/server/[ns_info server]/tdav/shares"] - if { ![string equal "" $tdav_shares] } { + if { "" ne $tdav_shares } { for {set i 0} {$i < [ns_set size $tdav_shares]} {incr i} { set tdav_share [ns_configsection "ns/server/[ns_info server]/tdav/share/[ns_set key $tdav_shares $i]"] tdav::apply_filters [ns_set get $tdav_share uri] [ns_set get $tdav_share options] [ns_set get $tdav_share enablefilesystem] Index: openacs-4/packages/oacs-dav/tcl/test/oacs-dav-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/oacs-dav/tcl/test/oacs-dav-procs.tcl,v diff -u -r1.2 -r1.2.12.1 --- openacs-4/packages/oacs-dav/tcl/test/oacs-dav-procs.tcl 1 Mar 2005 19:42:44 -0000 1.2 +++ openacs-4/packages/oacs-dav/tcl/test/oacs-dav-procs.tcl 11 Oct 2013 18:19:56 -0000 1.2.12.1 @@ -21,7 +21,7 @@ set sc_ops [db_list get_dav_ops ""] set valid_ops [list get put mkcol copy propfind proppatch move delete] foreach op_name $valid_ops { - aa_true "$op_name operation created" [expr [lsearch $sc_ops $op_name] > -1] + aa_true "$op_name operation created" [expr {[lsearch $sc_ops $op_name] > -1}] } aa_true "DAV put_type Service contract created" [expr [db_0or1row get_dav_pt_sc ""]] @@ -61,9 +61,9 @@ aa_log "Response was $response" set new_item_id [db_string item_exists "" -default ""] aa_log "Item_id=$new_item_id" - aa_true "Content Item Created" [expr ![empty_string_p $new_item_id]] + aa_true "Content Item Created" [expr {$new_item_id ne ""}] set revision_id [db_string revision_exists "" -default ""] - aa_true "Content Revision Created" [expr ![empty_string_p $revision_id]] + aa_true "Content Revision Created" [expr {$revision_id ne ""}] set cr_filename "[cr_fs_path]/[db_string get_content_filename ""]" aa_true "Content Attribute Set" [string equal [file size [oacs_dav::conn tmpfile]] [file size $cr_filename]] @@ -98,7 +98,7 @@ aa_log "name $fname uri $uri" set response [oacs_dav::impl::content_folder::mkcol] set new_folder_id [db_string folder_exists "" -default ""] - aa_true "Content Folder $fname created" [expr ![empty_string_p $new_folder_id]] + aa_true "Content Folder $fname created" [expr {$new_folder_id ne ""}] } }