use Params::Validate qw(validate_with :types);
use Debbugs::MIME qw(convert_to_utf8 decode_rfc1522 create_mime_message);
use Debbugs::CGI qw(:url :html :util);
-use Debbugs::Common qw(globify_scalar);
+use Debbugs::Common qw(globify_scalar english_join);
use POSIX qw(strftime);
BEGIN{
$output .= decode_rfc1522($record->{text});
# Link to forwarded http:// urls in the midst of the report
# (even though these links already exist at the top)
- $output =~ s,((?:ftp|http|https)://[\S~-]+?/?)([\)\'\:\.\,]?(?:\s|\.<|$)),<a href=\"$1\">$1</a>$2,go;
+ $output =~ s,((?:ftp|http|https)://[\S~-]+?/?)((?:[\)\'\:\.\,]|\&\#39;)?(?:\s|\.<|$)),<a href=\"$1\">$1</a>$2,go;
# Add links to the cloned bugs
$output =~ s{(Bug )(\d+)( cloned as bugs? )(\d+)(?:\-(\d+)|)}{$1.bug_links(bug=>$2).$3.bug_links(bug=>(defined $5)?[$4..$5]:$4)}eo;
# Add links to merged bugs
# Add links to blocked bugs
$output =~ s{(?<=Blocking bugs)(?:( of )(\d+))?( (?:added|set to|removed):\s+)([\d\s\,]+)}
{(defined $2?$1.bug_links(bug=>$2):'').$3.
- join(' ',map {bug_links(bug=>$_)} (split /\,?\s+/, $4))}eo;
+ english_join([map {bug_links(bug=>$_)} (split /\,?\s+/, $4)])}eo;
+ $output =~ s{((?:[Aa]dded|[Rr]emoved)\ blocking\ bug(?:\(s\))?)(?:(\ of\ )(\d+))?(:?\s+)
+ (\d+(?:,\s+\d+)*(?:\,?\s+and\s+\d+)?)}
+ {$1.(defined $3?$2.bug_links(bug=>$3):'').$4.
+ english_join([map {bug_links(bug=>$_)} (split /\,?\s+(?:and\s+)?/, $5)])}xeo;
# Add links to reassigned packages
$output =~ s{(Bug reassigned from package \`)([^']+?)((?:'|\&\#39;) to \`)([^']+?)((?:'|\&\#39;))}
{$1.q(<a href=").html_escape(pkg_url(pkg=>$2)).qq(">$2</a>).$3.q(<a href=").html_escape(pkg_url(pkg=>$4)).qq(">$4</a>).$5}eo;
qw(bug_status),
qw(getmaintainers_reverse),
qw(getpseudodesc),
+ qw(package_maintainer),
],
misc => [qw(make_list globify_scalar english_join checkpid),
qw(cleanup_eval_fail),
=cut
-our $_maintainer;
-our $_maintainer_rev;
+our $_maintainer = undef;
+our $_maintainer_rev = undef;
sub getmaintainers {
- return $_maintainer if $_maintainer;
- my %maintainer;
- my %maintainer_rev;
- for my $file (@config{qw(maintainer_file maintainer_file_override pseduo_maint_file)}) {
- next unless defined $file;
- my $maintfile = IO::File->new($file,'r') or
- die "Unable to open maintainer file $file: $!";
- while(<$maintfile>) {
- next unless m/^(\S+)\s+(\S.*\S)\s*$/;
- ($a,$b)=($1,$2);
- $a =~ y/A-Z/a-z/;
- $maintainer{$a}= $b;
- for my $maint (map {lc($_->address)} getparsedaddrs($b)) {
- push @{$maintainer_rev{$maint}},$a;
- }
- }
- close($maintfile);
- }
- $_maintainer = \%maintainer;
- $_maintainer_rev = \%maintainer_rev;
+ return $_maintainer if defined $_maintainer;
+ package_maintainer(rehash => 1);
return $_maintainer;
}
=cut
sub getmaintainers_reverse{
- return $_maintainer_rev if $_maintainer_rev;
- getmaintainers();
+ return $_maintainer_rev if defined $_maintainer_rev;
+ package_maintainer(rehash => 1);
return $_maintainer_rev;
}
+=head2 package_maintainer
+
+ my @s = package_maintainer(source => [qw(foo bar baz)],
+ binary => [qw(bleh blah)],
+ );
+
+=over
+
+=item source -- scalar or arrayref of source package names to return
+maintainers for, defaults to the empty arrayref.
+
+=item binary -- scalar or arrayref of binary package names to return
+maintainers for; automatically returns source package maintainer if
+the package name starts with 'src:', defaults to the empty arrayref.
+
+=item reverse -- whether to return the source/binary packages a
+maintainer maintains instead
+
+=item rehash -- whether to reread the maintainer and source maintainer
+files; defaults to 0
+
+=back
+
+=cut
+
+our $_source_maintainer = undef;
+our $_source_maintainer_rev = undef;
+sub package_maintainer {
+ my %param = validate_with(params => \@_,
+ spec => {source => {type => SCALAR|ARRAYREF,
+ default => [],
+ },
+ binary => {type => SCALAR|ARRAYREF,
+ default => [],
+ },
+ rehash => {type => BOOLEAN,
+ default => 0,
+ },
+ reverse => {type => BOOLEAN,
+ default => 0,
+ },
+ },
+ );
+ if ($param{rehash}) {
+ $_source_maintainer = undef;
+ $_source_maintainer_rev = undef;
+ $_maintainer = undef;
+ $_maintainer_rev = undef;
+ }
+ if (not defined $_source_maintainer or
+ not defined $_source_maintainer_rev) {
+ $_source_maintainer = {};
+ $_source_maintainer_rev = {};
+ for my $fn (@config{('source_maintainer_file',
+ 'source_maintainer_file_override',
+ 'pseduo_maint_file')}) {
+ next unless defined $fn;
+ __add_to_hash($fn,$_source_maintainer,
+ $_source_maintainer_rev);
+ }
+ }
+ if (not defined $_maintainer or
+ not defined $_maintainer_rev) {
+ $_maintainer = {};
+ $_maintainer_rev = {};
+ for my $fn (@config{('maintainer_file',
+ 'maintainer_file_override',
+ 'pseduo_maint_file')}) {
+ next unless defined $fn;
+ __add_to_hash($fn,$_maintainer,
+ $_maintainer_rev);
+ }
+ }
+ my @return;
+ my @extra_source;
+ my $b = $param{reverse}?$_maintainer_rev:$_maintainer;
+ for my $binary (make_list($param{binary})) {
+ if (not $param{reverse} and $binary =~ /^src:/) {
+ push @extra_source,$binary;
+ next;
+ }
+ push @return,grep {defined $_} make_list($b->{$binary});
+ }
+ my $s = $param{reverse}?$_source_maintainer_rev:$_source_maintainer;
+ for my $source (make_list($param{source},@extra_source)) {
+ push @return,grep {defined $_} make_list($s->{$source});
+ }
+ return @return;
+}
+
+#=head2 __add_to_hash
+#
+# __add_to_hash($file,$forward_hash,$reverse_hash,'address');
+#
+# Reads a maintainer/source maintainer/pseudo desc file and adds the
+# maintainers from it to the forward and reverse hashref; assumes that
+# the forward is unique; makes no assumptions of the reverse.
+#
+#=cut
+
+sub __add_to_hash {
+ my ($fn,$forward,$reverse,$type) = @_;
+ if (ref($forward) ne 'HASH') {
+ croak "__add_to_hash must be passed a hashref for the forward";
+ }
+ if (defined $reverse and not ref($reverse) eq 'HASH') {
+ croak "if reverse is passed to __add_to_hash, it must be a hashref";
+ }
+ $type //= 'address';
+ my $fh = IO::File->new($fn,'r') or
+ die "Unable to open $fn for reading: $!";
+ while (<$fh>) {
+ chomp;
+ next unless m/^(\S+)\s+(\S.*\S)\s*$/;
+ my ($key,$value)=($1,$2);
+ $key = lc $key;
+ $forward->{$key}= $value;
+ if (defined $reverse) {
+ if ($type eq 'address') {
+ for my $m (map {lc($_->address)} (getparsedaddrs($value))) {
+ push @{$reverse->{$m}},$key;
+ }
+ }
+ else {
+ push @{$reverse->{$value}}, $key;
+ }
+ }
+ }
+}
+
+
=head2 getpseudodesc
my $pseudopkgdesc = getpseudodesc(...);
=cut
-our $_pseudodesc;
+our $_pseudodesc = undef;
sub getpseudodesc {
- return $_pseudodesc if $_pseudodesc;
- my %pseudodesc;
-
- if (not defined $config{pseudo_desc_file}) {
- $_pseudodesc = {};
- return $_pseudodesc;
- }
- my $pseudo = IO::File->new($config{pseudo_desc_file},'r')
- or die "Unable to open $config{pseudo_desc_file}: $!";
- while(<$pseudo>) {
- next unless m/^(\S+)\s+(\S.*\S)\s*$/;
- $pseudodesc{lc $1} = $2;
- }
- close($pseudo);
- $_pseudodesc = \%pseudodesc;
+ return $_pseudodesc if defined $_pseudodesc;
+ $_pseudodesc = {};
+ __add_to_hash($config{pseudo_desc_file},$_pseudodesc) if
+ defined $config{pseudo_desc_file};
return $_pseudodesc;
}
print {$transcript} "Was blocked by: $data->{blockedby}\n";
}
my @changed;
- push @changed, 'added blocking bug(s) '.english_join([keys %added_blockers]) if keys %added_blockers;
- push @changed, 'removed blocking bug(s) '.english_join([keys %removed_blockers]) if keys %removed_blockers;
+ push @changed, 'added blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %added_blockers]) if keys %added_blockers;
+ push @changed, 'removed blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %removed_blockers]) if keys %removed_blockers;
$action = ucfirst(join ('; ',@changed)) if @changed;
if (not @changed) {
print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n"
# pseudo-headers
if ($line =~ m{^\s*(?:(?:Package|Source|Version)\:| #pseudo headers
(?:package|(?:no|)owner|severity|tag|summary| #control
- reopen|close|(?:not|)(?:fixed|found)|clone|
+ \#|reopen|close|(?:not|)(?:fixed|found)|clone|
(?:force|)merge|user(?:category|tag|)
)
)\s+\S}x) {
sub __internal_request{
my ($l) = @_;
$l = 0 if not defined $l;
- if (defined +(caller(2+$l))[0] and +(caller(2+$l))[0] eq __PACKAGE__) {
+ if (defined((caller(1+$l))[0]) and (caller(1+$l))[0] eq __PACKAGE__) {
return 1;
}
return 0;
if (not @data) {
die "Unable to read any bugs successfully.";
}
+ if (not $param{archived}) {
+ for my $data (@data) {
+ if ($data->{archived}) {
+ die "Not altering archived bugs; see unarchive.";
+ }
+ }
+ }
if (not __check_limit(data => \@data,
exists $param{limit}?(limit => $param{limit}):(),
)) {
recipients => $param{recipients},
(exists $param{command}?(actions_taken => {$param{command} => 1}):()),
debug => $debug,
- transcript => $transcript,
+ (__internal_request()?(transcript => $transcript):()),
);
print {$debug} "$param{bug} read done\n";
# need an extra cache for speed here.
return () unless defined $gBinarySourceMap;
+ if ($binname =~ m/^src:(.+)$/) {
+ return $1;
+ }
if (not tied %_binarytosource) {
tie %_binarytosource, MLDBM => $gBinarySourceMap, O_RDONLY or
die "Unable to open $gBinarySourceMap for reading";
type => 'bcc',
);
}
- if (defined(getmaintainers()->{$p})) {
- $addmaint= getmaintainers()->{$p};
- print {$param{debug}} "MR|$addmaint|$p|$ref|\n";
- _add_address(recipients => $param{recipients},
- address => $addmaint,
- reason => $p,
- bug_num => $param{data}{bug_num},
- type => 'cc',
- );
- print {$param{debug}} "maintainer add >$p|$addmaint<\n";
+ my @maints = package_maintainer(binary => $p);
+ if (@maints) {
+ print {$param{debug}} "MR|".join(',',@maints)."|$p|$ref|\n";
+ _add_address(recipients => $param{recipients},
+ address => \@maints,
+ reason => $p,
+ bug_num => $param{data}{bug_num},
+ type => 'cc',
+ );
+ print {$param{debug}} "maintainer add >$p|".join(',',@maints)."<\n";
}
- else {
+ else {
print {$param{debug}} "maintainer none >$p<\n";
print {$param{transcript}} "Warning: Unknown package '$p'\n";
print {$param{debug}} "MR|unknown-package|$p|$ref|\n";
) {
@elements = split $split_fields{$field}, $data->{$field};
}
- if (@elements != 1) {
- $data->{$field} = \@elements;
- }
- else {
- $data->{$field} = $elements[0];
- }
+ $data->{$field} = \@elements;
}
}
}
use warnings;
use strict;
-use Getopt::Long;
+use Getopt::Long qw(:config no_ignore_case);
use Pod::Usage;
=head1 NAME
File which contains the set of bugs to get.
Defaults to ~/.debbugs/bugs_to_get
+=item B<--bug-site>
+
+Hostname for a site which is running a debbugs install
+Defaults to bugs.debian.org
+
+=item B<--bug-mirror>
+
+Hostname for a site which is running an rsyncable mirror of the
+debbugs install above.
+Defaults to bugs-mirror.debian.org
+
=item B<--debug, -d>
Debug verbosity. (Default 0)
use File::Temp qw(tempdir);
use Params::Validate qw(validate_with :types);
use POSIX 'setsid';
-use Debbugs::Common qw(checkpid lockpid);
+use Debbugs::Common qw(checkpid lockpid get_hashname);
+use Debbugs::Mail qw(get_addresses);
+use SOAP::Lite;
+use IPC::Run;
+use IO::File;
+use File::Path;
+
my %options = (debug => 0,
help => 0,
verbose => 0,
quiet => 0,
detach => 1,
- cgi_bin => '/var/lib/debbugs/www/cgi-bin',
+ cgi_bin => '/var/lib/debbugs/www/cgi',
css => '/var/lib/debbugs/www/bugs.css',
+ bug_site => 'bugs.debian.org',
+ bug_mirror => 'bugs-mirror.debian.org',
);
my %option_defaults = (port => 8080,
debbugs_config => User->Home.'/.debbugs/debbugs_config',
- mirror_location => User->Home.'/.debbugs/mirror/',
+ mirror_location => User->Home.'/.debbugs/mirror',
bugs_to_get => User->Home.'/.debbugs/bugs_to_get',
);
'detach!',
'css=s','cgi_bin|cgi-bin|cgi=s',
'verbose|v+','quiet|q+',
+ 'bug_site|bug-site=s',
+ 'bug_mirror|bug-mirror=s',
'debug|d+','help|h|?','man|m');
pod2usage() if $options{help};
local_config(\%options);
+mkpath($options{mirror_location});
+
if ($options{daemon}) {
# daemonize, do stuff
my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
elsif ($options{mirror}) {
# run the mirror jobies
# figure out which bugs we need
- my @bugs = select_bugs(\%options);
+ my $bugs = select_bugs(\%options);
# get them
- my $tempdir = tempdir(CLEANUP => 1);
- my $mirror_log = IO::File->new($options{mirror_location}.'/mirror.log') or
+ my $tempdir = tempdir();#CLEANUP => 1);
+ my $mirror_log = IO::File->new($options{mirror_location}.'/mirror.log','>') or
die "Unable to open $options{mirror_location}/mirror.log for writing: $!";
- my $inc_fh = IO::File->new("$tempdir/include_list",'w') or
- die "Unable to open $tempdir/include_list for writing: $!";
- foreach my $bug (@bugs) {
- print {$inc_fh} "*/${bug}.*\n" or
- die "Unable to write to $tempdir/include_list: $!";
- }
- close $inc_fh or
- die "Unable to close $tempdir/include_list: $!";
- my ($wrf,$rfh);
+ write_bug_list("$tempdir/unarchived_bug_list",$bugs->{unarchived});
+ write_bug_list("$tempdir/archived_bug_list",$bugs->{archived});
+ my ($wrf,$rfh,$efh);
my @common_rsync_options = ('-avz','--partial');
print "Rsyncing bugs\n" if not $options{quiet};
run_rsync(log => $mirror_log,
($options{debug}?(debug => \*STDERR):()),
options => [@common_rsync_options,
'--delete-after',
- '--include-from',"$tempdir/include_list",
- # skip things not specifically included
- '--exclude','*/*',
- # skip the -1,-2,-3.log files
- '--exclude','*.log',
+ '--files-from',"$tempdir/unarchived_bug_list",
'rsync://'.$options{bug_mirror}.'/bts-spool-db/',
$options{mirror_location}.'/db-h/']
);
($options{debug}?(debug => \*STDERR):()),
options => [@common_rsync_options,
'--delete-after',
- '--include-from',"$tempdir/include_list",
- # skip things not specifically included
- '--exclude','*/*',
- # skip the -1,-2,-3.log files
- '--exclude','*.log',
+ '--files-from',"$tempdir/archived_bug_list",
'rsync://'.$options{bug_mirror}.'/bts-spool-archive/',
$options{mirror_location}.'/archive/',
],
'--delete-after',
'--exclude','*old',
'--exclude','*.bak',
- 'rsync://'.$options{bug_mirror}.'/bts-spool-versions/',
+ 'rsync://'.$options{bug_mirror}.'/bts-versions/',
$options{mirror_location}.'/versions/',
],
);
}
}
+sub write_bug_list {
+ my ($file,$bug_list) = @_;
+ my $inc_fh = IO::File->new($file,'w') or
+ die "Unable to open $file for writing: $!";
+ foreach my $bug (keys %{$bug_list}) {
+ my $file_loc = get_hashname($bug).'/'.$bug;
+ print {$inc_fh} map {$file_loc.'.'.$_.qq(\n)} qw(log summary report status) or
+ die "Unable to write to $file: $!";
+ }
+ close $inc_fh or
+ die "Unable to close $file: $!";
+}
+
# actually run rsync with the passed options
sub run_rsync{
my %param = validate_with(params => \@_,
},
}
);
- my ($output_fh,@rsync_options) = @_;
- my ($wfh,$rfh);
- my $pid = open3($wfh,$rfh,
- 'rsync',
- @{$param{options}}
- ) or die "Unable to start rsync: $!";
- close $wfh or die "Unable to close the writer filehandle $?";
- while (<$rfh>) {
- print {$param{log}} $_;
- if (exists $param{debug}) {
- print {$param{debug}} $_;
- }
+ my ($output,$error) = ('','');
+ my $h = IPC::Run::start(['rsync',@{$param{options}}],
+ \undef,\$output,\$error);
+ while ($h->pump) {
+ print {$param{log}} $output,$error;
+ #print {$param{debug}} $error if defined $param{debug};
+ }
+ $h->finish();
+ my $exit = $h->result(0);
+ # this is suboptimal, but we currently don't know whether we've
+ # selected an archive or unarchived bug, so..
+ if (defined $exit and not ($exit == 0 or $exit == 3 or $exit == 23)) {
+ print STDERR "Rsync exited with non-zero status: $exit\n";
}
}
my $soap = SOAP::Lite
-> uri('Debbugs/SOAP/V1')
- -> proxy("http://$options{bug_mirror}/cgi-bin/soap.cgi");
+ -> proxy("http://$options{bug_site}/cgi-bin/soap.cgi");
my @bugs;
my @bug_selections = ();
if (not -e $options{bugs_to_get}) {
# maintained by this user, submitted by this user, and rc
# bugs
push @bug_selections,
- ("correspondent:$addr archive:both",
- "maint:$addr archive:both",
- "submitter:$addr archive:both",
- "severity:serious severity:grave severity:critical archive:both",
+ ("correspondent:$addr archive:0",
+ "maint:$addr archive:0",
+ "submitter:$addr archive:0",
+ "severity:serious severity:grave severity:critical archive:0",
);
}
else {
}
}
}
+ # Split archive:both into archive:1 and archive:0
+ @bug_selections =
+ map {
+ if (m/archive:both/) {
+ my $y_archive = $_;
+ my $n_archive = $_;
+ $y_archive =~ s/archive:both/archive:1/;
+ $n_archive =~ s/archive:both/archive:0/;
+ ($y_archive,$n_archive);
+ }
+ else {
+ $_;
+ }
+ } @bug_selections;
+ my %bugs;
for my $selection (@bug_selections) {
- my @subselects = split /\s+/,$selection;
- my %search_parameters;
- my %users;
- for my $subselect (@subselects) {
- my ($key,$value) = split /:/, $subselect, 2;
- next unless $key;
- if (exists $valid_keys{$key}) {
- push @{$search_parameters{$valid_keys{$key}}},
- $value if $value;
- } elsif ($key =~/users?$/) {
- $users{$value} = 1 if $value;
- }
- }
- my %usertags;
- for my $user (keys %users) {
- my $ut = $soap->get_usertag($user)->result();
- next unless defined $ut and $ut ne "";
- for my $tag (keys %{$ut}) {
- push @{$usertags{$tag}},
- @{$ut->{$tag}};
- }
- }
- my $bugs = $soap->get_bugs(%search_parameters,
- (keys %usertags)?(usertags=>\%usertags):()
- )->result();
- push @bugs,@{$bugs} if defined $bugs and @{$bugs};
+ my $archived_bugs = "unarchived";
+ if ($selection =~ /archive:(\S+)/ and $1) {
+ $archived_bugs = "archived";
+ }
+ my @subselects = split /\s+/,$selection;
+ my %search_parameters;
+ my %users;
+ for my $subselect (@subselects) {
+ my ($key,$value) = split /:/, $subselect, 2;
+ next unless $key;
+ if (exists $valid_keys{$key}) {
+ push @{$search_parameters{$valid_keys{$key}}},
+ $value if $value;
+ } elsif ($key =~/users?$/) {
+ $users{$value} = 1 if $value;
+ }
+ }
+ my %usertags;
+ for my $user (keys %users) {
+ my $ut = $soap->get_usertag($user)->result();
+ next unless defined $ut and $ut ne "";
+ for my $tag (keys %{$ut}) {
+ push @{$usertags{$tag}},
+ @{$ut->{$tag}};
+ }
+ }
+ my $bugs = $soap->get_bugs(%search_parameters,
+ (keys %usertags)?(usertags=>\%usertags):()
+ )->result();
+ if (defined $bugs and @{$bugs}) {
+ $bugs{$archived_bugs}{$_} = 1 for @{$bugs};
+ }
}
- return @bugs;
+ return \%bugs;
}
use Debbugs::CGI::Bugreport qw(:all);
use Debbugs::Common qw(buglog getmaintainers make_list bug_status);
use Debbugs::Packages qw(getpkgsrc);
-use Debbugs::Status qw(splitpackages get_bug_status isstrongseverity);
+use Debbugs::Status qw(splitpackages split_status_fields get_bug_status isstrongseverity);
use Scalar::Util qw(looks_like_number);
}
-my %status = %{get_bug_status(bug=>$ref,
- bugusertags => \%bugusertags,
- )};
+my %status =
+ %{split_status_fields(get_bug_status(bug=>$ref,
+ bugusertags => \%bugusertags,
+ ))};
my @records;
eval{
}
# fixup various bits of the status
-$status{tags_array} = [sort(split(/\s+/, $status{tags}))];
+$status{tags_array} = [sort(make_list($status{tags}))];
$status{date_text} = strftime('%a, %e %b %Y %T UTC', gmtime($status{date}));
-$status{mergedwith_array} = [split(/ /,$status{mergedwith})];
+$status{mergedwith_array} = [make_list($status{mergedwith})];
my $version_graph = '';
-my @blockedby= split(/ /, $status{blockedby});
+my @blockedby= make_list($status{blockedby});
$status{blockedby_array} = [];
if (@blockedby && $status{"pending"} ne 'fixed' && ! length($status{done})) {
for my $b (@blockedby) {
}
}
-my @blocks= split(/ /, $status{blocks});
+my @blocks= make_list($status{blocks});
$status{blocks_array} = [];
if (@blocks && $status{"pending"} ne 'fixed' && ! length($status{done})) {
for my $b (@blocks) {
isstrongseverity => \&Debbugs::Status::isstrongseverity,
html_escape => \&Debbugs::CGI::html_escape,
looks_like_number => \&Scalar::Util::looks_like_number,
+ make_list => \&Debbugs::Common::make_list,
},
hole_var => {'&package_links' => \&Debbugs::CGI::package_links,
'&bug_links' => \&Debbugs::CGI::bug_links,
# soapy is stupid, and is using the 1999 schema; override it.
*SOAP::XMLSchema1999::Serializer::as_base64Binary = \&SOAP::XMLSchema2001::Serializer::as_base64Binary;
*SOAP::Serializer::as_anyURI = \&SOAP::XMLSchema2001::Serializer::as_string;
+# do this twice to avoid the warning if the serializer doesn't get
+# used
+*SOAP::XMLSchema1999::Serializer::as_base64Binary = \&SOAP::XMLSchema2001::Serializer::as_base64Binary;
+*SOAP::Serializer::as_anyURI = \&SOAP::XMLSchema2001::Serializer::as_string;
# to work around the serializer improperly using date/time stuff
# (Nothing in Debbugs should be looked at as if it were date/time) we
# kill off all of the date/time related bits in the serializer.
-debbugs (2.4.2~exp0) UNRELEASED; urgency=low
+debbugs (2.4.2~exp0) experimental; urgency=low
[ Anthony Towns ]
* Add "package" command to service (control@) to limit the bugs that
* Allow for tag nnn = baz + foo - bar in service (closes: #505189)
* Allow trailinng periods after the control stop commands (closes:
#517834)
+ * Ditch extra blank lines (closes: #494843)
+ * Handle ' ending links in Debbugs::CGI::Bugreport (closes: #539020)
- -- Colin Watson <cjwatson@debian.org> Fri, 20 Jun 2003 18:57:25 +0100
+ -- Don Armstrong <don@debian.org> Sun, 26 Jul 2009 05:48:16 -0700
debbugs (2.4.1) unstable; urgency=low
Section: misc
Priority: extra
Maintainer: Debbugs developers <debian-debbugs@lists.debian.org>
-Uploaders: Josip Rodin <joy-packages@debian.org>, Colin Watson <cjwatson@debian.org>, Don Armstrong <don@debian.org>
+Uploaders: Colin Watson <cjwatson@debian.org>, Don Armstrong <don@debian.org>
Standards-Version: 3.8.1
-Build-Depends-Indep: debhelper, libparams-validate-perl,
+Build-Depends: debhelper (>= 5)
+Build-Depends-Indep: libparams-validate-perl,
libmailtools-perl, libmime-tools-perl, libio-stringy-perl, libmldbm-perl,
liburi-perl, libsoap-lite-perl, libcgi-simple-perl,
libhttp-server-simple-perl, libtest-www-mechanize-perl,
dh_testdir
dh_testroot
rm -f *-stamp;
- -$(MAKE) -f Makefile.perl clean;
+ if [ -e Makefile.perl ]; then \
+ $(MAKE) -f Makefile.perl clean; \
+ fi;
#something to remove all trace and *.trace files?
+ rm -f debbugs.trace Makefile.perl.old
dh_clean
install: install-stamp
use Debbugs::Packages qw(getpkgsrc);
use Debbugs::User qw(read_usertags write_usertags);
use Debbugs::Common qw(:lock get_hashname);
-use Debbugs::Status qw(writebug isstrongseverity lockreadbugmerge lockreadbug read_bug :versions);
+use Debbugs::Status qw(writebug isstrongseverity lockreadbugmerge lockreadbug read_bug splitpackages :versions);
use Debbugs::CGI qw(html_escape bug_url);
}
close(SOURCES);
my $anymaintfound=0; my $anymaintnotfound=0;
- for my $p (split(m/[ \t?,():]+/,$data->{package})) {
+ for my $p (splitpackages($data->{package})) {
$p =~ y/A-Z/a-z/;
$p =~ /([a-z0-9.+-]+)/;
$p = $1;
my @common_control_options =
- (($dl > 0 ? (debug => $transcript):()),
- transcript => $transcript,
+ (transcript => $transcript,
requester => $header{from},
request_addr => $controlrequestaddr,
request_msgid => $header{'message-id'},
last;
} elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
$dl= $1+0;
- print {$transcript} "Debug level $dl.\n\n";
+ if ($dl > 0 and not grep /debug/,@common_control_options) {
+ push @common_control_options,(debug => $transcript);
+ }
+ print {$transcript} "Debug level $dl.\n\n";
} elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
$ref= $2+0;
&sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
# to set_found
if (defined($version) && length $version) {
set_found(@common_control_options,
- bug => $ref,
- version => $version,
+ bug => $ref,
+ found => $version,
);
}
};
if (scalar(@pkgs) > 0) {
%limit_pkgs = map { ($_, 1) } @pkgs;
$limit{package} = [@pkgs];
- print {$transcript} "Ignoring bugs not assigned to: " .
- join(" ", keys(%limit_pkgs)) . "\n\n";
+ print {$transcript} "Limiting to bugs with field 'package' containing at least one of ".join(', ',map {qq('$_')} @pkgs)."\n";
+ print {$transcript} "Limit currently set to ";
+ for my $limit_field (keys %limit) {
+ print {$transcript} " '$limit_field':".join(', ',map {qq('$_')} @{$limit{$limit_field}})."\n";
+ }
+ print {$transcript} "\n";
} else {
- %limit_pkgs = ();
- print {$transcript} "Not ignoring any bugs.\n\n";
+ %limit_pkgs = ();
+ $limit{package} = [];
+ print {$transcript} "Limit cleared.\n\n";
}
} elsif (m/^limit\:?\s+(\S.*\S)\s*$/) {
$ok++;
print {$transcript} "Limiting to bugs with field '$field' containing at least one of ".join(', ',map {qq('$_')} @options)."\n";
print {$transcript} "Limit currently set to ";
for my $limit_field (keys %limit) {
- print {$transcript} " '$limit_field':".join(', ',map {qq('$_')} @options)."\n";
+ print {$transcript} " '$limit_field':".join(', ',map {qq('$_')} @{$limit{$limit_field}})."\n";
}
print {$transcript} "\n";
}
-{include('mail/header')}
-{$body}
+{include('mail/header')}{$body}
{include('mail/footer')}
\ No newline at end of file
Please do not send mail to {$config{maintainer_email}} unless you wish
to report a problem with the {ucfirst($config{bug})}-tracking system.
-{$brokenness}
+{$brokenness}
\ No newline at end of file