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.
67 =head1 GENERAL FUNCTIONS
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 :misc 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);
96 use Debbugs::Recipients qw(:add);
98 use Params::Validate qw(validate_with :types);
99 use File::Path qw(mkpath);
102 use Debbugs::Text qw(:templates);
104 use Debbugs::Mail qw(rfc822_date);
106 use POSIX qw(strftime);
110 # These are a set of options which are common to all of these functions
112 my %common_options = (debug => {type => SCALARREF|HANDLE,
115 transcript => {type => SCALARREF|HANDLE,
118 affected_bugs => {type => HASHREF,
121 recipients => {type => HASHREF,
124 limit => {type => HASHREF,
130 my %append_action_options =
131 (action => {type => SCALAR,
134 requester => {type => SCALAR,
137 request_addr => {type => SCALAR,
140 location => {type => SCALAR,
143 message => {type => SCALAR|ARRAYREF,
146 append_log => {type => BOOLEAN,
148 depends => [qw(requester request_addr),
155 # this is just a generic stub for Debbugs::Control functions.
157 # my %param = validate_with(params => \@_,
158 # spec => {bug => {type => SCALAR,
159 # regex => qr/^\d+$/,
161 # # specific options here
163 # %append_action_options,
168 # local $SIG{__DIE__} = sub {
170 # for (1..$locks) { unfilelock(); }
174 # my ($debug,$transcript) = __handle_debug_transcript(%param);
176 # ($locks, @data) = lock_read_all_merged_bugs($param{bug});
177 # add_recipients(data => \@data,
178 # recipients => $param{recipients}
182 =head1 OWNER FUNCTIONS
188 transcript => $transcript,
189 ($dl > 0 ? (debug => $transcript):()),
190 requester => $header{from},
191 request_addr => $controlrequestaddr,
193 recipients => \%recipients,
199 print {$transcript} "Failed to mark $ref as not having an owner: $@";
202 Handles all setting of the owner field; given an owner of undef or of
203 no length, indicates that a bug is not owned by anyone.
208 my %param = validate_with(params => \@_,
209 spec => {bug => {type => SCALAR,
212 owner => {type => SCALAR|UNDEF,
215 %append_action_options,
220 local $SIG{__DIE__} = sub {
222 for (1..$locks) { unfilelock(); }
226 my ($debug,$transcript) = __handle_debug_transcript(%param);
228 ($locks, @data) = lock_read_all_merged_bugs($param{bug});
229 @data and defined $data[0] or die "No bug found for $param{bug}";
230 add_recipients(data => \@data,
231 recipients => $param{recipients}
234 for my $data (@data) {
235 if (not defined $param{owner} or not length $param{owner}) {
237 $action = "Removed annotation that $gBug was owned by " .
241 if (length $data->{owner}) {
242 $action = "Owner changed from $data->{owner} to $param{owner}.";
245 $action = "Owner recorded as $param{owner}."
248 $data->{owner} = $param{owner};
249 append_action_to_log(bug => $data->{bug_num},
251 __return_append_to_log_options(
256 if not exists $param{append_log} or $param{append_log};
259 for (1..$locks) { unfilelock(); }
264 =head1 ARCHIVE FUNCTIONS
271 bug_archive(bug => $bug_num,
273 transcript => \$transcript,
278 transcript("Unable to archive $bug_num\n");
281 transcript($transcript);
284 This routine archives a bug
288 =item bug -- bug number
290 =item check_archiveable -- check wether a bug is archiveable before
291 archiving; defaults to 1
293 =item archive_unarchived -- whether to archive bugs which have not
294 previously been archived; defaults to 1. [Set to 0 when used from
297 =item ignore_time -- whether to ignore time constraints when archiving
298 a bug; defaults to 0.
305 my %param = validate_with(params => \@_,
306 spec => {bug => {type => SCALAR,
309 check_archiveable => {type => BOOLEAN,
312 archive_unarchived => {type => BOOLEAN,
315 ignore_time => {type => BOOLEAN,
319 %append_action_options,
324 local $SIG{__DIE__} = sub {
326 for (1..$locks) { unfilelock(); }
330 my $action = "$config{bug} archived.";
331 my ($debug,$transcript) = __handle_debug_transcript(%param);
332 if ($param{check_archiveable} and
333 not bug_archiveable(bug=>$param{bug},
334 ignore_time => $param{ignore_time},
336 print {$transcript} "Bug $param{bug} cannot be archived\n";
337 die "Bug $param{bug} cannot be archived";
339 print {$debug} "$param{bug} considering\n";
341 ($locks, @data) = lock_read_all_merged_bugs($param{bug});
342 print {$debug} "$param{bug} read $locks\n";
343 @data and defined $data[0] or die "No bug found for $param{bug}";
344 print {$debug} "$param{bug} read done\n";
346 if (not $param{archive_unarchived} and
347 not exists $data[0]{unarchived}
349 print {$transcript} "$param{bug} has not been archived previously\n";
350 die "$param{bug} has not been archived previously";
352 add_recipients(recipients => $param{recipients},
355 my @bugs = map {$_->{bug_num}} @data;
356 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
357 for my $bug (@bugs) {
358 if ($param{check_archiveable}) {
359 die "Bug $bug cannot be archived (but $param{bug} can?)"
360 unless bug_archiveable(bug=>$bug,
361 ignore_time => $param{ignore_time},
365 # If we get here, we can archive/remove this bug
366 print {$debug} "$param{bug} removing\n";
367 for my $bug (@bugs) {
368 #print "$param{bug} removing $bug\n" if $debug;
369 my $dir = get_hashname($bug);
370 # First indicate that this bug is being archived
371 append_action_to_log(bug => $bug,
373 __return_append_to_log_options(
378 if not exists $param{append_log} or $param{append_log};
379 my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
380 if ($config{save_old_bugs}) {
381 mkpath("$config{spool_dir}/archive/$dir");
382 foreach my $file (@files_to_remove) {
383 link( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" ) or
384 copy( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" );
387 print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
389 unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
390 print {$transcript} "deleted $bug (from $param{bug})\n";
392 bughook_archive(@bugs);
393 if (exists $param{bugs_affected}) {
394 @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
396 print {$debug} "$param{bug} unlocking $locks\n";
398 for (1..$locks) { unfilelock(); }
400 print {$debug} "$param{bug} unlocking done\n";
407 bug_unarchive(bug => $bug_num,
409 transcript => \$transcript,
414 transcript("Unable to archive bug: $bug_num");
416 transcript($transcript);
418 This routine unarchives a bug
423 my %param = validate_with(params => \@_,
424 spec => {bug => {type => SCALAR,
428 %append_action_options,
432 local $SIG{__DIE__} = sub {
434 for (1..$locks) { unfilelock(); }
438 my $action = "$config{bug} unarchived.";
439 my ($debug,$transcript) = __handle_debug_transcript(%param);
440 print {$debug} "$param{bug} considering\n";
442 ($locks, @data) = lock_read_all_merged_bugs($param{bug},'archive');
443 print {$debug} "$param{bug} read $locks\n";
444 if (not @data or not defined $data[0]) {
445 print {$transcript} "No bug found for $param{bug}\n";
446 die "No bug found for $param{bug}";
448 print {$debug} "$param{bug} read done\n";
449 my @bugs = map {$_->{bug_num}} @data;
450 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
451 print {$debug} "$param{bug} unarchiving\n";
453 for my $bug (@bugs) {
454 print {$debug} "$param{bug} removing $bug\n";
455 my $dir = get_hashname($bug);
456 my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
457 mkpath("archive/$dir");
458 foreach my $file (@files_to_copy) {
460 link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
461 copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
462 die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
464 push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
465 print {$transcript} "Unarchived $config{bug} $bug\n";
467 unlink(@files_to_remove) or die "Unable to unlink bugs";
468 # Indicate that this bug has been archived previously
469 for my $bug (@bugs) {
470 my $newdata = readbug($bug);
471 if (not defined $newdata) {
472 print {$transcript} "$config{bug} $bug disappeared!\n";
473 die "Bug $bug disappeared!";
475 $newdata->{unarchived} = time;
476 append_action_to_log(bug => $bug,
478 __return_append_to_log_options(
483 if not exists $param{append_log} or $param{append_log};
484 writebug($bug,$newdata);
485 add_recipients(recipients => $param{recipients},
489 print {$debug} "$param{bug} unlocking $locks\n";
491 for (1..$locks) { unfilelock(); };
493 if (exists $param{bugs_affected}) {
494 @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
496 print {$debug} "$param{bug} unlocking done\n";
499 =head2 append_action_to_log
503 This should probably be moved to Debbugs::Log; have to think that out
508 sub append_action_to_log{
509 my %param = validate_with(params => \@_,
510 spec => {bug => {type => SCALAR,
513 action => {type => SCALAR,
515 requester => {type => SCALAR,
517 request_addr => {type => SCALAR,
519 location => {type => SCALAR,
522 message => {type => SCALAR|ARRAYREF,
524 get_lock => {type => BOOLEAN,
529 # Fix this to use $param{location}
530 my $log_location = buglog($param{bug});
531 die "Unable to find .log for $param{bug}"
532 if not defined $log_location;
533 if ($param{get_lock}) {
534 filelock("lock/$param{bug}");
536 my $log = IO::File->new(">>$log_location") or
537 die "Unable to open $log_location for appending: $!";
539 "<!-- time:".time." -->\n".
540 "<strong>".html_escape($param{action})."</strong>\n".
541 "Request was from <code>".html_escape($param{requester})."</code>\n".
542 "to <code>".html_escape($param{request_addr})."</code>. \n".
544 "\7\n",escape_log(make_list($param{message})),"\n\3\n"
545 or die "Unable to append to $log_location: $!";
546 close $log or die "Unable to close $log_location: $!";
547 if ($param{get_lock}) {
555 =head1 PRIVATE FUNCTIONS
557 =head2 __handle_debug_transcript
559 my ($debug,$transcript) = __handle_debug_transcript(%param);
561 Returns a debug and transcript filehandle
566 sub __handle_debug_transcript{
567 my %param = validate_with(params => \@_,
568 spec => {%common_options},
571 my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
572 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
573 return ($debug,$transcript);
576 sub __return_append_to_log_options{
578 my $action = $param{action} if exists $param{action};
579 if (not exists $param{requester}) {
580 $param{requester} = $config{control_internal_requester};
582 if (not exists $param{request_addr}) {
583 $param{request_addr} = $config{control_internal_request_addr};
585 if (not exists $param{message}) {
586 my $date = rfc822_date();
587 $param{message} = fill_in_template(template => 'mail/fake_control_message',
588 variables => {request_addr => $param{request_addr},
589 requester => $param{requester},
595 if (not defined $action) {
596 carp "Undefined action!";
597 $action = "unknown action";
599 return (action => $action,
600 (map {exists $append_action_options{$_}?($_,$param{$_}):()}