Index: openacs-4/packages/acs-tcl/tcl/community-core-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/community-core-init.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/acs-tcl/tcl/community-core-init.tcl 26 Jun 2018 13:45:52 -0000 1.3 +++ openacs-4/packages/acs-tcl/tcl/community-core-init.tcl 27 Jun 2018 15:54:21 -0000 1.4 @@ -1,5 +1,5 @@ # -# Create a cache for keeping user_info +# Create a cache for keeping party_info # # The user_info_cache can be configured via the config file like the # following: @@ -20,4 +20,49 @@ -parameter PartyInfoCacheTimeout \ -default 3600] +# +# Create a cache for keeping person_info +# +# The user_info_cache can be configured via the config file like the +# following: +# +# ns_section ns/server/${server}/acs/acs-tcl +# ns_param PersonInfoCacheSize 2000000 +# ns_param PersonInfoCacheTimeout 3600 +# +# The timeout is responsible, how precise/recent e.g. last_visit should be. +# +ns_cache create person_info_cache \ + -size [parameter::get \ + -package_id [apm_package_id_from_key acs-tcl] \ + -parameter PersonInfoCacheSize \ + -default 2000000] \ + -timeout [parameter::get \ + -package_id [apm_package_id_from_key acs-tcl] \ + -parameter PersonInfoCacheTimeout \ + -default 3600] + +# +# Create a cache for keeping user_info +# +# The user_info_cache can be configured via the config file like the +# following: +# +# ns_section ns/server/${server}/acs/acs-tcl +# ns_param UserInfoCacheSize 2000000 +# ns_param UserInfoCacheTimeout 3600 +# +# The timeout is responsible, how precise/recent e.g. last_visit should be. +# +ns_cache create user_info_cache \ + -size [parameter::get \ + -package_id [apm_package_id_from_key acs-tcl] \ + -parameter UserInfoCacheSize \ + -default 2000000] \ + -timeout [parameter::get \ + -package_id [apm_package_id_from_key acs-tcl] \ + -parameter UserInfoCacheTimeout \ + -default 3600] + + Index: openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl,v diff -u -r1.85 -r1.86 --- openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl 27 Jun 2018 09:05:03 -0000 1.85 +++ openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl 27 Jun 2018 15:54:21 -0000 1.86 @@ -17,7 +17,8 @@ } { Is this party a person? } { - return [string is true -strict [party::get -party_id $party_id -element person_p]] + set person [person::get_person_info -person_id $party_id] + return [expr {[llength $person] > 0}] } ad_proc -public person::new { @@ -42,33 +43,141 @@ delete a person } { db_exec_plsql delete_person {} - party::flush_cache -party_id $person_id + person::flush_cache -person_id $person_id } ad_proc -public person::get { {-person_id:required} + {-element ""} } { - Get info for a person as a Tcl array in list form. - - This function will be probably deprecated in the future: please use - the new generic party API. + Get person information together with inherited party and object + one. If person-only information is what you need, probably a + better choice would be person::get_person_info. + @param element if specified, only value in dict with this key will + be returned. + + @see person::get_person_info @see party::get + + @return a dict or a single string value if -element + was specified. } { - return [party::get -party_id $person_id] + set data [party::get -party_id $person_id] + # no party found = no user + if {[llength $data] == 0} { + return [list] + } + + # query person info only if we don't have what was asked for already + if {$element eq "" || ![dict exists $data $element]} { + lappend data {*}[person::get_person_info -person_id $person_id] + } + + if {$element ne ""} { + set data [expr {[dict exists $data $element] ? + [dict get $data $element] : ""}] + } + + return $data } +ad_proc -public person::get_person_info { + -person_id:required + {-element ""} +} { + Extracts person information. Differently from person::get this + proc won't return generic party information. + + @param element if specified, only value in dict with this key will + be returned. + + @see person::get + + @return a dict or a single string value if -element + was specified. +} { + set key [list get_person_info $person_id] + + set person [ns_cache eval person_info_cache $key { + person::get_person_info_not_cached -person_id $person_id + }] + + # don't cache invalid persons + if {[llength $person] == 0} { + ns_cache flush person_info_cache $key + } + + if {$element ne ""} { + return [expr {[dict exists $person $element] ? + [dict get $person $element] : ""}] + } else { + return $person + } +} + +ad_proc -public person::get_person_info_not_cached { + {-person_id:required} +} { + Extracts person information. Differently from person::get this + proc won't return generic party information. + + @see person::get +} { + set person_p [db_0or1row get_person_info { + select person_id, + first_names, + last_name, + first_names, first_names || ' ' || last_name as name, + bio + from persons + where person_id = :person_id + } -column_array person] + + if {$person_p} { + return [array get person] + } else { + return [list] + } +} + +ad_proc -public person::flush_person_info { + {-person_id:required} +} { + Flush only info coming from person::get_person_info proc. + + @see person::get_person_info +} { + set key [list get_person_info $person_id] + ns_cache flush person_info_cache $key +} + ad_proc -public person::name_flush { {-person_id:required} {-email ""} } { Flush the person::name cache. - - This function will be probably deprecated in the future: please use - the new generic party API. + This function as been renamed and will be deprecated in the + future. Please use suggested alternative. + + @see person::flush_person_info +} { + person::flush_person_info -person_id $person_id +} + +ad_proc -public person::flush_cache { + {-person_id:required} +} { + Flush all caches for specified person. This makes sense when we + really want all person information to be flushed. Finer-grained + procs exist and should be used when is clear what we want to + delete. + + @see person::flush_person_info @see party::flush_cache } { + person::flush_person_info -person_id $person_id party::flush_cache -party_id $person_id } @@ -77,13 +186,13 @@ {-email ""} } { Return the name of a person. - - This function will be probably deprecated in the future: please use - the new generic party API. @see party::get } { - return [party::get -party_id $person_id -email $email -element name] + if {$person_id eq ""} { + set person_id [party::get_by_email -email $email] + } + return [person::get_person_info -person_id $person_id -element name] } ad_proc -public person::update { @@ -95,7 +204,7 @@ } { db_dml update_person {} db_dml update_object_title {} - party::flush_cache -party_id $person_id + person::flush_cache -person_id $person_id } # DRB: Though I've moved the bio field to type specific rather than generic storage, I've @@ -129,7 +238,7 @@ upvar $exists_var exists_p } - set bio [party::get -party_id $person_id -element bio] + set bio [person::get_person_info -person_id $person_id -element bio] set exists_p [expr {$bio ne ""}] @@ -148,7 +257,7 @@ @author Lars Pind (lars@collaboraid.biz) } { db_dml update_bio {} - party::flush_cache -party_id $person_id + person::flush_person_info -person_id $person_id } @@ -165,7 +274,8 @@ } membership_rel::change_state -rel_id $rel_id -state $state - party::flush_cache -party_id $user_id + # flush user-specific info + acs_user::flush_user_info -user_id $user_id } ad_proc -public acs_user::approve { @@ -218,7 +328,7 @@ # must be removed manually acs_user::erase_portrait -user_id $user_id db_exec_plsql permanent_delete {} - party::flush_cache -party_id $user_id + acs_user::flush_cache -user_id $user_id } } @@ -239,12 +349,15 @@ set authority_id [auth::authority::local] } - set key [list get_by_username -authority_id $authority_id -username $username] + set key [list get_by_username \ + -authority_id $authority_id -username $username] set user_id [ns_cache eval party_info_cache $key { acs_user::get_by_username_not_cached \ -authority_id $authority_id \ -username $username }] + + # don't cache invalid usernames if {$user_id eq ""} { ns_cache flush party_info_cache $key } @@ -275,56 +388,44 @@ {-array} {-include_bio:boolean} } { - Get basic information about a user. You may supply either user_id, - or username. If you supply username, you may also supply - authority_id, or you may leave it out, in which case it defaults - to the local authority. If you supply neither user_id nor - username, and we have a connection, the currently logged in user - will be assumed. + Get all information about a user, together with related person, + party and object information. In case only user-specific + information was needed, probably a better alternative could be + acs_user::get_person_info.
+
+ The attributes returned are all those retrieved by person::get and + acs_user::get_person_info. - @param user_id The user_id of the user to get the bio for. Leave blank for current user. + + @param user_id User id to retrieve. Defaults to currently connected user. + @param authority_id if user_id was not specified, but a username + was given, this proc will try to retrieve a + user_id from username and authority. If + authority_id is lect blank, will default to + the local authority. + @param username if specified and no user_id was give, will be used + to retrieve user_id from the authority. If no + user_id and no username were specified, proc will + default to currently connected user. @param element If specified, only this element in the dict will be returned. If an array was specified, This function will contain only this element. @option include_bio Whether to include the bio in the user information. This flag is deprecated and bio will be now always returned. - @param array The name of an array into which you want the information put. + @param array The name of an array into which you want the + information put. This parameter is not mandatory, and + the actual suggested way to retrieve information from + this proc is to just set a variable from the return + value and use it as a dict. - The attributes returned are: + @see acs_user::get_person_info + @see person::get - - @result dict of attributes + @return dict or a single string value if the -element + parameter was specified. + @author Lars Pind (lars@collaboraid.biz) } { if { $user_id eq "" } { @@ -335,8 +436,22 @@ [ad_conn user_id]}] } - set data [party::get -party_id $user_id -element $element] + set data [person::get -person_id $user_id] + # no person found = no user + if {[llength $data] == 0} { + return [list] + } + # query user info only if we don't have what was asked for already + if {$element eq "" || ![dict exists $data $element]} { + lappend data {*}[acs_user::get_user_info -user_id $user_id] + } + + if {$element ne ""} { + set data [expr {[dict exists $data $element] ? + [dict get $data $element] : ""}] + } + if {$include_bio_p} { ns_log warning "acs_user::get: -include_bio flag is deprecated. Bio will be returned in any case." } @@ -353,19 +468,123 @@ return $data } +ad_proc acs_user::get_user_info { + -user_id:required + {-element ""} +} { + Extracts user information. Differently from acs_user::get this + proc won't return generic party information. + + @param element if specified, only value with this key in the dict + will be returned. + + @see acs_user::get + + @return dict or a single string value if the -element + parameter was specified. +} { + set key [list get_user_info $user_id] + + set user [ns_cache eval user_info_cache $key { + acs_user::get_user_info_not_cached -user_id $user_id + }] + + # don't cache invalid users + if {[llength $user] == 0} { + ns_cache flush user_info_cache $key + } + + if {$element ne ""} { + return [expr {[dict exists $user $element] ? + [dict get $user $element] : ""}] + } else { + return $user + } +} + +ad_proc -private acs_user::get_user_info_not_cached { + -user_id:required +} { + Extracts user information. Differently from acs_user::get this + proc won't return generic party information. + + @return a dict +} { + set registered_users_group_id [acs_magic_object "registered_users"] + set user_p [db_0or1row user_info { + select u.user_id, + u.authority_id, + u.username, + u.screen_name, + u.priv_name, + u.priv_email, + u.email_verified_p, + u.email_bouncing_p, + u.no_alerts_until, + u.last_visit, + to_char(last_visit, 'YYYY-MM-DD HH24:MI:SS') as last_visit_ansi, + u.second_to_last_visit, + to_char(second_to_last_visit, 'YYYY-MM-DD HH24:MI:SS') as second_to_last_visit_ansi, + u.n_sessions, + u.password, + u.salt, + u.password_question, + u.password_answer, + u.password_changed_date, + extract(day from current_timestamp - password_changed_date) as password_age_days, + u.auth_token, + mm.rel_id, + mr.member_state = 'approved' as registered_user_p, + mr.member_state + from users u + left join group_member_map mm on mm.member_id = u.user_id + and mm.group_id = mm.container_id + and mm.group_id = :registered_users_group_id + and mm.rel_type = 'membership_rel' + left join membership_rels mr on mr.rel_id = mm.rel_id + where u.user_id = :user_id + } -column_array user] + + if {$user_p} { + return [array get user] + } else { + return [list] + } +} + +ad_proc -public acs_user::flush_user_info { + {-user_id:required} +} { + Flush only info coming from acs_user::get_user_info proc. This + includes also lookup by username, because username and + authority_id might also have changed. + + @see acs_user::get_user_info +} { + set user [acs_user::get -user_id $user_id] + ns_cache flush user_info_cache [list get_by_username \ + -authority_id [dict get $user authority_id] \ + -username [dict get $user username]] + ns_cache flush user_info_cache [list get_user_info $user_id] +} + ad_proc -public acs_user::flush_cache { {-user_id:required} } { - Flush the acs_user::get cache for the given user_id. - - This function will be probably deprecated in the future: please use - the new generic party API. + Flush all caches for specified user. This makes sense when we + really want all user information to be flushed. Finer-grained + procs exist and should be used when is clear what we want to + delete. - @see party::flush_cache + @see acs_user::flush_user_info + @see acs_user::flush_portrait + @see person::flush_cache @author Peter Marklund } { - party::flush_cache -party_id $user_id + acs_user::flush_user_info -user_id $user_id + acs_user::flush_portrait -user_id $user_id + person::flush_cache -person_id $user_id } ad_proc -public acs_user::get_element { @@ -376,7 +595,7 @@ } { Get a particular element from the basic information about a user returned by acs_user::get. Throws an error if the element does not exist. - + This function will be probably deprecated in the future: please use the new 'element' parameter in acs_user::get @@ -422,8 +641,7 @@ } } db_dml user_update {} - - party::flush_cache -party_id $user_id + acs_user::flush_user_info -user_id $user_id } ad_proc -public acs_user::get_user_id_by_screen_name { @@ -471,7 +689,10 @@ if { $user_id eq ""} { set user_id [ad_conn user_id] } - return [party::get -party_id $user_id -element registered_user_p] + set registered_p [acs_user::get_user_info \ + -user_id $user_id \ + -element registered_user_p] + return [string is true -strict $registered_p] } @@ -494,7 +715,7 @@ This function will be probably deprecated in the future: please use the new generic party API. - + @return the parties email. @see party::get } { @@ -530,7 +751,7 @@ }] # don't cache invalid parties - if {[llength [dict keys $data]] == 0} { + if {[llength $data] == 0} { ns_cache flush party_info_cache $key } @@ -555,8 +776,6 @@ @return dict containing party information. If no party was found, an empty dict will be returned. } { - set registered_users_group_id [acs_magic_object "registered_users"] - set party_p [db_0or1row party_info { select o.object_id, o.object_type, @@ -572,59 +791,15 @@ o.modifying_ip, pa.party_id, pa.email, - pa.url, - pe.person_id, - pe.person_id is not null as person_p, - pe.first_names, - pe.last_name, - pe.first_names || ' ' || pe.last_name as name, - pe.bio, - u.user_id, - u.user_id is not null as user_p, - u.authority_id, - u.username, - u.screen_name, - u.priv_name, - u.priv_email, - u.email_verified_p, - u.email_bouncing_p, - u.no_alerts_until, - u.last_visit, - to_char(last_visit, 'YYYY-MM-DD HH24:MI:SS') as last_visit_ansi, - u.second_to_last_visit, - to_char(second_to_last_visit, 'YYYY-MM-DD HH24:MI:SS') as second_to_last_visit_ansi, - u.n_sessions, - u.password, - u.salt, - u.password_question, - u.password_answer, - u.password_changed_date, - extract(day from current_timestamp - password_changed_date) as password_age_days, - u.auth_token, - mm.rel_id, - mr.member_state = 'approved' as registered_user_p, - mr.member_state, - g.group_id, - g.group_id is not null as group_p, - g.group_name, - g.description as group_description, - g.join_policy - from parties pa - left join persons pe on pa.party_id = pe.person_id - left join users u on pe.person_id = u.user_id - left join group_member_map mm on mm.member_id = u.user_id - and mm.group_id = mm.container_id - and mm.group_id = :registered_users_group_id - and mm.rel_type = 'membership_rel' - left join membership_rels mr on mr.rel_id = mm.rel_id - left join groups g on g.group_id = pa.party_id, + pa.url + from parties pa, acs_objects o where o.object_id = pa.party_id and pa.party_id = :party_id } -column_array row] if {!$party_p} { - return {} + return [list] } else { return [array get row] } @@ -635,21 +810,13 @@ } { Flush the party cache } { - set party [party::get -party_id $party_id] + set email [party::get -party_id $party_id -element email] set keys [list] lappend keys \ [list get $party_id] \ - [lappend keys [list get_by_email [dict get $party email]] + [list get_by_email $email] - if {[dict get $party user_p]} { - lappend keys \ - [list get_portrait_id -user_id $party_id] \ - [list get_by_username \ - -authority_id [dict get $party authority_id] \ - -username [dict get $party username]] - } - foreach key $keys { ns_cache flush party_info_cache $key } @@ -780,6 +947,16 @@ return [expr {$item_id ne "" ? $item_id : 0}] } +ad_proc -private acs_user::flush_portrait { + {-user_id:required} +} { + Flush the portrait cache for specified user +} { + # Flush the portrait cache + set key [list get_portrait_id -user_id $user_id] + ns_cache flush user_info_cache $key +} + ad_proc -public acs_user::create_portrait { {-user_id:required} {-description ""} @@ -848,9 +1025,7 @@ content::item::delete -item_id $item_id } - # Flush the portrait cache - set key [list get_portrait_id -user_id $user_id] - ns_cache flush user_info_cache $key + acs_user::flush_portrait -user_id $user_id } # Local variables: