This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade CPANPLUS to 0.83_08
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Sun, 4 Nov 2007 12:28:45 +0000 (12:28 +0000)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Sun, 4 Nov 2007 12:28:45 +0000 (12:28 +0000)
p4raw-id: //depot/perl@32218

32 files changed:
lib/CPANPLUS.pm
lib/CPANPLUS/Backend.pm
lib/CPANPLUS/Dist/MM.pm
lib/CPANPLUS/Internals.pm
lib/CPANPLUS/Internals/Constants.pm
lib/CPANPLUS/Internals/Extract.pm
lib/CPANPLUS/Internals/Fetch.pm
lib/CPANPLUS/Internals/Report.pm
lib/CPANPLUS/Internals/Search.pm
lib/CPANPLUS/Internals/Source.pm
lib/CPANPLUS/Internals/Utils.pm
lib/CPANPLUS/Module.pm
lib/CPANPLUS/Selfupdate.pm
lib/CPANPLUS/Shell/Default.pm
lib/CPANPLUS/Shell/Default/Plugins/CustomSource.pm
lib/CPANPLUS/bin/cpan2dist
lib/CPANPLUS/t/00_CPANPLUS-Internals-Utils.t
lib/CPANPLUS/t/03_CPANPLUS-Internals-Source.t
lib/CPANPLUS/t/04_CPANPLUS-Module.t
lib/CPANPLUS/t/15_CPANPLUS-Shell.t
lib/CPANPLUS/t/20_CPANPLUS-Dist-MM.t
lib/CPANPLUS/t/40_CPANPLUS-Internals-Report.t
lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz.packed
lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz.packed
lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz.packed
lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/perl5.005_03.tar.gz.packed
lib/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.tar.gz.packed
lib/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.tar.gz.packed
lib/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.tar.gz.packed
lib/CPANPLUS/t/dummy-CPAN/modules/02packages.details.txt.gz.packed
lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz.packed
lib/CPANPLUS/t/inc/conf.pl

index 22cd8d0..d8fbea5 100644 (file)
@@ -13,7 +13,7 @@ BEGIN {
     use vars        qw( @EXPORT @ISA $VERSION );
     @EXPORT     =   qw( shell fetch get install );
     @ISA        =   qw( Exporter );
-    $VERSION = "0.83_02";     #have to hardcode or cpan.org gets unhappy
+    $VERSION = "0.83_08";     #have to hardcode or cpan.org gets unhappy
 }
 
 ### purely for backward compatibility, so we can call it from the commandline:
index 8752b71..75beb2e 100644 (file)
@@ -132,7 +132,27 @@ sub module_tree {
     if( @_ ) {
         my @rv;
         for my $name ( grep { defined } @_) {
-            push @rv, $modtree->{$name} || '';
+
+            ### From John Malmberg: This is failing on VMS 
+            ### because ODS-2 does not retain the case of 
+            ### filenames that are created.
+            ### The problem is the filename is being converted 
+            ### to a module name and then looked up in the 
+            ### %$modtree hash.
+            ### 
+            ### As a fix, we do a search on VMS instead --
+            ### more cpu cycles, but it gets around the case
+            ### problem --kane
+            my ($modobj) = do {
+                ON_VMS
+                    ? $self->search(
+                          type    => 'module',
+                          allow   => [qr/^$name$/i],
+                      )
+                    : $modtree->{$name}
+            };
+            
+            push @rv, $modobj || '';
         }
         return @rv == 1 ? $rv[0] : @rv;
     } else {
@@ -230,16 +250,19 @@ sub search {
     my $conf = $self->configure_object;
     my %hash = @_;
 
-    local $Params::Check::ALLOW_UNKNOWN = 1;
+    my ($type);
+    my $args = do {
+        local $Params::Check::NO_DUPLICATES = 0;
+        local $Params::Check::ALLOW_UNKNOWN = 1;
 
-    my ($data,$type);
-    my $tmpl = {
-        type    => { required => 1, allow => [CPANPLUS::Module->accessors(),
-                        CPANPLUS::Module::Author->accessors()], store => \$type },
-        allow   => { required => 1, default => [ ], strict_type => 1 },
-    };
+        my $tmpl = {
+            type    => { required => 1, allow => [CPANPLUS::Module->accessors(),
+                            CPANPLUS::Module::Author->accessors()], store => \$type },
+            allow   => { required => 1, default => [ ], strict_type => 1 },
+        };
 
-    my $args = check( $tmpl, \%hash ) or return;
+        check( $tmpl, \%hash )
+    } or return;
 
     ### figure out whether it was an author or a module search
     ### when ambiguous, it'll be an author search.
index 2e01ef1..e549ca5 100644 (file)
@@ -305,7 +305,7 @@ sub prepare {
             ### since cpanp-run-perl uses 'do' to execute the file, and do()
             ### checks your @INC.. so, if there's _another_ makefile.pl in
             ### your @INC, it will execute that one...
-            my $makefile_pl = $cb->_safe_path( path => MAKEFILE_PL->( $dir ) );
+            my $makefile_pl = MAKEFILE_PL->( $cb->_safe_path( path => $dir ) );
             
             ### setting autoflush to true fixes issue from rt #8047
             ### XXX this means that we need to keep the path to CPANPLUS
index f57facc..6bc6813 100644 (file)
@@ -40,7 +40,7 @@ use vars qw[@ISA $VERSION];
             CPANPLUS::Internals::Report
         ];
 
-$VERSION = "0.83_02";
+$VERSION = "0.83_08";
 
 =pod
 
index 00bf2c5..bfd4439 100644 (file)
@@ -230,8 +230,14 @@ use constant READ_DIR       => sub {
                                     my $dh  = OPEN_DIR->( $dir ) or return;
                                     
                                     ### exclude . and ..
-                                    my @files =  grep { $_ !~ /^\.{1,2}/ }         
+                                    my @files =  grep { $_ !~ /^\.{1,2}/ }
                                                     readdir($dh);
+
+                                    ### Remove trailing dot on VMS when
+                                    ### using VMS syntax.
+                                    if( ON_VMS ) {
+                                        s/(?<!\^)\.$// for @files;
+                                    }
                                     
                                     return @files;
                             };  
@@ -268,10 +274,12 @@ use constant CREATE_FILE_URI
                             => sub { 
                                     my $dir = $_[0] or return;
                                     return $dir =~ m|^/| 
-                                        ? 'file:/'  . $dir
-                                        : 'file://' . $dir;   
+                                        ? 'file://'  . $dir
+                                        : 'file:///' . $dir;   
                             };        
 
+use constant EMPTY_DSLIP    => '     ';
+
 use constant CUSTOM_AUTHOR_ID
                             => 'LOCAL';
 
index 8063b90..84a48a5 100644 (file)
@@ -201,11 +201,13 @@ sub _extract {
     my $dir;
     for my $try (
         File::Spec->rel2abs( 
-            $self->_safe_path( path =>
-                File::Spec->catdir( $to,  
-                                    $mod->package_name .'-'. 
-                                    $mod->package_version 
-        ) ) ),
+            ### _safe_path must be called before catdir because catdir on 
+            ### VMS currently will not handle the extra dots in the directories.
+            File::Spec->catdir( $self->_safe_path( path => $to ) ,  
+                                $self->_safe_path( path =>
+                                             $mod->package_name .'-'. 
+                                             $mod->package_version
+        ) ) ) ,
         File::Spec->rel2abs( $ae->extract_path ),
     ) {
         ($dir = $try) && last if -d $try;
index b8ad371..54d6015 100644 (file)
@@ -214,23 +214,75 @@ sub _fetch {
             for my $host ( @{$conf->get_conf('hosts')} ) {
                 $found_host++;
     
-                my $mirror_path = File::Spec::Unix->catfile(
-                                        $host->{'path'}, $remote_file
-                                    );
-    
-                ### build pretty print uri ###
                 my $where;
-                if( $host->{'scheme'} eq 'file' ) {
+
+                ### file:// uris are special and need parsing
+                if( $host->{'scheme'} eq 'file' ) {    
+    
+                    ### the full path in the native format of the OS
+                    my $host_spec = 
+                            File::Spec->file_name_is_absolute( $host->{'path'} )
+                                ? $host->{'path'}
+                                : File::Spec->rel2abs( $host->{'path'} );
+    
+                    ### there might be volumes involved on vms/win32
+                    if( ON_WIN32 or ON_VMS ) {
+                        
+                        ### now extract the volume in order to be Win32 and 
+                        ### VMS friendly.
+                        ### 'no_file' indicates that there's no file part
+                        ### of this path, so we only get 2 bits returned.
+                        my ($vol, $host_path) = File::Spec->splitpath(
+                                                    $host_spec, 'no_file' 
+                                                );
+                        
+                        ### and split up the directories
+                        my @host_dirs = File::Spec->splitdir( $host_path );
+        
+                        ### if we got a volume we pretend its a directory for 
+                        ### the sake of the file:// url
+                        if( defined $vol and $vol ) {
+    
+                            ### D:\foo\bar needs to be encoded as D|\foo\bar
+                            ### For details, see the following link:
+                            ###   http://en.wikipedia.org/wiki/File://
+                            ### The RFC doesnt seem to address Windows volume
+                            ### descriptors but it does address VMS volume
+                            ### descriptors, however wikipedia covers a bit of
+                            ### history regarding win32
+                            $vol =~ s/:$/|/ if ON_WIN32; 
+    
+                            ### XXX i'm not sure what cases this is addressing.
+                            ### this comes straight from dmq's file:// patches
+                            ### for win32. --kane
+                            if( $host_dirs[0] ) {
+                                unshift @host_dirs, $vol;
+                            } else {
+                                $host_dirs[0] = $vol;
+                            }                    
+                        }
+        
+                        ### now it's in UNIX format, which is the same format
+                        ### as used for URIs
+                        $host_spec = File::Spec::Unix->catdir( @host_dirs ); 
+                    }
+
+                    ### now create the file:// uri from the components               
                     $where = CREATE_FILE_URI->(
-                                File::Spec::Unix->rel2abs(
-                                    File::Spec::Unix->catdir(
-                                        grep { defined $_ && length $_ }
-                                        $host->{'host'},
-                                        $mirror_path
-                                     )
-                                )
-                            );
-                } else {
+                                    File::Spec::Unix->catfile(
+                                        $host->{'host'} || '',
+                                        $host_spec,
+                                        $remote_file,
+                                    )      
+                                );     
+
+                ### its components will be in unix format, for a http://,
+                ### ftp:// or any other style of URI
+                } else {     
+                    my $mirror_path = File::Spec::Unix->catfile(
+                                            $host->{'path'}, $remote_file
+                                        );
+    
                     my %args = ( scheme => $host->{scheme},
                                  host   => $host->{host},
                                  path   => $mirror_path,
index cbe20a6..cbe76ff 100644 (file)
@@ -52,8 +52,11 @@ reports. It returns true and loads them if they are, or returns false
 otherwise.
 
 =cut
+
+### XXX remove this list and move it into selfupdate, somehow..
+### this is dual administration
 {   my $query_list = {
-        'File::Fetch'   => '0.08',
+        'File::Fetch'   => '0.13_02',
         'YAML::Tiny'    => '0.0',
         'File::Temp'    => '0.0',
     };
index 2a711ab..85e1678 100644 (file)
@@ -314,24 +314,7 @@ sub _all_installed {
 
                     return if $seen{$mod}++;
 
-                    ### From John Malmberg: This is failing on VMS 
-                    ### because ODS-2 does not retain the case of 
-                    ### filenames that are created.
-                    ### The problem is the filename is being converted 
-                    ### to a module name and then looked up in the 
-                    ### %$modtree hash.
-                    ### 
-                    ### As a fix, we do a search on VMS instead --
-                    ### more cpu cycles, but it gets around the case
-                    ### problem --kane
-                    my ($modobj) = do {
-                        ON_VMS
-                            ? $self->search( 
-                                    type    => 'module',
-                                    allow   => [qr/^$mod$/i],
-                                )      
-                            : $self->module_tree($mod) 
-                    };
+                    my $modobj = $self->module_tree($mod);
                     
                     ### seperate return, a list context return with one ''
                     ### in it, is also true!
index d1308f6..0e7ee1f 100644 (file)
@@ -820,7 +820,7 @@ sub _create_mod_tree {
                                             # 'foo-bar-baz-1.03.tar.gz'
                 description => $dslip_tree->{ $data[0] }->{'description'},
                 dslip       => $dslip,
-                _id         => $self->_id,  #id of this internals object
+                _id         => $self->_id,  # id of this internals object
         );
 
     } #for
@@ -1107,10 +1107,15 @@ sub _remove_custom_module_source {
     ### use uri => local, instead of the other way around
     my %files = reverse $self->__list_custom_module_sources;
     
-    my $file = $files{ $uri } or do {
-                    error(loc("No such custom source '%1'", $uri));
-                    return;
-                };
+    ### On VMS the case of key to %files can be either exact or lower case
+    ### XXX abstract this lookup out? --kane
+    my $file = $files{ $uri };
+    $file    = $files{ lc $uri } if !defined($file) && ON_VMS;
+
+    unless (defined $file) {
+        error(loc("No such custom source '%1'", $uri));
+        return;
+    };
                 
     1 while unlink $file;
  
@@ -1242,8 +1247,13 @@ sub __update_custom_module_source {
             return;                      
         };
 
+        ### On VMS the case of key to %files can be either exact or lower case
+        ### XXX abstract this lookup out? --kane
+        my $file = $files{ $remote };
+        $file    = $files{ lc $remote } if !defined ($file) && ON_VMS;
+
         ### return the local file we're supposed to use
-        $files{ $remote } or do {
+        $file or do {
             error(loc("Remote source '%1' unknown -- needs '%2' argument",
                       $remote, 'local'));
             return;
@@ -1275,11 +1285,17 @@ sub __update_custom_module_source {
         } else {
             msg(loc("No index file found at '%1', generating one",
                     $ff->uri), $verbose );
+            
+            ### ON VMS, if you are working with a UNIX file specification,
+            ### you need currently use the UNIX variants of the File::Spec.
+            my $ff_path = do {
+                my $file_class = 'File::Spec';
+                $file_class .= '::Unix' if ON_VMS;
+                $file_class->catdir( File::Spec::Unix->splitdir( $ff->path ) );
+            };      
 
             $self->__write_custom_module_index(
-                path    => File::Spec->catdir(
-                                File::Spec::Unix->splitdir( $ff->path )
-                            ),
+                path    => $ff_path,
                 to      => $local,
                 verbose => $verbose,
             ) or return;
@@ -1347,7 +1363,7 @@ sub __write_custom_module_index {
         ### make sure to remove the leading slash as well.
         my $copy = $File::Find::name;
         my $re   = quotemeta($path);        
-        $copy    =~ s|^$path[\\/]?||i;
+        $copy    =~ s|^$re[\\/]?||i;
         
         push @files, $copy;
         
@@ -1434,7 +1450,11 @@ Returns true on success, false on failure.
                 
                 ### and now add it to the modlue tree -- this MAY
                 ### override things of course
-                if( $self->module_tree( $mod->module ) ) {
+                if( my $old_mod = $self->module_tree( $mod->module ) ) {
+
+                    ### On VMS use the old module name to get the real case
+                    $mod->module( $old_mod->module ) if ON_VMS;
+
                     msg(loc("About to overwrite module tree entry for '%1' with '%2'",
                             $mod->module, $mod->package), $verbose);
                 }
index 3f38aaa..b3e6534 100644 (file)
@@ -351,8 +351,11 @@ sub _host_to_uri {
 
     check( $tmpl, \%hash ) or return;
 
-    ### it's an URI, so unixify the path
-    $path = File::Spec::Unix->catdir( File::Spec->splitdir( $path ) );
+    ### it's an URI, so unixify the path.
+    ### VMS has a special method for just that
+    $path = ON_VMS
+                ? VMS::Filespec::unixify($path) 
+                : File::Spec::Unix->catdir( File::Spec->splitdir( $path ) );
 
     return "$scheme://" . File::Spec::Unix->catdir( $host, $path ); 
 }
@@ -429,6 +432,10 @@ sub _safe_path {
         ### Fixing this is a a three step procedure, which will work for 
         ### VMS in its traditional ODS-2 mode, and it will also work if 
         ### VMS is in the ODS-5 mode that is being implemented.
+        ### If the path is already in VMS syntax, assume that we are done.
+        ### VMS format is a path with a trailing ']' or ':'
+        return $path if $path =~ /\:|\]$/;
 
         ### 1. Make sure that the value to be converted, $path is 
         ### in UNIX directory syntax by appending a '/' to it.
index 96030d3..fb6be9b 100644 (file)
@@ -66,7 +66,7 @@ my $tmpl = {
                                                         # 'bar-baz-1.03.tgz'
     description => { default => '' },                   # description of the
                                                         # module
-    dslip       => { default => '    ' },               # dslip information
+    dslip       => { default => EMPTY_DSLIP },          # dslip information
     _id         => { required => 1 },                   # id of the Internals
                                                         # parent object
     _status     => { no_override => 1 },                # stores status object
@@ -75,15 +75,28 @@ my $tmpl = {
     mtime       => { default => '' },
 };
 
-### autogenerate accessors ###
-for my $key ( keys %$tmpl ) {
-    no strict 'refs';
-    *{__PACKAGE__."::$key"} = sub {
-        $_[0]->{$key} = $_[1] if @_ > 1;
-        return $_[0]->{$key};
+### some of these will be resolved by wrapper functions that
+### do Clever Things to find the actual value, so don't create
+### an autogenerated sub for that just here, take an alternate
+### name to allow for a wrapper
+{   my %rename = (
+        dslip   => '_dslip'
+    );
+
+    ### autogenerate accessors ###
+    for my $key ( keys %$tmpl ) {
+        no strict 'refs';
+      
+        my $sub = $rename{$key} || $key;
+      
+        *{__PACKAGE__."::$sub"} = sub {
+            $_[0]->{$key} = $_[1] if @_ > 1;
+            return $_[0]->{$key};
+        }
     }
 }
 
+
 =pod
 
 =head1 CLASS METHODS
@@ -136,6 +149,27 @@ Description of the module -- only registered modules have this.
 The five character dslip string, that represents meta-data of the
 module -- again, only registered modules have this.
 
+=cut
+
+sub dslip {
+    my $self    = shift;   
+
+    ### if this module has relevant dslip info, return it
+    return $self->_dslip if $self->_dslip ne EMPTY_DSLIP;
+
+    ### if not, look at other modules in the same package,
+    ### see if *they* have any dslip info
+    for my $mod ( $self->contains ) {
+        return $mod->_dslip if $mod->_dslip ne EMPTY_DSLIP;
+    }
+    
+    ### ok, really no dslip info found, return the default
+    return EMPTY_DSLIP;
+}
+
+
+=pod
+
 =item status
 
 The C<CPANPLUS::Module::Status> object associated with this object.
@@ -1172,7 +1206,7 @@ sub contains {
     my $self = shift;
     my $cb   = $self->parent;
     my $pkg  = $self->package;
-    
+
     my @mods = $cb->search( type => 'package', allow => [qr/^$pkg$/] );
     
     return @mods;
index bea8e12..efb7685 100644 (file)
@@ -40,7 +40,7 @@ CPANPLUS::Selfupdate
 
     my $Modules = {
         dependencies => {
-            'File::Fetch'               => '0.08', # win32 ftp support
+            'File::Fetch'               => '0.13_02', # win32 file:// support
             'File::Spec'                => '0.82',
             'IPC::Cmd'                  => '0.36', # 5.6.2 compat: 2-arg open
             'Locale::Maketext::Simple'  => '0.01',
@@ -48,9 +48,10 @@ CPANPLUS::Selfupdate
             'Module::Load'              => '0.10',
             'Module::Load::Conditional' => '0.18', # Better parsing: #23995,
                                                    # uses version.pm for <=>
-            'version'                   => '0.70', # needed for M::L::C
+            'version'                   => '0.73', # needed for M::L::C
                                                    # addresses #24630 and 
                                                    # #24675
+                                                   # Address ~0 overflow issue
             'Params::Check'             => '0.22',
             'Package::Constants'        => '0.01',
             'Term::UI'                  => '0.05',
@@ -83,7 +84,6 @@ CPANPLUS::Selfupdate
             cpantest        => [
                 {
                     'YAML::Tiny'     => '0.0',
-                    'File::Fetch'    => '0.08',
                     'Test::Reporter' => '1.34',
                 },
                 sub { 
index 2a2e375..66d3184 100644 (file)
@@ -26,7 +26,7 @@ local $Data::Dumper::Indent     = 1; # for dumpering from !
 BEGIN {
     use vars        qw[ $VERSION @ISA ];
     @ISA        =   qw[ CPANPLUS::Shell::_Base::ReadLine ];
-    $VERSION = "0.83_02";
+    $VERSION = "0.83_08";
 }
 
 load CPANPLUS::Shell;
index e055fbf..ad4701a 100644 (file)
@@ -76,7 +76,11 @@ sub _uri_from_cache {
     my %files = reverse $Cb->list_custom_sources;
 
     ### it's an URI we know
-    if( my $local = $files{ $uri } ) {
+    ### VMS can lower case all files, so make sure we check that too
+    my $local = $files{ $uri };
+       $local = $files{ lc $uri } if !$local && ON_VMS;
+       
+    if( $local ) {
         return wantarray 
             ? ($uri, $local)
             : $uri;
index 41349f4..8c913ba 100644 (file)
@@ -37,7 +37,8 @@ GetOptions( $opts,
             'logfile=s',            'timeout=s',
             'dist-opts=s%',         'set-config=s%',
             'default-banlist!',     'set-program=s%',
-            'default-ignorelist!',  'edit-metafile!'
+            'default-ignorelist!',  'edit-metafile!',
+            'install!'
         );
         
 die usage() if exists $opts->{'help'};
@@ -325,7 +326,8 @@ for my $name (@modules) {
     }        
     
 
-    my $dist = eval { 
+    my $target  = $opts->{'install'} ? 'install' : 'create';
+    my $dist    = eval { 
                     local $SIG{ALRM} = sub { die bless {}, ALARM_CLASS }
                         if $timeout;
                         
@@ -334,8 +336,8 @@ for my $name (@modules) {
                     my $dist_opts = $opts->{'dist-opts'} || {};
 
                     my $rv = $obj->install(   
-                            prereq_target   => 'create',
-                            target          => 'create',
+                            prereq_target   => $target,
+                            target          => $target,
                             keep_source     => $keep,
                             prereq_build    => $prereqbuild,
 
@@ -450,6 +452,8 @@ Options:
 
     ### take no argument:
     --help          Show this help message
+    --install       Install this package (and any prerequisites you built)
+                    after building it. 
     --skiptest      Skip tests. Can be negated using --noskiptest
     --force         Force operation. Can be negated using --noforce
     --verbose       Be verbose. Can be negated using --noverbose
@@ -520,6 +524,9 @@ Examples:
     ### don't bother running tests
     cpan2dist --format CPANPLUS::Dist::Deb --buildprereq --skiptest DBI
     
+    ### build a debian package of DBI and it's prerequisites and install them
+    cpan2dist --format CPANPLUS::Dist::Deb --buildprereq --install DBI
+    
     ### Build a package, whose format is determined by your config, of 
     ### the local tarball, reloading cpanplus' indices first and using
     ### the tarballs Makefile.PL if it has one.
index 2b3ad5a..18011fd 100644 (file)
@@ -34,10 +34,14 @@ rmdir $Dir  if -d $Dir;
 
 ### test _chdir ###
 {   ok( $Class->_chdir( dir => $Dir),   "Chdir to '$Dir'" );    
-    is( File::Spec->rel2abs(cwd()), File::Spec->rel2abs(File::Spec->catdir($Cwd,$Dir)),
+
+    my $abs_re = quotemeta File::Spec->rel2abs(File::Spec->catdir($Cwd,$Dir));
+    like( File::Spec->rel2abs(cwd()), qr/$abs_re/i,
                                         "   Cwd() is '$Dir'");  
+
+    my $cwd_re = quotemeta $Cwd;
     ok( $Class->_chdir( dir => $Cwd),   "Chdir back to '$Cwd'" );
-    like( File::Spec->rel2abs(cwd()), qr/$Cwd/i,
+    like( File::Spec->rel2abs(cwd()), qr/$cwd_re/i,
                                         "   Cwd() is '$Cwd'" );
 }
 
index d2ce5cd..606c274 100644 (file)
@@ -94,7 +94,15 @@ ok( scalar keys %$mt,           "Moduletree loaded successfully" );
         my %files = $cb->$meth;
         ok( scalar(keys(%files)),
                                 "   Got list of sources" );
-        ok( $files{ $src_file },"   Found proper entry" );
+        
+        ### on VMS, we can't predict the case unfortunately
+        ### so grep for it instead;
+        my $found = map { 
+            my $src_re = quotemeta($src_file);
+            $_ =~ /$src_re/i;
+        } keys %files;
+
+        ok( $found,             "   Found proper entry for $src_file" );
     }        
 
     ### now we can have it be loaded in
index 54236e4..7c1c8fa 100644 (file)
@@ -22,7 +22,7 @@ my $CB      = CPANPLUS::Backend->new( $Conf );
 ### start with fresh sources ###
 ok( $CB->reload_indices( update_source => 0 ),  "Rebuilding trees" );  
 
-my $AuthName    = 'EUNOXS';
+my $AuthName    = TEST_CONF_AUTHOR;
 my $Auth        = $CB->author_tree( $AuthName );
 my $ModName     = TEST_CONF_MODULE;
 my $Mod         = $CB->module_tree( $ModName );
@@ -173,6 +173,19 @@ isa_ok( $Auth->parent,          'CPANPLUS::Backend' );
     }
 }
 
+### dslip & related
+{   my $dslip = $Mod->dslip;   
+    ok( $dslip,             "Got dslip information from $ModName ($dslip)" );
+    
+    ### now find it for a submodule
+    {   my $submod = $CB->module_tree( TEST_CONF_MODULE_SUB );
+        ok( $submod,        "   Found submodule " . $submod->name );
+        ok( $submod->dslip, "   Got dslip info (".$submod->dslip.")" );
+        is( $submod->dslip, $dslip,
+                            "   It's identical to $ModName" );
+    }                            
+}
+
 {   ### details() test ###   
     my $href = {
         'Support Level'     => 'Developer',
index 09ab382..2a7e8c6 100644 (file)
@@ -23,6 +23,14 @@ use strict;
 use Test::More      'no_plan';
 use CPANPLUS::Internals::Constants;
 
+### in some subprocesses, the Term::ReadKey code will go
+### balistic and die because it can't figure out terminal
+### dimensions. If we add these env vars, it'll use them
+### as a default and not die. Thanks to Slaven Rezic for
+### reporting this.
+local $ENV{'COLUMNS'} = 80 unless $ENV{'COLUMNS'};
+local $ENV{'LINES'}   = 40 unless $ENV{'LINES'};
+
 my $Conf    = gimme_conf();
 my $Class   = 'CPANPLUS::Shell';
 my $Default = SHELL_DEFAULT;
@@ -55,6 +63,7 @@ isa_ok( $Shell, $Default,       "   Object" );
                         path    => $cs_path,
                     );
      
+    my $base = $Conf->get_conf('base');   
 
     ### XXX have to keep the list ordered, as some methods only work as 
     ### expected *after* others have run
@@ -85,13 +94,17 @@ isa_ok( $Shell, $Default,       "   Object" );
         '/? ?'                  => qr/usage/i,
         
         ### custom source plugin tests
+        ### lower case path matching, as on VMS we can't predict case
         "/? cs"                  => qr|/cs|,
         "/cs --add $cs_uri"      => qr/Added remote source/,
-        "/cs --list"             => do { my $re = quotemeta($cs_uri); qr/$re/ },
-        "/cs --contents $cs_uri" => qr/$TestAuth/,
+        "/cs --list"             => do { my $re = quotemeta($cs_uri); qr/$re/i },
+        "/cs --contents $cs_uri" => qr/$TestAuth/i,
         "/cs --update"           => qr/Updated remote sources/,
         "/cs --update $cs_uri"   => qr/Updated remote sources/,
-        "/cs --write $cs_path"   => qr/Wrote remote source index/,
+
+        ### --write leaves a file that we should clean up, so make
+        ### sure it's in the path that we clean up already anyway
+        "/cs --write $base"      => qr/Wrote remote source index/,
         "/cs --remove $cs_uri"   => qr/Removed remote source/,
     );
 
index 58f18fc..315cea6 100644 (file)
@@ -21,12 +21,17 @@ use File::Spec ();
 
 my $conf    = gimme_conf();
 my $cb      = CPANPLUS::Backend->new( $conf );
-my $noperms = ($< and not $conf->get_program('sudo')) &&
-              ($conf->get_conf('makemakerflags') or
-                not -w $Config{installsitelib} );
 my $File    = 'Bar.pm';
 my $Verbose = @ARGV ? 1 : 0;
 
+### if we need sudo that's no guarantee we can actually run it
+### so set $noperms if sudo is required, as that may mean tests
+### fail if you're not allowed to execute sudo. This resolves
+### #29904: make test should not use sudo
+my $noperms = $conf->get_program('sudo')        || #you need sudo
+              $conf->get_conf('makemakerflags') || #you set some funky flags
+              not -w $Config{installsitelib};      #cant write to install target
+
 #$IPC::Cmd::DEBUG = $Verbose;
 
 ### Make sure we get the _EUMM_NOXS_ version
@@ -121,10 +126,8 @@ $cb->_flush( list => [qw|lib|] );
 
 SKIP: {
 
-    skip(q[No install tests under core perl], 10) if $ENV{PERL_CORE};
-
-    skip(q[Probably no permissions to install, skipping], 10)
-        if $noperms;
+    skip(q[No install tests under core perl],            10) if $ENV{PERL_CORE};
+    skip(q[Possibly no permission to install, skipping], 10) if $noperms;
 
     ### XXX new EU::I should be forthcoming pending this patch from Steffen
     ### Mueller on p5p: http://www.xray.mpe.mpg.de/mailing-lists/ \ 
@@ -136,8 +139,9 @@ SKIP: {
     diag('other dirs than those in %Config. See bug #6871 on rt.cpan.org ' );
     diag('for details');
 
-    diag(q[Note: 'sudo' might ask for your password to do the install test])
-        if $conf->get_program('sudo');
+    ### we now say 'no perms' if sudo is configured, as per #29904
+    #diag(q[Note: 'sudo' might ask for your password to do the install test])
+    #    if $conf->get_program('sudo');
 
     ### make sure no options are set in PERL5_MM_OPT, as they might
     ### change the installation target and therefor will 1. mess up
index 1f71307..00c8173 100644 (file)
@@ -24,6 +24,10 @@ my $conf        = gimme_conf();
 my $CB          = CPANPLUS::Backend->new( $conf );
 my $ModName     = TEST_CONF_MODULE;
 my $ModPrereq   = TEST_CONF_PREREQ;
+
+### divide by many -- possibly ~0 is unsigned, and we cause an overflow,
+### as happens to version.pm 0.7203 among others.
+my $HighVersion = ~0/1000;
 my $Mod         = $CB->module_tree($ModName);
 my $int_ver     = $CPANPLUS::Internals::VERSION;
 
@@ -104,7 +108,7 @@ my $map = {
         pre_hook    => sub {
                         my $mod     = shift;
                         my $clone   = $mod->clone;
-                        $clone->status->prereqs( { $ModPrereq => ~0 } );
+                        $clone->status->prereqs({ $ModPrereq => $HighVersion });
                         return $clone;
                     },
         failed      => 1,
@@ -274,9 +278,7 @@ my $map = {
     
     {   my $clone   = $Mod->clone;
 
-        ### divide by two -- possibly ~0 is unsigned, and we cause an overflow,
-        ### as happens to version.pm 0.7203 among others.
-        my $prereqs = { $ModPrereq => ~0/2 };
+        my $prereqs = { $ModPrereq => $HighVersion };
     
         $clone->status->prereqs( $prereqs );
 
index 1015e11..c9546f8 100644 (file)
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz.packed
 
-Created at Tue Oct  9 17:23:14 2007
+Created at Sun Nov  4 11:24:49 2007
 #########################################################################
 __UU__
 M'XL("%_EO$4``S`Q;6%I;')C+G1X=`!+S,E,+%9P#8T(5@`#)=>*DM"2S)QB
index 55e297c..0c22cdc 100644 (file)
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz.packed
 
-Created at Tue Oct  9 17:23:14 2007
+Created at Sun Nov  4 11:24:49 2007
 #########################################################################
 __UU__
 M'XL("!1%OT4"`T)U;F1L92U&;V\M0F%R+3`N,#$N=&%R`.V7:V_:,!2&^8I_
index 28bec40..71e0feb 100644 (file)
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz.packed
 
-Created at Tue Oct  9 17:23:14 2007
+Created at Sun Nov  4 11:24:50 2007
 #########################################################################
 __UU__
 M'XL("/8X34("`T9O;RU"87(M,"XP,2YT87(`[9KQ;]I&%,?Y^?Z*1YE$(A5C
index d720eaa..8a25510 100644 (file)
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/perl5.005_03.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/perl5.005_03.tar.gz.packed
 
-Created at Tue Oct  9 17:23:14 2007
+Created at Sun Nov  4 11:24:50 2007
 #########################################################################
 __UU__
 M'XL(`'3DO44``^W/,0J`,`Q`T1RE)Y"T-O4XXN"DB%2]OR(*NNC4[;_E#\F0
index 12b23d8..cc106ad 100644 (file)
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.tar.gz.packed
 
-Created at Tue Oct  9 17:23:14 2007
+Created at Sun Nov  4 11:24:50 2007
 #########################################################################
 __UU__
 M'XL("`DY34("`T9O;RU"87(M,"XP,2YT87(`[5IK3]M(%,U7YE=<H%5``A.;
index 712dbb1..117ce6d 100644 (file)
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.tar.gz.packed
 
-Created at Tue Oct  9 17:23:14 2007
+Created at Sun Nov  4 11:24:50 2007
 #########################################################################
 __UU__
 M'XL("-<X34(``T9O;RU"87(M,"XP,2YT87(`[9E;;]HP%,=Y]J<X+9722@-R
index b52a1f9..19b5437 100644 (file)
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.tar.gz.packed
 
-Created at Tue Oct  9 17:23:15 2007
+Created at Sun Nov  4 11:24:50 2007
 #########################################################################
 __UU__
 M'XL("-\X34(``T9O;RU"87(M,"XP,2YT87(`[5K_3QI)%/=7YZ]XU39H(BN[
index 7fadcfa..4b4ff96 100644 (file)
@@ -10,16 +10,16 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/modules/02packages.details.txt.gz lib/CPANPLUS/t/dummy-CPAN/modules/02packages.details.txt.gz.packed
 
-Created at Tue Oct  9 17:23:15 2007
+Created at Sun Nov  4 11:24:50 2007
 #########################################################################
 __UU__
-M'XL("%^M`T<``S`R<&%C:V%G97,N9&5T86EL<RYT>'0`E=-1:]LP$`?P=WV*
-M>]C#"K&L.IB"GA9GR=B6=&6=:=^*9ET345LRTKE>]NDG-2OMPK)VA\$@GW[Z
-M'\A+TZ*$QQ)%KYH[M<'`-9(R;>#T@UC]=?74`UNB7N;Y.(Z\1]_RQG7Y_&)V
-MGG=.#RV&_(CR'D/C34_&V:A=[%O`J@X#W+K!:C`6M/'8D/,[>/-@JH&VSH?<
-MZ)S-73MT-OR.TC\#)G"//D1X$I=IRSY:0JM19TOG)<P&<ITBU'"+U&S!NX&,
-MQ3#9'QXA!.V:H4-+*L7C[,H;BD16[=)I7:M-H%&ES6_OH>!349S`]QW,K/:H
-M`O_LT)K-.V5-I^+,;!7Y;!YGHK3]5)R5)5NI0%G=ZQ1$PA7J"4P%?%(6"B$*
-M$*4LXG,&'];?&%LZ)V6EO)2+6LKK2S@HP<5I>B_JZ\L\-F>Q-TN+G)3GFY_/
-M@'7U+V!=O0HX_W)(/`'IVPM$&N(XL:A?)`[C_P=1Q9L5[[@\1AT0^_;L;])\
-<U,=R/%3QIY1^CI(+4=Z(Z2/!?@$#U+EW<`,`````
+M'XL("$TN$T<``S`R<&%C:V%G97,N9&5T86EL<RYT>'0`G=-1;],P$`#@=_^*
+M>^`!I,;Q4D63_$136@2T8Z)$VQORXEMKD=B1?5DHOQY[9=JH*#!.EB+9Y\]W
+M5KPT+4IX"%'TJOFJMABX1E*F#9R^$:L_K1YS8$?4RSP?QY'WZ%O>N"Z?7\XN
+M\L[IH<60GU#>8&B\Z<DX&[7+0PI8U6&`6S=8#<:"-AX;<GX/+^Y--=#.^9`;
+MG;.Y:X?.AI^E]$^`"=RA#Q&>Q&G:L7>6T&K4V=)Y";.!7*<(-=PB-3OP;B!C
+M,4P.AT<(0;MFZ-"22N5Q=N4-12*K]NFTKM4FT*C2YI=W4/"I*%[!S1YF5GM4
+M@7]P:,WVM;*F4[%GMHI\-H\]4=I^)L[+DJU4H*SN=2I$PA7J"4P%O%<6"B$*
+M$*4LXCB'M^O/C"V=D[)27LI%+>7U!HY"<'&6OHOZ>I/'Y"SF9FF2D_)\^_T)
+ML*[^!*RK?P(N/AX3CT!:^PN1FCA-+.IG$%)NAIO_(8YOX!E$%7_.^$SD*>J(
+B.*1GOY/FHSY5QWT4OTKI?95<B/*+F#X0[`?@'LWVLP,`````
index 5bafcc1..be6cb03 100644 (file)
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz.packed
 
-Created at Tue Oct  9 17:23:15 2007
+Created at Sun Nov  4 11:24:50 2007
 #########################################################################
 __UU__
 M'XL("#'FO$4``S`S;6]D;&ES="YD871A`%U3_6O;,!#].?HKCBXC"20A=<@&
index 5065116..dc43992 100644 (file)
@@ -90,6 +90,7 @@ my $Env = 'PERL5_CPANPLUS_TEST_VERBOSE';
 # prereq has to be in our package file && core!
 use constant TEST_CONF_PREREQ           => 'Cwd';   
 use constant TEST_CONF_MODULE           => 'Foo::Bar::EU::NOXS';
+use constant TEST_CONF_MODULE_SUB       => 'Foo::Bar::EU::NOXS::Sub';
 use constant TEST_CONF_AUTHOR           => 'EUNOXS';
 use constant TEST_CONF_INST_MODULE      => 'Foo::Bar';
 use constant TEST_CONF_INVALID_MODULE   => 'fnurk';
@@ -136,12 +137,25 @@ sub gimme_conf {
     ### during tests. They might hold broken/incorrect data
     ### for our test suite. Bug [perl #43629] showed this.
     my $conf = CPANPLUS::Configure->new( load_configs => 0 );
+
+    ### VMS needs this in directory format for rel2abs
+    my $test_dir = $^O eq 'VMS'
+                    ? File::Spec->catdir(TEST_CONF_CPAN_DIR)
+                    : TEST_CONF_CPAN_DIR;
+
+    ### Convert to an absolute file specification
+    my $abs_test_dir = File::Spec->rel2abs($test_dir);
+    
+    ### According to John M: the hosts path needs to be in UNIX format.  
+    ### File::Spec::Unix->rel2abs does not work at all on VMS
+    $abs_test_dir    = VMS::Filespec::unixify( $abs_test_dir ) if $^O eq 'VMS';
+    
     $conf->set_conf( hosts  => [ { 
-                        path        => File::Spec->rel2abs(TEST_CONF_CPAN_DIR),
+                        path        => $abs_test_dir,
                         scheme      => 'file',
                     } ],      
     );
-    $conf->set_conf( base       => 'dummy-cpanplus' );
+    $conf->set_conf( base       => File::Spec->rel2abs('dummy-cpanplus') );
     $conf->set_conf( dist_type  => '' );
     $conf->set_conf( signature  => 0 );
     $conf->set_conf( verbose    => 1 ) if $ENV{ $Env };
@@ -241,28 +255,31 @@ sub _clean_test_dir {
             
             my $path = File::Spec->catfile( $dir, $file );
             
-            ### John Malmberg reports yet another VMS issue:
-            ### A directory name on VMS in VMS format ends with .dir 
-            ### when it is referenced as a file.
-            ### In UNIX format traditionally PERL on VMS does not remove the
-            ### '.dir', however the VMS C library conversion routines do remove
-            ### the '.dir' and the VMS C library routines can not handle the
-            ### '.dir' being present on UNIX format filenames.
-            ### So code doing the fixup has on VMS has to be able to handle both
-            ### UNIX format names and VMS format names. 
-            ### XXX See http://www.xray.mpe.mpg.de/
-            ### mailing-lists/perl5-porters/2007-10/msg00064.html
-            ### for details -- the below regex could use some touchups
-            ### according to John. M.            
-            $file =~ s/\.dir//i if $^O eq 'VMS';
-            
-            my $dirpath = File::Spec->catdir( $dir, $file );
-            
             ### directory, rmtree it
             if( -d $path ) {
-                print "# Deleting directory '$path'\n" if $verbose;
-                eval { rmtree( $path ) };
-                warn "Could not delete '$path' while cleaning up '$dir'" if $@;
+
+                ### John Malmberg reports yet another VMS issue:
+                ### A directory name on VMS in VMS format ends with .dir 
+                ### when it is referenced as a file.
+                ### In UNIX format traditionally PERL on VMS does not remove the
+                ### '.dir', however the VMS C library conversion routines do
+                ### remove the '.dir' and the VMS C library routines can not 
+                ### handle the '.dir' being present on UNIX format filenames.
+                ### So code doing the fixup has on VMS has to be able to handle 
+                ### both UNIX format names and VMS format names. 
+                
+                ### XXX See http://www.xray.mpe.mpg.de/
+                ### mailing-lists/perl5-porters/2007-10/msg00064.html
+                ### for details -- the below regex could use some touchups
+                ### according to John. M.            
+                $file =~ s/\.dir//i if $^O eq 'VMS';
+                
+                my $dirpath = File::Spec->catdir( $dir, $file );
+
+                print "# Deleting directory '$dirpath'\n" if $verbose;
+                eval { rmtree( $dirpath ) };
+                warn "Could not delete '$dirpath' while cleaning up '$dir'" 
+                    if $@;
            
             ### regular file
             } else {