1 # This module is part of debbugs, and is released
2 # under the terms of the GPL version 2, or any later version. See the
3 # file README and COPYING for more information.
4 # Copyright 2008 by Don Armstrong <don@donarmstrong.com>.
5 # $Id: perl_module_header.pm 1221 2008-05-19 15:00:40Z don $
7 package Debbugs::Recipients;
11 Debbugs::Recipients -- Determine recipients of messages from the bts
27 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
28 use Exporter qw(import);
31 ($VERSION) = q$Revision: 1221 $ =~ /^Revision:\s+([^\s+])/;
32 $DEBUG = 0 unless defined $DEBUG;
35 %EXPORT_TAGS = (add => [qw(add_recipients)],
36 det => [qw(determine_recipients)],
39 Exporter::export_ok_tags(keys %EXPORT_TAGS);
40 $EXPORT_TAGS{all} = [@EXPORT_OK];
44 use Debbugs::Config qw(:config);
45 use Params::Validate qw(:types validate_with);
46 use Debbugs::Common qw(:misc :util);
47 use Debbugs::Status qw(splitpackages isstrongseverity);
49 use Debbugs::Packages qw(binary_to_source);
51 use Debbugs::Mail qw(get_addresses);
57 add_recipients(data => $data,
58 recipients => \%recipients;
61 Given data (from read_bug or similar) (or an arrayref of data),
62 calculates the addresses which need to receive mail involving this
67 =item data -- Data from read_bug or similar; can be an arrayref of data
69 =item recipients -- hashref of recipient data structure; pass to
70 subsequent calls of add_recipients or
72 =item debug -- optional
82 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
83 my %param = validate_with(params => \@_,
84 spec => {data => {type => HASHREF|ARRAYREF,
86 recipients => {type => HASHREF,
88 debug => {type => HANDLE|SCALARREF,
91 transcript => {type => HANDLE|SCALARREF,
94 actions_taken => {type => HASHREF,
97 unknown_packages => {type => HASHREF,
103 $param{transcript} = globify_scalar($param{transcript});
104 $param{debug} = globify_scalar($param{debug});
105 if (ref ($param{data}) eq 'ARRAY') {
106 for my $data (@{$param{data}}) {
107 add_recipients(data => $data,
108 map {exists $param{$_}?($_,$param{$_}):()}
109 qw(recipients debug transcript actions_taken unknown_packages)
115 my $ref = $param{data}{bug_num};
116 for my $p (splitpackages($param{data}{package})) {
118 if (defined $config{subscription_domain}) {
119 my @source_packages = binary_to_source(binary => $p,
122 if (@source_packages) {
123 for my $source (@source_packages) {
124 _add_address(recipients => $param{recipients},
125 address => "$source\@".$config{subscription_domain},
132 _add_address(recipients => $param{recipients},
133 address => "$p\@".$config{subscription_domain},
139 if (defined $param{data}{severity} and defined $config{strong_list} and
140 isstrongseverity($param{data}{severity})) {
141 _add_address(recipients => $param{recipients},
142 address => "$config{strong_list}\@".$config{list_domain},
143 reason => $param{data}{severity},
147 my @maints = package_maintainer(binary => $p);
149 print {$param{debug}} "MR|".join(',',@maints)."|$p|$ref|\n";
150 _add_address(recipients => $param{recipients},
153 bug_num => $param{data}{bug_num},
156 print {$param{debug}} "maintainer add >$p|".join(',',@maints)."<\n";
159 print {$param{debug}} "maintainer none >$p<\n";
160 if (not exists $param{unknown_packages}{$p}) {
161 print {$param{transcript}} "Warning: Unknown package '$p'\n";
162 $param{unknown_packages}{$p} = 1;
164 print {$param{debug}} "MR|unknown-package|$p|$ref|\n";
165 _add_address(recipients => $param{recipients},
166 address => $config{unknown_maintainer_email},
168 bug_num => $param{data}{bug_num},
171 if defined $config{unknown_maintainer_email} and
172 length $config{unknown_maintainer_email};
175 if (defined $config{bug_subscription_domain} and
176 length $config{bug_subscription_domain}) {
177 _add_address(recipients => $param{recipients},
178 address => 'bugs='.$param{data}{bug_num}.'@'.
179 $config{bug_subscription_domain},
180 reason => "bug $param{data}{bug_num}",
181 bug_num => $param{data}{bug_num},
185 if (defined $config{cc_all_mails_to_addr} and
186 length $config{cc_all_mails_to_addr}
188 _add_address(recipients => $param{recipients},
189 address => $config{cc_all_mails_to},
190 reason => "cc_all_mails_to",
191 bug_num => $param{data}{bug_num},
196 if (length $param{data}{owner}) {
197 $addmaint = $param{data}{owner};
198 print {$param{debug}} "MO|$addmaint|$param{data}{package}|$ref|\n";
199 _add_address(recipients => $param{recipients},
200 address => $addmaint,
201 reason => "owner of $param{data}{bug_num}",
202 bug_num => $param{data}{bug_num},
205 print {$param{debug}} "owner add >$param{data}{package}|$addmaint<\n";
207 if (exists $param{actions_taken}) {
208 if (exists $param{actions_taken}{done} and
209 $param{actions_taken}{done} and
210 length($config{done_list}) and
211 length($config{list_domain})
213 _add_address(recipients => $param{recipients},
215 address => $config{done_list}.'@'.$config{list_domain},
216 bug_num => $param{data}{bug_num},
217 reason => "bug $param{data}{bug_num} done",
220 if (exists $param{actions_taken}{forwarded} and
221 $param{actions_taken}{forwarded} and
222 length($config{forward_list}) and
223 length($config{list_domain})
225 _add_address(recipients => $param{recipients},
227 address => $config{forward_list}.'@'.$config{list_domain},
228 bug_num => $param{data}{bug_num},
229 reason => "bug $param{data}{bug_num} forwarded",
235 =head2 determine_recipients
237 my @recipients = determine_recipients(recipients => \%recipients,
240 my %recipients => determine_recipients(recipients => \%recipients,);
242 # or a crazy example:
243 send_mail_message(message => $message,
246 values %{{determine_recipients(
247 recipients => \%recipients)
252 Using the recipient hashref, determines the set of recipients.
254 If you specify one of C<bcc>, C<cc>, or C<to>, you will receive only a
255 LIST of recipients which the main should be Bcc'ed, Cc'ed, or To'ed
256 respectively. By default, a LIST with keys bcc, cc, and to is returned
257 with ARRAYREF values corresponding to the users to whom a message
262 =item address_only -- whether to only return mail addresses without reasons or realnamesq
266 Passing more than one of bcc, cc or to is a fatal error.
270 sub determine_recipients {
271 my %param = validate_with(params => \@_,
272 spec => {recipients => {type => HASHREF,
274 bcc => {type => BOOLEAN,
277 cc => {type => BOOLEAN,
280 to => {type => BOOLEAN,
283 address_only => {type => BOOLEAN,
289 if (1 < scalar grep {$param{$_}} qw(to cc bcc)) {
290 croak "Passing more than one of to, cc, or bcc is non-sensical";
293 my %final_recipients;
294 # start with the to recipients
295 for my $addr (keys %{$param{recipients}}) {
298 for my $reason (keys %{$param{recipients}{$addr}}) {
300 for my $bug (keys %{$param{recipients}{$addr}{$reason}}) {
302 my $t_level = $param{recipients}{$addr}{$reason}{$bug};
303 if ($level eq 'to' or
307 elsif ($t_level eq 'cc') {
311 # RFC 2822 comments cannot contain specials and
312 # unquoted () or \; there's no reason for us to allow
313 # insane things here, though, so we restrict this even
314 # more to 20-7E ( -~)
315 $reason =~ s/\\/\\\\/g;
316 $reason =~ s/([\)\(])/\\$1/g;
317 $reason =~ s/[^\x20-\x7E]//g;
318 push @reasons, $reason . ' for {'.join(',',@bugs).'}';
320 if ($param{address_only}) {
321 push @{$final_recipients{$level}}, get_addresses($addr);
324 push @{$final_recipients{$level}}, $addr . ' ('.join(', ',@reasons).')';
327 for (qw(to cc bcc)) {
329 if (exists $final_recipients{$_}) {
330 return @{$final_recipients{$_}||[]};
335 return %final_recipients;
339 =head1 PRIVATE FUNCTIONS
343 _add_address(recipients => $param{recipients},
344 address => $addmaint,
345 reason => $param{data}{package},
346 bug_num => $param{data}{bug_num},
355 my %param = validate_with(params => \@_,
356 spec => {recipients => {type => HASHREF,
358 bug_num => {type => SCALAR,
362 reason => {type => SCALAR,
365 address => {type => SCALAR|ARRAYREF,
367 type => {type => SCALAR,
369 regex => qr/^(?:b?cc|to)$/i,
373 for my $addr (make_list($param{address})) {
374 if (lc($param{type}) eq 'bcc' and
375 exists $param{recipients}{$addr}{$param{reason}}{$param{bug_num}}
379 elsif (lc($param{type}) eq 'cc' and
380 exists $param{recipients}{$addr}{$param{reason}}{$param{bug_num}}
381 and $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} eq 'to'
385 $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} = lc($param{type});