- Publicity: Public Only All
notification-callback-procs.tcl
Library for Notification's callback implementations
- Location:
- packages/notifications/tcl/notification-callback-procs.tcl
- Created:
- July 19, 2005
- Author:
- Enrique Catalan
- CVS Identification:
$Id: notification-callback-procs.tcl,v 1.7.2.3 2023/07/10 09:41:43 gustafn Exp $
Procedures in this file
Detailed information
[ hide source ] | [ make this the default ]Content File Source
ad_library { Library for Notification's callback implementations @creation-date July 19, 2005 @author Enrique Catalan <quio@galileo.edu> @cvs-id $Id: notification-callback-procs.tcl,v 1.7.2.3 2023/07/10 09:41:43 gustafn Exp $ } d_proc -callback merge::MergeShowUserInfo -impl notifications { -user_id:required } { Show the notifications of user_id } { set result [list "Notifications of $user_id"] set user_notifications [db_list_of_lists user_notification {}] lappend result $user_notifications return $result } d_proc -callback merge::MergePackageUser -impl notifications { -from_user_id:required -to_user_id:required } { Merge the notifications of two users. } { set msg "Merging notifications" set result [list $msg] ns_log Notice $msg db_transaction { db_dml upd_notifications {} db_dml upd_map {} lappend result "Notifications merge is done" } return $result } d_proc -public -callback acs_mail_lite::incoming_email -impl notifications { -array:required -package_id } { Implementation of the interface acs_mail_lite::incoming_email for notifications. Notification listens to replies sent out initially from notifications. According to the notification signature <EmailReplyAddressPrefix>$object_id-$type_id@<EmailDomain> it tries to figure out for which notification type the email was from. <p>The type corresponds to the service contract implementation. If the object_id exists notification creates an entry in the table notification_email_hold and tries to inform implementations of acs_mail_lite::incoming_email interested. Since the service contract NotificationType is implemented only once for a package the table acs_mail_lite_reply_prefixes is used simply figure out which package corresponds to the found type_id and has a valid package key. If a package key is found the callback implementation is called. @author Nima Mazloumi (nima.mazloumi@gmx.de) @creation-date 2005-07-15 @param array An array with all headers, files and bodies. To access the array you need to use upvar. @param package_id The package instance that registered the prefix @return nothing @error } { upvar $array email set is_auto_reply_p 0 #TODO: we need to check if it Auto-Submitted header exists or "Out of Office AutoReply" in Subject if { $is_auto_reply_p } { ns_log Notice "acs_mail_lite::incoming_email -impl notifications: message $email(message-id) is from an auto-responder, skipping" } set from [notification::email::parse_email_address $email(from)] set to [notification::email::parse_email_address $email(to)] set to_stuff [notification::email::parse_reply_address -reply_address $to] # We don't accept a bad incoming email address if {$to_stuff eq ""} { # This is not an e-mail notification can work with. Maybe bounce ? return } # Find the user_id of the sender ns_log Notice "acs_mail_lite::incoming_email -impl notifications: from $from" set user_id [party::get_by_email -email $from] # We don't accept empty users for now if {$user_id eq ""} { ns_log Notice "acs_mail_lite::incoming_email -impl notifications: Unknown sender with email $from. Bouncing message." # bounce message with an informative error. notification::email::bounce_mail_message \ -to_addr $from \ -from_addr $to \ -body $email(bodies) \ -message_headers $email(headers) \ -reason "Invalid sender. You must be a member of the site and\nyour From address must match your registered address." return } lassign $to_stuff object_id type_id set to_addr $to set headers $email(headers) set bodies $email(bodies) db_transaction { ns_log Notice "acs_mail_lite::incoming_email -impl notifications: Creating a reply for user: $user_id, object: object_id: $object_id, type_id: $type_id." set reply_id [notification::reply::new \ -object_id $object_id \ -type_id $type_id \ -from_user $user_id \ -subject $email(subject) \ -content $email(bodies)] db_dml holdinsert {} #extending email array for notification callback implementers set email(object_id) $object_id set email(type_id) $type_id set email(reply_id) $reply_id set email(user_id) $user_id if {[db_0or1row select_impl { select impl_owner_name as package_key from acs_sc_impls where impl_id = (select min(sc_impl_id) from notification_types where type_id = :type_id) }]} { ns_log Notice "acs_mail_lite::incoming_email -impl notifications: calling notifications::incoming_email implementation for package $package_key" if { [catch {callback -impl $package_key notifications::incoming_email -array email} error] } { ns_log Notice "acs_mail_lite::incoming_email -impl notifications: $error" } } else { ns_log Notice "acs_mail_lite::incoming_email -impl notifications: No corresponding package registered for type_id $type_id" } } on_error { ns_log Error "acs_mail_lite::incoming_email -impl notifications: error inserting incoming email into the queue: $errmsg" } } d_proc -public -callback notifications::incoming_email { -array:required } { } - # Local variables: # mode: tcl # tcl-indent-level: 4 # indent-tabs-mode: nil # End: