This queue is for tickets about the CPAN CPAN distribution.

Report information
The Basics
Id:
39551
Status:
resolved
Priority:
Low/Low
Queue:

People
Owner:
Nobody in particular
Requestors:
GAAS [...] cpan.org
Cc:
AdminCc:

BugTracker
Severity:
(no value)
Broken in:
(no value)
Fixed in:
(no value)

Attachments
0001-RT-39551-Allow-the-Distroprefs-match-entries-to-b.patch negated_distroprefs_match.patch



Subject: Allow the Distroprefs 'match' entries to be negated [PATCH]
The attached patch will allow the distroprefs match entries to be negated by prefixing them with "!". I currently use it for our build system to be able to specify entries that should apply everywhere except on "Mac OS X": match: distribution: .... perlconfig: osname: "!^darwin$" The alternative approach I was considering was to introduce a 'not_match' hash at the top level; but I droppped that as it seemed to require much bigger code changes and does not actually look better either.
Subject: negated_distroprefs_match.patch
Index: CPAN/lib/CPAN/Distroprefs.pm --- CPAN/lib/CPAN/Distroprefs.pm.~1~ Tue Sep 23 21:34:36 2008 +++ CPAN/lib/CPAN/Distroprefs.pm Tue Sep 23 21:34:36 2008 @@ -213,10 +213,18 @@ return eval sprintf 'qr{%s}', $self->data->{match}{$key}; } +sub _match { + my ($self, $qr, $val) = @_; + my $not = ($qr =~ s/!\s*//); + $qr = eval sprintf 'qr{%s}', $qr; + my $match = ($val =~ /$qr/); + $match = !$match if $not; + return $match; +} + sub _scalar_match { my ($self, $key, $data) = @_; - my $qr = $self->_pattern($key); - return $data =~ /$qr/ ? 1 : 0; + return $self->_match($self->data->{match}{$key}, $data); } sub _hash_match { @@ -224,8 +232,7 @@ my $match = $self->data->{match}{$key}; for my $mkey (keys %$match) { my $val = defined $data->{$mkey} ? $data->{$mkey} : ''; - my $qr = eval sprintf 'qr{%s}', $match->{$mkey}; - return 0 unless $val =~ /$qr/; + return 0 unless $self->_match($match->{$mkey}, $val); } return 1; } End of Patch.
Sorry I haven't responded earlier. I'm mentally in feature freeze for 1.93 because there was a patch with the word security in the label :-/ I'll address both your patches immediately after 1.93. Until then I have a question: could you imagine that the "!" be attached to the keyword instead of the argument? I'm not asking for not_matches. This is certainly too far fetched. But having the ! inside the value on the right hand side feels a bit hard to swallow. If it were doable on the left hand side, that would make it much smoother it seems. (I'm sorry, I haven't really thought it through, so I may be off the track)
On Mon Sep 29 19:25:00 2008, ANDK wrote:
Show quoted text
> Until then I have a question: could you imagine that the "!" be attached > to the keyword instead of the argument? I'm not asking for not_matches.
So are you suggesting we make it something like: | match: | distribution: "regexp" | perlconfig: | not_osname: "regexp" ?
On Tue Sep 30 04:08:30 2008, GAAS wrote:
Show quoted text
> On Mon Sep 29 19:25:00 2008, ANDK wrote:
> > Until then I have a question: could you imagine that the "!" be attached > > to the keyword instead of the argument? I'm not asking for not_matches.
> > So are you suggesting we make it something like: > > | match: > | distribution: "regexp" > | perlconfig: > | not_osname: "regexp" > > ?
I really hate how RT squashes spaces. I though it would help to prefix the lines with "|" but apparently not. Oh well...
Subject: Re: [rt.cpan.org #39551] Allow the Distroprefs 'match' entries to be negated [PATCH]
Date: Wed, 01 Oct 2008 21:51:56 +0200
To: bug-CPAN@rt.cpan.org
From: andreas.koenig.7os6VVqR@franz.ak.mind.de (Andreas J. Koenig)
Show quoted text
>>>>> On Tue, 30 Sep 2008 04:11:12 -0400, "Gisle_Aas via RT" <bug-CPAN@rt.cpan.org> said:
Show quoted text
>> So are you suggesting we make it something like: >> >> | match: >> | distribution: "regexp" >> | perlconfig: >> | not_osname: "regexp" >> >> ?
Yes, something like this. I'm not really suggesting it, I'm more asking for your opinion because you are probably closer to the problem at the moment than I am. I onloy know that C<foo: "!flurbl"> does not look like a negation to me, while I convince my perception that C<!foo: "flurbl"> might be a negation. With a prepended "not_" this perception is distracted again. It may be a personal dissonance only, I'm really not sure. -- andreas
On Wed Oct 01 15:52:10 2008, andreas.koenig.7os6VVqR@franz.ak.mind.de wrote:
Show quoted text
> >>>>> On Tue, 30 Sep 2008 04:11:12 -0400, "Gisle_Aas via RT" <bug-
> CPAN@rt.cpan.org> said: >
> >> So are you suggesting we make it something like: > >> > >> | match: > >> | distribution: "regexp" > >> | perlconfig: > >> | not_osname: "regexp" > >> > >> ?
> > Yes, something like this. I'm not really suggesting it, I'm more > asking for your opinion because you are probably closer to the problem > at the moment than I am. > > I onloy know that C<foo: "!flurbl"> does not look like a negation to > me, while I convince my perception that C<!foo: "flurbl"> might be a > negation. With a prepended "not_" this perception is distracted again. > It may be a personal dissonance only, I'm really not sure. >
!foo: "flurbl" does not work as YAML syntax. The ! is magic of some kind. foo!: "flurbl" does work, but it does not look like negation to me. "!foo": "flurbl" probably also work, but I also find that unreadable. My favorite of these are still "not_foo".
Subject: Re: [rt.cpan.org #39551] Allow the Distroprefs 'match' entries to be negated [PATCH]
Date: Wed, 1 Oct 2008 19:59:57 -0400
To: bug-CPAN@rt.cpan.org
From: "David Golden" <dagolden@cpan.org>
On Wed, Oct 1, 2008 at 4:12 PM, Gisle_Aas via RT <bug-CPAN@rt.cpan.org> wrote:
Show quoted text
> My favorite of these are still "not_foo".
+1 I like this. Is any "foo" and "not_foo" combination together legal? -- David
On Wed Oct 01 20:00:09 2008, DAGOLDEN wrote:
Show quoted text
> Is any "foo" and "not_foo" combination together legal?
Yes, I don't see any reason to complicate with exceptions. not_module is probably not that useful as it would basically require that none of the modules match the expression.
Attached is an updated patch that implement this with "not_" prefix on the keys and adds a test case and some lines to the docs. I created a new test file since the 42distroprefs.t file only ran when YAML was available while my tests examine the CPAN::Distroprefs::Pref behaviour directly and does not need that prereq. The patch is relative to CPAN-1.92_66.
From fcf58d2cfebe669734c0d0e9877adbfbc9aa729d Mon Sep 17 00:00:00 2001 From: Gisle Aas <gisle@aas.no> Date: Wed, 24 Sep 2008 10:38:25 +0200 Subject: [PATCH] RT#39551: Allow the Distroprefs 'match' entries to be negated --- MANIFEST | 1 + lib/CPAN.pm | 5 ++ lib/CPAN/Distroprefs.pm | 67 +++++++++++++++++++------- t/43distroprefspref.t | 123 +++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 179 insertions(+), 17 deletions(-) create mode 100644 t/43distroprefspref.t diff --git a/MANIFEST b/MANIFEST index 5af62ab..4dbb92b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -394,6 +394,7 @@ t/30shell.t t/31sessions.t t/41distribution.t t/42distroprefs.t +t/43distroprefspref.t t/50pod.t t/51pod.t t/52podcover.t diff --git a/lib/CPAN.pm b/lib/CPAN.pm index 7fab633..4eb7d24 100644 --- a/lib/CPAN.pm +++ b/lib/CPAN.pm @@ -11695,9 +11695,11 @@ C<expect>. match: module: "Dancing::Queen" distribution: "^CHACHACHA/Dancing-" + not_distribution: "\.zip$" perl: "/usr/local/cariba-perl/bin/perl" perlconfig: archname: "freebsd" + not_cc: "gcc" env: DANCING_FLOOR: "Shubiduh" disabled: 1 @@ -11815,6 +11817,7 @@ CPAN mantra. See below under I<Processing Instructions>. A hashref with one or more of the keys C<distribution>, C<modules>, C<perl>, C<perlconfig>, and C<env> that specify if a document is targeted at a specific CPAN distribution or installation. +Keys prefixed with C<not_> negates the corresponding match. The corresponding values are interpreted as regular expressions. The C<distribution> related one will be matched against the canonical @@ -11829,9 +11832,11 @@ absolute path). The value associated with C<perlconfig> is itself a hashref that is matched against corresponding values in the C<%Config::Config> hash living in the C<Config.pm> module. +Keys prefixed with C<not_> negates the corresponding match. The value associated with C<env> is itself a hashref that is matched against corresponding values in the C<%ENV> hash. +Keys prefixed with C<not_> negates the corresponding match. If more than one restriction of C<module>, C<distribution>, etc. is specified, the results of the separately computed match values must diff --git a/lib/CPAN/Distroprefs.pm b/lib/CPAN/Distroprefs.pm index 664ddb7..708a6f1 100644 --- a/lib/CPAN/Distroprefs.pm +++ b/lib/CPAN/Distroprefs.pm @@ -201,33 +201,63 @@ sub data { shift->{data} } sub has_any_match { $_[0]->data->{match} ? 1 : 0 } -sub has_match { exists $_[0]->data->{match}{$_[1]} } +sub has_match { + my $match = $_[0]->data->{match} || return 0; + exists $match->{$_[1]} || exists $match->{"not_$_[1]"} +} sub has_valid_subkeys { grep { exists $_[0]->data->{match}{$_} } + map { $_, "not_$_" } $_[0]->match_attributes } sub _pattern { - my ($self, $key) = @_; - return eval sprintf 'qr{%s}', $self->data->{match}{$key}; + my $re = shift; + return eval sprintf 'qr{%s}', $re; +} + +sub _match_scalar { + my ($match, $data) = @_; + my $qr = _pattern($match); + return $data =~ /$qr/; +} + +sub _match_hash { + my ($match, $data) = @_; + for my $mkey (keys %$match) { + (my $dkey = $mkey) =~ s/^not_//; + my $val = defined $data->{$dkey} ? $data->{$dkey} : ''; + if (_match_scalar($match->{$mkey}, $val)) { + return 0 if $mkey =~ /^not_/; + } + else { + return 0 if $mkey !~ /^not_/; + } + } + return 1; +} + +sub _match { + my ($self, $key, $data, $matcher) = @_; + my $m = $self->data->{match}; + if (exists $m->{$key}) { + return 0 unless $matcher->($m->{$key}, $data); + } + if (exists $m->{"not_$key"}) { + return 0 if $matcher->($m->{"not_$key"}, $data); + } + return 1; } sub _scalar_match { my ($self, $key, $data) = @_; - my $qr = $self->_pattern($key); - return $data =~ /$qr/ ? 1 : 0; + return $self->_match($key, $data, \&_match_scalar); } sub _hash_match { my ($self, $key, $data) = @_; - my $match = $self->data->{match}{$key}; - for my $mkey (keys %$match) { - my $val = defined $data->{$mkey} ? $data->{$mkey} : ''; - my $qr = eval sprintf 'qr{%s}', $match->{$mkey}; - return 0 unless $val =~ /$qr/; - } - return 1; + return $self->_match($key, $data, \&_match_hash); } # do not take the order of C<keys %$match> because "module" is by far the @@ -236,11 +266,14 @@ sub match_attributes { qw(env distribution perl perlconfig module) } sub match_module { my ($self, $modules) = @_; - my $qr = $self->_pattern('module'); - for my $module (@$modules) { - return 1 if $module =~ /$qr/; - } - return 0; + return $self->_match("module", $modules, sub { + my($match, $data) = @_; + my $qr = _pattern($match); + for my $module (@$data) { + return 1 if $module =~ /$qr/; + } + return 0; + }); } sub match_distribution { shift->_scalar_match(distribution => @_) } diff --git a/t/43distroprefspref.t b/t/43distroprefspref.t new file mode 100644 index 0000000..b2acd4f --- /dev/null +++ b/t/43distroprefspref.t @@ -0,0 +1,123 @@ +use strict; + +use Test::More; +use CPAN::Distroprefs; + +plan tests => 21; + +my $p; + +# start with something simple +$p = CPAN::Distroprefs::Pref->new({ + data => { + match => { + distribution => "^XML", + }, + }, +}); + +ok($p->data); +ok($p->has_match("distribution")); +ok(!$p->has_match("perl")); +ok($p->has_any_match); +ok($p->has_valid_subkeys); + +ok($p->matches({ + distribution => "XML::Parser", +})); + +ok(!$p->matches({ + distribution => "Foo::XML", +})); + +# still simple, but now a negated match +$p = CPAN::Distroprefs::Pref->new({ + data => { + match => { + not_distribution => "^XML", + }, + }, +}); + +ok($p->data); +ok($p->has_match("distribution")); +ok(!$p->has_match("perl")); +ok($p->has_any_match); +ok($p->has_valid_subkeys); + +ok(!$p->matches({ + distribution => "XML::Parser", +})); + +ok($p->matches({ + distribution => "Foo::XML", +})); + +# try some complicated matches +$p = CPAN::Distroprefs::Pref->new({ + data => { + match => { + distribution => "^XML", + not_distribution => "Parser", + perlconfig => { + osname => "linux", + not_cc => "^gcc\$", + }, + }, + }, +}); + +ok(!$p->matches({ + distribution => "XML::Parser", +})); + +ok($p->matches({ + distribution => "XML::Foo", + perlconfig => { + osname => "linux", + cc => "cc", + }, +})); + +ok(!$p->matches({ + distribution => "XML::Foo", + perlconfig => { + osname => "linux", + cc => "gcc", + }, +})); + +ok(!$p->matches({ + distribution => "XML::Foo", + perlconfig => { + osname => "darwin", + cc => "cc", + }, +})); + +# try match on module +$p = CPAN::Distroprefs::Pref->new({ + data => { + match => { + module => "^LWP", + not_module => "Foo", + }, + }, +}); + +ok($p->matches({ + module => ["LWP::UserAgent"], +})); + +ok(!$p->matches({ + module => ["LWP::UserAgent", "LWP::Foo"], +})); + +ok(!$p->matches({ + module => ["Bar"], +})); + +# Local Variables: +# mode: cperl +# cperl-indent-level: 2 +# End: -- 1.6.0.GIT
Thanks! Applied to my repository.


This service runs on Request Tracker, is sponsored by The Perl Foundation, and maintained by Best Practical Solutions.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.