From 786f190434f20bd7fcacd8052275ced17de0fe7f Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Mon, 20 Nov 2006 23:59:30 -0800 Subject: [PATCH] fix Debbugs::Status for the errorlib changes; fix 03_versions.t --- Debbugs/Status.pm | 45 +++++++++++++++++++++++++++++---------------- t/03_versions.t | 2 +- 2 files changed, 30 insertions(+), 17 deletions(-) diff --git a/Debbugs/Status.pm b/Debbugs/Status.pm index 58a7e65..cffd958 100644 --- a/Debbugs/Status.pm +++ b/Debbugs/Status.pm @@ -46,6 +46,7 @@ BEGIN{ read => [qw(readbug read_bug lockreadbug)], write => [qw(writebug makestatus unlockwritebug)], versions => [qw(addfoundversion addfixedversion), + qw(removefoundversions) ], ); @EXPORT_OK = (); @@ -388,33 +389,45 @@ sub addfoundversions { } } +=head2 removefoundversions + + removefoundversions($data,$package,$versiontoremove) + +Removes found versions from $data + +If a version is fully qualified (contains /) only versions matching +exactly are removed. Otherwise, all versions matching the version +number are removed. + +Currently $package and $isbinary are entirely ignored, but accepted +for backwards compatibilty. + +=cut + sub removefoundversions { my $data = shift; my $package = shift; my $version = shift; my $isbinary = shift; return unless defined $version; - undef $package if $package =~ m[(?:\s|/)]; - my $source = $package; - - if (defined $package and $isbinary) { - my @srcinfo = binarytosource($package, $version, undef); - if (@srcinfo) { - # We know the source package(s). Use a fully-qualified version. - removefoundversions($data, $_->[0], $_->[1], '') foreach @srcinfo; - return; - } - # Otherwise, an unqualified version will have to do. - undef $source; - } foreach my $ver (split /[,\s]+/, $version) { - my $sver = defined($source) ? "$source/$ver" : ''; - @{$data->{found_versions}} = - grep { $_ ne $ver and $_ ne $sver } @{$data->{found_versions}}; + if ($ver =~ m{/}) { + # fully qualified version + @{$data->{found_versions}} = + grep {$_ ne $ver} + @{$data->{found_versions}}; + } + else { + # non qualified version; delete all matchers + @{$data->{found_versions}} = + grep {$_ !~ m[(?:^|/)\Q$ver\E$]} + @{$data->{found_versions}}; + } } } + sub addfixedversions { my $data = shift; my $package = shift; diff --git a/t/03_versions.t b/t/03_versions.t index ace98ce..1a9af80 100644 --- a/t/03_versions.t +++ b/t/03_versions.t @@ -20,7 +20,7 @@ my %data = (package => q(foo), ); -require_ok('scripts/errorlib.in'); +use_ok('Debbugs::Status',qw(:versions)); # check removefoundversions my $data = dclone(\%data); removefoundversions($data,$data->{package},'1.00'); -- 2.39.2