OpenACS

daveb
committed
MAIN:daveb:20031102001423
on 02 Nov 03
Adding return_url to register links
/tcl/notification-email-procs.tcl (+33 -27)
8 8
9 9 }
10 10
11 11 namespace eval notification::email {
12 12
13 13     ad_proc -public get_package_id {} {
14 14         return [apm_package_id_from_key notifications]
15 15     }
16 16
17 17     ad_proc -public get_parameter {
18 18         {-name:required}
19 19         {-default ""}
20 20     } {
21 21         return [parameter::get -package_id [get_package_id] -parameter $name -default $default]
22 22     }
23 23
24 24     ad_proc -public address_domain {} {
25 25         return [get_parameter -name "EmailDomain"]
26 26     }
27 27
  28     ad_proc -public manage_notifications_url {} {
  29         return "[ad_url][apm_package_url_from_key [notification::package_key]]manage"
  30     }
  31
28 32     ad_proc -public reply_address_prefix {} {
29 33         return [get_parameter -name "EmailReplyAddressPrefix"]
30 34     }
31 35
32 36     ad_proc -private qmail_mail_queue_dir {} {
33 37         return [get_parameter -name "EmailQmailQueue"]
34 38     }
35 39
36 40     ad_proc -private parse_email_address {email} {
37 41         if {![regexp {<([^>]*)>} $email all clean_email]} {
38 42             return $email
39 43         } else {
40 44             return $clean_email
41 45         }
42 46     }
43 47
44 48     ad_proc -public reply_address {
45 49         {-object_id:required}
46 50         {-type_id:required}
47 51     } {
48 52         if {[empty_string_p $object_id] || [empty_string_p $type_id]} {
49               return [reply_address_prefix]
  53             return "[address_domain] mailer <[reply_address_prefix]@[address_domain]>"
50 54         } else {
51               return "[reply_address_prefix]-$object_id-$type_id@[address_domain]"
  55             return "[address_domain] mailer <[reply_address_prefix]-$object_id-$type_id@[address_domain]>"
52 56         }
53 57     }
54 58
55 59     ad_proc -public parse_reply_address {
56 60         {-reply_address:required}
57 61     } {
58 62         This takes a reply address, checks it for consistency, and returns a list of object_id and type_id
59 63     } {
60 64         # The pattern to match
61 65         set regexp_str "^[reply_address_prefix]-(\[0-9\]*)-(\[0-9\]*)\@"
62 66
63 67         # Check the format and extract type_id and object_id at the same time
64 68         if {![regexp $regexp_str $reply_address all object_id type_id]} {
65 69             return ""
66 70         }
67 71
68 72         return [list $object_id $type_id]
69 73     }
70 74
71  
72 75     ad_proc -public send {
73 76         to_user_id
74 77         reply_object_id
75 78         notification_type_id
76 79         subject
77 80         content
78 81     } {
79 82         Send the actual email
80 83     } {
81 84         # Get email
82 85         set email [cc_email_from_party $to_user_id]
83 86
  87        append content "\n\nGetting too much email? Manage your notifications at: [manage_notifications_url]"
  88
84 89         acs_mail_lite::send \
85 90             -to_addr $email \
86 91             -from_addr [reply_address -object_id $reply_object_id -type_id $notification_type_id] \
87 92             -subject $subject \
88 93             -body $content
89 94     }
90 95
91 96     ad_proc -private load_qmail_mail_queue {
92 97         {-queue_dir:required}
93 98     } {
94 99         Scans qmail incoming email queue and queues up messages
95 100         using acs-mail.
96 101
97           @Author dan.wickstrom@openforce.net, ben@openforce
  102         @author ben@openforce.net
  103         @author dan.wickstrom@openforce.net
98 104         @creation-date 22 Sept, 2001
99 105
100 106         @param queue_dir The location of the qmail mail queue in
101 107         the file-system.
102 108     } {
103 109         if {[catch {
104 110             set messages [glob "$queue_dir/new/*"]
105 111         } errmsg]} {
106 112             ns_log Notice "queue dir = $queue_dir/new/*, no messages"
107 113             return [list]
108 114         }
109 115
110 116         set list_of_reply_ids [list]
111 117         set new_messages_p 0
112 118
113 119         foreach msg $messages {
114 120             ns_log Notice "opening file: $msg"
115 121             if [catch {set f [open $msg r]}] {
116 122                 continue
117 123             }