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 @@
"/>
+
+
+
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 @@
Section Missing
+
+ Section Missing
+
+
+
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 @@
+
+
+
+
+ Using Selenium Remote Control
+
+ by Dave
+ Bauer
+
+ To use Selenium Remote Control to run browser-based tested from
+ acs-automated-testing first install Selenium Remote
+ Control. Download
+ Selenium RC. This requires a working Java
+ configuration. See Selenium
+ RC Documentation and specifically Selenium
+ RC Installation.
+
+ You can record tests to Tcl code that will run in
+ acs-automated-testing by adding the a Tcl-RC mode in Selenium-IDE.
+
+
+ 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.
+
+/*
+ * 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>
+
+
+ You may also refer to
+ the Selenese
+ Commands Documentation which may give some hints to
+ writing tests.
+
+
+