Debbugs/Recipients.pm

   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 $
   6
   7 package Debbugs::Recipients;
   8
   9 =head1 NAME
  10
  11 Debbugs::Recipients -- Determine recipients of messages from the bts
  12
  13 =head1 SYNOPSIS
  14
  15
  16 =head1 DESCRIPTION
  17
  18
  19 =head1 BUGS
  20
  21 None known.
  22
  23 =cut
  24
  25 use warnings;
  26 use strict;
  27 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
  28 use base qw(Exporter);
  29
  30 BEGIN{
  31      ($VERSION) = q$Revision: 1221 $ =~ /^Revision:\s+([^\s+])/;
  32      $DEBUG = 0 unless defined $DEBUG;
  33
  34      @EXPORT = ();
  35      %EXPORT_TAGS = (add    => [qw(add_recipients)],
  36                      det    => [qw(determine_recipients)],
  37                     );
  38      @EXPORT_OK = ();
  39      Exporter::export_ok_tags(keys %EXPORT_TAGS);
  40      $EXPORT_TAGS{all} = [@EXPORT_OK];
  41
  42 }
  43
  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);
  48
  49 use Debbugs::Mail qw(get_addresses);
  50
  51 use Carp;
  52
  53 =head2 add_recipients
  54
  55      add_recipients(data => $data,
  56                     recipients => \%recipients;
  57                    );
  58
  59 Given data (from read_bug or similar) (or an arrayref of data),
  60 calculates the addresses which need to receive mail involving this
  61 bug.
  62
  63 =over
  64
  65 =item data -- Data from read_bug or similar; can be an arrayref of data
  66
  67 =item recipients -- hashref of recipient data structure; pass to
  68 subsequent calls of add_recipients or
  69
  70 =item debug -- optional
  71
  72
  73 =back
  74
  75 =cut
  76
  77
  78 sub add_recipients {
  79      # Data structure is:
  80      #   maintainer email address &c -> assoc of packages -> assoc of bug#'s
  81      my %param = validate_with(params => \@_,
  82                                spec   => {data => {type => HASHREF|ARRAYREF,
  83                                                   },
  84                                           recipients => {type => HASHREF,
  85                                                         },
  86                                           debug => {type => HANDLE|SCALARREF,
  87                                                     optional => 1,
  88                                                    },
  89                                           transcript => {type => HANDLE|SCALARREF,
  90                                                          optional => 1,
  91                                                         },
  92                                           actions_taken => {type => HASHREF,
  93                                                             default => {},
  94                                                            },
  95                                          },
  96                               );
  97
  98      $param{transcript} = globify_scalar($param{transcript});
  99      $param{debug} = globify_scalar($param{debug});
 100      if (ref ($param{data}) eq 'ARRAY') {
 101           for my $data (@{$param{data}}) {
 102                add_recipients(data => $data,
 103                               map {exists $param{$_}?($_,$param{$_}):()}
 104                               qw(recipients debug transcript actions_taken)
 105                              );
 106           }
 107           return;
 108      }
 109      my ($p, $addmaint);
 110      my $anymaintfound=0; my $anymaintnotfound=0;
 111      my $ref = $param{data}{bug_num};
 112      for my $p (splitpackages($param{data}{package})) {
 113           $p = lc($p);
 114           if (defined $config{subscription_domain}) {
 115                my @source_packages = binarytosource($p);
 116                if (@source_packages) {
 117                     for my $source (@source_packages) {
 118                          _add_address(recipients => $param{recipients},
 119                                       address => "$source\@".$config{subscription_domain},
 120                                       reason => $source,
 121                                       type  => 'bcc',
 122                                      );
 123                     }
 124                }
 125                else {
 126                     _add_address(recipients => $param{recipients},
 127                                  address => "$p\@".$config{subscription_domain},
 128                                  reason => $p,
 129                                  type  => 'bcc',
 130                                 );
 131                }
 132           }
 133           if (defined $param{data}{severity} and defined $config{strong_list} and
 134               isstrongseverity($param{data}{severity})) {
 135                _add_address(recipients => $param{recipients},
 136                             address => "$config{strong_list}\@".$config{list_domain},
 137                             reason => $param{data}{severity},
 138                             type  => 'bcc',
 139                            );
 140           }
 141           if (defined(getmaintainers()->{$p})) {
 142                $addmaint= getmaintainers()->{$p};
 143                print {$param{debug}} "MR|$addmaint|$p|$ref|\n";
 144                _add_address(recipients => $param{recipients},
 145                             address => $addmaint,
 146                             reason => $p,
 147                             bug_num => $param{data}{bug_num},
 148                             type  => 'cc',
 149                            );
 150                print {$param{debug}} "maintainer add >$p|$addmaint<\n";
 151           }
 152           else {
 153                print {$param{debug}} "maintainer none >$p<\n";
 154                print {$param{transcript}} "Warning: Unknown package '$p'\n";
 155                print {$param{debug}} "MR|unknown-package|$p|$ref|\n";
 156                _add_address(recipients => $param{recipients},
 157                             address => $config{unknown_maintainer_email},
 158                             reason => $p,
 159                             bug_num => $param{data}{bug_num},
 160                             type  => 'cc',
 161                            )
 162                     if defined $config{unknown_maintainer_email} and
 163                          length $config{unknown_maintainer_email};
 164           }
 165       }
 166      if (defined $config{bug_subscription_domain} and
 167          length $config{bug_subscription_domain}) {
 168           _add_address(recipients => $param{recipients},
 169                        address    => 'bug='.$param{data}{bug_num}.'@'.
 170                                      $config{bug_subscription_domain},
 171                        reason     => "bug $param{data}{bug_num}",
 172                        bug_num    => $param{data}{bug_num},
 173                        type       => 'bcc',
 174                       );
 175      }
 176
 177      if (length $param{data}{owner}) {
 178           $addmaint = $param{data}{owner};
 179           print {$param{debug}} "MO|$addmaint|$param{data}{package}|$ref|\n";
 180           _add_address(recipients => $param{recipients},
 181                        address => $addmaint,
 182                        reason => "owner of $param{data}{bug_num}",
 183                        bug_num => $param{data}{bug_num},
 184                        type  => 'cc',
 185                       );
 186         print {$param{debug}} "owner add >$param{data}{package}|$addmaint<\n";
 187      }
 188      if (exists $param{actions_taken}) {
 189           if (exists $param{actions_taken}{done} and
 190               $param{actions_taken}{done} and
 191               length($config{done_list}) and
 192               length($config{list_domain})
 193              ) {
 194                _add_address(recipients => $param{recipients},
 195                             type       => 'cc',
 196                             address    => $config{done_list}.'@'.$config{list_domain},
 197                             bug_num    => $param{data}{bug_num},
 198                             reason     => "bug $param{data}{bug_num} done",
 199                            );
 200           }
 201           if (exists $param{actions_taken}{forwarded} and
 202               $param{actions_taken}{forwarded} and
 203               length($config{forward_list}) and
 204               length($config{list_domain})
 205              ) {
 206                _add_address(recipients => $param{recipients},
 207                             type       => 'cc',
 208                             address    => $config{forward_list}.'@'.$config{list_domain},
 209                             bug_num    => $param{data}{bug_num},
 210                             reason     => "bug $param{data}{bug_num} forwarded",
 211                            );
 212           }
 213      }
 214 }
 215
 216 =head2 determine_recipients
 217
 218      my @recipients = determine_recipients(recipients => \%recipients,
 219                                            bcc => 1,
 220                                           );
 221      my %recipients => determine_recipients(recipients => \%recipients,);
 222
 223      # or a crazy example:
 224      send_mail_message(message => $message,
 225                        recipients =>
 226                         [make_list(
 227                           values %{{determine_recipients(
 228                                 recipients => \%recipients)
 229                                   }})
 230                         ],
 231                       );
 232
 233 Using the recipient hashref, determines the set of recipients.
 234
 235 If you specify one of C<bcc>, C<cc>, or C<to>, you will receive only a
 236 LIST of recipients which the main should be Bcc'ed, Cc'ed, or To'ed
 237 respectively. By default, a LIST with keys bcc, cc, and to is returned
 238 with ARRAYREF values correponding to the users to whom a message
 239 should be sent.
 240
 241 =over
 242
 243 =item address_only -- whether to only return mail addresses without reasons or realnamesq
 244
 245 =back
 246
 247 Passing more than one of bcc, cc or to is a fatal error.
 248
 249 =cut
 250
 251 sub determine_recipients {
 252      my %param = validate_with(params => \@_,
 253                                spec   => {recipients => {type => HASHREF,
 254                                                         },
 255                                           bcc        => {type => BOOLEAN,
 256                                                          default => 0,
 257                                                         },
 258                                           cc         => {type => BOOLEAN,
 259                                                          default => 0,
 260                                                         },
 261                                           to         => {type => BOOLEAN,
 262                                                          default => 0,
 263                                                         },
 264                                           address_only => {type => BOOLEAN,
 265                                                            default => 0,
 266                                                           }
 267                                          },
 268                               );
 269
 270      if (1 < scalar grep {$param{$_}} qw(to cc bcc)) {
 271           croak "Passing more than one of to, cc, or bcc is non-sensical";
 272      }
 273
 274      my %final_recipients;
 275      # start with the to recipients
 276      for my $addr (keys %{$param{recipients}}) {
 277           my $level = 'bcc';
 278           my @reasons;
 279           for my $reason (keys %{$param{recipients}{$addr}}) {
 280                my @bugs;
 281                for my $bug (keys %{$param{recipients}{$addr}{$reason}}) {
 282                     push @bugs, $bug;
 283                     my $t_level = $param{recipients}{$addr}{$reason}{$bug};
 284                     if ($level eq 'to' or
 285                         $t_level eq 'to') {
 286                          $level = 'to';
 287                     }
 288                     elsif ($t_level eq 'cc') {
 289                          $level = 'cc';
 290                     }
 291                }
 292                # strip out all non-word non-spaces
 293                $reason =~ s/[^\ \w]//g;
 294                push @reasons, $reason . ' for {'.join(',',@bugs).'}';
 295           }
 296           if ($param{address_only}) {
 297                push @{$final_recipients{$level}}, get_addresses($addr);
 298           }
 299           else {
 300                push @{$final_recipients{$level}}, $addr . ' ('.join(', ',@reasons).')';
 301           }
 302      }
 303      for (qw(to cc bcc)) {
 304           if ($param{$_}) {
 305                return @{$final_recipients{$_}};
 306           }
 307      }
 308      return %final_recipients;
 309 }
 310
 311
 312 =head1 PRIVATE FUNCTIONS
 313
 314 =head2 _add_address
 315
 316           _add_address(recipients => $param{recipients},
 317                        address => $addmaint,
 318                        reason => $param{data}{package},
 319                        bug_num => $param{data}{bug_num},
 320                        type  => 'cc',
 321                       );
 322
 323
 324 =cut
 325
 326
 327 sub _add_address {
 328      my %param = validate_with(params => \@_,
 329                                spec => {recipients => {type => HASHREF,
 330                                                       },
 331                                         bug_num    => {type => SCALAR,
 332                                                        regex => qr/^\d*$/,
 333                                                        default => '',
 334                                                       },
 335                                         reason     => {type => SCALAR,
 336                                                        default => '',
 337                                                       },
 338                                         address    => {type => SCALAR|ARRAYREF,
 339                                                       },
 340                                         type       => {type => SCALAR,
 341                                                        default => 'cc',
 342                                                        regex   => qr/^(?:b?cc|to)$/i,
 343                                                       },
 344                                        },
 345                               );
 346      for my $addr (make_list($param{address})) {
 347           if (lc($param{type}) eq 'bcc' and
 348               exists $param{recipients}{$addr}{$param{reason}}{$param{bug_num}}
 349              ) {
 350                next;
 351           }
 352           elsif (lc($param{type}) eq 'cc' and
 353                  exists $param{recipients}{$addr}{$param{reason}}{$param{bug_num}}
 354                  and $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} eq 'to'
 355                 ) {
 356                next;
 357           }
 358           $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} = lc($param{type});
 359      }
 360 }
 361
 362 1;
 363
 364
 365 __END__
 366
 367
 368
 369
 370
 371