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