Index: openacs-4/etc/install/dotlrn-basic-setup.test
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/dotlrn-basic-setup.test,v
diff -u -r1.3 -r1.4
--- openacs-4/etc/install/dotlrn-basic-setup.test	11 Oct 2003 22:12:36 -0000	1.3
+++ openacs-4/etc/install/dotlrn-basic-setup.test	12 Oct 2003 01:11:48 -0000	1.4
@@ -3,46 +3,46 @@
 
     # Test Execution START
         
-    ::twt::util::log "Login the site wide admin"
+    ::twt::log "Login the site wide admin"
     ::twt::user::login_site_wide_admin
     
-    ::twt::util::log "Add the site wide admin to dotLRN"
+    ::twt::log "Add the site wide admin to dotLRN"
     ::twt::dotlrn::add_site_wide_admin $server_url
     
-    ::twt::util::log "Upload users"
+    ::twt::log "Upload users"
     ::twt::user::upload_users $server_url
 
-    ::twt::util::log "Set up terms"
+    ::twt::log "Set up terms"
     ::twt::dotlrn::setup_terms $server_url
     
-    ::twt::util::log "Set up departments"
+    ::twt::log "Set up departments"
     ::twt::dotlrn::setup_departments $server_url
     
-    ::twt::util::log "Set up subjects"
+    ::twt::log "Set up subjects"
     ::twt::dotlrn::setup_subjects $server_url
     
-    ::twt::util::log "Set up classes"
+    ::twt::log "Set up classes"
     ::twt::dotlrn::setup_classes $server_url
     
-    ::twt::util::log "Set up communities (i.e. Tennis Club etc.)"
+    ::twt::log "Set up communities (i.e. Tennis Club etc.)"
     ::twt::dotlrn::setup_communities $server_url    
     
-    ::twt::util::log "Add class members, i.e. professors, students and assistants"
+    ::twt::log "Add class members, i.e. professors, students and assistants"
     ::twt::class::setup_memberships $server_url
     
-    ::twt::util::log "Add class subgroups"
+    ::twt::log "Add class subgroups"
     ::twt::class::setup_subgroups $server_url
     
-    ::twt::util::log "Add class member applet"    
+    ::twt::log "Add class member applet"    
     ::twt::class::add_member_applets $server_url
     
-    ::twt::util::log "Set up class forums - one per class"
+    ::twt::log "Set up class forums - one per class"
     ::twt::forums::add_default_forums $server_url
     
-    #::twt::util::log "Add forum postings"
-    #::twt::forums::add_postings 
+    ::twt::log "Add forum postings"
+    ::twt::forums::add_postings 
     
-    ::twt::util::log "Add news items - one per class"
+    ::twt::log "Add news items - one per class"
     ::twt::news::add_item_to_classes $server_url
 
     # Test Execution END
Index: openacs-4/etc/install/openacs-install.test
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/openacs-install.test,v
diff -u -r1.3 -r1.4
--- openacs-4/etc/install/openacs-install.test	11 Oct 2003 17:20:45 -0000	1.3
+++ openacs-4/etc/install/openacs-install.test	12 Oct 2003 01:11:48 -0000	1.4
@@ -4,7 +4,7 @@
 # Test Execution START
 
 # Request the root page
-do_request "$server_url"
+::twt::do_request $server_url
 
 # Check that database connection is there and configuration is ok
 assert ![regexp -nocase "At least one misconfiguration was discovered" "[response text]"]
@@ -41,6 +41,6 @@
 
 form submit
 
-twt::util::write_response_to_file $install_output_file
+::twt::write_response_to_file $install_output_file
 
 # Test Execution END
Index: openacs-4/etc/install/tcl-api-test.test
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl-api-test.test,v
diff -u -r1.1 -r1.2
--- openacs-4/etc/install/tcl-api-test.test	8 Sep 2003 05:48:00 -0000	1.1
+++ openacs-4/etc/install/tcl-api-test.test	12 Oct 2003 01:11:48 -0000	1.2
@@ -1,14 +1,14 @@
 if { [catch {
     # Source procedures
-    source tclwebtest-functions.tcl
+    source tcl/test-procs.tcl
 
     # Test Execution START
 
-    # Login the site wide admin
-    login_site_wide_admin
+    ::twt::log "Login the site wide admin"
+    ::twt::user::login_site_wide_admin
 
     # Run all tests
-    do_request "${server_url}/test/admin/rerun?package_key=&category=&view_by=package&quiet=0"
+    ::twt::do_request "test/admin/rerun?package_key=&category=&view_by=package&quiet=0"
 
     # Grep for packages with failed tests
     if { [regexp -nocase {fail} [response body]] } {
Index: openacs-4/etc/install/tcl/admin-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/admin-procs.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/etc/install/tcl/admin-procs.tcl	11 Oct 2003 17:20:21 -0000	1.2
+++ openacs-4/etc/install/tcl/admin-procs.tcl	12 Oct 2003 01:10:13 -0000	1.3
@@ -10,7 +10,7 @@
 
 ad_proc ::twt::admin::install_all_packages { server_url } {
 
-    do_request "$server_url/acs-admin/apm/packages-install?checked_by_default_p=1"
+    ::twt::do_request "$server_url/acs-admin/apm/packages-install?checked_by_default_p=1"
     #assert text "Package Installation"
     # If there are no new packages to install, just return
     if { [regexp -nocase {no new packages to install} [response body] match] } {
@@ -32,7 +32,7 @@
 
 ad_proc ::twt::admin::add_main_site_folder { server_url folder_name } {
 
-	do_request "$server_url/admin/site-map"
+	::twt::do_request "$server_url/admin/site-map"
 
 	link follow ~c "new sub folder" 
 	form find ~a new 
@@ -43,7 +43,7 @@
 
 ad_proc ::twt::admin::mount_main_site_package { server_url folder_name instance_name package_key } {
 
-    do_request "$server_url/admin/site-map"
+    ::twt::do_request "$server_url/admin/site-map"
 
     # Follow the link to add a new application at the first matching folder name
     link find ~c $folder_name
@@ -72,15 +72,15 @@
 
 ad_proc ::twt::admin::set_acs_subsite_param { server_url old_parameter_value parameter_value } {
 
-    do_request "$server_url/admin/site-map"
+    ::twt::do_request "$server_url/admin/site-map"
     link follow ~u {parameter-set\?package%5fid=[0-9]+&package%5fkey=acs%2dsubsite&instance%5fname=Main%20Site}
 
     submit_acs_param_internal $old_parameter_value $parameter_value
 }
 
 ad_proc ::twt::admin::set_acs_kernel_param { server_url param_section old_parameter_value parameter_value } {
 
-    do_request "$server_url/admin/site-map"
+    ::twt::do_request "$server_url/admin/site-map"
     link follow ~u {parameter-set\?package%5fid=[0-9]+&package%5fkey=acs%2dkernel}
 
     if { ![string equal $param_section "acs-kernel"] } {
Index: openacs-4/etc/install/tcl/class-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/class-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/etc/install/tcl/class-procs.tcl	11 Oct 2003 22:10:10 -0000	1.3
+++ openacs-4/etc/install/tcl/class-procs.tcl	12 Oct 2003 01:10:13 -0000	1.4
@@ -6,24 +6,33 @@
 
 namespace eval ::twt::class {}
 
-ad_proc ::twt::class::get_admin_urls { server_url term_pretty_name } {
+ad_proc ::twt::class::get_admin_urls { } {
     Returns a list with the fully qualified URLs of the admin pages of
     all .LRN classes.
 } {
-    set admin_url_base "$server_url/dotlrn/admin/term"
-    set admin_url_no_term "${admin_url_base}?term_id=-1"
+    set term_id [::twt::dotlrn::current_term_id]
+    set page_url [::twt::dotlrn::class_admin_url -term_id $term_id]
 
-    # First extract the term_id corresponding to the term_pretty_name
-    do_request $admin_url_no_term
-    form find ~n term_form
-    field find ~n term_id
-    field select $term_pretty_name
-    array set term_select_field [field current]
-    set term_id $term_select_field(value)
+    set url_pattern {/dotlrn/classes/.*/one-community-admin$}
 
-    set admin_url_term "${admin_url_base}?term_id=$term_id"
+    return [::twt::get_url_list $page_url $url_pattern]
+}
 
-    return [::twt::util::get_url_list $server_url $admin_url_term {/dotlrn/classes/.*/one-community-admin$}]
+ad_proc ::twt::class::get_urls { } {
+    Returns a list with the fully qualified URLs of the home pages of
+    all .LRN classes.
+} {
+    # The trick we use here is that we know that class urls are the admin
+    # URLs minus "one-community-admin"
+    set url_list [list]
+    set admin_url_list [get_admin_urls]
+
+    foreach admin_url $admin_url_list {
+        regexp {^(.*)one-community-admin$} $admin_url match class_url
+        lappend url_list $class_url
+    }
+
+    return $url_list
 }
 
 ad_proc ::twt::class::engineering_p { class_url } {
@@ -50,10 +59,10 @@
 
 ad_proc ::twt::class::setup_memberships { server_url } {
 
-    foreach admin_url [get_admin_urls $server_url "[::twt::dotlrn::current_term_pretty_name]"] {
+    foreach admin_url [get_admin_urls] {
 
         # Admin page for the class
-        do_request "$admin_url"
+        ::twt::do_request "$admin_url"
 
         # Member management for the class
         follow_members_link
@@ -72,7 +81,7 @@
             { [expr $admin_counter < 2 && $admin_counter < [llength $admin_users]] } \
             { incr admin_counter } {
 
-            set admin_label [::twt::util::get_random_items_from_list $admin_labels 1]
+            set admin_label [::twt::get_random_items_from_list $admin_labels 1]
             add_member [lindex $admin_users $admin_counter] $admin_label
         }
     }
@@ -109,12 +118,12 @@
 
 ad_proc ::twt::class::setup_subgroups { server_url } {
 
-    foreach admin_url [get_admin_urls $server_url "[::twt::dotlrn::current_term_pretty_name]"] {
+    foreach admin_url [get_admin_urls] {
 
         foreach {name description policy} [subcommunity_properties_list] {
 
             # Admin page of one class
-            do_request $admin_url
+            ::twt::do_request $admin_url
 
             # Add subcommunity form
             link follow ~u subcommunity-new
@@ -145,14 +154,14 @@
 
 ad_proc ::twt::class::add_member_applets { server_url } {
 
-    foreach admin_url [get_admin_urls $server_url "[::twt::dotlrn::current_term_pretty_name]"] {
+    foreach admin_url [get_admin_urls] {
 
         # Only add the members applet to computing classes so that we can
         # demo adding it to other classes manually
         if { [regexp -nocase {comput} $admin_url match] } {
 
             # Admin page of the class
-            do_request $admin_url
+            ::twt::do_request $admin_url
         
             # Manage Applets
             link follow ~u {applets$}
Index: openacs-4/etc/install/tcl/config-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/config-procs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/etc/install/tcl/config-procs.tcl	12 Oct 2003 01:10:13 -0000	1.1
@@ -0,0 +1,63 @@
+# Procs to support testing OpenACS with Tclwebtest.
+#
+# Procs for getting config info. If those tests were to run
+# from within OpenACS some of these procs could go away.
+#
+# @author Peter Marklund
+
+namespace eval ::twt::config {}
+
+####################
+#
+# Global variables
+#
+####################
+
+# TODO: put variables in twt namespace
+
+global __server_url
+set __server_url $server_url
+
+global __admin_last_name
+set __admin_last_name $admin_last_name
+
+global __admin_email
+set __admin_email $admin_email
+
+global __admin_password
+set __admin_password $admin_password
+
+global __url_history
+set __url_history [list]
+
+global __demo_users_password
+if { [info exists demo_users_password] } {
+    set __demo_users_password $demo_users_password
+} else {
+    set __demo_users_password "guest"
+}
+
+global __dotlrn_users_data_file
+if { [info exists dotlrn_users_data_file] } {
+    set __dotlrn_users_data_file $dotlrn_users_data_file
+} else {
+    set __dotlrn_users_data_file users-data.csv
+} 
+
+ad_proc ::twt::config::server_url { } {
+    global __server_url
+
+    return $__server_url
+}
+
+ad_proc ::twt::config::admin_email { } {
+    global __admin_email
+
+    return $__admin_email
+}
+
+ad_proc ::twt::config::admin_password { } {
+    global __admin_password
+
+    return $__admin_password
+}
Index: openacs-4/etc/install/tcl/dotlrn-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/dotlrn-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/etc/install/tcl/dotlrn-procs.tcl	11 Oct 2003 22:10:11 -0000	1.3
+++ openacs-4/etc/install/tcl/dotlrn-procs.tcl	12 Oct 2003 01:10:13 -0000	1.4
@@ -9,7 +9,7 @@
 
 ad_proc ::twt::dotlrn::add_term { server_url term_name start_month start_year end_month end_year } {
 
-    do_request "$server_url/dotlrn/admin/term-new"
+    ::twt::do_request "$server_url/dotlrn/admin/term-new"
     form find ~n add_term
     field find ~n "term_name"
 
@@ -38,9 +38,27 @@
     return "Fall 2003/2004"
 }
 
+ad_proc ::twt::dotlrn::current_term_id {} {
+    ::twt::do_request [class_admin_url]
+
+    form find ~n term_form
+    field find ~n term_id
+    field select [current_term_pretty_name]
+    array set term_select_field [field current]
+    set term_id $term_select_field(value)
+
+    return $term_id
+}
+
+ad_proc ::twt::dotlrn::class_admin_url {
+    {-term_id "-1"}
+} {
+   return "dotlrn/admin/term?term_id=$term_id" 
+}
+
 ad_proc ::twt::dotlrn::add_department { server_url pretty_name description external_url } {
 
-    do_request "$server_url/dotlrn/admin/department-new"
+    ::twt::do_request "$server_url/dotlrn/admin/department-new"
     form find ~n add_department
     field find ~n "pretty_name"
     field fill $pretty_name
@@ -73,7 +91,7 @@
 
 ad_proc ::twt::dotlrn::add_subject { server_url department_pretty_name pretty_name description } {
 
-    do_request "$server_url/dotlrn/admin/class-new"
+    ::twt::do_request "$server_url/dotlrn/admin/class-new"
 
     form find ~n add_class
     field find ~n "form:id"
@@ -111,7 +129,7 @@
 
 ad_proc ::twt::dotlrn::get_class_add_urls { server_url } {
 
-    return [::twt::util::get_url_list $server_url "$server_url/dotlrn/admin/classes" "class-instance-new"]
+    return [::twt::get_url_list "dotlrn/admin/classes" "class-instance-new"]
 }
 
 ad_proc ::twt::dotlrn::setup_classes { server_url } {
@@ -124,7 +142,7 @@
 
     foreach link [get_class_add_urls $server_url] {
 
-        do_request $link
+        ::twt::do_request $link
         form find ~n "add_class_instance"
         field find
         field select $term_name
@@ -146,7 +164,7 @@
 
 ad_proc ::twt::dotlrn::add_community { server_url name description policy } {
     
-    do_request "${server_url}/dotlrn/admin/club-new"    
+    ::twt::do_request "${server_url}/dotlrn/admin/club-new"    
 
     form find ~n add_club
 
@@ -160,12 +178,23 @@
     form submit
 }
 
+ad_proc ::twt::dotlrn::get_user_admin_url { email } {
+    Get the .LRN admin URL for a user. This is awkward. If we could
+    lookup the user_id from email this would be much easier.
+} {
+    ::twt::do_request "dotlrn/admin/users-search?name=$email&form%3Aid=user_search"
+
+    link follow ~u {user}
+
+    return [response url]
+}
+
 ad_proc ::twt::dotlrn::add_site_wide_admin { server_url } {
 
     global __admin_last_name
 
     # Goto users page
-    do_request "$server_url/dotlrn/admin/users?type=pending"
+    ::twt::do_request "/dotlrn/admin/users?type=pending"
 
     # Goto the community page for the site-wide admin (assuming he's first in the list)
     link follow ~u {user\?user_id=}
Index: openacs-4/etc/install/tcl/forums-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/forums-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/etc/install/tcl/forums-procs.tcl	11 Oct 2003 22:10:11 -0000	1.3
+++ openacs-4/etc/install/tcl/forums-procs.tcl	12 Oct 2003 01:10:13 -0000	1.4
@@ -9,10 +9,10 @@
 ad_proc ::twt::forums::add_default_forums { server_url } {
     Adds a general forum to each class. Goes via the class admin pages.
 } {
-    foreach admin_url [::twt::class::get_admin_urls $server_url "[::twt::dotlrn::current_term_pretty_name]"] {
+    foreach admin_url [::twt::class::get_admin_urls] {
 
         # Admin page of one class
-        do_request $admin_url
+        ::twt::do_request $admin_url
 
         # Add forum form
         link follow ~u forum-new
@@ -24,16 +24,75 @@
 }
 
 ad_proc ::twt::forums::add_postings {} {
-    global __server_url
 
     # Loop over all classes
-    foreach forum_url [::twt::class::get_urls] {
-        # Create thread
+    foreach class_url [::twt::class::get_urls] {
 
-        # Enter thread
+        # Class index page
+        ::twt::do_request $class_url
 
+        # Forum index page
+        link follow ~u {forum-view?[^/]+$}
+
         # Post question
+        array set question [get_question]
+        link follow ~u {message-post?[^/]+$}
+        field find ~n subject
+        field fill $question(subject)
+        field find ~n content
+        field fill $question(content)
+        form submit
 
-        # Post answers
+        # Assuming here we are redirected to thread page - fragile...
+        set thread_url [response url]
+
+        # Post answer
+        array set answer [get_answer]
+        ::twt::user::login albert_einstein@dotlrn.test
+        ::twt::do_request $thread_url
+        link follow ~u {message-post?[^/]+$}
+        field find ~n content
+        field fill $answer(content)
+        form submit
+        
+        ::twt::user::login_site_wide_admin
     }
 }
+
+ad_proc ::twt::forums::get_question {} {
+
+    return {
+        subject "What is the meaning of life?"
+        content "Let's step back a moment...
+
+Why do you want to know the meaning of life?
+
+Often people ask this question when they really want the answer to some other question. Let's try and get those people back on track with some \"pre-meaning of life\" advice:
+
+    * If you're questioning the meaning of life because you've been unhappy and depressed a good bit, click here.
+
+    * On a related note, if you want to know the meaning of life because you feel useless and worthless, click here.
+
+    * If you want to see our answer so that you can prove your intellectual prowess by poking holes in it, click here.
+
+    * If something awful just happened to you or someone you care about and you don't understand why bad things happen to good people, click here.
+    ...
+    From http://www.aristotle.net/~diogenes/meaning1.htm
+
+    Comments?
+"
+    }
+}
+
+ad_proc ::twt::forums::get_answer {} {
+
+    return {
+        content "
+      I was impressed by the earnestness of your struggle to find a purpose for the life of the individual and of mankind as a whole. In my opinion there can be no reasonable answer if the question is put this way. If we speak of the purpose and goal of an action we mean simply the question: which kind of desire should we fulfill by the action or its consequences or which undesired consequences should be prevented? We can, of course, also speak in a clear way of the goal of an action from the standpoint of a community to which the individual belongs. In such cases the goal of the action has also to do at least indirectly with fulfillment of desires of the individuals which constitute a society.
+
+      If you ask for the purpose or goal of society as a whole or of an individual taken as a whole the question loses its meaning. This is, of course, even more so if you ask the purpose or meaning of nature in general. For in those cases it seems quite arbitrary if not unreasonable to assume somebody whose desires are connected with the happenings.
+
+      Nevertheless we all feel that it is indeed very reasonable and important to ask ourselves how we should try to conduct our lives. The answer is, in my opinion: satisfaction of the desires and needs of all, as far as this can be achieved, and achievement of harmony and beauty in the human relationships. This presupposes a good deal of conscious thought and of self-education. It is undeniable that the enlightened Greeks and the old Oriental sages had achieved a higher level in this all-important field than what is alive in our schools and universities.
+"
+    }
+}
Fisheye: Tag 1.2 refers to a dead (removed) revision in file `openacs-4/etc/install/tcl/global-vars.tcl'.
Fisheye: No comparison available.  Pass `N' to diff?
Index: openacs-4/etc/install/tcl/news-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/news-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/etc/install/tcl/news-procs.tcl	11 Oct 2003 22:10:11 -0000	1.3
+++ openacs-4/etc/install/tcl/news-procs.tcl	12 Oct 2003 01:10:13 -0000	1.4
@@ -11,20 +11,20 @@
     set news_item_list [get_items]
 
     set class_counter 0
-    foreach admin_url [::twt::class::get_admin_urls $server_url "[::twt::dotlrn::current_term_pretty_name]"] {
+    foreach admin_url [::twt::class::get_admin_urls] {
 
         # We want the professor of the class to post the news item
         # TODO
         #set email [::twt::class::get_professor $admin_url]
         #user::login $email [::twt::user::get_password $email]
 
         # Admin page of the class
-        do_request $admin_url
+        ::twt::do_request $admin_url
 
         # News item add
         link follow ~u {news/+item-create}
 
-        set news_item [lindex [::twt::util::get_random_items_from_list $news_item_list 1] 0]
+        set news_item [lindex [::twt::get_random_items_from_list $news_item_list 1] 0]
 
         form find ~a preview
         set publish_title [lindex $news_item 0]
Index: openacs-4/etc/install/tcl/test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/test-procs.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/etc/install/tcl/test-procs.tcl	11 Oct 2003 17:20:21 -0000	1.2
+++ openacs-4/etc/install/tcl/test-procs.tcl	12 Oct 2003 01:10:13 -0000	1.3
@@ -9,8 +9,8 @@
 
 set script_dir [file dirname [info script]]
 
-source $script_dir/global-vars.tcl
-source $script_dir/util-procs.tcl
+source $script_dir/config-procs.tcl
+source $script_dir/twt-procs.tcl
 source $script_dir/user-procs.tcl
 source $script_dir/admin-procs.tcl
 source $script_dir/dotlrn-procs.tcl
Index: openacs-4/etc/install/tcl/twt-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/twt-procs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/etc/install/tcl/twt-procs.tcl	12 Oct 2003 01:10:13 -0000	1.1
@@ -0,0 +1,170 @@
+# Procs to support testing OpenACS with Tclwebtest.
+#
+# Basic utility procs.
+#
+# @author Peter Marklund
+
+namespace eval ::twt {}
+
+ad_proc ::twt::log { message } {
+    set script_name [file tail [info script]]
+    puts ""
+    puts "##############################"
+    puts "#"
+    puts "# ${script_name}: $message"
+    puts "#"
+    puts "##############################"
+    puts ""
+}
+
+ad_proc ::twt::do_request { page_url } {
+    Takes a a url and invokes tclwebtest::do_request. The URL
+    can either be relative to server root or absolute 
+    (in which case it must start with with http://).
+} {
+    if { [regexp {^http://} $page_url] } {
+        # We were given an absolute url
+        set absolute_url $page_url
+    } else {
+        # Relative url - prepend system url
+        set absolute_url "[::twt::config::server_url]/$page_url"
+    }
+
+    ::tclwebtest::do_request $absolute_url
+}
+
+ad_proc ::twt::get_url_list { page_url link_url_pattern } {
+
+    ::twt::do_request $page_url
+
+    set urls_list [list]
+
+    # Loop over and add all links
+    set errno "0"
+    while { $errno == "0" } {
+	set errno [catch {
+            array set link_array [link find -next ~u "$link_url_pattern"]} error]
+
+         if { [string equal $errno "0"] } {
+            set url $link_array(url)
+     
+            lappend urls_list $url
+        }
+    }
+    
+
+    return $urls_list
+}
+
+ad_proc ::twt::get_random_items_from_list { list number } {
+    Given a list and the lenght of the list to return, 
+    return a list with a random subset of items from the input list.
+} {
+
+    # Build a list of indices
+    set index_list [list]
+    for { set i 0 } { $i < [llength $list] } { incr i } {
+        lappend index_list $i
+    }
+
+    # If the list was empty - return
+    if { [llength $index_list] == 0 } {
+        return {}
+    }
+
+    # Cannot return more items than are in the list
+    if { $number > [llength $list] } {
+        error "get_random_items_from_list: cannot return $number items from list $list"
+    }
+
+    # Pick number random indices from the list. Remove each index that we have
+    # already picked.
+    set random_indices [list]
+    for { set index_count 0 } { $index_count < $number } { incr index_count } {
+        set random_index [randomRange [llength $index_list]]
+
+        lappend random_indices [lindex $index_list $random_index]
+
+        # Remove the index that we picked
+        set index_list [lreplace $index_list $random_index $random_index]
+    }
+
+    # Build and return the items at the random indices
+    set return_list [list]
+    foreach index $random_indices {
+        lappend return_list [lindex $list $index]
+    }
+    if { [llength $return_list] == 1 } {
+        return [lindex $return_list 0]
+    } else {
+        return $return_list
+    }
+}
+
+ad_proc ::twt::randomRange {range} {
+    Given an integer N, return an integer between 0 and N.
+} {
+
+     return [expr int([expr rand()] * $range)]
+}
+
+ad_proc ::twt::write_response_to_file { filename } {
+    Write the HTML body of the last HTTP response to the
+    file with given path. If the directory of the file doesn't
+    exist then create it.
+} {
+
+    # Create the directory of the output file if it doesn't exist
+    if { ![file isdirectory [file dirname $filename]] } { 
+        exec mkdir -p [file dirname $filename] 
+    }
+    set file_id [open "$filename" w+]
+    puts $file_id "[response body]"
+}
+
+ad_proc ::twt::crawl_links {} {
+    TODO: This proc currently doesn't crawl nearly as many links as we would like
+} {
+
+    global __url_history
+
+    set start_url [lindex $__url_history end]
+
+    # Return if given start URL is external
+    global __server_url
+    set absolute_url [tclwebtest::absolute_link $start_url]
+    if { [string first $__server_url $absolute_url] == -1 } {
+        #puts "not following link to external url $absolute_url"
+        return
+    }
+
+    # Also return if this is the logout link
+    if { [regexp {/register/logout} $start_url match] } {
+        #puts "not following logout link"
+        return
+    }
+
+    ::twt::do_request $start_url
+
+    set errno 0
+    while { $errno == "0" } {
+	set errno [catch {
+            array set link_array [link find -next]} error]
+
+         if { [string equal $errno "0"] } {
+            set url $link_array(url)
+
+            # Don't revisit URL:s we have already tested
+            # Don't follow relative anchors on pages - can't get them to work with TclWebtest
+            if { [lsearch -exact $__url_history $url] == -1 && [string range $url 0 0] != "#" } {
+                #puts "$start_url following url $url"
+
+                lappend __url_history $url
+
+                crawl_links
+            } else {
+                #puts "$start_url skipping url $url as visited before"
+            }
+         }
+   }
+}
Index: openacs-4/etc/install/tcl/user-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/user-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/etc/install/tcl/user-procs.tcl	11 Oct 2003 22:10:11 -0000	1.3
+++ openacs-4/etc/install/tcl/user-procs.tcl	12 Oct 2003 01:10:13 -0000	1.4
@@ -27,45 +27,46 @@
 } {
     set email_list [get_users $type]
 
-    return [::twt::util::get_random_items_from_list $email_list $number]
+    return [::twt::get_random_items_from_list $email_list $number]
 }
 
 ad_proc ::twt::user::get_password { email } {
-    global __demo_users_password
 
-    return $__demo_users_password
+    if { [string equal $email  [::twt::config::admin_email]] } {
+        return [::twt::config::admin_password]
+    } else {
+        global __demo_users_password
+        return $__demo_users_password
+    }
 }
 
-ad_proc ::twt::user::login { user_email user_password} {
+ad_proc ::twt::user::login { email } {
 
     ::twt::user::logout
 
     global __server_url
 
     # Request the start page
-    do_request "${__server_url}/register"
+    ::twt::do_request "${__server_url}/register"
 
     # Login the user
     form find ~n login
     field find ~n email
-    field fill "$user_email"
+    field fill "$email"
     field find ~n password
-    field fill "$user_password"
+    field fill [get_password $email]
     form submit
 }
 
 ad_proc ::twt::user::logout {} {
     global __server_url
 
-    do_request "${__server_url}/register/logout"
+    ::twt::do_request "${__server_url}/register/logout"
 }
 
 ad_proc ::twt::user::login_site_wide_admin {} {
-    global __server_url
-    global __admin_email
-    global __admin_password
 
-    ::twt::user::login $__admin_email $__admin_password
+    ::twt::user::login [::twt::config::admin_email]
 }
 
 ad_proc ::twt::user::add { 
@@ -78,7 +79,7 @@
     full_access
     guest
 } {
-    do_request "$server_url/dotlrn/admin/users"
+    ::twt::do_request "$server_url/dotlrn/admin/users"
     link follow ~u "user-add"
 
     form find ~a "/dotlrn/user-add"
@@ -89,9 +90,9 @@
     field find ~n "last_name"
     field fill $last_name
     field find ~n "password"
-    field fill [::twt::user::get_password $email]
+    field fill [get_password $email]
     field find ~n "password_confirm"
-    field fill [::twt::user::get_password $email]
+    field fill [get_password $email]
     form submit
 
     form find ~n add_user
@@ -182,7 +183,10 @@
 
     # We want the users to have a known password so people can log in with them
     set_passwords $server_url
-    
+
+    # Since Einstein will be posting in all classes
+    # we make him site-wide-admin
+    ::twt::user::make_site_wide_admin albert_einstein@dotlrn.test
 }
 
 ad_proc ::twt::user::set_passwords { server_url } {
@@ -191,7 +195,7 @@
         #puts "setting guest password for user $user_email"
 
         # User admin page
-        do_request "${server_url}/dotlrn/admin/users"
+        ::twt::do_request "${server_url}/dotlrn/admin/users"
 
         form find ~a "users-search"
         field fill $user_email ~n name    
@@ -209,3 +213,10 @@
         form submit
     }
 }
+
+ad_proc ::twt::user::make_site_wide_admin { email } {
+    ::twt::do_request [::twt::dotlrn::get_user_admin_url $email]
+
+    # Do nothing if the user is already site-wide-admin
+    catch {link follow ~u {site-wide-admin-toggle.*value=grant}}
+}
\ No newline at end of file
Fisheye: Tag 1.4 refers to a dead (removed) revision in file `openacs-4/etc/install/tcl/util-procs.tcl'.
Fisheye: No comparison available.  Pass `N' to diff?