my $path;
BIN: for my $bin (@bins) {
-
+
### parallel to your cpanp/cpanp-boxed
my $maybe = File::Spec->rel2abs(
File::Spec->catfile( dirname($0), $bin )
### descriptors, however wikipedia covers a bit of
### history regarding win32
$vol =~ s/:$/|/ if ON_WIN32;
-
+
$vol =~ s/:// if ON_VMS;
-
+
### XXX i'm not sure what cases this is addressing.
### this comes straight from dmq's file:// patches
### for win32. --kane
+ ### According to dmq, the best summary is:
+ ### "if file:// urls dont look right on VMS reuse
+ ### the win32 logic and see if that fixes things"
+
+ ### first element not empty? Might happen on VMS.
+ ### prepend the volume in that case.
if( $host_dirs[0] ) {
unshift @host_dirs, $vol;
+
+ ### element empty? reuse it to store the volume
+ ### encoded as a directory name. (Win32/VMS)
} else {
$host_dirs[0] = $vol;
}
check( $tmpl, \%hash ) or return;
- my $index = File::Spec->catfile(
- $conf->get_conf('base'),
- $conf->_get_build('custom_sources'),
- $self->_uri_encode( uri => $uri ),
- );
+ ### what index file should we use on disk?
+ my $index = $self->__custom_module_source_index_file( uri => $uri );
### already have it.
if( IS_FILE->( $index ) ) {
### write the file
my $fh = OPEN_FILE->( $index => '>' ) or do {
- error(loc("Could not write index file for '%1'", $uri));
+ error(loc("Could not open index file for '%1'", $uri));
return;
};
- ### basically we 'touched' it.
- close $fh;
+ ### basically we 'touched' it. Check the return value, may be
+ ### important on win32 and similar OS, where there's file length
+ ### limits
+ close $fh or do {
+ error(loc("Could not write index file to disk for '%1'", $uri));
+ return;
+ };
$self->__update_custom_module_source(
remote => $uri,
return $index;
}
+=head2 $index = $cb->__custom_module_source_index_file( uri => $uri );
+
+Returns the full path to the encoded index file for C<$uri>, as used by
+all C<custom module source> routines.
+
+=cut
+
+sub __custom_module_source_index_file {
+ my $self = shift;
+ my $conf = $self->configure_object;
+ my %hash = @_;
+
+ my($verbose,$uri);
+ my $tmpl = {
+ uri => { required => 1, store => \$uri }
+ };
+
+ check( $tmpl, \%hash ) or return;
+
+ my $index = File::Spec->catfile(
+ $conf->get_conf('base'),
+ $conf->_get_build('custom_sources'),
+ $self->_uri_encode( uri => $uri ),
+ );
+
+ return $index;
+}
+
=head2 $file = $cb->_remove_custom_module_source( uri => URI, [verbose => BOOL] );
Removes a custom index file based on the URI provided.
### only need to fix it up if there's spaces in the path
return $path unless $path =~ /\s+/;
- ### or if we are on win32
- return $path if $^O ne 'MSWin32';
-
### clean up paths if we are on win32
return Win32::GetShortPathName( $path ) || $path;
# Address ~0 overflow issue
'Params::Check' => '0.22',
'Package::Constants' => '0.01',
- 'Term::UI' => '0.05',
+ 'Term::UI' => '0.18', # option parsing
'Test::Harness' => '2.62', # due to bug #19505
# only 2.58 and 2.60 are bad
'Test::More' => '0.47', # to run our tests
### check custom sources
### XXX whitebox test
-{ ### first, find a file to serve as a source
+SKIP: {
+ ### first, find a file to serve as a source
my $mod = $mt->{$modname};
my $package = File::Spec->rel2abs(
File::Spec->catfile(
path => File::Spec->catfile( dirname($package) )
);
- ### local file
+ my $expected_file = $cb->__custom_module_source_index_file( uri => $uri );
+
+ ok( $expected_file, "Sources should be written to '$uri'" );
+
+ skip( "Index file size too long (>260 chars). Can't write to disk", 28 )
+ if length $expected_file > 260 and ON_WIN32;
+
+
+ ### local file
+ ### 2 tests
my $src_file = $cb->_add_custom_module_source( uri => $uri );
ok( $src_file, "Sources written to '$src_file'" );
ok( -e $src_file, " File exists" );
- ### and write the file
+ ### and write the file
+ ### 5 tests
{ my $meth = '__write_custom_module_index';
can_ok( $cb, $meth );
}
### let's see if we can find our custom files
+ ### 3 tests
{ my $meth = '__list_custom_module_sources';
can_ok( $cb, $meth );
}
### now we can have it be loaded in
+ ### 6 tests
{ my $meth = '__create_custom_module_entries';
can_ok( $cb, $meth );
}
### test updating custom sources
+ ### 3 tests
{ my $meth = '__update_custom_module_sources';
can_ok( $cb, $meth );
}
### now update it individually
+ ### 3 tests
{ my $meth = '__update_custom_module_source';
can_ok( $cb, $meth );
}
### now update using the higher level API, see if it's part of the update
+ ### 3 tests
{ CPANPLUS::Error->flush;
### mark what time it is now, sleep 1 second for better measuring
}
### now remove the index file;
+ ### 3 tests
{ my $meth = '_remove_custom_module_source';
can_ok( $cb, $meth );
### create a file URI. Make sure to split it by LOCAL rules
### and JOIN by unix rules, so we get a proper file uri
### otherwise, we might break win32. See bug #18702
-
- my $cwd = cwd();
- my $in_file;
-
- if ($^O eq 'VMS') {
- $in_file = File::Spec->catfile($cwd, $base);
- ### Force UNIX syntax on VMS
- $in_file = VMS::Filespec::unixify($in_file);
- } else {
- $in_file = File::Spec::Unix->catfile(
- File::Spec::Unix->catdir(
- File::Spec->splitdir( $cwd ),
- ),
- $base
- )
- }
-
+ my $cwd = cwd();
+ my $in_file = $^O eq 'VMS'
+ ? VMS::Filespec::unixify( File::Spec->catfile($cwd, $base) )
+ : File::Spec::Unix->catfile(
+ File::Spec::Unix->catdir( File::Spec->splitdir( $cwd ) ),
+ $base
+ );
+
my $target = CREATE_FILE_URI->($in_file);
-
+
my $fake = $cb->parse_module( module => $target );
ok( IS_FAKE_MODOBJ->(mod => $fake),
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz.packed
-Created at Fri Nov 9 15:20:34 2007
+Created at Wed Nov 14 12:37:27 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 Fri Nov 9 15:20:34 2007
+Created at Wed Nov 14 12:37:27 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 Fri Nov 9 15:20:34 2007
+Created at Wed Nov 14 12:37:27 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 Fri Nov 9 15:20:34 2007
+Created at Wed Nov 14 12:37:27 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 Fri Nov 9 15:20:34 2007
+Created at Wed Nov 14 12:37:27 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 Fri Nov 9 15:20:34 2007
+Created at Wed Nov 14 12:37:27 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 Fri Nov 9 15:20:34 2007
+Created at Wed Nov 14 12:37:27 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 Fri Nov 9 15:20:34 2007
+Created at Wed Nov 14 12:37:28 2007
#########################################################################
__UU__
M'XL("$TN$T<``S`R<&%C:V%G97,N9&5T86EL<RYT>'0`G=-1;],P$`#@=_^*
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz.packed
-Created at Fri Nov 9 15:20:34 2007
+Created at Wed Nov 14 12:37:28 2007
#########################################################################
__UU__
M'XL("#'FO$4``S`S;6]D;&ES="YD871A`%U3_6O;,!#].?HKCBXC"20A=<@&