Index: openacs-4/packages/acs-automated-testing/acs-automated-testing.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/acs-automated-testing.info,v
diff -u -r1.29 -r1.30
--- openacs-4/packages/acs-automated-testing/acs-automated-testing.info 11 Jul 2009 23:47:23 -0000 1.29
+++ openacs-4/packages/acs-automated-testing/acs-automated-testing.info 17 Sep 2009 15:57:01 -0000 1.30
@@ -32,6 +32,9 @@
"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="XMLReportDir" description="The full path to the directory where the xml report of system tests are stored. This is also the directory where the install and test xml reports of other servers should be stored if this server is to function as a master test server.
"/>
+ <parameter datatype="string" min_n_values="1" max_n_values="1" name="SeleniumRcBrowsers" default="*firefox" description="Browsers to test with. Default *firefox"/>
+ <parameter datatype="string" min_n_values="1" max_n_values="1" name="SeleniumRcServer" description="Hostname of the Selenium RC Server. If this is blank the Selenium RC tests will not be run."/>
+ <parameter datatype="number" min_n_values="1" max_n_values="1" name="SeleniumRcPort" default="4444" description="Port the Selenium RC server is listening on. Default 4444."/>
</parameters>
</version>
Index: openacs-4/packages/acs-automated-testing/tcl/aa-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/tcl/aa-test-procs.tcl,v
diff -u -r1.37 -r1.38
--- openacs-4/packages/acs-automated-testing/tcl/aa-test-procs.tcl 10 Jan 2007 21:22:01 -0000 1.37
+++ openacs-4/packages/acs-automated-testing/tcl/aa-test-procs.tcl 17 Sep 2009 15:57:01 -0000 1.38
@@ -27,6 +27,11 @@
nsv_set aa_test init_classes {}
nsv_set aa_test categories { config db api web smoke stress security_risk populator production_safe }
nsv_set aa_test exclusion_categories { stress security_risk }
+ if {[parameter::get_from_package_key -package_key "acs-automated-testing" -parameter "SeleniumRcServer"] ne ""} {
+ nsv_lappend aa_test categories "selenium"
+ } else {
+ nsv_lappend aa_test exclusion_categories "selenium"
+ }
}
ad_proc -public aa_stub {
@@ -130,14 +135,21 @@
the descructor to unmount the package.
@author Peter Harper
@creation-date 04 November 2001
+
+ @param init_class_id Unique string to identify the init class
+ @param init_class_desc Longer description of the init class
+ @param constructor Tcl code block to run to setup the init class
+ @param destructor Tcl code block to tear down the init class
} {
#
# Work out the package key
#
set package_root [file join [acs_root_dir] packages]
set package_rel [string replace [info script] \
0 [string length $package_root]]
- set package_key [lindex [file split $package_rel] 0]
+ if {![info exists package_key]} {
+ set package_key [lindex [file split $package_rel] 0]
+ }
#
# First, search the current list of init_classes. If an old version already
# exists, replace it with the new version.
@@ -375,6 +387,9 @@
#
set filtered_inits {}
foreach init_class $init_classes {
+ if {[llength $init_class] == 2} {
+ set init_class [lindex $init_class 0]
+ }
if {[string trim $init_class] ne ""} {
set found 0
foreach init_class_info [nsv_get aa_test init_classes] {
@@ -441,10 +456,16 @@
global aa_init_class_logs
upvar 2 _aa_exports _aa_exports
foreach init_class \[list $init_classes\] {
- foreach v \$_aa_exports(\[list $package_key \$init_class\]) {
+ if {[llength $init_class] == 2} {
+ set init_package_key [lindex $init_class 1]
+ set init_class [lindex $init_class 0]
+ } else {
+ set init_package_key $package_key
+ }
+ foreach v \$_aa_exports(\[list \$init_package_key \$init_class\]) {
upvar 2 \$v \$v
}
- foreach logpair \$aa_init_class_logs(\[list $package_key \$init_class\]) {
+ foreach logpair \$aa_init_class_logs(\[list \$init_package_key \$init_class\]) {
aa_log_result \[lindex \$logpair 0\] \[lindex \$logpair 1\]
}
}
@@ -1226,3 +1247,50 @@
aa_log_result "fail" $explanation
}
}
+
+ad_proc -public aa_selenium_init {} {
+ Setup a global Selenium RC server connection
+
+ @return true is everything is ok, false if there was any error
+} {
+ # check if the global selenium connection already exists
+ global _acs_automated_testing_selenium_init
+ if {[info exists _acs_automated_testing_selenium_init]} {
+ # if we already initialized Selenium RC this will be true if
+ # we already failed to initialize Selenium RC this will be
+ # false. We don't want to try to initialize Selenium RC more
+ # than once per request thread in any case so just return the
+ # previous status. This is a global and is reset on every
+ # request.
+ return $_acs_automated_testing_selenium_init
+ }
+
+ set server_url [parameter::get_from_package_key \
+ -package_key acs-automated-testing \
+ -parameter "SeleniumRcServer" \
+ -default ""]
+ if {$server_url eq ""} {
+ # no server configured so don't try to initialize
+ return 0
+ }
+ set server_port [parameter::get_from_package_key \
+ -package_key acs-automated-testing \
+ -parameter "SeleniumRcPort" \
+ -default "4444"]
+ set browsers [parameter::get_from_package_key \
+ -package_key acs-automated-testing \
+ -parameter "SeleniumRcBrowsers" \
+ -default "*firefox"]
+ set success_p [expr {![catch {Se init $server_url $server_port ${browsers} [ad_url]} errmsg]}]
+ if {!$success_p} {
+ ns_log error [ad_log_stack_trace]
+ }
+ set _acs_automated_testing_selenium_init $success_p
+ return $success_p
+}
+
+aa_register_init_class \
+ "selenium" \
+ "Init Class for Selenium Remote Control" \
+ {aa_selenium_init} \
+ {catch {Se stop} errmsg}
Index: openacs-4/packages/acs-automated-testing/tcl/http.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/tcl/Attic/http.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-automated-testing/tcl/http.tcl 17 Sep 2009 15:57:01 -0000 1.1
@@ -0,0 +1,1200 @@
+# OpenACS is using this for Selenium Remote Control
+# NOTE: This is sourced by selenium Remote Control adapter so it is
+# not named http-procs.tcl! daveb dave@solutiongrove.com 2009-09-17
+
+# http.tcl --
+#
+# Client-side HTTP for GET, POST, and HEAD commands.
+# These routines can be used in untrusted code that uses
+# the Safesock security policy. These procedures use a
+# callback interface to avoid using vwait, which is not
+# defined in the safe base.
+#
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: http.tcl,v 1.1 2009/09/17 15:57:01 daveb Exp $
+
+# Rough version history:
+# 1.0 Old http_get interface
+# 2.0 http:: namespace and http::geturl
+# 2.1 Added callbacks to handle arriving data, and timeouts
+# 2.2 Added ability to fetch into a channel
+# 2.3 Added SSL support, and ability to post from a channel
+# This version also cleans up error cases and eliminates the
+# "ioerror" status in favor of raising an error
+# 2.4 Added -binary option to http::geturl and charset element
+# to the state array.
+# 2.5 Added HTTP/1.1 support for persistent connections. New options
+# -protocol, -keepalive, -socketvar. (Pat Thoyts)
+# 2.6 Added support for HTTP/1.1 extensions. New option -method used
+# for WebDav. (Vince Darley)
+# 2.6.1 Synchronized with Tcl http 2.4.4 (encoding enhancements)
+# 2.6.2 Removed to -socketvar option and now handle socket usage internally
+# 2.6.3 Added support for chunked encoding.
+
+package require Tcl 8.2
+# keep this in sync with pkgIndex.tcl
+package provide http 2.6.3
+
+if {0 && [info command _proc] == {}} {
+ rename proc _proc
+ _proc proc {name arglist body} {
+ _proc $name $arglist [concat "proc_begin;" $body ";proc_end"]
+ }
+ _proc proc_begin {} {
+ puts "[string repeat > [info level]][lindex [info level -1] 0]"
+ }
+ _proc proc_end {} {
+ puts "[string repeat < [info level]][lindex [info level -1] 0]"
+ }
+}
+
+namespace eval http {
+ variable http
+ if {![info exists http]} {
+ array set http {
+ -accept */*
+ -proxyhost {}
+ -proxyport {}
+ -proxyfilter http::ProxyRequired
+ }
+
+ # Use a Mozilla compatible useragent header to avoid problems with
+ # some web sites.
+ set http(-useragent) \
+ "Mozilla/5.0 ([string totitle $::tcl_platform(platform)];\
+ $::tcl_platform(os)) http/[package provide http]\
+ Tcl/[package provide Tcl]"
+ }
+
+ proc init {} {
+ variable formMap
+ variable alphanumeric a-zA-Z0-9
+ for {set i 0} {$i <= 256} {incr i} {
+ set c [format %c $i]
+ if {![string match \[$alphanumeric\] $c]} {
+ set formMap($c) %[format %.2x $i]
+ }
+ }
+ # These are handled specially
+ array set formMap { " " + \n %0d%0a }
+
+ # Create a map for HTTP/1.1 open sockets
+ variable socketmap
+ if {[info exists socketmap]} {
+ foreach {url sock} [array get socketmap] {
+ catch {close $sock}
+ }
+ array unset a
+ }
+ array set socketmap {}
+ }
+ init
+
+ variable urlTypes
+ array set urlTypes {
+ http {80 ::socket}
+ }
+
+ variable encodings [string tolower [encoding names]]
+ # This can be changed, but iso8859-1 is the RFC standard.
+ variable defaultCharset "iso8859-1"
+
+ namespace export geturl config reset wait formatQuery register unregister
+ # Useful, but not exported: data size status code
+}
+
+# http::register --
+#
+# See documentation for details.
+#
+# Arguments:
+# proto URL protocol prefix, e.g. https
+# port Default port for protocol
+# command Command to use to create socket
+# Results:
+# list of port and command that was registered.
+
+proc http::register {proto port command} {
+ variable urlTypes
+ set urlTypes($proto) [list $port $command]
+}
+
+# http::unregister --
+#
+# Unregisters URL protocol handler
+#
+# Arguments:
+# proto URL protocol prefix, e.g. https
+# Results:
+# list of port and command that was unregistered.
+
+proc http::unregister {proto} {
+ variable urlTypes
+ if {![info exists urlTypes($proto)]} {
+ return -code error "unsupported url type \"$proto\""
+ }
+ set old $urlTypes($proto)
+ unset urlTypes($proto)
+ return $old
+}
+
+# http::config --
+#
+# See documentation for details.
+#
+# Arguments:
+# args Options parsed by the procedure.
+# Results:
+# TODO
+
+proc http::config {args} {
+ variable http
+ set options [lsort [array names http -*]]
+ set usage [join $options ", "]
+ if {[llength $args] == 0} {
+ set result {}
+ foreach name $options {
+ lappend result $name $http($name)
+ }
+ return $result
+ }
+ set options [string map {- ""} $options]
+ set pat ^-([join $options |])$
+ if {[llength $args] == 1} {
+ set flag [lindex $args 0]
+ if {[regexp -- $pat $flag]} {
+ return $http($flag)
+ } else {
+ return -code error "Unknown option $flag, must be: $usage"
+ }
+ } else {
+ foreach {flag value} $args {
+ if {[regexp -- $pat $flag]} {
+ set http($flag) $value
+ } else {
+ return -code error "Unknown option $flag, must be: $usage"
+ }
+ }
+ }
+}
+
+# http::Finish --
+#
+# Clean up the socket and eval close time callbacks
+#
+# Arguments:
+# token Connection token.
+# errormsg (optional) If set, forces status to error.
+# skipCB (optional) If set, don't call the -command callback. This
+# is useful when geturl wants to throw an exception instead
+# of calling the callback. That way, the same error isn't
+# reported to two places.
+#
+# Side Effects:
+# Closes the socket
+
+proc http::Finish { token {errormsg ""} {skipCB 0}} {
+ variable $token
+ upvar 0 $token state
+ global errorInfo errorCode
+ if {[string length $errormsg] != 0} {
+ set state(error) [list $errormsg $errorInfo $errorCode]
+ set state(status) error
+ }
+ if {[info exists state(connection)] && $state(connection) == "close"} {
+ CloseSocket $state(sock) $token
+ }
+ catch {after cancel $state(after)}
+ if {[info exists state(-command)] && !$skipCB} {
+ if {[catch {eval $state(-command) {$token}} err]} {
+ if {[string length $errormsg] == 0} {
+ set state(error) [list $err $errorInfo $errorCode]
+ set state(status) error
+ }
+ }
+ if {[info exists state(-command)]} {
+ # Command callback may already have unset our state
+ unset state(-command)
+ }
+ }
+}
+
+proc ::http::CloseSocket {s {token {}}} {
+ #puts "CloseSocket $s"
+ catch {fileevent $s readable {}}
+ if {$token != {}} {
+ variable $token
+ upvar 0 $token state
+ if {[info exists state(socketinfo)]} {
+ if {[info exists socketmap($state(socketinfo))]} {
+ unset socketmap($state(socketinfo))
+ }
+ }
+ } else {
+ set map [array get socketmap]
+ set ndx [lsearch -exact $map $s]
+ if {$ndx != -1} {
+ incr ndx -1
+ unset socketmap([lindex $map $ndx])
+ }
+ }
+ catch {close $s}
+}
+
+# -------------------------------------------------------------------------
+
+proc ::http::OpenConnection {host port {socketcmd socket} {async ""}} {
+ variable socketmap
+ if {![info exists socketmap($host:$port)]} {
+ set sock [eval $socketcmd $async $host $port]
+ set id [string map {sock conn} $sock]
+ variable $id
+ upvar 0 $id conn
+ set conn(sock) $sock
+ set id [namespace which -variable $id]
+ set socketmap($host:$port) $id
+ } else {
+ set id $socketmap($host:$port)
+ }
+ return $id
+}
+
+proc ::http::CloseConnection {connection} {
+ variable $connection
+ upvar 0 $connection conn
+ catch {close $conn(sock)}
+ unset $connection
+ return
+}
+
+# -------------------------------------------------------------------------
+
+# http::reset --
+#
+# See documentation for details.
+#
+# Arguments:
+# token Connection token.
+# why Status info.
+#
+# Side Effects:
+# See Finish
+
+proc http::reset { token {why reset} } {
+ variable $token
+ upvar 0 $token state
+ set state(status) $why
+ catch {fileevent $state(sock) readable {}}
+ catch {fileevent $state(sock) writable {}}
+ Finish $token
+ if {[info exists state(error)]} {
+ set errorlist $state(error)
+ unset state
+ eval ::error $errorlist
+ }
+}
+
+# http::geturl --
+#
+# Establishes a connection to a remote url via http.
+#
+# Arguments:
+# url The http URL to goget.
+# args Option value pairs. Valid options include:
+# -blocksize, -validate, -headers, -timeout
+# Results:
+# Returns a token for this connection.
+# This token is the name of an array that the caller should
+# unset to garbage collect the state.
+
+proc http::geturl { url args } {
+ variable http
+ variable urlTypes
+ variable defaultCharset
+
+ # Initialize the state variable, an array. We'll return the
+ # name of this array as the token for the transaction.
+
+ if {![info exists http(uid)]} {
+ set http(uid) 0
+ }
+ set token [namespace current]::[incr http(uid)]
+ variable $token
+ upvar 0 $token state
+ reset $token
+
+ # Process command options.
+
+ array set state {
+ -binary false
+ -blocksize 8192
+ -queryblocksize 8192
+ -validate 0
+ -headers {}
+ -timeout 0
+ -type application/x-www-form-urlencoded
+ -queryprogress {}
+ -protocol 1.1
+ -keepalive 1
+ binary 0
+ state header
+ meta {}
+ coding {}
+ currentsize 0
+ totalsize 0
+ querylength 0
+ queryoffset 0
+ type text/html
+ body {}
+ status ""
+ http ""
+ connection close
+ }
+ set state(charset) $defaultCharset
+ set options {-binary -blocksize -channel -command -handler -headers \
+ -progress -query -queryblocksize -querychannel -queryprogress\
+ -validate -timeout -type -protocol -keepalive -method}
+ set usage [join $options ", "]
+ set options [string map {- ""} $options]
+ set pat ^-([join $options |])$
+ foreach {flag value} $args {
+ if {[regexp $pat $flag]} {
+ # Validate numbers
+ if {[info exists state($flag)] && \
+ [string is integer -strict $state($flag)] && \
+ ![string is integer -strict $value]} {
+ unset $token
+ return -code error "Bad value for $flag ($value), must be integer"
+ }
+ set state($flag) $value
+ } else {
+ unset $token
+ return -code error "Unknown option $flag, can be: $usage"
+ }
+ }
+
+ # Make sure -query and -querychannel aren't both specified
+
+ set isQueryChannel [info exists state(-querychannel)]
+ set isQuery [info exists state(-query)]
+ if {$isQuery && $isQueryChannel} {
+ unset $token
+ return -code error "Can't combine -query and -querychannel options!"
+ }
+
+ # Validate URL, determine the server host and port, and check proxy case
+ # Recognize user:pass@host URLs also, although we do not do anything
+ # with that info yet.
+
+ set exp {^(([^:]*)://)?([^@]+@)?([^/:]+)(:([0-9]+))?(/.*)?$}
+ if {![regexp -nocase $exp $url x prefix proto user host y port srvurl]} {
+ unset $token
+ return -code error "Unsupported URL: $url"
+ }
+ if {[string length $proto] == 0} {
+ set proto http
+ set url ${proto}://$url
+ }
+ if {![info exists urlTypes($proto)]} {
+ unset $token
+ return -code error "Unsupported URL type \"$proto\""
+ }
+ set defport [lindex $urlTypes($proto) 0]
+ set defcmd [lindex $urlTypes($proto) 1]
+
+ if {[string length $port] == 0} {
+ set port $defport
+ }
+ if {[string length $srvurl] == 0} {
+ set srvurl /
+ }
+ if {[string length $proto] == 0} {
+ set url http://$url
+ }
+ set state(url) $url
+ if {![catch {$http(-proxyfilter) $host} proxy]} {
+ set phost [lindex $proxy 0]
+ set pport [lindex $proxy 1]
+ }
+
+ # If a timeout is specified we set up the after event
+ # and arrange for an asynchronous socket connection.
+
+ if {$state(-timeout) > 0} {
+ set state(after) [after $state(-timeout) \
+ [list http::reset $token timeout]]
+ set async -async
+ } else {
+ set async ""
+ }
+
+ # If we are using the proxy, we must pass in the full URL that
+ # includes the server name.
+ if {[info exists phost] && [string length $phost]} {
+ set srvurl $url
+ set state(socketinfo) $phost:$pport
+ } else {
+ set state(socketinfo) $host:$port
+ }
+
+ # See if we are supposed to use a previously opened channel.
+ set s {}
+ if {$state(-keepalive)} {
+ variable socketmap
+ if {[info exists socketmap($state(socketinfo))]} {
+ #puts -nonewline "try to reuse $state(socketinfo): "
+ if {[catch {fconfigure $socketmap($state(socketinfo))}]} {
+ #puts "socket was closed"
+ unset socketmap($state(socketinfo))
+ } else {
+ #puts "reusing"
+ set s $socketmap($state(socketinfo))
+ catch {fileevent $s writable {}}
+ catch {fileevent $s readable {}}
+ }
+ }
+
+ set state(connection) {}
+ }
+ if {$s == {}} {
+
+ set conStat [catch {
+ eval $defcmd $async [split $state(socketinfo) :]
+ } s]
+ if {$conStat} {
+
+ # something went wrong while trying to establish the
+ # connection Clean up after events and such, but DON'T
+ # call the command callback (if available) because we're
+ # going to throw an exception from here instead.
+
+ Finish $token "" 1
+ cleanup $token
+ return -code error $s
+ }
+ }
+ set state(sock) $s
+ set socketmap($state(socketinfo)) $s
+
+ # Wait for the connection to complete
+
+ if {$state(-timeout) > 0} {
+ fileevent $s writable [list http::Connect $token]
+ http::wait $token
+
+ if {[string equal $state(status) "error"]} {
+ # something went wrong while trying to establish the connection
+ # Clean up after events and such, but DON'T call the command
+ # callback (if available) because we're going to throw an
+ # exception from here instead.
+ set err [lindex $state(error) 0]
+ cleanup $token
+ return -code error $err
+ } elseif {![string equal $state(status) "connect"]} {
+ # Likely to be connection timeout
+ return $token
+ }
+ set state(status) ""
+ }
+
+ # Send data in cr-lf format, but accept any line terminators
+
+ fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)
+
+ # The following is disallowed in safe interpreters, but the socket
+ # is already in non-blocking mode in that case.
+
+ catch {fconfigure $s -blocking off}
+ set how GET
+ if {$isQuery} {
+ set state(querylength) [string length $state(-query)]
+ if {$state(querylength) > 0} {
+ set how POST
+ set contDone 0
+ } else {
+ # there's no query data
+ unset state(-query)
+ set isQuery 0
+ }
+ } elseif {$state(-validate)} {
+ set how HEAD
+ } elseif {$isQueryChannel} {
+ set how POST
+ # The query channel must be blocking for the async Write to
+ # work properly.
+ fconfigure $state(-querychannel) -blocking 1 -translation binary
+ set contDone 0
+ }
+ if {[info exists state(-method)]} {
+ set how $state(-method)
+ }
+ if {[catch {
+ puts $s "$how $srvurl HTTP/$state(-protocol)"
+ puts $s "Accept: $http(-accept)"
+ if {$port == $defport} {
+ # Don't add port in this case, to handle broken servers.
+ # [Bug #504508]
+ puts $s "Host: $host"
+ } else {
+ puts $s "Host: $host:$port"
+ }
+ puts $s "User-Agent: $http(-useragent)"
+ if { $state(-protocol) == 1.0 && $state(-keepalive)} {
+ puts $s "Connection: keep-alive"
+ }
+ if { $state(-protocol) > 1.0 && ! $state(-keepalive) } {
+ puts $s "Connection: close" ;# RFC2616 sec 8.1.2.1
+ }
+ if {[info exists phost] && [string length $phost] \
+ && $state(-keepalive)} {
+ puts $s "Proxy-Connection: Keep-Alive"
+ }
+ foreach {key value} $state(-headers) {
+ set value [string map [list \n "" \r ""] $value]
+ set key [string trim $key]
+ if {[string equal $key "Content-Length"]} {
+ set contDone 1
+ set state(querylength) $value
+ }
+ if {[string length $key]} {
+ puts $s "$key: $value"
+ }
+ }
+ if {$isQueryChannel && $state(querylength) == 0} {
+ # Try to determine size of data in channel
+ # If we cannot seek, the surrounding catch will trap us
+
+ set start [tell $state(-querychannel)]
+ seek $state(-querychannel) 0 end
+ set state(querylength) \
+ [expr {[tell $state(-querychannel)] - $start}]
+ seek $state(-querychannel) $start
+ }
+
+ # Flush the request header and set up the fileevent that will
+ # either push the POST data or read the response.
+ #
+ # fileevent note:
+ #
+ # It is possible to have both the read and write fileevents active
+ # at this point. The only scenario it seems to affect is a server
+ # that closes the connection without reading the POST data.
+ # (e.g., early versions TclHttpd in various error cases).
+ # Depending on the platform, the client may or may not be able to
+ # get the response from the server because of the error it will
+ # get trying to write the post data. Having both fileevents active
+ # changes the timing and the behavior, but no two platforms
+ # (among Solaris, Linux, and NT) behave the same, and none
+ # behave all that well in any case. Servers should always read thier
+ # POST data if they expect the client to read their response.
+
+ if {$isQuery || $isQueryChannel} {
+ puts $s "Content-Type: $state(-type)"
+ if {!$contDone} {
+ puts $s "Content-Length: $state(querylength)"
+ }
+ puts $s ""
+ fconfigure $s -translation {auto binary}
+ fileevent $s writable [list http::Write $token]
+ } else {
+ puts $s ""
+ flush $s
+ fileevent $s readable [list http::Event $s $token]
+ }
+
+ if {! [info exists state(-command)]} {
+
+ # geturl does EVERYTHING asynchronously, so if the user
+ # calls it synchronously, we just do a wait here.
+
+ wait $token
+ if {[string equal $state(status) "error"]} {
+ # Something went wrong, so throw the exception, and the
+ # enclosing catch will do cleanup.
+ return -code error [lindex $state(error) 0]
+ }
+ }
+ } err]} {
+ # The socket probably was never connected,
+ # or the connection dropped later.
+
+ # Clean up after events and such, but DON'T call the command callback
+ # (if available) because we're going to throw an exception from here
+ # instead.
+
+ # if state(status) is error, it means someone's already called Finish
+ # to do the above-described clean up.
+ if {[string equal $state(status) "error"]} {
+ Finish $token $err 1
+ }
+ cleanup $token
+ return -code error $err
+ }
+
+ return $token
+}
+
+# Data access functions:
+# Data - the URL data
+# Status - the transaction status: ok, reset, eof, timeout
+# Code - the HTTP transaction code, e.g., 200
+# Size - the size of the URL data
+
+proc http::data {token} {
+ variable $token
+ upvar 0 $token state
+ return $state(body)
+}
+proc http::status {token} {
+ variable $token
+ upvar 0 $token state
+ return $state(status)
+}
+proc http::code {token} {
+ variable $token
+ upvar 0 $token state
+ return $state(http)
+}
+proc http::ncode {token} {
+ variable $token
+ upvar 0 $token state
+ if {[regexp {[0-9]{3}} $state(http) numeric_code]} {
+ return $numeric_code
+ } else {
+ return $state(http)
+ }
+}
+proc http::size {token} {
+ variable $token
+ upvar 0 $token state
+ return $state(currentsize)
+}
+
+proc http::error {token} {
+ variable $token
+ upvar 0 $token state
+ if {[info exists state(error)]} {
+ return $state(error)
+ }
+ return ""
+}
+
+# http::cleanup
+#
+# Garbage collect the state associated with a transaction
+#
+# Arguments
+# token The token returned from http::geturl
+#
+# Side Effects
+# unsets the state array
+
+proc http::cleanup {token} {
+ variable $token
+ upvar 0 $token state
+ if {[info exists state]} {
+ unset state
+ }
+}
+
+# http::Connect
+#
+# This callback is made when an asyncronous connection completes.
+#
+# Arguments
+# token The token returned from http::geturl
+#
+# Side Effects
+# Sets the status of the connection, which unblocks
+# the waiting geturl call
+
+proc http::Connect {token} {
+ variable $token
+ upvar 0 $token state
+ global errorInfo errorCode
+ if {[eof $state(sock)] ||
+ [string length [fconfigure $state(sock) -error]]} {
+ Finish $token "connect failed [fconfigure $state(sock) -error]" 1
+ } else {
+ set state(status) connect
+ fileevent $state(sock) writable {}
+ }
+ return
+}
+
+# http::Write
+#
+# Write POST query data to the socket
+#
+# Arguments
+# token The token for the connection
+#
+# Side Effects
+# Write the socket and handle callbacks.
+
+proc http::Write {token} {
+ variable $token
+ upvar 0 $token state
+ set s $state(sock)
+
+ # Output a block. Tcl will buffer this if the socket blocks
+
+ set done 0
+ if {[catch {
+
+ # Catch I/O errors on dead sockets
+
+ if {[info exists state(-query)]} {
+
+ # Chop up large query strings so queryprogress callback
+ # can give smooth feedback
+
+ puts -nonewline $s \
+ [string range $state(-query) $state(queryoffset) \
+ [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]]
+ incr state(queryoffset) $state(-queryblocksize)
+ if {$state(queryoffset) >= $state(querylength)} {
+ set state(queryoffset) $state(querylength)
+ puts $s ""
+ set done 1
+ }
+ } else {
+
+ # Copy blocks from the query channel
+
+ set outStr [read $state(-querychannel) $state(-queryblocksize)]
+ puts -nonewline $s $outStr
+ incr state(queryoffset) [string length $outStr]
+ if {[eof $state(-querychannel)]} {
+ set done 1
+ }
+ }
+ } err]} {
+ # Do not call Finish here, but instead let the read half of
+ # the socket process whatever server reply there is to get.
+
+ set state(posterror) $err
+ set done 1
+ }
+ if {$done} {
+ catch {flush $s}
+ fileevent $s writable {}
+ fileevent $s readable [list http::Event $s $token]
+ }
+
+ # Callback to the client after we've completely handled everything
+
+ if {[string length $state(-queryprogress)]} {
+ eval $state(-queryprogress) [list $token $state(querylength)\
+ $state(queryoffset)]
+ }
+}
+
+# http::Event
+#
+# Handle input on the socket
+#
+# Arguments
+# s The socket receiving input.
+# token The token returned from http::geturl
+#
+# Side Effects
+# Read the socket and handle callbacks.
+
+proc http::Event {s token} {
+ variable $token
+ upvar 0 $token state
+
+ if {![info exists state]} {
+ puts "Event $s $token with no token"
+ if {! [eof $s]} {
+ puts "oops: \"[read $s]\""
+ }
+ CloseSocket $s
+ return
+ }
+ if {[eof $s]} {
+ if {[info exists $token]} {
+ #puts "got eof on $s"
+ set state(connection) close
+ Eof $token
+ } else {
+ # open connection closed on a token that has been cleaned up.
+ puts "close $s without token"
+ CloseSocket $s
+ }
+ return
+ }
+ if {[string equal $state(state) "header"]} {
+ if {[catch {gets $s line} n]} {
+ Finish $token $n
+ } elseif {$n == 0} {
+ # We now have read all headers.
+ if {$state(http) == ""} {puts ">$line<"; return}
+#puts "[string repeat - 60]\n$token: [array get state]\n[string repeat - 60]"
+ # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3
+ if {[lindex $state(http) 1] == 100} {
+ return
+ }
+ variable encodings
+ set state(state) body
+
+ # We have to use binary translation to count bytes properly.
+ fconfigure $s -translation binary
+
+ if {$state(-binary) || ![string match -nocase text* $state(type)]
+ || [string match *gzip* $state(coding)]
+ || [string match *compress* $state(coding)]} {
+ # Turn off conversions for non-text data
+ set state(binary) 1
+ if {[info exists state(-channel)]} {
+ fconfigure $state(-channel) -translation binary
+ }
+ }
+ if {[info exists state(-channel)] && \
+ ![info exists state(-handler)]} {
+ # Initiate a sequence of background fcopies
+ fileevent $s readable {}
+ CopyStart $s $token
+ }
+ } elseif {$n > 0} {
+ # Process header lines
+ if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
+ switch [string tolower $key] {
+ content-type {
+ set state(type) [string trim [string tolower $value]]
+ # grab the optional charset information
+ regexp -nocase {charset\s*=\s*(\S+)} $state(type) \
+ x state(charset)
+ }
+ content-length {
+ set state(totalsize) [string trim $value]
+ }
+ content-encoding {
+ set state(coding) [string trim $value]
+ }
+ transfer-encoding {
+ set state(transfer) \
+ [string trim [string tolower $value]]
+ }
+ proxy-connection -
+ connection {
+ set state(connection) \
+ [string trim [string tolower $value]]
+ }
+ }
+ lappend state(meta) $key [string trim $value]
+
+ } elseif {[string match HTTP* $line]} {
+ set state(http) $line
+ }
+ }
+ } else {
+ # Now reading body
+ if {[catch {
+ if {[info exists state(-handler)]} {
+ set n [eval $state(-handler) {$s $token}]
+ } elseif {[info exists state(transfer_final)]} {
+ set line [getTextLine $s]
+ set n [string length $line]
+ if {$n > 0} {
+ #puts "final: $n"
+ append state(transfer_final) $line
+ } else {
+ #puts "final chunk part"
+ Eof $token
+ }
+ } elseif {[info exists state(transfer)]
+ && $state(transfer) == "chunked"} {
+ set size 0
+ set chunk [getTextLine $s]
+ set n [string length $chunk]
+ if {[string trim $chunk] != ""} {
+ scan $chunk %x size
+ if {$size != 0} {
+ set bl [fconfigure $s -blocking]
+ fconfigure $s -blocking 1
+ set chunk [read $s $size]
+ fconfigure $s -blocking $bl
+ set n [string length $chunk]
+ if {$n >= 0} {
+ append state(body) $chunk
+ }
+ #puts " size $size got [string length $chunk]"
+ getTextLine $s
+ } else {
+ set state(transfer_final) {}
+ }
+ }
+ } else {
+ set block [read $s $state(-blocksize)]
+ set n [string length $block]
+ if {$n >= 0} {
+ append state(body) $block
+ }
+ }
+ if {[info exists state]} {
+ if {$n >= 0} {
+ incr state(currentsize) $n
+ }
+ # If Content-Length - check for end of data.
+ if {$state(totalsize) > 0 \
+ && $state(currentsize) >= $state(totalsize)} {
+ Eof $token
+ }
+ }
+ } err]} {
+ Finish $token $err
+ } else {
+ if {[info exists state(-progress)]} {
+ eval $state(-progress) \
+ {$token $state(totalsize) $state(currentsize)}
+ }
+ }
+ }
+}
+
+# http::getTextLine --
+#
+# Get one line with the stream in blocking crlf mode
+#
+# Arguments
+# s The socket receiving input.
+#
+# Results:
+# The line of text, without trailing newline
+
+proc http::getTextLine {s} {
+ set tr [fconfigure $s -translation]
+ set bl [fconfigure $s -blocking]
+ fconfigure $s -translation crlf -blocking 1
+ set r [gets $s]
+ fconfigure $s -translation $tr -blocking $bl
+ return $r
+}
+
+# http::CopyStart
+#
+# Error handling wrapper around fcopy
+#
+# Arguments
+# s The socket to copy from
+# token The token returned from http::geturl
+#
+# Side Effects
+# This closes the connection upon error
+
+proc http::CopyStart {s token} {
+ variable $token
+ upvar 0 $token state
+ if {[catch {
+ fcopy $s $state(-channel) -size $state(-blocksize) -command \
+ [list http::CopyDone $token]
+ } err]} {
+ Finish $token $err
+ }
+}
+
+# http::CopyDone
+#
+# fcopy completion callback
+#
+# Arguments
+# token The token returned from http::geturl
+# count The amount transfered
+#
+# Side Effects
+# Invokes callbacks
+
+proc http::CopyDone {token count {error {}}} {
+ variable $token
+ upvar 0 $token state
+ set s $state(sock)
+ incr state(currentsize) $count
+ if {[info exists state(-progress)]} {
+ eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
+ }
+ # At this point the token may have been reset
+ if {[string length $error]} {
+ Finish $token $error
+ } elseif {[catch {eof $s} iseof] || $iseof} {
+ Eof $token
+ } else {
+ CopyStart $s $token
+ }
+}
+
+# http::Eof
+#
+# Handle eof on the socket
+#
+# Arguments
+# token The token returned from http::geturl
+#
+# Side Effects
+# Clean up the socket
+
+proc http::Eof {token {force 0}} {
+ variable $token
+ upvar 0 $token state
+ if {[string equal $state(state) "header"]} {
+ # Premature eof
+ set state(status) eof
+ } else {
+ set state(status) ok
+ }
+
+ if { ! $state(binary) } {
+
+ # If we are getting text, set the incoming channel's
+ # encoding correctly. iso8859-1 is the RFC default, but
+ # this could be any IANA charset. However, we only know
+ # how to convert what we have encodings for.
+
+ set enc [CharsetToEncoding $state(charset)]
+ if {$enc != "binary"} {
+ set state(body) [encoding convertfrom $enc $state(body)]
+ }
+
+ # Translate text line endings.
+ set state(body) [string map {\r\n \n \r \n} $state(body)]
+ }
+
+ Finish $token
+}
+
+# http::wait --
+#
+# See documentation for details.
+#
+# Arguments:
+# token Connection token.
+#
+# Results:
+# The status after the wait.
+
+proc http::wait {token} {
+ variable $token
+ upvar 0 $token state
+
+ if {![info exists state(status)] || [string length $state(status)] == 0} {
+ # We must wait on the original variable name, not the upvar alias
+ vwait $token\(status)
+ }
+
+ return $state(status)
+}
+
+# http::formatQuery --
+#
+# See documentation for details.
+# Call http::formatQuery with an even number of arguments, where
+# the first is a name, the second is a value, the third is another
+# name, and so on.
+#
+# Arguments:
+# args A list of name-value pairs.
+#
+# Results:
+# TODO
+
+proc http::formatQuery {args} {
+ set result ""
+ set sep ""
+ foreach i $args {
+ append result $sep [mapReply $i]
+ if {[string equal $sep "="]} {
+ set sep &
+ } else {
+ set sep =
+ }
+ }
+ return $result
+}
+
+# http::mapReply --
+#
+# Do x-www-urlencoded character mapping
+#
+# Arguments:
+# string The string the needs to be encoded
+#
+# Results:
+# The encoded string
+
+proc http::mapReply {string} {
+ variable formMap
+ variable alphanumeric
+
+ # The spec says: "non-alphanumeric characters are replaced by '%HH'"
+ # 1 leave alphanumerics characters alone
+ # 2 Convert every other character to an array lookup
+ # 3 Escape constructs that are "special" to the tcl parser
+ # 4 "subst" the result, doing all the array substitutions
+
+ regsub -all \[^$alphanumeric\] $string {$formMap(&)} string
+ regsub -all {[][{})\\]\)} $string {\\&} string
+ return [subst -nocommand $string]
+}
+
+# http::ProxyRequired --
+# Default proxy filter.
+#
+# Arguments:
+# host The destination host
+#
+# Results:
+# The current proxy settings
+
+proc http::ProxyRequired {host} {
+ variable http
+ if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
+ if {![info exists http(-proxyport)] || \
+ ![string length $http(-proxyport)]} {
+ set http(-proxyport) 8080
+ }
+ return [list $http(-proxyhost) $http(-proxyport)]
+ }
+}
+
+# http::CharsetToEncoding --
+#
+# Tries to map a given IANA charset to a tcl encoding.
+# If no encoding can be found, returns binary.
+#
+
+proc http::CharsetToEncoding {charset} {
+ variable encodings
+ variable defaultCharset
+
+ set charset [string tolower $charset]
+ if {[regexp {iso-?8859-([0-9]+)} $charset - num]} {
+ set encoding "iso8859-$num"
+ } elseif {[regexp {iso-?2022-(jp|kr)} $charset - ext]} {
+ set encoding "iso2022-$ext"
+ } elseif {[regexp {shift[-_]?js} $charset -]} {
+ set encoding "shiftjis"
+ } elseif {[regexp {(windows|cp)-?([0-9]+)} $charset - - num]} {
+ set encoding "cp$num"
+ } elseif {[string equal $charset "us-ascii"]} {
+ set encoding "ascii"
+ } elseif {[regexp {(iso-?)?lat(in)?-?([0-9]+)} $charset - - - num]} {
+ switch $num {
+ 5 {set encoding "iso8859-9"}
+ 1 -
+ 2 -
+ 3 {set encoding "iso8859-$num"}
+ }
+ } else {
+ # other charset, like euc-xx, utf-8,... may directly maps to encoding
+ set encoding $charset
+ }
+ set idx [lsearch -exact $encodings $encoding]
+ if {$idx >= 0} {
+ return $encoding
+ } else {
+ return "binary"
+ }
+}
Index: openacs-4/packages/acs-automated-testing/tcl/selenium-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/tcl/selenium-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-automated-testing/tcl/selenium-procs.tcl 17 Sep 2009 15:57:01 -0000 1.1
@@ -0,0 +1,123 @@
+# selenium.tcl
+#
+# This code implements a driver to control Selenium, an open source
+# test tool for web applications, see http://selenium.openqa.org/
+#
+# This code is modeled after the Python and Ruby drivers. It differs
+# by not implementing each supported command separately, but instead
+# using a default dispatch to pass commands to the Selenium server with
+# very little modification. This is why the commands are not called
+# get_title, wait_for_page_to_load, etc. but with the same "camelCase"
+# names used by Selenium itself, i.e. getTitle, waitForPageToLoad, etc.
+#
+# All commands known to return a list are singled out and their return
+# string is converted before returning the result. Since everything is
+# a string in Tcl, no special handling is needed for numbers and booleans
+# (boolean results will be the same as in Selenium, i.e. "true"/"false").
+#
+# Note: This code requires a new HTTP/1.1 aware version of geturl - the current
+# http 2.4 package in Tcl doesn't know how to keep a 1.1 connection alive
+# and will slow down because *each* Selenium request will time out.
+#
+# Example use:
+#
+# package require selenium
+#
+# Se init localhost 4444 *firefox http://www.google.com/webhp
+# Se start
+#
+# Se open http://www.google.com/webhp
+# Se type q "hello world"
+# Se clickAndWait btnG
+# Se assertTitle "hello world - Google Search"
+#
+# Se stop
+#
+# by Jean-Claude Wippler, 2007-02-24
+
+source [file dirname [info script]]/http.tcl
+package require http
+
+package provide selenium 0.1
+
+proc Se {cmd args} {
+ global selenium
+ switch -- $cmd {
+
+ init {
+ set selenium(host) [lindex $args 0]
+ set selenium(port) [lindex $args 1]
+ set selenium(browserStartCommand) [lindex $args 2]
+ set selenium(browserURL) [lindex $args 3]
+ set selenium(sessionId) ""
+ }
+
+ start {
+ set selenium(sessionId) [Se getNewBrowserSession \
+ $selenium(browserStartCommand) \
+ $selenium(browserURL)]
+ }
+
+ stop {
+ Se testComplete
+ set selenium(sessionId) ""
+ }
+
+ default {
+ set query [list http::formatQuery cmd $cmd]
+ set i 0
+ foreach arg $args {
+ lappend query [incr i] $arg
+ }
+ if {$selenium(sessionId) ne ""} {
+ lappend query sessionId $selenium(sessionId)
+ }
+ set url "http://$selenium(host):$selenium(port)"
+ append url /selenium-server/driver/? [eval $query]
+ #puts "url $url"
+ set token [http::geturl $url]
+ #puts " status [http::status $token] code [http::code $token]"
+ set data [http::data $token]
+ #puts " result: $data"
+ http::cleanup $token
+ if {[string range $data 0 1] ne "OK"} {
+ error $data
+ }
+ switch -- $cmd {
+ getSelectedLabels -
+ getSelectedValues -
+ getSelectedIndexes -
+ getSelectedIds -
+ getSelectOptions -
+ getAllButtons -
+ getAllLinks -
+ getAllFields -
+ getAttributeFromAllWindows -
+ getAllWindowIds -
+ getAllWindowNames -
+ getAllWindowTitles {
+ set token ""
+ set tokens {}
+ set escape 0
+ foreach letter [split $data ""] {
+ if {$escape} {
+ append token $letter
+ set escape 0
+ } else {
+ switch -- $letter {
+ \\ { set escape 1 }
+ , { lappend tokens $token; set token "" }
+ default { append token $letter }
+ }
+ }
+ }
+ lappend tokens $token
+ return [lrange $tokens 1 end] ;# drop the "OK" element
+ }
+ default {
+ return [string range $data 3 end] ;# drop the "OK," prefix
+ }
+ }
+ }
+ }
+}
Index: openacs-4/packages/acs-automated-testing/tcl/test/selenium-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/tcl/test/selenium-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-automated-testing/tcl/test/selenium-procs.tcl 17 Sep 2009 15:57:01 -0000 1.1
@@ -0,0 +1,14 @@
+ad_library {
+ Test cases for Selenium Remote Control integration
+}
+
+aa_register_case \
+ -cats {web selenium smoke} \
+ -init_classes {{selenium acs-automated-testing}} selenium_server_configured {
+ Is the selenium server configured and working?
+} {
+ aa_false "Start Selenium RC Session" [catch {Se start} errmsg]
+ aa_log $errmsg
+ aa_false "Open [ad_url]" [catch {Se open [ad_url]} errmsg]
+ aa_log $errmsg
+}
\ No newline at end of file
Index: openacs-4/packages/acs-automated-testing/www/doc/xml/index.xml
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/www/doc/xml/index.xml,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-automated-testing/www/doc/xml/index.xml 26 Feb 2004 14:40:27 -0000 1.4
+++ openacs-4/packages/acs-automated-testing/www/doc/xml/index.xml 17 Sep 2009 15:57:02 -0000 1.5
@@ -14,4 +14,9 @@
<xi:include href="requirements.xml" xmlns:xi="http://www.w3.org/2001/XInclude">
<xi:fallback>Section Missing</xi:fallback>
</xi:include>
+ <xi:include href="selenium.xml" xmlns:xi="http://www.w3.org/2001/XInclude">
+ <xi:fallback>Section Missing</xi:fallback>
+ </xi:include>
</article>
+
+
Index: openacs-4/packages/acs-automated-testing/www/doc/xml/selenium.xml
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/www/doc/xml/selenium.xml,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-automated-testing/www/doc/xml/selenium.xml 17 Sep 2009 15:57:02 -0000 1.1
@@ -0,0 +1,214 @@
+<?xml version='1.0' ?>
+<!DOCTYPE article PUBLIC "-//OASIS//DTD DocBook XML V4.1.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.1.2/docbookx.dtd" [
+]>
+
+<sect1 id="selenium">
+ <title>Using Selenium Remote Control</title>
+ <authorblurb>
+ <para>by <ulink url="mailto:dave@solutiongrove.com">Dave
+ Bauer</ulink></para>
+ <para>
+ To use Selenium Remote Control to run browser-based tested from
+ acs-automated-testing first install Selenium Remote
+ Control. <ulink url="http://seleniumhq.org/download/">Download
+ Selenium RC</ulink>. This requires a working Java
+ configuration. See <ulink url="http://seleniumhq.org/docs/05_selenium_rc.html">Selenium
+ RC Documentation</ulink> and specifically <ulink url="
+ http://seleniumhq.org/docs/05_selenium_rc.html#installation">Selenium
+ RC Installation</ulink>.
+ </para>
+ You can record tests to Tcl code that will run in
+ acs-automated-testing by adding the a Tcl-RC mode in Selenium-IDE.
+ </para>
+ <para>
+ Open up Firefox, click on Tools, select Selenium IDE, select
+ Options, then Options again. Click on the formats tab. Click add.
+ Name the format "Tcl-Rc". Paste the following code in the large
+ box.
+ <programlisting>
+/*
+ * Format for Selenium Remote Control Python client.
+ */
+
+load('remoteControl.js');
+
+this.name = "tcl-rc";
+
+function testMethodName(testName) {
+ return "test_" + underscore(testName);
+}
+
+notOperator = function() {
+ return "! ";
+}
+
+tclString = function(value) {
+ value = value.replace(/\\/g, '\\\\');
+ value = value.replace(/\"/g, '\\"');
+ value = value.replace(/\r/g, '\\r');
+ value = value.replace(/\n/g, '\\n');
+ value = value.replace(/\{/g, '\\{');
+ value = value.replace(/\}/g, '\\}');
+ value = value.replace(/\[/g, '\\[');
+ value = value.replace(/\]/g, '\\]');
+ value = value.replace(/\$/g, '\\$');
+
+ var unicode = false;
+ for (var i = 0; i < value.length; i++) {
+ if (value.charCodeAt(i) >= 128) {
+ unicode = true;
+ }
+ }
+ return (unicode ? 'u' : '') + '"' + value + '"';
+}
+
+function assertTrue(expression) {
+ return "aa_true " + tclString(expression.toString()) + " [expr {![catch {" + expression.toString() + "} errmsg]}]";
+}
+
+function assertFalse(expression) {
+ return "aa_false " + tclString(expression.toString()) + " [expr {![catch {" + expression.toString() + "} errmsg]}]";
+}
+
+function verify(statement) {
+ return statement;
+}
+
+function verifyTrue(expression) {
+ return verify(assertTrue(expression));
+}
+
+function verifyFalse(expression) {
+ return verify(assertFalse(expression));
+}
+
+function joinExpression(expression) {
+ return "join " + expression.toString();
+}
+
+function assignToVariable(type, variable, expression) {
+ return "set " + underscore(variable) + " [" + expression.toString() + "]";
+}
+
+function waitFor(expression) {
+ return "for {set i 0} {i < " + expression.toString() + "} {incr i} {\n"
+ + "if {" + expression.toString() + "} {break}\n"
+ + "after 1000\n"
+ + "}\n"
+ + "if {$i == 60} {error \"time out\"}";
+}
+
+function assertOrVerifyFailure(line, isAssert) {
+ return "" + line + "} errmsg]} {error \"expected failure\"}";
+}
+
+Equals.prototype.toString = function() {
+ return this.e1.toString() + " eq " + this.e2.toString();
+}
+
+Equals.prototype.assert = function() {
+ return 'aa_equal ' + string(this.e2.toString() + this.e1.toString()) + ' ' + this.e1.toString() + ' [' + this.e2.toString() +']';
+}
+
+Equals.prototype.verify = function() {
+ return verify(this.assert());
+}
+
+NotEquals.prototype.toString = function() {
+ return this.e1.toString() + " ne " + this.e2.toString();
+}
+
+NotEquals.prototype.assert = function() {
+ return "aa_true " + tclString(this.e1.toString() + " ne " + this.e2.toString()) + " [expr {" + this.e1.toString() + " ne " + this.e2.toString() + "}]";
+}
+
+NotEquals.prototype.verify = function() {
+ return verify(this.assert());
+}
+
+RegexpMatch.prototype.toString = function() {
+ var str = this.pattern;
+ if (str.match(/\"/) || str.match(/\n/)) {
+ str = str.replace(/\\/g, "\\\\");
+ str = str.replace(/\"/g, '\\"');
+ str = str.replace(/\n/g, '\\n');
+ return '"' + str + '"';
+ } else {
+ str = 'r"' + str + '"';
+ }
+ return "re.search(" + str + ", " + this.expression + ")";
+}
+
+function pause(milliseconds) {
+ return "after " + milliseconds;
+}
+
+function echo(message) {
+ return "aa_log " + xlateArgument(message);
+}
+
+function statement(expression) {
+ return expression.toString();
+}
+
+function array(value) {
+ var str = '[lst ';
+ for (var i = 0; i < value.length; i++) {
+ str += string(value[i]);
+ if (i < value.length - 1) str += " ";
+ }
+ str += ']';
+ return str;
+}
+
+function nonBreakingSpace() {
+ return "u\"\\u00a0\"";
+}
+
+CallSelenium.prototype.toString = function() {
+ var result = '';
+ if (this.negative) {
+ result += '! ';
+ }
+ if (options.receiver) {
+ result += options.receiver + ' ';
+ }
+ result += this.message + ' ';
+ for (var i = 0; i < this.args.length; i++) {
+ result += this.args[i];
+ if (i < this.args.length - 1) {
+ result += ' ';
+ }
+ }
+ return result;
+}
+
+function formatComment(comment) {
+ return comment.comment.replace(/.+/mg, function(str) {
+ return "# " + str;
+ });
+}
+
+this.options = {
+ header:'',
+ footer:''
+};
+
+
+this.configForm =
+ '<description>Variable for Selenium instance</description>' +
+ '<description>Header</description>' +
+ '<textbox id="options_header" multiline="true" flex="1" rows="4"/>' +
+ '<description>Footer</description>' +
+ '<textbox id="options_footer" multiline="true" flex="1" rows="4"/>';
+ </programlisting>
+ </para>
+ <para>
+ You may also refer to
+ the <ulink url="http://seleniumhq.org/docs/04_selenese_commands.html">Selenese
+ Commands Documentation</ulink> which may give some hints to
+ writing tests.
+ </para>
+ </authorblurb>
+