use warnings;
use strict;
use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
-use base qw(Exporter);
+use Exporter qw(import);
BEGIN{
($VERSION) = q$Revision: 1221 $ =~ /^Revision:\s+([^\s+])/;
}
use Debbugs::Config qw(:config);
+use Params::Validate qw(:types validate_with);
+use Debbugs::Common qw(:misc :util);
+use Debbugs::Status qw(splitpackages isstrongseverity);
+
+use Debbugs::Packages qw(binary_to_source);
+
+use Debbugs::Mail qw(get_addresses);
+
+use Carp;
=head2 add_recipients
debug => {type => HANDLE|SCALARREF,
optional => 1,
},
+ transcript => {type => HANDLE|SCALARREF,
+ optional => 1,
+ },
+ actions_taken => {type => HASHREF,
+ default => {},
+ },
+ unknown_packages => {type => HASHREF,
+ default => {},
+ },
},
);
+
+ $param{transcript} = globify_scalar($param{transcript});
+ $param{debug} = globify_scalar($param{debug});
if (ref ($param{data}) eq 'ARRAY') {
- for (@{$param{data}}) {
- add_recipients(map {exists $param{$_}?:($_,$param{$_}):()}
- qw(recipients debug)
+ for my $data (@{$param{data}}) {
+ add_recipients(data => $data,
+ map {exists $param{$_}?($_,$param{$_}):()}
+ qw(recipients debug transcript actions_taken unknown_packages)
);
}
+ return;
}
- my ($p, $addmaint);
- my $anymaintfound=0; my $anymaintnotfound=0;
+ my ($addmaint);
+ my $ref = $param{data}{bug_num};
for my $p (splitpackages($param{data}{package})) {
$p = lc($p);
if (defined $config{subscription_domain}) {
- my @source_packages = binarytosource($p);
+ my @source_packages = binary_to_source(binary => $p,
+ source_only => 1,
+ );
if (@source_packages) {
for my $source (@source_packages) {
_add_address(recipients => $param{recipients},
type => 'bcc',
);
}
- if (defined(getmaintainers->{$p})) {
- $addmaint= getmaintainers->{$p};
- print {$transcript} "MR|$addmaint|$p|$ref|\n" if $dl>2;
- _add_address(recipients => $param{recipients},
- address => $addmaint,
- reason => $p,
- bug_num => $param{data}{bug_num},
- type => 'cc',
- );
- print "maintainer add >$p|$addmaint<\n" if $debug;
+ my @maints = package_maintainer(binary => $p);
+ if (@maints) {
+ print {$param{debug}} "MR|".join(',',@maints)."|$p|$ref|\n";
+ _add_address(recipients => $param{recipients},
+ address => \@maints,
+ reason => $p,
+ bug_num => $param{data}{bug_num},
+ type => 'cc',
+ );
+ print {$param{debug}} "maintainer add >$p|".join(',',@maints)."<\n";
}
- else {
- print "maintainer none >$p<\n" if $debug;
- print {$transcript} "Warning: Unknown package '$p'\n";
- print {$transcript} "MR|unknown-package|$p|$ref|\n" if $dl>2;
+ else {
+ print {$param{debug}} "maintainer none >$p<\n";
+ if (not exists $param{unknown_packages}{$p}) {
+ print {$param{transcript}} "Warning: Unknown package '$p'\n";
+ $param{unknown_packages}{$p} = 1;
+ }
+ print {$param{debug}} "MR|unknown-package|$p|$ref|\n";
_add_address(recipients => $param{recipients},
address => $config{unknown_maintainer_email},
reason => $p,
if (defined $config{bug_subscription_domain} and
length $config{bug_subscription_domain}) {
_add_address(recipients => $param{recipients},
- address => 'bug='.$param{data}{bug_num}.'@'.
+ address => 'bugs='.$param{data}{bug_num}.'@'.
$config{bug_subscription_domain},
reason => "bug $param{data}{bug_num}",
bug_num => $param{data}{bug_num},
if (length $param{data}{owner}) {
$addmaint = $param{data}{owner};
- print {$transcript} "MO|$addmaint|$param{data}{package}|$ref|\n" if $dl>2;
+ print {$param{debug}} "MO|$addmaint|$param{data}{package}|$ref|\n";
_add_address(recipients => $param{recipients},
address => $addmaint,
reason => "owner of $param{data}{bug_num}",
bug_num => $param{data}{bug_num},
type => 'cc',
);
- print "owner add >$param{data}{package}|$addmaint<\n" if $debug;
+ print {$param{debug}} "owner add >$param{data}{package}|$addmaint<\n";
+ }
+ if (exists $param{actions_taken}) {
+ if (exists $param{actions_taken}{done} and
+ $param{actions_taken}{done} and
+ length($config{done_list}) and
+ length($config{list_domain})
+ ) {
+ _add_address(recipients => $param{recipients},
+ type => 'cc',
+ address => $config{done_list}.'@'.$config{list_domain},
+ bug_num => $param{data}{bug_num},
+ reason => "bug $param{data}{bug_num} done",
+ );
+ }
+ if (exists $param{actions_taken}{forwarded} and
+ $param{actions_taken}{forwarded} and
+ length($config{forward_list}) and
+ length($config{list_domain})
+ ) {
+ _add_address(recipients => $param{recipients},
+ type => 'cc',
+ address => $config{forward_list}.'@'.$config{list_domain},
+ bug_num => $param{data}{bug_num},
+ reason => "bug $param{data}{bug_num} forwarded",
+ );
+ }
+ }
+}
+
+=head2 determine_recipients
+
+ my @recipients = determine_recipients(recipients => \%recipients,
+ bcc => 1,
+ );
+ my %recipients => determine_recipients(recipients => \%recipients,);
+
+ # or a crazy example:
+ send_mail_message(message => $message,
+ recipients =>
+ [make_list(
+ values %{{determine_recipients(
+ recipients => \%recipients)
+ }})
+ ],
+ );
+
+Using the recipient hashref, determines the set of recipients.
+
+If you specify one of C<bcc>, C<cc>, or C<to>, you will receive only a
+LIST of recipients which the main should be Bcc'ed, Cc'ed, or To'ed
+respectively. By default, a LIST with keys bcc, cc, and to is returned
+with ARRAYREF values corresponding to the users to whom a message
+should be sent.
+
+=over
+
+=item address_only -- whether to only return mail addresses without reasons or realnamesq
+
+=back
+
+Passing more than one of bcc, cc or to is a fatal error.
+
+=cut
+
+sub determine_recipients {
+ my %param = validate_with(params => \@_,
+ spec => {recipients => {type => HASHREF,
+ },
+ bcc => {type => BOOLEAN,
+ default => 0,
+ },
+ cc => {type => BOOLEAN,
+ default => 0,
+ },
+ to => {type => BOOLEAN,
+ default => 0,
+ },
+ address_only => {type => BOOLEAN,
+ default => 0,
+ }
+ },
+ );
+
+ if (1 < scalar grep {$param{$_}} qw(to cc bcc)) {
+ croak "Passing more than one of to, cc, or bcc is non-sensical";
}
+
+ my %final_recipients;
+ # start with the to recipients
+ for my $addr (keys %{$param{recipients}}) {
+ my $level = 'bcc';
+ my @reasons;
+ for my $reason (keys %{$param{recipients}{$addr}}) {
+ my @bugs;
+ for my $bug (keys %{$param{recipients}{$addr}{$reason}}) {
+ push @bugs, $bug;
+ my $t_level = $param{recipients}{$addr}{$reason}{$bug};
+ if ($level eq 'to' or
+ $t_level eq 'to') {
+ $level = 'to';
+ }
+ elsif ($t_level eq 'cc') {
+ $level = 'cc';
+ }
+ }
+ # RFC 2822 comments cannot contain specials and
+ # unquoted () or \; there's no reason for us to allow
+ # insane things here, though, so we restrict this even
+ # more to 20-7E ( -~)
+ $reason =~ s/\\/\\\\/g;
+ $reason =~ s/([\)\(])/\\$1/g;
+ $reason =~ s/[^\x20-\x7E]//g;
+ push @reasons, $reason . ' for {'.join(',',@bugs).'}';
+ }
+ if ($param{address_only}) {
+ push @{$final_recipients{$level}}, get_addresses($addr);
+ }
+ else {
+ push @{$final_recipients{$level}}, $addr . ' ('.join(', ',@reasons).')';
+ }
+ }
+ for (qw(to cc bcc)) {
+ if ($param{$_}) {
+ if (exists $final_recipients{$_}) {
+ return @{$final_recipients{$_}||[]};
+ }
+ return ();
+ }
+ }
+ return %final_recipients;
}
+
=head1 PRIVATE FUNCTIONS
=head2 _add_address
},
type => {type => SCALAR,
default => 'cc',
- regex => qr/^b?cc/i,
+ regex => qr/^(?:b?cc|to)$/i,
},
},
);
for my $addr (make_list($param{address})) {
- if (lc($param{type}) eq 'bcc' and
+ if (lc($param{type}) eq 'bcc' and
exists $param{recipients}{$addr}{$param{reason}}{$param{bug_num}}
) {
next;
}
- $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} = $param{type};
+ elsif (lc($param{type}) eq 'cc' and
+ exists $param{recipients}{$addr}{$param{reason}}{$param{bug_num}}
+ and $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} eq 'to'
+ ) {
+ next;
+ }
+ $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} = lc($param{type});
}
}