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{log};
 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;
 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     }
 505     for my $data (@data) {
 506          print {$debug} "Going to change summary";
 507          if (length $summary) {
 508               if (length $data->{summary}) {
 509                    $action = "Summary replaced with message bug $param{bug} message $summary_msg";
 510               }
 511               else {
 512                    $action = "Summary recorded from message bug $param{bug} message $summary_msg";
 513               }
 514          }
 515          $data->{summary} = $summary;
 516          append_action_to_log(bug => $data->{bug_num},
 517                               get_lock => 0,
 518                               __return_append_to_log_options(
 519                                                              %param,
 520                                                              action => $action,
 521                                                             ),
 522                              )
 523                if not exists $param{append_log} or $param{append_log};
 524           writebug($data->{bug_num},$data);
 525           print {$transcript} "$action\n";
 526           add_recipients(data => $data,
 527                          recipients => $param{recipients},
 528                          debug      => $debug,
 529                          transcript => $transcript,
 530                         );
 531      }
 532      if ($locks) {
 533           for (1..$locks) { unfilelock(); }
 534      }
 535
 536 }
 537
 538
 539
 540
 541 =head1 OWNER FUNCTIONS
 542
 543 =head2 owner
 544
 545      eval {
 546             owner(bug          => $ref,
 547                   transcript   => $transcript,
 548                   ($dl > 0 ? (debug => $transcript):()),
 549                   requester    => $header{from},
 550                   request_addr => $controlrequestaddr,
 551                   message      => \@log,
 552                   recipients   => \%recipients,
 553                   owner        => undef,
 554                  );
 555         };
 556         if ($@) {
 557             $errors++;
 558             print {$transcript} "Failed to mark $ref as having an owner: $@";
 559         }
 560
 561 Handles all setting of the owner field; given an owner of undef or of
 562 no length, indicates that a bug is not owned by anyone.
 563
 564 =cut
 565
 566 sub owner {
 567      my %param = validate_with(params => \@_,
 568                                spec   => {bug => {type   => SCALAR,
 569                                                   regex  => qr/^\d+$/,
 570                                                  },
 571                                           owner => {type => SCALAR|UNDEF,
 572                                                    },
 573                                           %common_options,
 574                                           %append_action_options,
 575                                          },
 576                               );
 577      our $locks = 0;
 578      $locks = 0;
 579      local $SIG{__DIE__} = sub {
 580           if ($locks) {
 581                for (1..$locks) { unfilelock(); }
 582                $locks = 0;
 583           }
 584      };
 585      my ($debug,$transcript) = __handle_debug_transcript(%param);
 586      my (@data);
 587      ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 588      __handle_affected_packages(data => \@data,%param);
 589      print {$transcript} __bug_info(@data);
 590      @data and defined $data[0] or die "No bug found for $param{bug}";
 591      add_recipients(data => \@data,
 592                     recipients => $param{recipients},
 593                     debug      => $debug,
 594                     transcript => $transcript,
 595                    );
 596      my $action = '';
 597      for my $data (@data) {
 598           print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
 599           print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
 600           if (not defined $param{owner} or not length $param{owner}) {
 601                $param{owner} = '';
 602                $action = "Removed annotation that $config{bug} was owned by " .
 603                     "$data->{owner}.";
 604           }
 605           else {
 606                if (length $data->{owner}) {
 607                     $action = "Owner changed from $data->{owner} to $param{owner}.";
 608                }
 609                else {
 610                     $action = "Owner recorded as $param{owner}."
 611                }
 612           }
 613           $data->{owner} = $param{owner};
 614           append_action_to_log(bug => $data->{bug_num},
 615                                get_lock => 0,
 616                __return_append_to_log_options(
 617                                               %param,
 618                                               action => $action,
 619                                              ),
 620                               )
 621                if not exists $param{append_log} or $param{append_log};
 622           writebug($data->{bug_num},$data);
 623           print {$transcript} "$action\n";
 624           add_recipients(data => $data,
 625                          recipients => $param{recipients},
 626                          debug      => $debug,
 627                          transcript => $transcript,
 628                         );
 629      }
 630      if ($locks) {
 631           for (1..$locks) { unfilelock(); }
 632      }
 633 }
 634
 635
 636 =head1 ARCHIVE FUNCTIONS
 637
 638
 639 =head2 bug_archive
 640
 641      my $error = '';
 642      eval {
 643         bug_archive(bug => $bug_num,
 644                     debug => \$debug,
 645                     transcript => \$transcript,
 646                    );
 647      };
 648      if ($@) {
 649         $errors++;
 650         transcript("Unable to archive $bug_num\n");
 651         warn $@;
 652      }
 653      transcript($transcript);
 654
 655
 656 This routine archives a bug
 657
 658 =over
 659
 660 =item bug -- bug number
 661
 662 =item check_archiveable -- check wether a bug is archiveable before
 663 archiving; defaults to 1
 664
 665 =item archive_unarchived -- whether to archive bugs which have not
 666 previously been archived; defaults to 1. [Set to 0 when used from
 667 control@]
 668
 669 =item ignore_time -- whether to ignore time constraints when archiving
 670 a bug; defaults to 0.
 671
 672 =back
 673
 674 =cut
 675
 676 sub bug_archive {
 677      my %param = validate_with(params => \@_,
 678                                spec   => {bug => {type   => SCALAR,
 679                                                   regex  => qr/^\d+$/,
 680                                                  },
 681                                           check_archiveable => {type => BOOLEAN,
 682                                                                 default => 1,
 683                                                                },
 684                                           archive_unarchived => {type => BOOLEAN,
 685                                                                  default => 1,
 686                                                                 },
 687                                           ignore_time => {type => BOOLEAN,
 688                                                           default => 0,
 689                                                          },
 690                                           %common_options,
 691                                           %append_action_options,
 692                                          },
 693                               );
 694      our $locks = 0;
 695      $locks = 0;
 696      local $SIG{__DIE__} = sub {
 697           if ($locks) {
 698                for (1..$locks) { unfilelock(); }
 699                $locks = 0;
 700           }
 701      };
 702      my $action = "$config{bug} archived.";
 703      my ($debug,$transcript) = __handle_debug_transcript(%param);
 704      if ($param{check_archiveable} and
 705          not bug_archiveable(bug=>$param{bug},
 706                              ignore_time => $param{ignore_time},
 707                             )) {
 708           print {$transcript} "Bug $param{bug} cannot be archived\n";
 709           die "Bug $param{bug} cannot be archived";
 710      }
 711      print {$debug} "$param{bug} considering\n";
 712      my (@data);
 713      ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 714      __handle_affected_packages(data => \@data,%param);
 715      print {$transcript} __bug_info(@data);
 716      print {$debug} "$param{bug} read $locks\n";
 717      @data and defined $data[0] or die "No bug found for $param{bug}";
 718      print {$debug} "$param{bug} read done\n";
 719
 720      if (not $param{archive_unarchived} and
 721          not exists $data[0]{unarchived}
 722         ) {
 723           print {$transcript} "$param{bug} has not been archived previously\n";
 724           die "$param{bug} has not been archived previously";
 725      }
 726      add_recipients(recipients => $param{recipients},
 727                     data => \@data,
 728                     debug      => $debug,
 729                     transcript => $transcript,
 730                    );
 731      my @bugs = map {$_->{bug_num}} @data;
 732      print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
 733      for my $bug (@bugs) {
 734          if ($param{check_archiveable}) {
 735              die "Bug $bug cannot be archived (but $param{bug} can?)"
 736                  unless bug_archiveable(bug=>$bug,
 737                                         ignore_time => $param{ignore_time},
 738                                        );
 739          }
 740      }
 741      # If we get here, we can archive/remove this bug
 742      print {$debug} "$param{bug} removing\n";
 743      for my $bug (@bugs) {
 744           #print "$param{bug} removing $bug\n" if $debug;
 745           my $dir = get_hashname($bug);
 746           # First indicate that this bug is being archived
 747           append_action_to_log(bug => $bug,
 748                                get_lock => 0,
 749                                __return_append_to_log_options(
 750                                  %param,
 751                                  action => $action,
 752                                 )
 753                               )
 754                if not exists $param{append_log} or $param{append_log};
 755           my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
 756           if ($config{save_old_bugs}) {
 757                mkpath("$config{spool_dir}/archive/$dir");
 758                foreach my $file (@files_to_remove) {
 759                     link( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" ) or
 760                          copy( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" );
 761                }
 762
 763                print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
 764           }
 765           unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
 766           print {$transcript} "deleted $bug (from $param{bug})\n";
 767      }
 768      bughook_archive(@bugs);
 769      if (exists $param{bugs_affected}) {
 770           @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
 771      }
 772      print {$debug} "$param{bug} unlocking $locks\n";
 773      if ($locks) {
 774           for (1..$locks) { unfilelock(); }
 775      }
 776      print {$debug} "$param{bug} unlocking done\n";
 777 }
 778
 779 =head2 bug_unarchive
 780
 781      my $error = '';
 782      eval {
 783         bug_unarchive(bug => $bug_num,
 784                       debug => \$debug,
 785                       transcript => \$transcript,
 786                      );
 787      };
 788      if ($@) {
 789         $errors++;
 790         transcript("Unable to archive bug: $bug_num");
 791      }
 792      transcript($transcript);
 793
 794 This routine unarchives a bug
 795
 796 =cut
 797
 798 sub bug_unarchive {
 799      my %param = validate_with(params => \@_,
 800                                spec   => {bug => {type   => SCALAR,
 801                                                   regex  => qr/^\d+/,
 802                                                  },
 803                                           %common_options,
 804                                           %append_action_options,
 805                                          },
 806                               );
 807      our $locks = 0;
 808      local $SIG{__DIE__} = sub {
 809           if ($locks) {
 810                for (1..$locks) { unfilelock(); }
 811                $locks = 0;
 812           }
 813      };
 814      my $action = "$config{bug} unarchived.";
 815      my ($debug,$transcript) = __handle_debug_transcript(%param);
 816      print {$debug} "$param{bug} considering\n";
 817      my @data = ();
 818      ($locks, @data) = lock_read_all_merged_bugs($param{bug},'archive');
 819      __handle_affected_packages(data => \@data,%param);
 820      print {$transcript} __bug_info(@data);
 821      print {$debug} "$param{bug} read $locks\n";
 822      if (not @data or not defined $data[0]) {
 823          print {$transcript} "No bug found for $param{bug}\n";
 824          die "No bug found for $param{bug}";
 825      }
 826      print {$debug} "$param{bug} read done\n";
 827      my @bugs = map {$_->{bug_num}} @data;
 828      print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
 829      print {$debug} "$param{bug} unarchiving\n";
 830      my @files_to_remove;
 831      for my $bug (@bugs) {
 832           print {$debug} "$param{bug} removing $bug\n";
 833           my $dir = get_hashname($bug);
 834           my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
 835           mkpath("archive/$dir");
 836           foreach my $file (@files_to_copy) {
 837                # die'ing here sucks
 838                link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
 839                     copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
 840                          die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
 841           }
 842           push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
 843           print {$transcript} "Unarchived $config{bug} $bug\n";
 844      }
 845      unlink(@files_to_remove) or die "Unable to unlink bugs";
 846      # Indicate that this bug has been archived previously
 847      for my $bug (@bugs) {
 848           my $newdata = readbug($bug);
 849           if (not defined $newdata) {
 850                print {$transcript} "$config{bug} $bug disappeared!\n";
 851                die "Bug $bug disappeared!";
 852           }
 853           $newdata->{unarchived} = time;
 854           append_action_to_log(bug => $bug,
 855                                get_lock => 0,
 856                                __return_append_to_log_options(
 857                                  %param,
 858                                  action => $action,
 859                                 )
 860                               )
 861                if not exists $param{append_log} or $param{append_log};
 862           writebug($bug,$newdata);
 863           add_recipients(recipients => $param{recipients},
 864                          data       => $newdata,
 865                          debug      => $debug,
 866                          transcript => $transcript,
 867                         );
 868      }
 869      print {$debug} "$param{bug} unlocking $locks\n";
 870      if ($locks) {
 871           for (1..$locks) { unfilelock(); };
 872      }
 873      if (exists $param{bugs_affected}) {
 874           @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
 875      }
 876      print {$debug} "$param{bug} unlocking done\n";
 877 }
 878
 879 =head2 append_action_to_log
 880
 881      append_action_to_log
 882
 883 This should probably be moved to Debbugs::Log; have to think that out
 884 some more.
 885
 886 =cut
 887
 888 sub append_action_to_log{
 889      my %param = validate_with(params => \@_,
 890                                spec   => {bug => {type   => SCALAR,
 891                                                   regex  => qr/^\d+/,
 892                                                  },
 893                                           action => {type => SCALAR,
 894                                                     },
 895                                           requester => {type => SCALAR,
 896                                                        },
 897                                           request_addr => {type => SCALAR,
 898                                                           },
 899                                           location => {type => SCALAR,
 900                                                        optional => 1,
 901                                                       },
 902                                           message  => {type => SCALAR|ARRAYREF,
 903                                                       },
 904                                           get_lock   => {type => BOOLEAN,
 905                                                          default => 1,
 906                                                         },
 907                                          }
 908                               );
 909      # Fix this to use $param{location}
 910      my $log_location = buglog($param{bug});
 911      die "Unable to find .log for $param{bug}"
 912           if not defined $log_location;
 913      if ($param{get_lock}) {
 914           filelock("lock/$param{bug}");
 915      }
 916      my $log = IO::File->new(">>$log_location") or
 917           die "Unable to open $log_location for appending: $!";
 918      print {$log} "\6\n".
 919           "<!-- time:".time." -->\n".
 920           "<strong>".html_escape($param{action})."</strong>\n".
 921           "Request was from <code>".html_escape($param{requester})."</code>\n".
 922           "to <code>".html_escape($param{request_addr})."</code>. \n".
 923           "\3\n".
 924           "\7\n",escape_log(make_list($param{message})),"\n\3\n"
 925                or die "Unable to append to $log_location: $!";
 926      close $log or die "Unable to close $log_location: $!";
 927      if ($param{get_lock}) {
 928           unlockfile();
 929      }
 930
 931
 932 }
 933
 934
 935 =head1 PRIVATE FUNCTIONS
 936
 937 =head2 __handle_affected_packages
 938
 939      __handle_affected_packages(affected_packages => {},
 940                                 data => [@data],
 941                                )
 942
 943
 944
 945 =cut
 946
 947 sub __handle_affected_packages{
 948      my %param = validate_with(params => \@_,
 949                                spec   => {%common_options,
 950                                           data => {type => ARRAYREF|HASHREF
 951                                                   },
 952                                          },
 953                                allow_extra => 1,
 954                               );
 955      for my $data (make_list($param{data})) {
 956           $param{affected_packages}{$data->{package}} = 1;
 957      }
 958 }
 959
 960 =head2 __handle_debug_transcript
 961
 962      my ($debug,$transcript) = __handle_debug_transcript(%param);
 963
 964 Returns a debug and transcript filehandle
 965
 966
 967 =cut
 968
 969 sub __handle_debug_transcript{
 970      my %param = validate_with(params => \@_,
 971                                spec   => {%common_options},
 972                                allow_extra => 1,
 973                               );
 974      my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
 975      my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
 976      return ($debug,$transcript);
 977 }
 978
 979 =head2 __bug_info
 980
 981      __bug_info($data)
 982
 983 Produces a small bit of bug information to kick out to the transcript
 984
 985 =cut
 986
 987 sub __bug_info{
 988      my $return = '';
 989      for my $data (@_) {
 990           $return .= "Bug ".($data->{bug_num}||'').
 991                " [".($data->{package}||''). "] ".
 992                     ($data->{subject}||'')."\n";
 993      }
 994      return $return;
 995 }
 996
 997
 998 sub __return_append_to_log_options{
 999      my %param = @_;
1000      my $action = $param{action} if exists $param{action};
1001      if (not exists $param{requester}) {
1002           $param{requester} = $config{control_internal_requester};
1003      }
1004      if (not exists $param{request_addr}) {
1005           $param{request_addr} = $config{control_internal_request_addr};
1006      }
1007      if (not exists $param{message}) {
1008           my $date = rfc822_date();
1009           $param{message} = fill_in_template(template  => 'mail/fake_control_message',
1010                                              variables => {request_addr => $param{request_addr},
1011                                                            requester    => $param{requester},
1012                                                            date         => $date,
1013                                                            action       => $action
1014                                                           },
1015                                             );
1016      }
1017      if (not defined $action) {
1018           carp "Undefined action!";
1019           $action = "unknown action";
1020      }
1021      return (action => $action,
1022              (map {exists $append_action_options{$_}?($_,$param{$_}):()}
1023               keys %param),
1024             );
1025 }
1026
1027
1028 1;
1029
1030 __END__