+proc maybe_upload_entry {im def} {
+ global reqkind privacy_setting env dbname quiet aadepth
+
+ debug "DB-UPDATE PRIVACY $privacy_setting"
+ if {!$privacy_setting} return
+
+ debug "DB-UPDATE UPLOADING"
+
+ set pl {}
+ lappend pl dict $dbname
+ lappend pl version 3
+ lappend pl depth $aadepth
+
+ if {$privacy_setting>=2} {
+ set pirate [string totitle $env(YPPSC_PIRATE)]
+ set ocean [string totitle $env(YPPSC_OCEAN)]
+ debug "DB-UPDATE NON-ANON $ocean $pirate"
+ lappend pl \
+ pirate $pirate \
+ ocean $ocean
+ }
+ lappend pl entry [format_database_entry/$reqkind $im $def]
+
+ set url $env(YPPSC_PCTB_DICT_SUBMIT)
+ append url dictionary-update-receiver
+
+ set query [eval ::http::formatQuery $pl]
+ regsub -all {%0d} $query {} query
+ debug "DB-UPDATE QUERY $query"
+
+ if {[regexp {^\.?/} $url]} {
+ set cmd [list $url $query]
+ debug "SUBMIT CMD [string range $cmd 0 200]..."
+ set body [eval exec $cmd 2>@ stderr]
+ regsub {^Content-Type: text/plain.*\n\n} $body {} body
+ } else {
+
+ if {[catch {
+ set req [::http::geturl $url -query $query]
+ } emsg]} {
+ puts stderr \
+ "\nWARNING: Cannot do dictionary upload: $emsg\n"
+ return
+ }
+ upvar #0 $req s
+ debug "DB-UPDATE DONE $req $s(status) [array names s]"
+ set ncode [::http::ncode $req]
+
+ if {!(![string compare ok $s(status)] &&
+ ![string compare 200 $ncode])} {
+ set m "\nWARNING: Dictionary upload failed:"
+ foreach v {status http error posterror} {
+ if {[info exists s($v)]} { append m "\n $v: $s($v)" }
+ }
+ puts stderr $m
+ return
+ }
+ set body $s(body)
+ ::http::cleanup $req
+ }
+
+ if {![string match {OK *} $body]} {
+ set m "\nWARNING: Dictionary upload went wrong:\n"
+ append m "\n " [join [split $body "\n"] "\n "]
+ puts stderr $m
+ return
+ }
+
+ if {!$quiet} {
+ puts stderr \
+ "Uploaded $dbname `$def': $body"
+ }
+}
+