Debbugs/Control.pm

   1 # This module is part of debbugs, and is released
   2 # under the terms of the GPL version 2, or any later
   3 # version at your option.
   4 # See the file README and COPYING for more information.
   5 #
   6 # [Other people have contributed to this file; their copyrights should
   7 # go here too.]
   8 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
   9
  10 package Debbugs::Control;
  11
  12 =head1 NAME
  13
  14 Debbugs::Control -- Routines for modifying the state of bugs
  15
  16 =head1 SYNOPSIS
  17
  18 use Debbugs::Control;
  19
  20
  21 =head1 DESCRIPTION
  22
  23 This module is an abstraction of a lot of functions which originally
  24 were only present in service.in, but as time has gone on needed to be
  25 called from elsewhere.
  26
  27 All of the public functions take the following options:
  28
  29 =over
  30
  31 =item debug -- scalar reference to which debbuging information is
  32 appended
  33
  34 =item transcript -- scalar reference to which transcript information
  35 is appended
  36
  37 =item affected_bugs -- hashref which is updated with bugs affected by
  38 this function
  39
  40
  41 =back
  42
  43 Functions which should (probably) append to the .log file take the
  44 following options:
  45
  46 =over
  47
  48 =item requester -- Email address of the individual who requested the change
  49
  50 =item request_addr -- Address to which the request was sent
  51
  52 =item location -- Optional location; currently ignored but may be
  53 supported in the future for updating archived bugs upon archival
  54
  55 =item message -- The original message which caused the action to be taken
  56
  57 =item append_log -- Whether or not to append information to the log.
  58
  59 =back
  60
  61 B<append_log> (for most functions) is a special option. When set to
  62 false, no appending to the log is done at all. When it is not present,
  63 the above information is faked, and appended to the log file. When it
  64 is true, the above options must be present, and their values are used.
  65
  66
  67 =head1 GENERAL FUNCTIONS
  68
  69 =cut
  70
  71 use warnings;
  72 use strict;
  73 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
  74 use base qw(Exporter);
  75
  76 BEGIN{
  77      $VERSION = 1.00;
  78      $DEBUG = 0 unless defined $DEBUG;
  79
  80      @EXPORT = ();
  81      %EXPORT_TAGS = (affects => [qw(affects)],
  82                      summary => [qw(summary)],
  83                      owner   => [qw(owner)],
  84                      archive => [qw(bug_archive bug_unarchive),
  85                                 ],
  86                      log     => [qw(append_action_to_log),
  87                                 ],
  88                     );
  89      @EXPORT_OK = ();
  90      Exporter::export_ok_tags(keys %EXPORT_TAGS);
  91      $EXPORT_TAGS{all} = [@EXPORT_OK];
  92 }
  93
  94 use Debbugs::Config qw(:config);
  95 use Debbugs::Common qw(:lock buglog :misc get_hashname);
  96 use Debbugs::Status qw(bug_archiveable :read :hook writebug splitpackages);
  97 use Debbugs::CGI qw(html_escape);
  98 use Debbugs::Log qw(:misc);
  99 use Debbugs::Recipients qw(:add);
 100
 101 use Params::Validate qw(validate_with :types);
 102 use File::Path qw(mkpath);
 103 use IO::File;
 104
 105 use Debbugs::Text qw(:templates);
 106
 107 use Debbugs::Mail qw(rfc822_date);
 108
 109 use POSIX qw(strftime);
 110
 111 use Carp;
 112
 113 # These are a set of options which are common to all of these functions
 114
 115 my %common_options = (debug       => {type => SCALARREF|HANDLE,
 116                                       optional => 1,
 117                                      },
 118                       transcript  => {type => SCALARREF|HANDLE,
 119                                       optional => 1,
 120                                      },
 121                       affected_bugs => {type => HASHREF,
 122                                         optional => 1,
 123                                        },
 124                       affected_packages => {type => HASHREF,
 125                                             optional => 1,
 126                                            },
 127                       recipients    => {type => HASHREF,
 128                                         default => {},
 129                                        },
 130                       limit         => {type => HASHREF,
 131                                         default => {},
 132                                        },
 133                      );
 134
 135
 136 my %append_action_options =
 137      (action => {type => SCALAR,
 138                  optional => 1,
 139                 },
 140       requester => {type => SCALAR,
 141                     optional => 1,
 142                    },
 143       request_addr => {type => SCALAR,
 144                        optional => 1,
 145                       },
 146       location => {type => SCALAR,
 147                    optional => 1,
 148                   },
 149       message  => {type => SCALAR|ARRAYREF,
 150                    optional => 1,
 151                   },
 152       append_log => {type => BOOLEAN,
 153                      optional => 1,
 154                      depends => [qw(requester request_addr),
 155                                  qw(message),
 156                                 ],
 157                     },
 158      );
 159
 160
 161 # this is just a generic stub for Debbugs::Control functions.
 162 #
 163 # =head2 foo
 164 #
 165 #      eval {
 166 #           foo(bug          => $ref,
 167 #               transcript   => $transcript,
 168 #               ($dl > 0 ? (debug => $transcript):()),
 169 #               requester    => $header{from},
 170 #               request_addr => $controlrequestaddr,
 171 #               message      => \@log,
 172 #               affected_packages => \%affected_packages,
 173 #               recipients   => \%recipients,
 174 #               summary      => undef,
 175 #              );
 176 #       };
 177 #       if ($@) {
 178 #           $errors++;
 179 #           print {$transcript} "Failed to foo $ref bar: $@";
 180 #       }
 181 #
 182 # Foo frobinates
 183 #
 184 # =cut
 185 #
 186 # sub foo {
 187 #     my %param = validate_with(params => \@_,
 188 #                             spec   => {bug => {type   => SCALAR,
 189 #                                                regex  => qr/^\d+$/,
 190 #                                               },
 191 #                                        # specific options here
 192 #                                        %common_options,
 193 #                                        %append_action_options,
 194 #                                       },
 195 #                            );
 196 #     our $locks = 0;
 197 #     $locks = 0;
 198 #     local $SIG{__DIE__} = sub {
 199 #       if ($locks) {
 200 #           for (1..$locks) { unfilelock(); }
 201 #           $locks = 0;
 202 #       }
 203 #     };
 204 #     my ($debug,$transcript) = __handle_debug_transcript(%param);
 205 #     my (@data);
 206 #     ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 207 #     __handle_affected_packages(data => \@data,%param);
 208 #     print {$transcript} __bug_info(@data);
 209 #     add_recipients(data => \@data,
 210 #                    recipients => $param{recipients}
 211 #                    debug      => $debug,
 212 #                    transcript => $transcript,
 213 #                   );
 214 #     for my $data (@data) {
 215 #        append_action_to_log(bug => $data->{bug_num},
 216 #                             get_lock => 0,
 217 #                             __return_append_to_log_options(
 218 #                                                            %param,
 219 #                                                            action => $action,
 220 #                                                           ),
 221 #                            )
 222 #              if not exists $param{append_log} or $param{append_log};
 223 #         writebug($data->{bug_num},$data);
 224 #         print {$transcript} "$action\n";
 225 #         add_recipients(data => $data,
 226 #                        recipients => $param{recipients},
 227 #                        debug      => $debug,
 228 #                        transcript => $transcript,
 229 #                       );
 230 #      }
 231 #      if ($locks) {
 232 #         for (1..$locks) { unfilelock(); }
 233 #      }
 234 #
 235 # }
 236
 237 =head2 affects
 238
 239      eval {
 240             affects(bug          => $ref,
 241                     transcript   => $transcript,
 242                     ($dl > 0 ? (debug => $transcript):()),
 243                     requester    => $header{from},
 244                     request_addr => $controlrequestaddr,
 245                     message      => \@log,
 246                     affected_packages => \%affected_packages,
 247                     recipients   => \%recipients,
 248                     packages     => undef,
 249                     add          => 1,
 250                     remove       => 0,
 251                    );
 252         };
 253         if ($@) {
 254             $errors++;
 255             print {$transcript} "Failed to mark $ref as affecting $packages: $@";
 256         }
 257
 258 This marks a bug as affecting packages which the bug is not actually
 259 in. This should only be used in cases where fixing the bug instantly
 260 resolves the problem in the other packages.
 261
 262 By default, the packages are set to the list of packages passed.
 263 However, if you pass add => 1 or remove => 1, the list of packages
 264 passed are added or removed from the affects list, respectively.
 265
 266 =cut
 267
 268 sub affects {
 269     my %param = validate_with(params => \@_,
 270                               spec   => {bug => {type   => SCALAR,
 271                                                  regex  => qr/^\d+$/,
 272                                                 },
 273                                          # specific options here
 274                                          packages => {type => SCALAR|ARRAYREF,
 275                                                       default => [],
 276                                                      },
 277                                          add      => {type => BOOLEAN,
 278                                                       default => 0,
 279                                                      },
 280                                          remove   => {type => BOOLEAN,
 281                                                       default => 0,
 282                                                      },
 283                                          %common_options,
 284                                          %append_action_options,
 285                                         },
 286                              );
 287     if ($param{add} and $param{remove}) {
 288          croak "Asking to both add and remove affects is nonsensical";
 289     }
 290     our $locks = 0;
 291     $locks = 0;
 292     local $SIG{__DIE__} = sub {
 293         if ($locks) {
 294             for (1..$locks) { unfilelock(); }
 295             $locks = 0;
 296         }
 297     };
 298     my ($debug,$transcript) = __handle_debug_transcript(%param);
 299     my (@data);
 300     ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 301     __handle_affected_packages(data => \@data,%param);
 302     print {$transcript} __bug_info(@data);
 303     add_recipients(data => \@data,
 304                    recipients => $param{recipients},
 305                    debug      => $debug,
 306                    transcript => $transcript,
 307                   );
 308     my $action = 'Did not alter affected packages';
 309     for my $data (@data) {
 310          print {$debug} "Going to change affects\n";
 311          my @packages = splitpackages($data->{affects});
 312          my %packages;
 313          @packages{@packages} = (1) x @packages;
 314          if ($param{add}) {
 315               my @added = ();
 316               for my $package (make_list($param{packages})) {
 317                    if (not $packages{$package}) {
 318                         $packages{$package} = 1;
 319                         push @added,$package;
 320                    }
 321               }
 322               if (@added) {
 323                    $action = "Added indication that $data->{bug_num} affects ".
 324                         english_join(', ',' and ',@added);
 325               }
 326          }
 327          elsif ($param{remove}) {
 328               my @removed = ();
 329               for my $package (make_list($param{packages})) {
 330                    if ($packages{$package}) {
 331                         delete $packages{$package};
 332                         push @removed,$package;
 333                    }
 334               }
 335               $action = "Removed indication that $data->{bug_num} affects " .
 336                    english_join(', ',' and ',@removed);
 337          }
 338          else {
 339               %packages = ();
 340               for my $package (make_list($param{packages})) {
 341                    $packages{$package} = 1;
 342               }
 343               $action = "Noted that $data->{bug_num} affects ".
 344                    english_join(', ',' and ', keys %packages);
 345          }
 346          $data->{affects} = join(',',keys %packages);
 347          append_action_to_log(bug => $data->{bug_num},
 348                               get_lock => 0,
 349                               __return_append_to_log_options(
 350                                                              %param,
 351                                                              action => $action,
 352                                                             ),
 353                              )
 354                if not exists $param{append_log} or $param{append_log};
 355           writebug($data->{bug_num},$data);
 356           print {$transcript} "$action\n";
 357           add_recipients(data => $data,
 358                          recipients => $param{recipients},
 359                          debug      => $debug,
 360                          transcript => $transcript,
 361                         );
 362      }
 363      if ($locks) {
 364           for (1..$locks) { unfilelock(); }
 365      }
 366
 367 }
 368
 369
 370 =head1 SUMMARY FUNCTIONS
 371
 372 =head2 summary
 373
 374      eval {
 375             summary(bug          => $ref,
 376                     transcript   => $transcript,
 377                     ($dl > 0 ? (debug => $transcript):()),
 378                     requester    => $header{from},
 379                     request_addr => $controlrequestaddr,
 380                     message      => \@log,
 381                     affected_packages => \%affected_packages,
 382                     recipients   => \%recipients,
 383                     summary      => undef,
 384                    );
 385         };
 386         if ($@) {
 387             $errors++;
 388             print {$transcript} "Failed to mark $ref with summary foo: $@";
 389         }
 390
 391 Handles all setting of summary fields
 392
 393 If summary is undef, unsets the summary
 394
 395 If summary is 0, sets the summary to the first paragraph contained in
 396 the message passed.
 397
 398 If summary is numeric, sets the summary to the message specified.
 399
 400
 401 =cut
 402
 403
 404 sub summary {
 405     my %param = validate_with(params => \@_,
 406                               spec   => {bug => {type   => SCALAR,
 407                                                  regex  => qr/^\d+$/,
 408                                                 },
 409                                          # specific options here
 410                                          summary => {type => SCALAR|UNDEF,
 411                                                      default => 0,
 412                                                     },
 413                                          %common_options,
 414                                          %append_action_options,
 415                                         },
 416                              );
 417     croak "summary must be numeric or undef" if
 418          defined $param{summary} and not $param{summary} =~ /^\d+$/;
 419     our $locks = 0;
 420     $locks = 0;
 421     local $SIG{__DIE__} = sub {
 422         if ($locks) {
 423             for (1..$locks) { unfilelock(); }
 424             $locks = 0;
 425         }
 426     };
 427     my ($debug,$transcript) = __handle_debug_transcript(%param);
 428     my (@data);
 429     ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 430     __handle_affected_packages(data => \@data,%param);
 431     print {$transcript} __bug_info(@data);
 432     add_recipients(data => \@data,
 433                    recipients => $param{recipients},
 434                    debug      => $debug,
 435                    transcript => $transcript,
 436                   );
 437     # figure out the log that we're going to use
 438     my $summary = '';
 439     my $summary_msg = '';
 440     my $action = '';
 441     if (not defined $param{summary}) {
 442          # do nothing
 443          print {$debug} "Removing summary fields";
 444          $action = 'Removed summary';
 445     }
 446     else {
 447          my $log = [];
 448          my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
 449          if ($param{summary} == 0) {
 450               $log = $param{message};
 451               $summary_msg = @records + 1;
 452          }
 453          else {
 454               if (($param{summary} - 1 ) > $#records) {
 455                    die "Message number '$param{summary}' exceeds the maximum message '$#records'";
 456               }
 457               my $record = $records[($param{summary} - 1 )];
 458               if ($record->{type} !~ /incoming-recv|recips/) {
 459                    die "Message number '$param{summary}' is a invalid message type '$record->{type}'";
 460               }
 461               $summary_msg = $param{summary};
 462               $log = [$record->{text}];
 463          }
 464          my $p_o = Debbugs::MIME::parse(join('',@{$log}));
 465          my $body = $p_o->{body};
 466          my $in_pseudoheaders = 0;
 467          my $paragraph = '';
 468          # walk through body until we get non-blank lines
 469          for my $line (@{$body}) {
 470               if ($line =~ /^\s*$/) {
 471                    if (length $paragraph) {
 472                         if ($paragraph =~ m/^(?:.+\n\>)+.+\n/x) {
 473                              $paragraph = '';
 474                              next;
 475                         }
 476                         last;
 477                    }
 478                    $in_pseudoheaders = 0;
 479                    next;
 480               }
 481               # skip a paragraph if it looks like it's control or
 482               # pseudo-headers
 483               if ($line =~ m{^\s*(?:(?:Package|Source|Version)\:| #pseudo headers
 484                                  (?:package|(?:no|)owner|severity|tag|summary| #control
 485                                       reopen|close|(?:not|)(?:fixed|found)|clone|
 486                                       (?:force|)merge|user(?:category|tag|)
 487                                  )
 488                             )\s+\S}x) {
 489                    if (not length $paragraph) {
 490                         print {$debug} "Found control/pseudo-headers and skiping them\n";
 491                         $in_pseudoheaders = 1;
 492                         next;
 493                    }
 494               }
 495               next if $in_pseudoheaders;
 496               $paragraph .= $line ." \n";
 497          }
 498          print {$debug} "Summary is going to be '$paragraph'\n";
 499          $summary = $paragraph;
 500          $summary =~ s/[\n\r]//g;
 501          if (not length $summary) {
 502               die "Unable to find summary message to use";
 503          }
 504          # trim off a trailing space
 505          $summary =~ s/\ $//;
 506     }
 507     for my $data (@data) {
 508          print {$debug} "Going to change summary";
 509          if (length $summary) {
 510               if (length $data->{summary}) {
 511                    $action = "Summary replaced with message bug $param{bug} message $summary_msg";
 512               }
 513               else {
 514                    $action = "Summary recorded from message bug $param{bug} message $summary_msg";
 515               }
 516          }
 517          $data->{summary} = $summary;
 518          append_action_to_log(bug => $data->{bug_num},
 519                               get_lock => 0,
 520                               __return_append_to_log_options(
 521                                                              %param,
 522                                                              action => $action,
 523                                                             ),
 524                              )
 525                if not exists $param{append_log} or $param{append_log};
 526           writebug($data->{bug_num},$data);
 527           print {$transcript} "$action\n";
 528           add_recipients(data => $data,
 529                          recipients => $param{recipients},
 530                          debug      => $debug,
 531                          transcript => $transcript,
 532                         );
 533      }
 534      if ($locks) {
 535           for (1..$locks) { unfilelock(); }
 536      }
 537
 538 }
 539
 540
 541
 542
 543 =head1 OWNER FUNCTIONS
 544
 545 =head2 owner
 546
 547      eval {
 548             owner(bug          => $ref,
 549                   transcript   => $transcript,
 550                   ($dl > 0 ? (debug => $transcript):()),
 551                   requester    => $header{from},
 552                   request_addr => $controlrequestaddr,
 553                   message      => \@log,
 554                   recipients   => \%recipients,
 555                   owner        => undef,
 556                  );
 557         };
 558         if ($@) {
 559             $errors++;
 560             print {$transcript} "Failed to mark $ref as having an owner: $@";
 561         }
 562
 563 Handles all setting of the owner field; given an owner of undef or of
 564 no length, indicates that a bug is not owned by anyone.
 565
 566 =cut
 567
 568 sub owner {
 569      my %param = validate_with(params => \@_,
 570                                spec   => {bug => {type   => SCALAR,
 571                                                   regex  => qr/^\d+$/,
 572                                                  },
 573                                           owner => {type => SCALAR|UNDEF,
 574                                                    },
 575                                           %common_options,
 576                                           %append_action_options,
 577                                          },
 578                               );
 579      our $locks = 0;
 580      $locks = 0;
 581      local $SIG{__DIE__} = sub {
 582           if ($locks) {
 583                for (1..$locks) { unfilelock(); }
 584                $locks = 0;
 585           }
 586      };
 587      my ($debug,$transcript) = __handle_debug_transcript(%param);
 588      my (@data);
 589      ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 590      __handle_affected_packages(data => \@data,%param);
 591      print {$transcript} __bug_info(@data);
 592      @data and defined $data[0] or die "No bug found for $param{bug}";
 593      add_recipients(data => \@data,
 594                     recipients => $param{recipients},
 595                     debug      => $debug,
 596                     transcript => $transcript,
 597                    );
 598      my $action = '';
 599      for my $data (@data) {
 600           print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
 601           print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
 602           if (not defined $param{owner} or not length $param{owner}) {
 603                $param{owner} = '';
 604                $action = "Removed annotation that $config{bug} was owned by " .
 605                     "$data->{owner}.";
 606           }
 607           else {
 608                if (length $data->{owner}) {
 609                     $action = "Owner changed from $data->{owner} to $param{owner}.";
 610                }
 611                else {
 612                     $action = "Owner recorded as $param{owner}."
 613                }
 614           }
 615           $data->{owner} = $param{owner};
 616           append_action_to_log(bug => $data->{bug_num},
 617                                get_lock => 0,
 618                __return_append_to_log_options(
 619                                               %param,
 620                                               action => $action,
 621                                              ),
 622                               )
 623                if not exists $param{append_log} or $param{append_log};
 624           writebug($data->{bug_num},$data);
 625           print {$transcript} "$action\n";
 626           add_recipients(data => $data,
 627                          recipients => $param{recipients},
 628                          debug      => $debug,
 629                          transcript => $transcript,
 630                         );
 631      }
 632      if ($locks) {
 633           for (1..$locks) { unfilelock(); }
 634      }
 635 }
 636
 637
 638 =head1 ARCHIVE FUNCTIONS
 639
 640
 641 =head2 bug_archive
 642
 643      my $error = '';
 644      eval {
 645         bug_archive(bug => $bug_num,
 646                     debug => \$debug,
 647                     transcript => \$transcript,
 648                    );
 649      };
 650      if ($@) {
 651         $errors++;
 652         transcript("Unable to archive $bug_num\n");
 653         warn $@;
 654      }
 655      transcript($transcript);
 656
 657
 658 This routine archives a bug
 659
 660 =over
 661
 662 =item bug -- bug number
 663
 664 =item check_archiveable -- check wether a bug is archiveable before
 665 archiving; defaults to 1
 666
 667 =item archive_unarchived -- whether to archive bugs which have not
 668 previously been archived; defaults to 1. [Set to 0 when used from
 669 control@]
 670
 671 =item ignore_time -- whether to ignore time constraints when archiving
 672 a bug; defaults to 0.
 673
 674 =back
 675
 676 =cut
 677
 678 sub bug_archive {
 679      my %param = validate_with(params => \@_,
 680                                spec   => {bug => {type   => SCALAR,
 681                                                   regex  => qr/^\d+$/,
 682                                                  },
 683                                           check_archiveable => {type => BOOLEAN,
 684                                                                 default => 1,
 685                                                                },
 686                                           archive_unarchived => {type => BOOLEAN,
 687                                                                  default => 1,
 688                                                                 },
 689                                           ignore_time => {type => BOOLEAN,
 690                                                           default => 0,
 691                                                          },
 692                                           %common_options,
 693                                           %append_action_options,
 694                                          },
 695                               );
 696      our $locks = 0;
 697      $locks = 0;
 698      local $SIG{__DIE__} = sub {
 699           if ($locks) {
 700                for (1..$locks) { unfilelock(); }
 701                $locks = 0;
 702           }
 703      };
 704      my $action = "$config{bug} archived.";
 705      my ($debug,$transcript) = __handle_debug_transcript(%param);
 706      if ($param{check_archiveable} and
 707          not bug_archiveable(bug=>$param{bug},
 708                              ignore_time => $param{ignore_time},
 709                             )) {
 710           print {$transcript} "Bug $param{bug} cannot be archived\n";
 711           die "Bug $param{bug} cannot be archived";
 712      }
 713      print {$debug} "$param{bug} considering\n";
 714      my (@data);
 715      ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 716      __handle_affected_packages(data => \@data,%param);
 717      print {$transcript} __bug_info(@data);
 718      print {$debug} "$param{bug} read $locks\n";
 719      @data and defined $data[0] or die "No bug found for $param{bug}";
 720      print {$debug} "$param{bug} read done\n";
 721
 722      if (not $param{archive_unarchived} and
 723          not exists $data[0]{unarchived}
 724         ) {
 725           print {$transcript} "$param{bug} has not been archived previously\n";
 726           die "$param{bug} has not been archived previously";
 727      }
 728      add_recipients(recipients => $param{recipients},
 729                     data => \@data,
 730                     debug      => $debug,
 731                     transcript => $transcript,
 732                    );
 733      my @bugs = map {$_->{bug_num}} @data;
 734      print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
 735      for my $bug (@bugs) {
 736          if ($param{check_archiveable}) {
 737              die "Bug $bug cannot be archived (but $param{bug} can?)"
 738                  unless bug_archiveable(bug=>$bug,
 739                                         ignore_time => $param{ignore_time},
 740                                        );
 741          }
 742      }
 743      # If we get here, we can archive/remove this bug
 744      print {$debug} "$param{bug} removing\n";
 745      for my $bug (@bugs) {
 746           #print "$param{bug} removing $bug\n" if $debug;
 747           my $dir = get_hashname($bug);
 748           # First indicate that this bug is being archived
 749           append_action_to_log(bug => $bug,
 750                                get_lock => 0,
 751                                __return_append_to_log_options(
 752                                  %param,
 753                                  action => $action,
 754                                 )
 755                               )
 756                if not exists $param{append_log} or $param{append_log};
 757           my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
 758           if ($config{save_old_bugs}) {
 759                mkpath("$config{spool_dir}/archive/$dir");
 760                foreach my $file (@files_to_remove) {
 761                     link( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" ) or
 762                          copy( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" );
 763                }
 764
 765                print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
 766           }
 767           unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
 768           print {$transcript} "deleted $bug (from $param{bug})\n";
 769      }
 770      bughook_archive(@bugs);
 771      if (exists $param{bugs_affected}) {
 772           @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
 773      }
 774      print {$debug} "$param{bug} unlocking $locks\n";
 775      if ($locks) {
 776           for (1..$locks) { unfilelock(); }
 777      }
 778      print {$debug} "$param{bug} unlocking done\n";
 779 }
 780
 781 =head2 bug_unarchive
 782
 783      my $error = '';
 784      eval {
 785         bug_unarchive(bug => $bug_num,
 786                       debug => \$debug,
 787                       transcript => \$transcript,
 788                      );
 789      };
 790      if ($@) {
 791         $errors++;
 792         transcript("Unable to archive bug: $bug_num");
 793      }
 794      transcript($transcript);
 795
 796 This routine unarchives a bug
 797
 798 =cut
 799
 800 sub bug_unarchive {
 801      my %param = validate_with(params => \@_,
 802                                spec   => {bug => {type   => SCALAR,
 803                                                   regex  => qr/^\d+/,
 804                                                  },
 805                                           %common_options,
 806                                           %append_action_options,
 807                                          },
 808                               );
 809      our $locks = 0;
 810      local $SIG{__DIE__} = sub {
 811           if ($locks) {
 812                for (1..$locks) { unfilelock(); }
 813                $locks = 0;
 814           }
 815      };
 816      my $action = "$config{bug} unarchived.";
 817      my ($debug,$transcript) = __handle_debug_transcript(%param);
 818      print {$debug} "$param{bug} considering\n";
 819      my @data = ();
 820      ($locks, @data) = lock_read_all_merged_bugs($param{bug},'archive');
 821      __handle_affected_packages(data => \@data,%param);
 822      print {$transcript} __bug_info(@data);
 823      print {$debug} "$param{bug} read $locks\n";
 824      if (not @data or not defined $data[0]) {
 825          print {$transcript} "No bug found for $param{bug}\n";
 826          die "No bug found for $param{bug}";
 827      }
 828      print {$debug} "$param{bug} read done\n";
 829      my @bugs = map {(defined $_ and exists $_->{bug_num} and defined $_->{bug_num})?$_->{bug_num}:()} @data;
 830      print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
 831      print {$debug} "$param{bug} unarchiving\n";
 832      my @files_to_remove;
 833      for my $bug (@bugs) {
 834           print {$debug} "$param{bug} removing $bug\n";
 835           my $dir = get_hashname($bug);
 836           my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
 837           mkpath("archive/$dir");
 838           foreach my $file (@files_to_copy) {
 839                # die'ing here sucks
 840                link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
 841                     copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
 842                          die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
 843           }
 844           push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
 845           print {$transcript} "Unarchived $config{bug} $bug\n";
 846      }
 847      unlink(@files_to_remove) or die "Unable to unlink bugs";
 848      # Indicate that this bug has been archived previously
 849      for my $bug (@bugs) {
 850           my $newdata = readbug($bug);
 851           if (not defined $newdata) {
 852                print {$transcript} "$config{bug} $bug disappeared!\n";
 853                die "Bug $bug disappeared!";
 854           }
 855           $newdata->{unarchived} = time;
 856           append_action_to_log(bug => $bug,
 857                                get_lock => 0,
 858                                __return_append_to_log_options(
 859                                  %param,
 860                                  action => $action,
 861                                 )
 862                               )
 863                if not exists $param{append_log} or $param{append_log};
 864           writebug($bug,$newdata);
 865           add_recipients(recipients => $param{recipients},
 866                          data       => $newdata,
 867                          debug      => $debug,
 868                          transcript => $transcript,
 869                         );
 870      }
 871      print {$debug} "$param{bug} unlocking $locks\n";
 872      if ($locks) {
 873           for (1..$locks) { unfilelock(); };
 874      }
 875      if (exists $param{bugs_affected}) {
 876           @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
 877      }
 878      print {$debug} "$param{bug} unlocking done\n";
 879 }
 880
 881 =head2 append_action_to_log
 882
 883      append_action_to_log
 884
 885 This should probably be moved to Debbugs::Log; have to think that out
 886 some more.
 887
 888 =cut
 889
 890 sub append_action_to_log{
 891      my %param = validate_with(params => \@_,
 892                                spec   => {bug => {type   => SCALAR,
 893                                                   regex  => qr/^\d+/,
 894                                                  },
 895                                           action => {type => SCALAR,
 896                                                     },
 897                                           requester => {type => SCALAR,
 898                                                         default => '',
 899                                                        },
 900                                           request_addr => {type => SCALAR,
 901                                                            default => '',
 902                                                           },
 903                                           location => {type => SCALAR,
 904                                                        optional => 1,
 905                                                       },
 906                                           message  => {type => SCALAR|ARRAYREF,
 907                                                        default => '',
 908                                                       },
 909                                           desc       => {type => SCALAR,
 910                                                          default => '',
 911                                                         },
 912                                           get_lock   => {type => BOOLEAN,
 913                                                          default => 1,
 914                                                         },
 915                                          }
 916                               );
 917      # Fix this to use $param{location}
 918      my $log_location = buglog($param{bug});
 919      die "Unable to find .log for $param{bug}"
 920           if not defined $log_location;
 921      if ($param{get_lock}) {
 922           filelock("lock/$param{bug}");
 923      }
 924      my $log = IO::File->new(">>$log_location") or
 925           die "Unable to open $log_location for appending: $!";
 926      my $msg = "\6\n".
 927           "<!-- time:".time." -->\n".
 928           "<strong>".html_escape($param{action})."</strong>\n";
 929      if (length $param{requester}) {
 930           $msg .= "Request was from <code>".html_escape($param{requester})."</code>\n";
 931      }
 932      if (length $param{request_addr}) {
 933           $msg .= "to <code>".html_escape($param{request_addr})."</code>";
 934      }
 935      if (length $param{desc}) {
 936           $msg .= ":<br>\n$param{desc}\n";
 937      }
 938      else {
 939           $msg .= ".\n";
 940      }
 941      $msg .= "\3\n";
 942      if ((ref($param{message}) and @{$param{message}}) or length($param{message})) {
 943           $msg .= "\7\n".join('',escape_log(make_list($param{message})))."\n\3\n"
 944                or die "Unable to append to $log_location: $!";
 945      }
 946      print {$log} $msg or die "Unable to append to $log_location: $!";
 947      close $log or die "Unable to close $log_location: $!";
 948      if ($param{get_lock}) {
 949           unfilelock();
 950      }
 951
 952
 953 }
 954
 955
 956 =head1 PRIVATE FUNCTIONS
 957
 958 =head2 __handle_affected_packages
 959
 960      __handle_affected_packages(affected_packages => {},
 961                                 data => [@data],
 962                                )
 963
 964
 965
 966 =cut
 967
 968 sub __handle_affected_packages{
 969      my %param = validate_with(params => \@_,
 970                                spec   => {%common_options,
 971                                           data => {type => ARRAYREF|HASHREF
 972                                                   },
 973                                          },
 974                                allow_extra => 1,
 975                               );
 976      for my $data (make_list($param{data})) {
 977           next unless exists $data->{package} and defined $data->{package};
 978           $param{affected_packages}{$data->{package}} = 1;
 979      }
 980 }
 981
 982 =head2 __handle_debug_transcript
 983
 984      my ($debug,$transcript) = __handle_debug_transcript(%param);
 985
 986 Returns a debug and transcript filehandle
 987
 988
 989 =cut
 990
 991 sub __handle_debug_transcript{
 992      my %param = validate_with(params => \@_,
 993                                spec   => {%common_options},
 994                                allow_extra => 1,
 995                               );
 996      my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
 997      my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
 998      return ($debug,$transcript);
 999 }
1000
1001 =head2 __bug_info
1002
1003      __bug_info($data)
1004
1005 Produces a small bit of bug information to kick out to the transcript
1006
1007 =cut
1008
1009 sub __bug_info{
1010      my $return = '';
1011      for my $data (@_) {
1012           $return .= "Bug ".($data->{bug_num}||'').
1013                " [".($data->{package}||''). "] ".
1014                     ($data->{subject}||'')."\n";
1015      }
1016      return $return;
1017 }
1018
1019
1020 sub __return_append_to_log_options{
1021      my %param = @_;
1022      my $action = $param{action} if exists $param{action};
1023      if (not exists $param{requester}) {
1024           $param{requester} = $config{control_internal_requester};
1025      }
1026      if (not exists $param{request_addr}) {
1027           $param{request_addr} = $config{control_internal_request_addr};
1028      }
1029      if (not exists $param{message}) {
1030           my $date = rfc822_date();
1031           $param{message} = fill_in_template(template  => 'mail/fake_control_message',
1032                                              variables => {request_addr => $param{request_addr},
1033                                                            requester    => $param{requester},
1034                                                            date         => $date,
1035                                                            action       => $action
1036                                                           },
1037                                             );
1038      }
1039      if (not defined $action) {
1040           carp "Undefined action!";
1041           $action = "unknown action";
1042      }
1043      return (action => $action,
1044              (map {exists $append_action_options{$_}?($_,$param{$_}):()}
1045               keys %param),
1046             );
1047 }
1048
1049
1050 1;
1051
1052 __END__