From: Vincent Pit Date: Sat, 11 Sep 2010 13:20:28 +0000 (+0200) Subject: Allow the correct package names in atoms X-Git-Tag: v0.11~23 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=c915539acae3c42715a7587868c8165f9bb7137f;p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git Allow the correct package names in atoms Including names containing +, like Text-Tabs+Wrap. --- diff --git a/lib/CPANPLUS/Dist/Gentoo/Atom.pm b/lib/CPANPLUS/Dist/Gentoo/Atom.pm index bbb6d88..33c622c 100644 --- a/lib/CPANPLUS/Dist/Gentoo/Atom.pm +++ b/lib/CPANPLUS/Dist/Gentoo/Atom.pm @@ -32,7 +32,10 @@ use overload ( use CPANPLUS::Dist::Gentoo::Version; -my $version_rx = $CPANPLUS::Dist::Gentoo::Version::version_rx; +my $range_rx = qr/(?:<|<=|=|>=|>)/; +my $name_rx = qr/[a-zA-Z0-9_+-]+/; +my $category_rx = $name_rx; +my $version_rx = $CPANPLUS::Dist::Gentoo::Version::version_rx; =head1 METHODS @@ -52,10 +55,11 @@ sub new { if (defined $args{name}) { ($range, $category, $name, $version) = @args{qw/range category name version/}; Carp::confess('Category unspecified') unless defined $category; - /[^\w-]/ and Carp::confess('Invalid argument') for $name, $category; + Carp::confess('Invalid category') unless $category =~ /^$category_rx$/o; + Carp::confess('Invalid name') unless $name =~ /^$name_rx$/o; } elsif (defined $args{atom}) { my $atom = $args{atom}; - $atom =~ m{^(<|<=|=|>=|>)?([\w-]+)/([\w-]+)(?:-v?($version_rx))?$} + $atom =~ m{^($range_rx)?($category_rx)/($name_rx)(?:-v?($version_rx))?$}o or Carp::confess('Invalid atom'); ($range, $category, $name, $version) = ($1, $2, $3, $4); } else { @@ -71,8 +75,7 @@ sub new { if (defined $version) { if (defined $range) { - Carp::confess("Invalid range $range") - unless grep $range eq $_, qw|< <= = >= >|; + Carp::confess("Invalid range $range") unless $range =~ /^$range_rx$/o; } else { $range = '>='; } @@ -103,7 +106,7 @@ sub new_from_ebuild { my $ebuild = shift; $ebuild = '' unless defined $ebuild; - $ebuild =~ m{/([\w-]+)/([\w-]+)/\2-v?($version_rx)\.ebuild$} + $ebuild =~ m{/($category_rx)/($name_rx)/\2-v?($version_rx)\.ebuild$}o or Carp::confess('Invalid ebuild'); my ($category, $name, $version) = ($1, $2, $3); diff --git a/t/30-atom-new.t b/t/30-atom-new.t index b44f937..a28b290 100644 --- a/t/30-atom-new.t +++ b/t/30-atom-new.t @@ -3,38 +3,50 @@ use strict; use warnings; -use Test::More tests => 15; +use Test::More tests => 23; use CPANPLUS::Dist::Gentoo::Atom; sub A () { 'CPANPLUS::Dist::Gentoo::Atom' } my $no_info = qr/^Not enough information/; +my $no_category = qr/^Category unspecified/; my $range_no_ver = qr/^Range atoms require a valid version/; -my $inv_atom = qr/^Invalid atom/; -my $inv_ebuild = qr/^Invalid ebuild/; -my $a0 = { category => 'test', name => 'a' }; -my $a1 = { category => 'test', name => 'a', version => '1.0' }; +sub inv { qr/^Invalid \Q$_[0]\E/ } + +my $a0 = { category => 'test', name => 'a' }; +my $a1 = { category => 'test', name => 'a', version => '1.0' }; +my $a2 = { category => 'test+', name => 'a+b', version => '1.2.3' }; my @tests = ( [ { } => $no_info ], [ { category => 'test' } => $no_info ], + [ { name => 'a' } => $no_category ], + + [ { category => '', name => 'a' } => inv('category') ], + [ { category => 'test$', name => 'a' } => inv('category') ], + [ { category => 'test', name => '' } => inv('name') ], + [ { category => 'test', name => 'a$' } => inv('name') ], + [ $a0 => $a0 ], + [ { %$a0, range => '' } => { %$a0, range => '' } ], [ { %$a0, range => '<=' } => $range_no_ver ], [ $a1 => { %$a1, range => '>=' } ], + [ { %$a1, range => '<>' } => inv('range'), ], [ { %$a1, range => '<=' } => { %$a1, range => '<=' } ], [ { atom => 'test/a' } => $a0 ], [ { atom => 'test/a-1.0' } => { %$a1, range => '>=' } ], [ { atom => '=test/a-v1.0' } => { %$a1, range => '=' } ], - [ { atom => '= $inv_atom ], + [ { atom => '= inv('atom') ], [ { atom => '>=test/a' } => $range_no_ver ], - [ { ebuild => undef } => $inv_ebuild ], - [ { ebuild => '/wat/test/a/a.ebuild' } => $inv_ebuild ], + [ { ebuild => undef } => inv('ebuild') ], + [ { ebuild => '/wat/test/a/a.ebuild' } => inv('ebuild') ], [ { ebuild => '/wat/test/a/a-1.0.ebuild' } => { %$a1, range => '>=' } ], - [ { ebuild => '/wat/test/a/b-1.0.ebuild' } => $inv_ebuild ], + [ { ebuild => '/wat/test/a/b-1.0.ebuild' } => inv('ebuild') ], + [ { ebuild => '/wat/test+/a+b/a+b-1.2.3.ebuild' } => { %$a2, range => '>=' } ], ); my @fields = qw/range category name version ebuild/;