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.
6 # [Other people have contributed to this file; their copyrights should
8 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
10 package Debbugs::Control;
14 Debbugs::Control -- Routines for modifying the state of bugs
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.
27 All of the public functions take the following options:
31 =item debug -- scalar reference to which debbuging information is
34 =item transcript -- scalar reference to which transcript information
37 =item affected_bugs -- hashref which is updated with bugs affected by
43 Functions which should (probably) append to the .log file take the
48 =item requester -- Email address of the individual who requested the change
50 =item request_addr -- Address to which the request was sent
52 =item location -- Optional location; currently ignored but may be
53 supported in the future for updating archived bugs upon archival
55 =item message -- The original message which caused the action to be taken
57 =item append_log -- Whether or not to append information to the log.
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.
73 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
74 use base qw(Exporter);
78 $DEBUG = 0 unless defined $DEBUG;
81 %EXPORT_TAGS = (archive => [qw(bug_archive bug_unarchive),
83 log => [qw(append_action_to_log),
87 Exporter::export_ok_tags(qw(archive log));
88 $EXPORT_TAGS{all} = [@EXPORT_OK];
91 use Debbugs::Config qw(:config);
92 use Debbugs::Common qw(:lock buglog make_list get_hashname);
93 use Debbugs::Status qw(bug_archiveable :read :hook writebug);
94 use Debbugs::CGI qw(html_escape);
95 use Debbugs::Log qw(:misc);
97 use Params::Validate qw(validate_with :types);
98 use File::Path qw(mkpath);
102 use Debbugs::Text qw(:templates);
104 use Debbugs::Mail qw(rfc822_date);
106 use POSIX qw(strftime);
108 # These are a set of options which are common to all of these functions
110 my %common_options = (debug => {type => SCALARREF,
113 transcript => {type => SCALARREF,
116 affected_bugs => {type => HASHREF,
122 my %append_action_options =
123 (action => {type => SCALAR,
126 requester => {type => SCALAR,
129 request_addr => {type => SCALAR,
132 location => {type => SCALAR,
135 message => {type => SCALAR|ARRAYREF,
138 append_log => {type => BOOLEAN,
140 depends => [qw(requester request_addr),
151 bug_archive(bug => $bug_num,
153 transcript => \$transcript,
158 transcript("Unable to archive $bug_num\n");
161 transcript($transcript);
164 This routine archives a bug
169 my %param = validate_with(params => \@_,
170 spec => {bug => {type => SCALAR,
173 check_archiveable => {type => BOOLEAN,
176 ignore_time => {type => BOOLEAN,
180 %append_action_options,
184 local $SIG{__DIE__} = sub {
186 for (1..$locks) { unfilelock(); }
190 my $action = "$config{bug} archived.";
191 my ($debug,$transcript) = __handle_debug_transcript(%param);
192 if ($param{check_archiveable} and
193 not bug_archiveable(bug=>$param{bug},
194 ignore_time => $param{ignore_time},
196 print {$transcript} "Bug $param{bug} cannot be archived\n";
197 die "Bug $param{bug} cannot be archived";
199 print {$debug} "$param{bug} considering\n";
201 ($locks, $data) = lockreadbugmerge($param{bug});
202 print {$debug} "$param{bug} read $locks\n";
203 defined $data or die "No bug found for $param{bug}";
204 print {$debug} "$param{bug} read ok (done $data->{done})\n";
205 print {$debug} "$param{bug} read done\n";
206 my @bugs = ($param{bug});
208 # @bugs{@bugs} = (1) x @bugs;
209 if (length($data->{mergedwith})) {
210 push(@bugs,split / /,$data->{mergedwith});
212 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
213 for my $bug (@bugs) {
215 print {$debug} "$param{bug} $bug check\n";
216 if ($bug != $param{bug}) {
217 print {$debug} "$param{bug} $bug reading\n";
218 $newdata = lockreadbug($bug) || die "huh $bug ?";
219 print {$debug} "$param{bug} $bug read ok\n";
224 print {$debug} "$param{bug} $bug read/not\n";
225 my $expectmerge= join(' ',grep($_ != $bug, sort { $a <=> $b } @bugs));
226 $newdata->{mergedwith} eq $expectmerge ||
227 die "$param{bug} differs from $bug: ($newdata->{mergedwith}) vs. ($expectmerge) (".join(' ',@bugs).")";
228 print {$debug} "$param{bug} $bug merge-ok\n";
229 if ($param{check_archiveable}) {
230 die "Bug $bug cannot be archived (but $param{bug} can?)"
231 unless bug_archiveable(bug=>$bug,
232 ignore_time => $param{ignore_time},
236 # If we get here, we can archive/remove this bug
237 print {$debug} "$param{bug} removing\n";
238 for my $bug (@bugs) {
239 #print "$param{bug} removing $bug\n" if $debug;
240 my $dir = get_hashname($bug);
241 # First indicate that this bug is being archived
242 append_action_to_log(bug => $bug,
244 __return_append_to_log_options(
245 (map {exists $param{$_}?($_,$param{$_}):()}
246 keys %append_action_options,
251 if not exists $param{append_log} or $param{append_log};
252 my @files_to_remove = map {s#db-h/$dir/##; $_} glob("db-h/$dir/$bug.*");
253 if ($config{save_old_bugs}) {
254 mkpath("archive/$dir");
255 foreach my $file (@files_to_remove) {
256 link( "db-h/$dir/$file", "archive/$dir/$file" ) || copy( "db-h/$dir/$file", "archive/$dir/$file" );
259 print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
261 unlink(map {"db-h/$dir/$_"} @files_to_remove);
262 print {$transcript} "deleted $bug (from $param{bug})\n";
264 bughook_archive(@bugs);
265 if (exists $param{bugs_affected}) {
266 @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
268 print {$debug} "$param{bug} unlocking $locks\n";
270 for (1..$locks) { unfilelock(); }
272 print {$debug} "$param{bug} unlocking done\n";
279 bug_unarchive(bug => $bug_num,
281 transcript => \$transcript,
286 transcript("Unable to archive bug: $bug_num");
288 transcript($transcript);
290 This routine unarchives a bug
295 my %param = validate_with(params => \@_,
296 spec => {bug => {type => SCALAR,
300 %append_action_options,
303 my $action = "$config{bug} unarchived.";
304 my ($debug,$transcript) = __handle_debug_transcript(%param);
305 print {$debug} "$param{bug} considering\n";
306 my ($locks, $data) = lockreadbugmerge($param{bug},'archive');
307 print {$debug} "$param{bug} read $locks\n";
308 if (not defined $data) {
309 print {$transcript} "No bug found for $param{bug}\n";
310 die "No bug found for $param{bug}";
312 print {$debug} "$param{bug} read ok (done $data->{done})\n";
313 print {$debug} "$param{bug} read done\n";
314 my @bugs = ($param{bug});
316 # @bugs{@bugs} = (1) x @bugs;
317 if (length($data->{mergedwith})) {
318 push(@bugs,split / /,$data->{mergedwith});
320 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
321 for my $bug (@bugs) {
323 print {$debug} "$param{bug} $bug check\n";
324 if ($bug != $param{bug}) {
325 print {$debug} "$param{bug} $bug reading\n";
326 $newdata = lockreadbug($bug,'archive') or die "huh $bug ?";
327 print {$debug} "$param{bug} $bug read ok\n";
332 print {$debug} "$param{bug} $bug read/not\n";
333 my $expectmerge= join(' ',grep($_ != $bug, sort { $a <=> $b } @bugs));
334 if ($newdata->{mergedwith} ne $expectmerge ) {
335 print {$transcript} "$param{bug} differs from $bug: ($newdata->{mergedwith}) vs. ($expectmerge) (@bugs)";
336 die "$param{bug} differs from $bug: ($newdata->{mergedwith}) vs. ($expectmerge) (@bugs)";
338 print {$debug} "$param{bug} $bug merge-ok\n";
340 # If we get here, we can archive/remove this bug
341 print {$debug} "$param{bug} removing\n";
343 for my $bug (@bugs) {
344 print {$debug} "$param{bug} removing $bug\n";
345 my $dir = get_hashname($bug);
346 my @files_to_copy = map {s#archive/$dir/##; $_} glob("archive/$dir/$bug.*");
347 mkpath("archive/$dir");
348 foreach my $file (@files_to_copy) {
350 link( "archive/$dir/$file", "db-h/$dir/$file" ) or
351 copy( "archive/$dir/$file", "db-h/$dir/$file" ) or
352 die "Unable to copy archive/$dir/$file to db-h/$dir/$file";
354 push @files_to_remove, map {"archive/$dir/$_"} @files_to_copy;
355 print {$transcript} "Unarchived $config{bug} $bug\n";
357 unlink(@files_to_remove) or die "Unable to unlink bugs";
358 # Indicate that this bug has been archived previously
359 for my $bug (@bugs) {
360 my $newdata = readbug($bug);
361 if (not defined $newdata) {
362 print {$transcript} "$config{bug} $bug disappeared!\n";
363 die "Bug $bug disappeared!";
365 $newdata->{unarchived} = time;
366 append_action_to_log(bug => $bug,
368 __return_append_to_log_options(
369 (map {exists $param{$_}?($_,$param{$_}):()}
370 keys %append_action_options,
375 if not exists $param{append_log} or $param{append_log};
376 writebug($bug,$newdata);
378 print {$debug} "$param{bug} unlocking $locks\n";
380 for (1..$locks) { unfilelock(); };
382 if (exists $param{bugs_affected}) {
383 @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
385 print {$debug} "$param{bug} unlocking done\n";
388 =head2 append_action_to_log
392 This should probably be moved to Debbugs::Log; have to think that out
397 sub append_action_to_log{
398 my %param = validate_with(params => \@_,
399 spec => {bug => {type => SCALAR,
402 action => {type => SCALAR,
404 requester => {type => SCALAR,
406 request_addr => {type => SCALAR,
408 location => {type => SCALAR,
411 message => {type => SCALAR|ARRAYREF,
413 get_lock => {type => BOOLEAN,
418 # Fix this to use $param{location}
419 my $log_location = buglog($param{bug});
420 die "Unable to find .log for $param{bug}"
421 if not defined $log_location;
422 if ($param{get_lock}) {
423 filelock("lock/$param{bug}");
425 my $log = IO::File->new(">>$log_location") or
426 die "Unable to open $log_location for appending: $!";
428 "<!-- time:".time." -->\n".
429 "<strong>".html_escape($param{action})."</strong>\n".
430 "Request was from <code>".html_escape($param{requester})."</code>\n".
431 "to <code>".html_escape($param{request_addr})."</code>. \n".
433 "\7\n",escape_log(make_list($param{message})),"\n\3\n"
434 or die "Unable to append to $log_location: $!";
435 close $log or die "Unable to close $log_location: $!";
436 if ($param{get_lock}) {
444 =head1 PRIVATE FUNCTIONS
446 =head2 __handle_debug_transcript
448 my ($debug,$transcript) = __handle_debug_transcript(%param);
450 Returns a debug and transcript IO::Scalar filehandle
455 sub __handle_debug_transcript{
456 my %param = validate_with(params => \@_,
457 spec => {%common_options},
461 my $debug = IO::Scalar->new(exists $param{debug}?$param{debug}:\$fake_scalar);
462 my $transcript = IO::Scalar->new(exists $param{transcript}?$param{transcript}:\$fake_scalar);
463 return ($debug,$transcript);
467 sub __return_append_to_log_options{
469 my $action = 'Unknown action';
470 if (not exists $param{requester}) {
471 $param{requester} = $config{control_internal_requester};
473 if (not exists $param{request_addr}) {
474 $param{request_addr} = $config{control_internal_request_addr};
476 if (not exists $param{message}) {
477 $action = $param{action} if exists $param{action};
478 my $date = rfc822_date();
479 $param{message} = fill_in_template(template => 'mail/fake_control_message',
480 variables => {request_addr => $param{request_addr},
481 requester => $param{requester},
487 return (action => $action,