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 bbb6d882ff6df607c05fb28b4d1e04ad11bd11cf..33c622c1622e54b3f3641ebe24cbee44d2b63154 100644 (file)
--- 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;
 
 
 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
 
 
 =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;
  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};
  } 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 {
                                                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) {
 
  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 = '>=';
   }
   } else {
    $range = '>=';
   }


@@ -103,7 +106,7 @@ sub new_from_ebuild {
  my $ebuild = shift;
  $ebuild = '' unless defined $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);
 
                                              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 b44f9375d9559790f62678933c19ae9e9b0abdcc..a28b290072bfa826ece5ab1f7b892b04960810e8 100644 (file)
--- a/t/30-atom-new.t
+++ b/t/30-atom-new.t
@@ -3,38 +3,50 @@
 use strict;
 use warnings;
 
 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/;
 
 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 $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 ],
 
 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                     => $a0 ],

+ [ { %$a0, range => ''   } => { %$a0, range => '' } ],

  [ { %$a0, range => '<=' } => $range_no_ver ],
  [ $a1                     => { %$a1, 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 => '=' } ],
  [ { %$a1, range => '<=' } => { %$a1, range => '<=' } ],
 
  [ { atom => 'test/a' }        => $a0 ],
  [ { atom => 'test/a-1.0' }    => { %$a1, range => '>=' } ],
  [ { atom => '=test/a-v1.0' }  => { %$a1, range => '=' } ],

- [ { atom => '=<test/a-v1.0' } => $inv_atom ],
+ [ { atom => '=<test/a-v1.0' } => inv('atom') ],

  [ { atom => '>=test/a' }      => $range_no_ver ],
 
  [ { 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/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/;
 );
 
 my @fields = qw/range category name version ebuild/;