Index: openacs-4/packages/acs-authentication/tcl/authority-procs-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/authority-procs-oracle.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-authentication/tcl/authority-procs-oracle.xql 27 Aug 2003 13:10:15 -0000 1.1
@@ -0,0 +1,41 @@
+
+
+
+ oracle8.1.6
+
+
+
+ begin
+ :1 := authority.new(
+ authority_id => :authority_id,
+ null, -- object_type
+ short_name => :short_name,
+ pretty_name => :pretty_name,
+ enabled_p => :enabled_p,
+ sort_order => :sort_order,
+ auth_impl_id => :auth_impl_id,
+ pwd_impl_id => :pwd_impl_id,
+ forgotten_pwd_url => :forgotten_pwd_url,
+ change_pwd_url => :change_pwd_url,
+ register_impl_id => :register_impl_id,
+ register_url => :register_url,
+ help_contact_text => :help_contact_text,
+ creation_user => :creation_user,
+ creation_ip => :creation_ip,
+ context_id => :context_id
+ );
+ end;
+
+
+
+
+
+ begin
+ :1 := authority.del(
+ authority_id => :authority_id
+ );
+ end;
+
+
+
+
Index: openacs-4/packages/acs-authentication/tcl/authority-procs-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/authority-procs-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-authentication/tcl/authority-procs-postgresql.xql 27 Aug 2003 13:10:15 -0000 1.1
@@ -0,0 +1,37 @@
+
+
+
+ postgresql7.1
+
+
+
+ select authority__new(
+ :authority_id,
+ null, -- object_type
+ :short_name,
+ :pretty_name,
+ :enabled_p,
+ :sort_order,
+ :auth_impl_id,
+ :pwd_impl_id,
+ :forgotten_pwd_url,
+ :change_pwd_url,
+ :register_impl_id,
+ :register_url,
+ :help_contact_text,
+ :creation_user,
+ :creation_ip,
+ :context_id
+ );
+
+
+
+
+
+ select authority__del(
+ :authority_id
+ );
+
+
+
+
Index: openacs-4/packages/acs-authentication/tcl/authority-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/authority-procs.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-authentication/tcl/authority-procs.tcl 22 Aug 2003 16:15:23 -0000 1.2
+++ openacs-4/packages/acs-authentication/tcl/authority-procs.tcl 27 Aug 2003 13:10:15 -0000 1.3
@@ -130,15 +130,19 @@
}
}
- lappend names "autority_id"
+ if { ![exists_and_not_null context_id] } {
+ set context_id [ad_conn package_id]
+ }
- db_dml insert_authority "
- insert into auth_authorities (
- [join $names ", "]
- ) values (
- :[join $names ", :"]
- )
- "
+ if { ![exists_and_not_null creation_user] } {
+ set creation_user [ad_conn user_id]
+ }
+
+ if { ![exists_and_not_null creation_ip] } {
+ set creation_ip [ad_conn peeraddr]
+ }
+
+ set authority_id [db_exec_plsql create_authority {}]
}
return $authority_id
@@ -261,3 +265,10 @@
"
}
+ad_proc -public auth::authority::delete {
+ {-authority_id:required}
+} {
+ Delete an authority.
+} {
+ db_exec_plsql delete_authority {}
+}
Index: openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl 27 Aug 2003 11:50:48 -0000 1.4
+++ openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl 27 Aug 2003 13:10:15 -0000 1.5
@@ -259,12 +259,16 @@
return
}
- array set password_result [auth::password::forgotten \
- -authority_id $test_vars(authority_id) \
- -username $test_vars(username)]
+ aa_run_with_teardown \
+ -rollback \
+ -test_code {
+ array set password_result [auth::password::forgotten \
+ -authority_id $test_vars(authority_id) \
+ -username $test_vars(username)]
- aa_equals "status ok" $password_result(password_status) "ok"
- aa_true "non-empty message" [expr ![empty_string_p $password_result(password_message)]]
+ aa_equals "status ok" $password_result(password_status) "ok"
+ aa_true "non-empty message" [expr ![empty_string_p $password_result(password_message)]]
+ }
}
aa_register_case auth_password_get_forgotten_url {
@@ -350,6 +354,81 @@
}
}
+###########
+#
+# Authority Management API
+#
+###########
+
+aa_register_case auth_authority_api {
+ Test the auth::authority::create, auth::authority::edit, and auth::authority::delete procs.
+
+ @author Simon Carstensen
+} {
+ aa_run_with_teardown \
+ -rollback \
+ -test_code {
+
+ # Add authority and test that it was added correctly.
+ array set columns {
+ short_name "test"
+ pretty_name "Test authority"
+ help_contact_text "Blah blah"
+ enabled_p "t"
+ sort_order "1000"
+ auth_impl_id ""
+ pwd_impl_id ""
+ forgotten_pwd_url ""
+ change_pwd_url ""
+ register_impl_id ""
+ register_url ""
+ }
+
+
+ set authority_id [auth::authority::create -array columns]
+
+ set authority_added_p [db_string authority_added_p {
+ select count(*) from auth_authorities where authority_id = :authority_id
+ } -default "0"]
+
+ aa_true "was the authority added?" $authority_added_p
+
+ # Edit authority and test that it has actually changed.
+ array set columns {
+ short_name "test2"
+ pretty_name "Test authority2"
+ help_contact_text "Blah blah2"
+ enabled_p "f"
+ sort_order "1001"
+ forgotten_pwd_url "foobar.com"
+ change_pwd_url "foobar.com"
+ register_url "foobar.com"
+ }
+
+ auth::authority::edit \
+ -authority_id $authority_id \
+ -array columns
+
+ auth::authority::get \
+ -authority_id $authority_id \
+ -array edit_result
+
+ foreach column [array names columns] {
+ aa_equals "edited column $column" $edit_result($column) $columns($column)
+ }
+
+ # Delete authority and test that it was actually added.
+ auth::authority::delete -authority_id $authority_id
+
+ set authority_exists_p [db_string authority_added_p {
+ select count(*) from auth_authorities where authority_id = :authority_id
+ } -default "0"]
+
+ aa_false "was the authority deleted?" $authority_exists_p
+ }
+}
+
+
#####
#
# Helper procs