OpenACS

gerardom
committed
oacs-5-2:gerardom:20051114142251
on 14 Nov 05
optimizing the code of the faq tests
openacs-4/.../test/tclwebtest-procs.tcl (+385)
  1 ad_library {
  2     Automated tests.
  3
  4     @author Mounir Lallali
  5     @creation-date 14 June 2005
  6   
  7 }
  8
  9 namespace eval dotlrn::twt {}
  10
  11 ad_proc dotlrn::twt::term_new {term_name start_date end_date} {
  12
  13         set response 0
  14         tclwebtest::cookies clear
  15         # Login user
  16         array set user_info [twt::user::create -admin]
  17         twt::user::login $user_info(email) $user_info(password)
  18         
  19         # The admin dotlrn page url
  20         set dotlrn_admin_page_url "[site_node::get_package_url -package_key dotlrn]admin"       
  21         ::twt::do_request $dotlrn_admin_page_url
  22
  23         tclwebtest::link follow "Terms"
  24         tclwebtest::link follow "New Term"
  25         tclwebtest::form find ~n "add_term"
  26         tclwebtest::field find ~n "term_name"
  27         tclwebtest::field fill $term_name
  28         tclwebtest::field find ~n "start_date"
  29         tclwebtest::field fill $start_date
  30         tclwebtest::field find ~n "end_date"
  31         tclwebtest::field fill $end_date
  32         tclwebtest::form submit
  33         
  34         aa_log "Add Term form submited"
  35
  36         set response_url [tclwebtest::response url]
  37
  38         if {[string match "*$dotlrn_admin_page_url/terms" $response_url] } {
  39             if { [catch {tclwebtest::link find $term_name } errmsg] } {
  40                 aa_error  "dotlrn::twt::term_new failed $errmsg : Didn't create a New Term"
  41             } else {
  42                 aa_log "a New Term created"
  43                 set response 1
  44             }
  45         } else {
  46             aa_error "dotlrn::twt::term_new failed, bad response url : $response_url"
  47         }
  48
  49         twt::user::logout
  50         return $response
  51 }
  52
  53 ad_proc dotlrn::twt::term_edit { term_name new_term_name term_year start_date end_date} {
  54
  55         set response 0
  56         tclwebtest::cookies clear
  57         # Login user
  58         array set user_info [twt::user::create -admin]
  59         twt::user::login $user_info(email) $user_info(password)
  60
  61         # The admin dotlrn page url
  62         set dotlrn_admin_page_url "[site_node::get_package_url -package_key dotlrn]admin"
  63         ::twt::do_request $dotlrn_admin_page_url
  64
  65         tclwebtest::link follow "Terms" 
  66         tclwebtest::link follow $term_name
  67         tclwebtest::link follow "Edit"
  68
  69         tclwebtest::form find ~n "edit_term"
  70         tclwebtest::field find ~n "term_name"
  71         tclwebtest::field fill $new_term_name
  72         tclwebtest::field find ~n "term_year"
  73         tclwebtest::field fill $term_year
  74         tclwebtest::field find ~n "start_date"
  75         tclwebtest::field fill $start_date
  76         tclwebtest::field find ~n "end_date"
  77         tclwebtest::field fill $end_date
  78         tclwebtest::form submit
  79         aa_log "Edit Term form submited"
  80
  81         set response_url [tclwebtest::response url]
  82
  83         if {[string match "*$dotlrn_admin_page_url/term*" $response_url] } {
  84             if { [catch {tclwebtest::assert text $new_term_name } errmsg] || [catch {tclwebtest::assert text $term_year } errmsg]} {
  85                 aa_error  "dotlrn::twt::term_edit failed $errmsg : Didn't create a New Term"
  86             } else {
  87                 aa_log "Term edited"
  88                 set response 1
  89             }
  90         } else {
  91             aa_error "dotlrn::twt::term_edit failed, bad response url : $response_url"
  92         }
  93
  94         twt::user::logout
  95         return $response
  96 }
  97  
  98 ad_proc dotlrn::twt::department_new  {department_name description external_url department_key } {
  99
  100         set response 0
  101         tclwebtest::cookies clear
  102         # Login user
  103         array set user_info [twt::user::create -admin]
  104         twt::user::login $user_info(email) $user_info(password)
  105
  106         # The admin dotlrn page url
  107         set dotlrn_admin_page_url "[site_node::get_package_url -package_key dotlrn]admin"
  108         ::twt::do_request $dotlrn_admin_page_url
  109         
  110         tclwebtest::link follow "Departments"
  111         tclwebtest::link follow "New Department"
  112
  113         tclwebtest::form find ~n "add_department"
  114         tclwebtest::field find ~n "pretty_name"
  115         tclwebtest::field fill $department_name         
  116         tclwebtest::field find ~n "description"
  117         tclwebtest::field fill $description
  118         tclwebtest::field find ~n "external_url"
  119         tclwebtest::field fill $external_url    
  120         tclwebtest::field find ~n "department_key"
  121         tclwebtest::field fill $department_key                  
  122         tclwebtest::form submit
  123         aa_log "Add Department form submited"
  124
  125         set response_url [tclwebtest::response url]     
  126         
  127         if {[string match "*$dotlrn_admin_page_url/departments" $response_url] } {
  128             if { [catch {tclwebtest::link find $department_name } errmsg] } {
  129                         aa_error  "dotlrn::twt::department_new failed $errmsg : Didn't create a New Department"
  130             } else {
  131                 aa_log "New Department Created"
  132                 set response 1
  133             }
  134         } else {
  135             aa_error "dotlrn::twt::department_new failed, bad response url : $response_url"
  136         }
  137         
  138         twt::user::logout
  139         return $response
  140 }
  141
  142 ad_proc dotlrn::twt::department_delete { department_name department_key } {
  143
  144         set response 0
  145         tclwebtest::cookies clear
  146         
  147         # Login user
  148         array set user_info [twt::user::create -admin]
  149         twt::user::login $user_info(email) $user_info(password)
  150
  151         # The admin dotlrn page url
  152         set dotlrn_departments_page_url "[site_node::get_package_url -package_key dotlrn]admin/departments"
  153         ::twt::do_request $dotlrn_departments_page_url
  154         
  155         set delete_url [export_vars -base "department-delete" { {department_key "$department_key"} {pretty_name "$department_name"} {referer "departments"} }]
  156         
  157         ::twt::do_request "$delete_url"
  158         
  159         tclwebtest::form find ~n "delete_department"    
  160         tclwebtest::form submit ~n "yes_button"
  161         aa_log "Delete Department form submited"
  162
  163         set response_url [tclwebtest::response url]     
  164
  165         if {[string match "*$dotlrn_departments_page_url" $response_url] } {
  166             if { ![catch {tclwebtest::link find $department_name} errmsg] } {
  167                 aa_error "dotlrn::twt::department_delete failed $errmsg : Didn't Delete a Department"
  168             } else {
  169                 aa_log "Dorlrn Department Deleted"
  170                 set response 1
  171             }
  172         } else {
  173             aa_error "dotlrn::twt::department_delete failed, bad response url : $response_url"
  174         }
  175
  176         twt::user::logout
  177         return $response
  178 }
  179
  180 ad_proc dotlrn::twt::subject_new  { department_name subject_name description subject_key } {
  181
  182         set response 0
  183         tclwebtest::cookies clear
  184         # Login user
  185         array set user_info [twt::user::create -admin]
  186         twt::user::login $user_info(email) $user_info(password)
  187
  188         # The admin dotlrn page url
  189         set dotlrn_admin_page_url "[site_node::get_package_url -package_key dotlrn]admin"
  190         ::twt::do_request $dotlrn_admin_page_url
  191         
  192         tclwebtest::link follow "Departments"
  193         tclwebtest::link follow $department_name
  194         tclwebtest::link follow {New subject}
  195
  196         tclwebtest::form find ~n "add_class"
  197         tclwebtest::field find ~n "department_key"              
  198         tclwebtest::field select  $department_name
  199         tclwebtest::field find ~n pretty_name
  200         tclwebtest::field fill $subject_name
  201         tclwebtest::field find ~n description
  202         tclwebtest::field fill $description
  203         tclwebtest::form submit
  204         aa_log "Add Subject Form submited"
  205
  206         set response_url [tclwebtest::response url]     
  207         
  208         if {[string match "*$dotlrn_admin_page_url/classes*" $response_url] } {
  209             if { [catch {tclwebtest::link find $subject_name } errmsg] } {
  210                 aa_error  "dotlrn::twt::subject_new failed $errmsg : Didn't Create a New Subject"
  211             } else {
  212                 aa_log "Create a New Subject"
  213                 set response 1
  214             }
  215         } else {
  216             aa_error "dotlrn::twt::subject_new failed, bad response url : $response_url"
  217         }
  218
  219         twt::user::logout
  220         return $response
  221 }
  222
  223 ad_proc dotlrn::twt::subject_delete  { department_name } {
  224
  225         set response 0
  226         tclwebtest::cookies clear
  227         # Login user
  228         array set user_info [twt::user::create -admin]
  229         twt::user::login $user_info(email) $user_info(password)
  230
  231         # The admin dotlrn page url
  232         set dotlrn_admin_page_url "[site_node::get_package_url -package_key dotlrn]admin"
  233         ::twt::do_request $dotlrn_admin_page_url
  234         
  235         tclwebtest::link follow "Departments"
  236         tclwebtest::link follow $department_name
  237         tclwebtest::link follow {Delete subject}
  238
  239         tclwebtest::form find ~n "delete_class" 
  240         tclwebtest::form submit ~n "formbutton:ok"
  241         aa_log "Delete Subject Form submited"
  242
  243         set response_url [tclwebtest::response url]     
  244         
  245         if {[string match "*$dotlrn_admin_page_url/classes*" $response_url] } {
  246             if {![catch {tclwebtest::link find $subject_name } errmsg] } {
  247                 aa_error  "dotlrn::twt::subject_delete failed $errmsg : Didn't Delete Subject Department"
  248             } else {
  249                   aa_log "Delete Subject Department"
  250                         set response 1
  251                 }
  252         } else {
  253                 aa_error "dotlrn::twt::subject_delete failed, bad response url : $response_url"
  254         }
  255
  256         twt::user::logout
  257         return $response
  258 }
  259
  260 ad_proc dotlrn::twt::subject_edit  { department_name subject_name new_subject_name new_description } {
  261
  262         set response 0
  263         tclwebtest::cookies clear
  264         # Login user
  265         array set user_info [twt::user::create -admin]
  266         twt::user::login $user_info(email) $user_info(password)
  267
  268         # The admin dotlrn page url
  269         set dotlrn_admin_page_url "[site_node::get_package_url -package_key dotlrn]admin"
  270         ::twt::do_request $dotlrn_admin_page_url
  271         
  272         tclwebtest::link follow "Departments"
  273         tclwebtest::link follow $department_name
  274         tclwebtest::link follow $subject_name
  275         tclwebtest::link follow "Edit Subject properties."
  276
  277         tclwebtest::form find ~n "edit_class"
  278         tclwebtest::field find ~n pretty_name
  279         tclwebtest::field fill $new_subject_name
  280         tclwebtest::field find ~n description
  281         tclwebtest::field fill $new_description
  282         tclwebtest::form submit
  283         aa_log "Edit Subject Form submited"
  284
  285         set response_url [tclwebtest::response url]
  286
  287         if {[string match "*$dotlrn_admin_page_url/class?class_key*" $response_url] } {
  288             if {[catch {tclwebtest::assert text $new_subject_name } errmsg] || [catch {tclwebtest::assert text $new_description } errmsg]} {
  289                 aa_error  "dotlrn::twt::subject_edit failed $errmsg : Didn't Edit Subject Department"
  290             } else {
  291                 aa_log "Edit Subject Department"
  292                 set response 1
  293             }
  294         } else {
  295             aa_error "dotlrn::twt::subject_edit failed, bad response url : $response_url"
  296         }
  297
  298         twt::user::logout
  299         return $response
  300 }
  301
  302 ad_proc dotlrn::twt::class_new  { department_name class_name description class_key } {
  303
  304         set response 0
  305         tclwebtest::cookies clear
  306         # Login user
  307         array set user_info [twt::user::create -admin]
  308         twt::user::login $user_info(email) $user_info(password)
  309
  310         # The admin dotlrn page url
  311         set dotlrn_admin_page_url "[site_node::get_package_url -package_key dotlrn]admin"
  312         ::twt::do_request $dotlrn_admin_page_url
  313         
  314         tclwebtest::link follow "Departments"
  315         tclwebtest::link follow $department_name
  316         tclwebtest::link follow {New Class}
  317
  318         tclwebtest::form find ~n "add_class_instance"
  319         tclwebtest::field find ~n pretty_name
  320         tclwebtest::field fill $class_name
  321         tclwebtest::field find ~n description
  322         tclwebtest::field fill $description
  323         tclwebtest::field find ~n add_instructor
  324         tclwebtest::field select -index 1
  325         tclwebtest::field find ~n class_instance_key
  326         tclwebtest::field fill $class_key
  327         tclwebtest::form submit
  328         aa_log "Add Class Form submited"
  329
  330         set response_url [tclwebtest::response url]     
  331         
  332         if {[string match "*$dotlrn_admin_page_url/class*" $response_url] } {
  333                 if {[catch {tclwebtest::link find $class_name } errmsg] } {
  334                         aa_error  "dotlrn::twt::class_new failed $errmsg : Didn't Create a New Class"
  335                 } else {
  336                         aa_log "Create a New Class"
  337                         set response 1
  338                 }
  339         } else {
  340                 aa_error "dotlrn::twt::class_new failed, bad response url : $response_url"
  341         }
  342
  343         twt::user::logout
  344         return $response
  345 }
  346
  347 ad_proc dotlrn::twt::community_new { community_name description } {
  348
  349         set response 0
  350         tclwebtest::cookies clear
  351         # Login user
  352         array set user_info [twt::user::create -admin]
  353         twt::user::login $user_info(email) $user_info(password)
  354
  355         # The admin dotlrn page url
  356         set dotlrn_community_page_url "[site_node::get_package_url -package_key dotlrn]admin/clubs"
  357         ::twt::do_request $dotlrn_community_page_url
  358         #tclwebtest::link follow Communities
  359
  360         tclwebtest::link follow {New Community}
  361
  362         tclwebtest::form find ~n "add_club"
  363         tclwebtest::field find ~n pretty_name
  364         tclwebtest::field fill $community_name
  365         tclwebtest::field find ~n description
  366         tclwebtest::field fill $description
  367         tclwebtest::form submit 
  368
  369         aa_log "Add Community Form submited"            
  370
  371         set response_url [tclwebtest::response url]     
  372         
  373         if {[string match "*$dotlrn_community_page_url*" $response_url] } {
  374                 if {[catch {tclwebtest::link find $community_name } errmsg] } {
  375                         aa_error  "dotlrn::twt::community_new failed $errmsg : Didn't Create a New Community"
  376                 } else {
  377                         aa_log "Create a New Community"
  378                         set response 1
  379                 }
  380         } else {
  381                 aa_error "dotlrn::twt::community_new failed, bad response url : $response_url"
  382         }
  383         twt::user::logout
  384         return $response
  385 }