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 = (owner => [qw(owner)],
82 archive => [qw(bug_archive bug_unarchive),
84 log => [qw(append_action_to_log),
88 Exporter::export_ok_tags(keys %EXPORT_TAGS);
89 $EXPORT_TAGS{all} = [@EXPORT_OK];
92 use Debbugs::Config qw(:config);
93 use Debbugs::Common qw(:lock buglog :misc get_hashname);
94 use Debbugs::Status qw(bug_archiveable :read :hook writebug);
95 use Debbugs::CGI qw(html_escape);
96 use Debbugs::Log qw(:misc);
97 use Debbugs::Recipients qw(:add);
99 use Params::Validate qw(validate_with :types);
100 use File::Path qw(mkpath);
103 use Debbugs::Text qw(:templates);
105 use Debbugs::Mail qw(rfc822_date);
107 use POSIX qw(strftime);
111 # These are a set of options which are common to all of these functions
113 my %common_options = (debug => {type => SCALARREF|HANDLE,
116 transcript => {type => SCALARREF|HANDLE,
119 affected_bugs => {type => HASHREF,
122 affected_packages => {type => HASHREF,
125 recipients => {type => HASHREF,
128 limit => {type => HASHREF,
134 my %append_action_options =
135 (action => {type => SCALAR,
138 requester => {type => SCALAR,
141 request_addr => {type => SCALAR,
144 location => {type => SCALAR,
147 message => {type => SCALAR|ARRAYREF,
150 append_log => {type => BOOLEAN,
152 depends => [qw(requester request_addr),
159 # this is just a generic stub for Debbugs::Control functions.
161 # my %param = validate_with(params => \@_,
162 # spec => {bug => {type => SCALAR,
163 # regex => qr/^\d+$/,
165 # # specific options here
167 # %append_action_options,
172 # local $SIG{__DIE__} = sub {
174 # for (1..$locks) { unfilelock(); }
178 # my ($debug,$transcript) = __handle_debug_transcript(%param);
180 # ($locks, @data) = lock_read_all_merged_bugs($param{bug});
181 # __handle_affected_packages(data => \@data,%param);
182 # add_recipients(data => \@data,
183 # recipients => $param{recipients}
187 =head1 OWNER FUNCTIONS
193 transcript => $transcript,
194 ($dl > 0 ? (debug => $transcript):()),
195 requester => $header{from},
196 request_addr => $controlrequestaddr,
198 recipients => \%recipients,
204 print {$transcript} "Failed to mark $ref as having an owner: $@";
207 Handles all setting of the owner field; given an owner of undef or of
208 no length, indicates that a bug is not owned by anyone.
213 my %param = validate_with(params => \@_,
214 spec => {bug => {type => SCALAR,
217 owner => {type => SCALAR|UNDEF,
220 %append_action_options,
225 local $SIG{__DIE__} = sub {
227 for (1..$locks) { unfilelock(); }
231 my ($debug,$transcript) = __handle_debug_transcript(%param);
233 ($locks, @data) = lock_read_all_merged_bugs($param{bug});
234 __handle_affected_packages(data => \@data,%param);
235 @data and defined $data[0] or die "No bug found for $param{bug}";
236 add_recipients(data => \@data,
237 recipients => $param{recipients}
240 for my $data (@data) {
241 print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
242 print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
243 if (not defined $param{owner} or not length $param{owner}) {
245 $action = "Removed annotation that $config{bug} was owned by " .
249 if (length $data->{owner}) {
250 $action = "Owner changed from $data->{owner} to $param{owner}.";
253 $action = "Owner recorded as $param{owner}."
256 $data->{owner} = $param{owner};
257 append_action_to_log(bug => $data->{bug_num},
259 __return_append_to_log_options(
264 if not exists $param{append_log} or $param{append_log};
265 writebug($data->{bug_num},$data);
266 print {$transcript} "$action\n";
267 add_recipients(data => $data,
268 recipients => $param{recipients},
272 for (1..$locks) { unfilelock(); }
277 =head1 ARCHIVE FUNCTIONS
284 bug_archive(bug => $bug_num,
286 transcript => \$transcript,
291 transcript("Unable to archive $bug_num\n");
294 transcript($transcript);
297 This routine archives a bug
301 =item bug -- bug number
303 =item check_archiveable -- check wether a bug is archiveable before
304 archiving; defaults to 1
306 =item archive_unarchived -- whether to archive bugs which have not
307 previously been archived; defaults to 1. [Set to 0 when used from
310 =item ignore_time -- whether to ignore time constraints when archiving
311 a bug; defaults to 0.
318 my %param = validate_with(params => \@_,
319 spec => {bug => {type => SCALAR,
322 check_archiveable => {type => BOOLEAN,
325 archive_unarchived => {type => BOOLEAN,
328 ignore_time => {type => BOOLEAN,
332 %append_action_options,
337 local $SIG{__DIE__} = sub {
339 for (1..$locks) { unfilelock(); }
343 my $action = "$config{bug} archived.";
344 my ($debug,$transcript) = __handle_debug_transcript(%param);
345 if ($param{check_archiveable} and
346 not bug_archiveable(bug=>$param{bug},
347 ignore_time => $param{ignore_time},
349 print {$transcript} "Bug $param{bug} cannot be archived\n";
350 die "Bug $param{bug} cannot be archived";
352 print {$debug} "$param{bug} considering\n";
354 ($locks, @data) = lock_read_all_merged_bugs($param{bug});
355 __handle_affected_packages(data => \@data,%param);
356 print {$debug} "$param{bug} read $locks\n";
357 @data and defined $data[0] or die "No bug found for $param{bug}";
358 print {$debug} "$param{bug} read done\n";
360 if (not $param{archive_unarchived} and
361 not exists $data[0]{unarchived}
363 print {$transcript} "$param{bug} has not been archived previously\n";
364 die "$param{bug} has not been archived previously";
366 add_recipients(recipients => $param{recipients},
369 my @bugs = map {$_->{bug_num}} @data;
370 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
371 for my $bug (@bugs) {
372 if ($param{check_archiveable}) {
373 die "Bug $bug cannot be archived (but $param{bug} can?)"
374 unless bug_archiveable(bug=>$bug,
375 ignore_time => $param{ignore_time},
379 # If we get here, we can archive/remove this bug
380 print {$debug} "$param{bug} removing\n";
381 for my $bug (@bugs) {
382 #print "$param{bug} removing $bug\n" if $debug;
383 my $dir = get_hashname($bug);
384 # First indicate that this bug is being archived
385 append_action_to_log(bug => $bug,
387 __return_append_to_log_options(
392 if not exists $param{append_log} or $param{append_log};
393 my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
394 if ($config{save_old_bugs}) {
395 mkpath("$config{spool_dir}/archive/$dir");
396 foreach my $file (@files_to_remove) {
397 link( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" ) or
398 copy( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" );
401 print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
403 unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
404 print {$transcript} "deleted $bug (from $param{bug})\n";
406 bughook_archive(@bugs);
407 if (exists $param{bugs_affected}) {
408 @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
410 print {$debug} "$param{bug} unlocking $locks\n";
412 for (1..$locks) { unfilelock(); }
414 print {$debug} "$param{bug} unlocking done\n";
421 bug_unarchive(bug => $bug_num,
423 transcript => \$transcript,
428 transcript("Unable to archive bug: $bug_num");
430 transcript($transcript);
432 This routine unarchives a bug
437 my %param = validate_with(params => \@_,
438 spec => {bug => {type => SCALAR,
442 %append_action_options,
446 local $SIG{__DIE__} = sub {
448 for (1..$locks) { unfilelock(); }
452 my $action = "$config{bug} unarchived.";
453 my ($debug,$transcript) = __handle_debug_transcript(%param);
454 print {$debug} "$param{bug} considering\n";
456 ($locks, @data) = lock_read_all_merged_bugs($param{bug},'archive');
457 __handle_affected_packages(data => \@data,%param);
458 print {$debug} "$param{bug} read $locks\n";
459 if (not @data or not defined $data[0]) {
460 print {$transcript} "No bug found for $param{bug}\n";
461 die "No bug found for $param{bug}";
463 print {$debug} "$param{bug} read done\n";
464 my @bugs = map {$_->{bug_num}} @data;
465 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
466 print {$debug} "$param{bug} unarchiving\n";
468 for my $bug (@bugs) {
469 print {$debug} "$param{bug} removing $bug\n";
470 my $dir = get_hashname($bug);
471 my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
472 mkpath("archive/$dir");
473 foreach my $file (@files_to_copy) {
475 link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
476 copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
477 die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
479 push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
480 print {$transcript} "Unarchived $config{bug} $bug\n";
482 unlink(@files_to_remove) or die "Unable to unlink bugs";
483 # Indicate that this bug has been archived previously
484 for my $bug (@bugs) {
485 my $newdata = readbug($bug);
486 if (not defined $newdata) {
487 print {$transcript} "$config{bug} $bug disappeared!\n";
488 die "Bug $bug disappeared!";
490 $newdata->{unarchived} = time;
491 append_action_to_log(bug => $bug,
493 __return_append_to_log_options(
498 if not exists $param{append_log} or $param{append_log};
499 writebug($bug,$newdata);
500 add_recipients(recipients => $param{recipients},
504 print {$debug} "$param{bug} unlocking $locks\n";
506 for (1..$locks) { unfilelock(); };
508 if (exists $param{bugs_affected}) {
509 @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
511 print {$debug} "$param{bug} unlocking done\n";
514 =head2 append_action_to_log
518 This should probably be moved to Debbugs::Log; have to think that out
523 sub append_action_to_log{
524 my %param = validate_with(params => \@_,
525 spec => {bug => {type => SCALAR,
528 action => {type => SCALAR,
530 requester => {type => SCALAR,
532 request_addr => {type => SCALAR,
534 location => {type => SCALAR,
537 message => {type => SCALAR|ARRAYREF,
539 get_lock => {type => BOOLEAN,
544 # Fix this to use $param{location}
545 my $log_location = buglog($param{bug});
546 die "Unable to find .log for $param{bug}"
547 if not defined $log_location;
548 if ($param{get_lock}) {
549 filelock("lock/$param{bug}");
551 my $log = IO::File->new(">>$log_location") or
552 die "Unable to open $log_location for appending: $!";
554 "<!-- time:".time." -->\n".
555 "<strong>".html_escape($param{action})."</strong>\n".
556 "Request was from <code>".html_escape($param{requester})."</code>\n".
557 "to <code>".html_escape($param{request_addr})."</code>. \n".
559 "\7\n",escape_log(make_list($param{message})),"\n\3\n"
560 or die "Unable to append to $log_location: $!";
561 close $log or die "Unable to close $log_location: $!";
562 if ($param{get_lock}) {
570 =head1 PRIVATE FUNCTIONS
572 =head2 __handle_affected_packages
574 __handle_affected_packages(affected_packages => {},
582 sub __handle_affected_packages{
583 my %param = validate_with(params => \@_,
584 spec => {%common_options,
585 data => {type => ARRAYREF|HASHREF
590 for my $data (make_list($param{data})) {
591 $param{affected_packages}{$data->{package}} = 1;
595 =head2 __handle_debug_transcript
597 my ($debug,$transcript) = __handle_debug_transcript(%param);
599 Returns a debug and transcript filehandle
604 sub __handle_debug_transcript{
605 my %param = validate_with(params => \@_,
606 spec => {%common_options},
609 my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
610 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
611 return ($debug,$transcript);
614 sub __return_append_to_log_options{
616 my $action = $param{action} if exists $param{action};
617 if (not exists $param{requester}) {
618 $param{requester} = $config{control_internal_requester};
620 if (not exists $param{request_addr}) {
621 $param{request_addr} = $config{control_internal_request_addr};
623 if (not exists $param{message}) {
624 my $date = rfc822_date();
625 $param{message} = fill_in_template(template => 'mail/fake_control_message',
626 variables => {request_addr => $param{request_addr},
627 requester => $param{requester},
633 if (not defined $action) {
634 carp "Undefined action!";
635 $action = "unknown action";
637 return (action => $action,
638 (map {exists $append_action_options{$_}?($_,$param{$_}):()}