Index: openacs-4/packages/contacts/tcl/contacts-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/tcl/contacts-procs.tcl,v diff -u -r1.19 -r1.20 --- openacs-4/packages/contacts/tcl/contacts-procs.tcl 1 Jul 2005 00:35:05 -0000 1.19 +++ openacs-4/packages/contacts/tcl/contacts-procs.tcl 6 Jul 2005 23:38:22 -0000 1.20 @@ -15,6 +15,7 @@ namespace eval contact::special_attributes:: {} namespace eval contact::rels:: {} + ad_proc -public contacts::default_group { {-package_id ""} } { @@ -157,12 +158,28 @@ } +ad_proc -public contact::link { + {-party_id:required} +} { + this returns the contact's name. Cached +} { + set contact_name [contact::name -party_id $party_id] + if { ![empty_string_p $contact_name] } { + set contact_url [contact::url -party_id $party_id] + return "${contact_name}" + } else { + return {} + } +} + ad_proc -public contact::type { {-party_id:required} } { returns the contact type } { - if {[contact::person_p -party_id $party_id]} { + if {[contact::user_p -party_id $party_id]} { + return "user" + } elseif {[contact::person_p -party_id $party_id]} { return "person" } elseif {[contact::organization_p -party_id $party_id]} { return "organization" @@ -206,6 +223,26 @@ } } +ad_proc -public contact::user_p { + {-party_id:required} +} { + is this party a user? Cached +} { + return [util_memoize [list ::contact::user_p_not_cached -party_id $party_id]] +} + +ad_proc -public contact::user_p_not_cached { + {-party_id:required} +} { + is this party a person? Cached +} { + if {[db_0or1row contact_user_exists_p {select '1' from users where user_id = :party_id}]} { + return 1 + } else { + return 0 + } +} + ad_proc -public contact::organization_p { {-party_id:required} } { @@ -273,6 +310,27 @@ } } +ad_proc -private contact::person_upgrade_to_user { + {-person_id ""} +} { + Upgrade a person to a user. This proc does not send an email to the newly created user. +} { + contact::flush -party_id $person_id + ns_log Notice "set username [contact::email -party_id $person_id]" + db_transaction { + set username [contact::email -party_id $person_id] + set user_id $person_id + set extra_vars [ns_set create] + oacs_util::vars_to_ns_set -ns_set $extra_vars -var_list {user_id username} + package_instantiate_object -extra_vars $extra_vars user + # we reset the password in admin mode. this means that an email + # will not automatically be sent. + auth::password::reset -authority_id [auth::authority::local] -username $username -admin + } on_error { + error "There was an error in contact::person_upgrade_to_user: $errmsg" + } +} + ad_proc -private contact::group::new { {-group_id ""} {-email ""} @@ -366,19 +424,17 @@ -form:required } { } { - set object_type [contact::type \ - -party_id $party_id] + set object_type [contact::type -party_id $party_id] db_1row get_extra_info { select email, url from parties where party_id = :party_id} set element_list [list email url] - if {$object_type == "person" } { + if { [lsearch [list person user] $object_type] >= 0 } { - array set person [person::get \ - -person_id $party_id] + array set person [person::get -person_id $party_id] set first_names $person(first_names) set last_name $person(last_name) @@ -406,10 +462,9 @@ -form:required } { } { - set object_type [contact::type \ - -party_id $party_id] + set object_type [contact::type -party_id $party_id] set element_list [list email url] - if {$object_type == "person" } { + if { [lsearch [list person user] $object_type] >= 0 } { lappend element_list first_names last_name } elseif {$object_type == "organization" } { lappend element_list name legal_name reg_number notes @@ -438,7 +493,7 @@ } } } - if {$object_type == "person" } { + if { [lsearch [list person user] $object_type] >= 0 } { # first_names and last_name are required Index: openacs-4/packages/contacts/www/contact-add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/www/contact-add.tcl,v diff -u -r1.23 -r1.24 --- openacs-4/packages/contacts/www/contact-add.tcl 1 Jul 2005 22:46:04 -0000 1.23 +++ openacs-4/packages/contacts/www/contact-add.tcl 6 Jul 2005 23:37:19 -0000 1.24 @@ -101,10 +101,10 @@ if { $object_type == "person" } { ad_form -extend -name party_ae \ -form { - {create_user_p:text(radio) - {label "[_ contacts.Create_user]"} - {options {{[_ acs-kernel.common_Yes] "t"} {[_ acs-kernel.common_no] "f"}}} - {values "f"} + {create_user_p:text(checkbox),optional + {label ""} + {options {{"[_ contacts.Create_a_user_account_for_this_person]" "t"}}} + {values ""} } } set title "[_ contacts.Add_a_Person]" @@ -138,9 +138,8 @@ } -edit_request { } -on_submit { - # MGEDDERT: I NEED TO MAKE SURE THAT VALUES THAT NEED TO BE UNIQUE ARE UNIQUE - # for orgs name needs to be unique + # for users username needs to be unique # for all of them email needs to be unique if { $object_type == "person" } { @@ -150,11 +149,37 @@ if { ![exists_and_not_null last_name] } { template::element::set_error party_ae last_name "[_ contacts.lt_Last_Name_is_required]" } + if { $create_user_p == "t" } { + if { ![exists_and_not_null email] } { + template::element::set_error party_ae email "[_ contacts.lt_Email_Address_is_required_for_users]" + } else { + set other_user_id [acs_user::get_by_username -username $email] + if { ![empty_string_p $other_user_id] } { + set another_user [contact::link -party_id $other_user_id] + template::element::set_error party_ae email "[_ contacts.lt_-another_user-_already_uses_this_username]" + } + } + } } else { if { ![exists_and_not_null name] } { template::element::set_error party_ae name "[_ contacts.Name_is_required]" - } + } else { + set other_organization_id [organization::get_by_name -name $name] + if { ![empty_string_p $other_organization_id] } { + set another_organization [contact::link -party_id $other_organization_id] + template::element::set_error party_ae name "[_ contacts.lt_-another_organization-_already_uses_this_name]" + } + } } + + if { [exists_and_not_null email] } { + set other_party_id [party::get_by_email -email $email] + if { ![empty_string_p $other_party_id] } { + set another_contact [contact::link -party_id $other_party_id] + template::element::set_error party_ae email "[_ contacts.lt_-another_contact-_already_uses_this_email]" + } + } + if { ![template::form::is_valid party_ae] } { break } @@ -180,64 +205,35 @@ } -new_data { if { $object_type == "person" } { - if { ![exists_and_not_null email] } { - set email "$party_id@bogusdomain.com" - set username $party_id - } - if { ![exists_and_not_null username] } { - set username $email - } + if { ![exists_and_not_null url] } { set url "" } - if {$create_user_p == "f"} { - # Initialize Party Entry - # We do not want to create a new user with each contact - template::form create add_party - template::element create add_party email -value "$email" - template::element create add_party first_names -value "$first_names" - template::element create add_party last_name -value "$last_name" - template::element create add_party url -value "$url" - - set party_id [party::new -party_id $party_id -form_id add_party person] - - } else { - - array set creation_info [auth::create_user \ - -user_id $party_id \ - -verify_password_confirm \ - -username $email \ - -email $email \ - -first_names $first_names \ - -last_name $last_name \ - -screen_name "" \ - -password "" \ - -password_confirm "" \ - -url $url \ - -secret_question "" \ - -secret_answer ""] - if { ![string equal $creation_info(creation_status) "ok"] } { - ad_return_error "Error" "contacts/www/contact add user error: \n creation_status \n $creation_info(creation_status) \n creation_message \n $creation_info(creation_message) \n element_messages \n $creation_info(element_messages)" - error $creation_info(creation_status) - } - } - - - if { "$email" == "$party_id@bogusdomain.com" } { - # we need to delete the party email address - party::update -party_id $party_id -email "" -url $url - } - - - foreach group_id $group_ids { - group::add_member \ - -group_id $group_id \ - -user_id $party_id \ - -rel_type "membership_rel" - } - - + # Initialize Person + template::form create add_party + template::element create add_party email -value "$email" + template::element create add_party first_names -value "$first_names" + template::element create add_party last_name -value "$last_name" + template::element create add_party url -value "$url" + set party_id [party::new -party_id $party_id -form_id add_party person] + # party::new does not correctly save email address + party::update -party_id $party_id -email $email -url $url + + # in order to create a user we need a valid unique username (i.e. their email address). + # the on_submit block has already validated that this is in fact a valid and unique + # email address which will serve as their username + if { $create_user_p == "t" } { + contact::person_upgrade_to_user -person_id $party_id + } + + foreach group_id $group_ids { + group::add_member \ + -group_id $group_id \ + -user_id $party_id \ + -rel_type "membership_rel" + } + callback contact::person_new -package_id $package_id -contact_id $party_id } else { @@ -305,7 +301,9 @@ } # Add the user to the - util_user_message -html -message "The $object_type [contact::name -party_id $party_id] was added" + set contact_link [contact::link -party_id $party_id] + set object_type [_ contacts.$object_type] + util_user_message -html -message "[_ contacts.lt_The_-object_type-_-contact_link-_was_added]" } -after_submit { contact::flush -party_id $party_id