#!/bin/sh
# -*- tcl -*- \
exec tclsh8.3 $0 ${1+"$@"}
package require Tcl 8.3
if {![catch { package require nstcl-html }] &&
![catch { package require nstcl-http }]} {
namespace import nstcl::*
} else {
package require http
proc ns_geturl {url} {
set conn [http::geturl $url]
set html [http::data $conn]
http::cleanup $conn
return $html
}
proc ns_urlencode {string} {
set allowed_chars {[a-zA-Z0-9]}
set encoded_string ""
foreach char [split $string ""] {
if {[string match $allowed_chars $char]} {
append encoded_string $char
} else {
scan $char %c ascii
append encoded_string %[format %02x $ascii]
}
}
return $encoded_string
}
proc util_httppost {url formvars} {
set conn [http::geturl $url -query $formvars]
set html [http::data $conn]
http::cleanup $conn
return $html
}
}
proc environment {default args} {
foreach arg $args {
if {[info exists ::env($arg)] && [string length $::env($arg)]} {
return $::env($arg)
}
}
return $default
}
proc editor {} {
if {$::tcl_platform(platform) == "unix"} {
set default vi
} else {
set default notepad
}
return [environment $default EDITOR Editor editor]
}
proc temp_directory {} {
return [environment [pwd] TEMP Temp temp TMP Tmp tmp TEMPDIR Tempdir]
}
proc abort {reason} {
puts stderr $reason
exit 1
}
proc editfile {file} {
global tcl_platform
if {$tcl_platform(platform) == "unix"} {
package require Expect
log_user 0
spawn [editor] $file
interact
} else {
exec [editor] $file
}
}
proc main {page} {
set wiki http://wiki.tcl.tk
set url $wiki/[ns_urlencode $page]
# Fetch the wiki page
if {[catch { ns_geturl $url } html]} {
abort "Error retrieveing $url: $html"
}
# find the edit URL
if {![regexp {Edit <a href="((\d+)@)">} $html => edit page_num]} {
abort "$url is not an editable page"
}
# Retrieve the edit page <form>
if {[catch { ns_geturl http://wiki.tcl.tk/$edit } html]} {
abort "Error fetching http://wiki.tcl.tk/$edit: $html"
}
set vars [list]
# Figure out where the form is supposed to POST results to
if {![regexp -nocase -- {form\s+[^<]*action="([^"]+)"} $html => action]} {
abort "Couldn't figure out where to POST the edit to"
}
# normalize the action URL if it's not an absolute link
switch -regexp -- $action {
{(?i)^http} {}
{^/*} { set action http://wiki.tcl.tk$action }
default { set action http://wiki.tcl.tk/$action }
}
# Snag the existing content so we can edit it
if {![regexp {(?i)(<textarea[^>]+>)([^<]*)<} $html => textarea content]} {
abort "Couldn't find any editable content"
}
# Figure out what formvar we're supposed to pass the contents back as
if {![regexp {(?i)name=['"]?([^'"\s]+)['"]} $textarea => textvar]} {
abort "Couldn't figure out the name of the <textarea>"
}
# find and propagate all (hidden) form variables/defaults
foreach input [regexp -inline -all -- {(?i)<input\s+[^>]+>} $html] {
if {[regexp -nocase -- {name=['"]?([^'"\s]+)} $input => name]} {
if {![regexp {(?i)value=['"]([^'"]+)['"]} $input => value]} {
set value ""
}
lappend vars [ns_urlencode $name]=[ns_urlencode $value]
}
}
# unescape HTML entities
set content [string map [list "&" & \
"<" < \
">" > \
""" \"] $content]
# compute the name of the temporary file to use
set tmpfile [file join [temp_directory] wiki-$page_num.tmp]
# file shouldn't exist ...
if {[file exists $tmpfile]} {
abort "Another edit already in progress? $tmpfile already exists"
}
# save existing wiki content to the temporary file
if {[catch {
set fp [open $tmpfile w]
puts -nonewline $fp $content
close $fp
} problem]} {
catch { file delete -force $tmpfile }
abort "Error writing $tmpfile ($problem)"
}
# edit the file
if {[catch { editfile $tmpfile } problem]} {
catch { file delete -force $tmpfile }
abort "Error occured trying to start the editor: $problem"
}
# read
if {[catch {
set fp [open $tmpfile]
set new_content [read $fp]
close $fp
file delete -force $tmpfile
} problem]} {
catch { file delete -force $tmpfile }
abort "Error reading edited content: $problem"
}
# were there ANY changes at all?
if {[string equal $content $new_content]} {
# don't barf if stdout is closed
catch { puts "No changes were made" }
exit 0
}
lappend vars $textvar=[ns_urlencode $new_content]
# POST the edited version
if {[catch { util_httppost $action [join $vars &] } html]} {
abort "Error uploading changes: $html"
}
switch -regexp -- $html {
{Page saved\.\.\.} { set result "Wiki updated" }
{Edit conflict} { set result "Wiki NOT updated due to edit conflict" }
default {
set result "Warning!: Not sure if the Wiki was updated or not..."
}
}
# don't barf if stdout is closed
catch { puts $result }
}
if {[llength $argv] != 1} {
abort "usage: wiki-edit page"
} else {
main [lindex $argv 0]
}MHo Using a variable instead of a fixed URL would enable this app to be used with our own wikis. Can't get uploading to work yet... Could it be because of sending action=save & action=cancel with the data??? So I applied the following hack and it works:
# find and propagate all (hidden) form variables/defaults
foreach input [regexp -inline -all -- {(?i)<input\s+[^>]+>} $html] {
if {[regexp -nocase -- {name=['"]?([^'"\s]+)} $input => name]} {
if {![regexp {(?i)value=['"]([^'"]+)['"]} $input => value]} {
set value ""
}
### hier mehrmals action='...', daher folgender HACK:
if {"$name" == "Action" && "$value" == "Cancel"} {
} else {
lappend vars [ns_urlencode $name]=[ns_urlencode $value]
}
}
}Also, the test if a page upload succeeded don't work (anymore...)?!