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:
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 {
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.
### 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
CPANPLUS::Internals::Report
];
-$VERSION = "0.83_02";
+$VERSION = "0.83_08";
=pod
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;
};
=> 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';
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;
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,
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',
};
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!
# '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
### 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;
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;
} 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;
### 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;
### 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);
}
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 );
}
### 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.
# '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
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
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.
my $self = shift;
my $cb = $self->parent;
my $pkg = $self->package;
-
+
my @mods = $cb->search( type => 'package', allow => [qr/^$pkg$/] );
return @mods;
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',
'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',
cpantest => [
{
'YAML::Tiny' => '0.0',
- 'File::Fetch' => '0.08',
'Test::Reporter' => '1.34',
},
sub {
BEGIN {
use vars qw[ $VERSION @ISA ];
@ISA = qw[ CPANPLUS::Shell::_Base::ReadLine ];
- $VERSION = "0.83_02";
+ $VERSION = "0.83_08";
}
load CPANPLUS::Shell;
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;
'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'};
}
- my $dist = eval {
+ my $target = $opts->{'install'} ? 'install' : 'create';
+ my $dist = eval {
local $SIG{ALRM} = sub { die bless {}, ALARM_CLASS }
if $timeout;
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,
### 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
### 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.
### 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'" );
}
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
### 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 );
}
}
+### 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',
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;
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
'/? ?' => 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/,
);
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
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/ \
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
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;
pre_hook => sub {
my $mod = shift;
my $clone = $mod->clone;
- $clone->status->prereqs( { $ModPrereq => ~0 } );
+ $clone->status->prereqs({ $ModPrereq => $HighVersion });
return $clone;
},
failed => 1,
{ 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 );
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
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_
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
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
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.;
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
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[
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,`````
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=<@&
# 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';
### 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 };
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 {
projects / p5sagit/p5-mst-13.2.git / commitdiff