diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPANPLUS')
30 files changed, 438 insertions, 216 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Backend.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Backend.pm index a599e5429eb..43e73b7b1fe 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Backend.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Backend.pm @@ -492,7 +492,7 @@ sub parse_module { return $maybe if IS_MODOBJ->( module => $maybe ); } - ### Special case arbitary file paths such as '.' etc. + ### Special case arbitrary file paths such as '.' etc. if ( $mod and -d File::Spec->rel2abs($mod) ) { my $dir = File::Spec->rel2abs($mod); my $parent = File::Spec->rel2abs( File::Spec->catdir( $dir, '..' ) ); @@ -1162,7 +1162,8 @@ sub save_state { ### XXX these wrappers are not individually tested! only the underlying -### code through source.t and indirectly trought he CustomSource plugin. +### code through source.t and indirectly through he CustomSource plugin. + =pod =head1 CUSTOM MODULE SOURCES @@ -1238,7 +1239,7 @@ Here's an example of how custom sources would resolve into index files: file:///path/to/sources => file:///path/to/sources/packages.txt http://example.com/sources => http://example.com/sources/packages.txt ftp://example.com/sources => ftp://example.com/sources/packages.txt - + The file C<packages.txt> simply holds a list of packages that can be found under the root of the C<URI>. This file can be automatically generated for you when the remote source is a C<file:// URI>. For C<http://>, C<ftp://>, diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Backend/RV.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Backend/RV.pm index 9edbe0452c9..e861a093a27 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Backend/RV.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Backend/RV.pm @@ -34,7 +34,7 @@ CPANPLUS::Backend::RV $passed_args = $backend_rv->args; # args passed to function $ok = $backend_rv->ok; # boolean indication overall # result of the call - $function = $backend_rv->fucntion # name of the calling + $function = $backend_rv->function # name of the calling # function $rv = $backend_rv->rv # the actual return value # of the calling function diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Config.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Config.pm index 740ef1e637f..5cf11d3e732 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Config.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Config.pm @@ -57,7 +57,7 @@ their meaning. =cut ### BAH! you can't have POD interleaved with a hash -### declaration.. so declare every entry seperatedly :( +### declaration.. so declare every entry separately :( my $Conf = { '_fetch' => { 'blacklist' => [ 'ftp' ], @@ -125,13 +125,13 @@ An example entry would like this: }, { 'scheme' => 'ftp', - 'path' => '/pub/CPAN/', - 'host' => 'ftp.nl.uu.net' + 'path' => '/', + 'host' => 'cpan.hexten.net' }, { 'scheme' => 'ftp', - 'path' => '/pub/CPAN/', - 'host' => 'cpan.valueclick.com' + 'path' => '/CPAN/', + 'host' => 'cpan.cpantesters.org' }, { 'scheme' => 'ftp', @@ -225,7 +225,7 @@ Defaults to C<true> =cut - ### this addresses #32248 which requests a possibillity to + ### this addresses #32248 which requests a possibility to ### turn off custom sources $Conf->{'conf'}->{'enable_custom_sources'} = 1; @@ -297,14 +297,14 @@ when invoked. Defaults to an empty string. =item md5 -A boolean indicating whether or not md5 checks should be done when -an archive is fetched. Defaults to 'true' if you have C<Digest::MD5> +A boolean indicating whether or not sha256 checks should be done when +an archive is fetched. Defaults to 'true' if you have C<Digest::SHA> installed, 'false' otherwise. =cut $Conf->{'conf'}->{'md5'} = ( - check_install( module => 'Digest::MD5' ) ? 1 : 0 ); + check_install( module => 'Digest::SHA' ) ? 1 : 0 ); =item no_update @@ -332,6 +332,7 @@ C<Compress::Zlib> installed (as that would mean we could not extract C<.tar.gz> files) =cut + ### if we dont have c::zlib, we'll need to use /bin/tar or we ### can not extract any files. Good time to change the default $Conf->{'conf'}->{'prefer_bin'} = @@ -637,7 +638,7 @@ with CPANPLUS, which is used to enable autoflushing in spawned processes. $path = $maybe and last BIN if -f $maybe; ### you installed CPANPLUS in a custom prefix, - ### so go paralel to /that/. PREFIX=/tmp/cp + ### so go parallel to /that/. PREFIX=/tmp/cp ### would put cpanp-run-perl in /tmp/cp/bin and ### CPANPLUS.pm in ### /tmp/cp/lib/perl5/site_perl/5.8.8 diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Configure.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Configure.pm index baac91dc886..ba1ca0785ac 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Configure.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Configure.pm @@ -70,14 +70,18 @@ This method returns a new object. Normal users will never need to invoke the C<new> method, but instead retrieve the desired object via a method call on a C<CPANPLUS::Backend> object. +=over 4 + =item load_configs Controls whether or not additional user configurations are to be loaded or not. Defaults to C<true>. +=back + =cut -### store teh CPANPLUS::Config object in a closure, so we only +### store the CPANPLUS::Config object in a closure, so we only ### initialize it once.. otherwise, on a 2nd ->new, settings ### from configs on top of this one will be reset { my $Config; @@ -336,7 +340,7 @@ sub save { } return unless $self->can_save($file); - ### find only accesors that are not private + ### find only accessors that are not private my @acc = sort grep { $_ !~ /^_/ } $self->conf->ls_accessors; ### for dumping the values diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Configure/Setup.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Configure/Setup.pm index 3bcf8f45090..b6f34f2a521 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Configure/Setup.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Configure/Setup.pm @@ -1203,7 +1203,7 @@ are done. #$self->_pager_open; # host lists might be long print loc(" -You can enter multiple sites by seperating them by a space. +You can enter multiple sites by separating them by a space. For example: 1 4 2 5 "); @@ -1373,7 +1373,7 @@ This may take a while... "); - ### use the enew configuratoin ### + ### use the new configuration ### $cpan->configure_object( $conf ); load CPANPLUS::Module::Fake; diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist.pm index 551b8ec405f..20c74fcd4ad 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist.pm @@ -88,18 +88,18 @@ works. This will be set upon a successful create. =head2 $dist = CPANPLUS::Dist::YOUR_DIST_TYPE_HERE->new( module => MODOBJ ); -Create a new C<CPANPLUS::Dist::YOUR_DIST_TYPE_HERE> object based on the +Create a new C<CPANPLUS::Dist::YOUR_DIST_TYPE_HERE> object based on the provided C<MODOBJ>. *** DEPRECATED *** The optional argument C<format> is used to indicate what type of dist -you would like to create (like C<CPANPLUS::Dist::MM> or +you would like to create (like C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build> and so on ). -C<< CPANPLUS::Dist->new >> is exlusively meant as a method to be +C<< CPANPLUS::Dist->new >> is exclusively meant as a method to be inherited by C<CPANPLUS::Dist::MM|Build>. -Returns a C<CPANPLUS::Dist::YOUR_DIST_TYPE_HERE> object on success +Returns a C<CPANPLUS::Dist::YOUR_DIST_TYPE_HERE> object on success and false on failure. =cut @@ -114,7 +114,7 @@ sub new { my $tmpl = { module => { required => 1, allow => IS_MODOBJ, store => \$mod }, ### for backwards compatibility - format => { default => $class, store => \$format, + format => { default => $class, store => \$format, allow => [ __PACKAGE__->dist_types ], }, }; @@ -130,7 +130,7 @@ sub new { my $obj = $format->SUPER::new; $obj->mk_accessors( qw[parent status] ); - + ### set the parent $obj->parent( $mod ); @@ -139,7 +139,7 @@ sub new { $obj->status($acc); ### add minimum supported accessors - $acc->mk_accessors( qw[prepared created installed uninstalled + $acc->mk_accessors( qw[prepared created installed uninstalled distdir dist] ); } @@ -178,7 +178,7 @@ Returns a list of the CPANPLUS::Dist::* classes available ### backdoor method to add more dist types sub _add_dist_types { my $self = shift; push @Dists, @_ }; - + ### backdoor method to exclude dist types sub _ignore_dist_types { my $self = shift; push @Ignore, @_ }; sub _reset_dist_ignore { @Ignore = () }; @@ -208,8 +208,8 @@ Returns a list of the CPANPLUS::Dist::* classes available require => 1, except => [ keys %except ] ); - my %ignore = map { $_ => $_ } @Ignore; - + my %ignore = map { $_ => $_ } @Ignore; + push @Dists, grep { not $ignore{$_} and not $except{$_} } __PACKAGE__->_dist_types; } @@ -224,12 +224,12 @@ C<CPANPLUS::Dist::*> classes and want to make them available to the current process. =cut - + sub rescan_dist_types { my $dist = shift; $Loaded = 0; # reset the flag; return $dist->dist_types; - } + } } =head2 $bool = CPANPLUS::Dist->has_dist_type( $type ) @@ -241,9 +241,9 @@ Returns true if distribution type C<$type> is loaded/supported. sub has_dist_type { my $dist = shift; my $type = shift or return; - + return scalar grep { $_ eq $type } CPANPLUS::Dist->dist_types; -} +} =head2 $bool = $dist->prereq_satisfied( modobj => $modobj, version => $version_spec ) @@ -257,26 +257,26 @@ sub prereq_satisfied { my $dist = shift; my $cb = $dist->parent->parent; my %hash = @_; - + my($mod,$ver); my $tmpl = { version => { required => 1, store => \$ver }, modobj => { required => 1, store => \$mod, allow => IS_MODOBJ }, }; - + check( $tmpl, \%hash ) or return; - + return 1 if $mod->is_uptodate( version => $ver ); - + if ( $cb->_vcmp( $ver, $mod->version ) > 0 ) { - error(loc( + error(loc( "This distribution depends on %1, but the latest version". " of %2 on CPAN (%3) doesn't satisfy the specific version". " dependency (%4). You may have to resolve this dependency ". - "manually.", + "manually.", $mod->module, $mod->module, $mod->version, $ver )); - + } return; @@ -284,7 +284,7 @@ sub prereq_satisfied { =head2 $configure_requires = $dist->find_configure_requires( [file => /path/to/META.yml] ) -Reads the configure_requires for this distribution from the META.yml +Reads the configure_requires for this distribution from the META.yml or META.json file in the root directory and returns a hashref with module names and versions required. @@ -293,56 +293,112 @@ and versions required. sub find_configure_requires { my $self = shift; my $mod = $self->parent; + my %hash = @_; + + my ($meta); + my $href = {}; + + my $tmpl = { + file => { store => \$meta }, + }; + + check( $tmpl, \%hash ) or return; + my $meth = 'configure_requires'; - - ### the prereqs as we have them now - my @args = ( + + { + + ### the prereqs as we have them now + my @args = ( defaults => $mod->status->$meth || {}, - keys => [ $meth ], - ); + ); + + my @possibles = do { defined $mod->status->extract + ? ( META_JSON->( $mod->status->extract ), + META_YML->( $mod->status->extract ) ) + : () + }; + + unshift @possibles, $meta if $meta; + + META: foreach my $mfile ( grep { -e } @possibles ) { + push @args, ( file => $mfile ); + if ( $mfile =~ /\.json/ ) { + $href = $self->_prereqs_from_meta_json( @args, keys => [ 'configure' ] ); + } + else { + $href = $self->_prereqs_from_meta_file( @args, keys => [ $meth ] ); + } + last META; + } - ### the default file to use, which may be overriden - push @args, ( file => META_YML->( $mod->status->extract ) ) - if defined $mod->status->extract; - - my $href = $self->_prereqs_from_meta_file( @args, @_ ); + } ### and store it in the module $mod->status->$meth( $href ); return { %$href }; -} +} sub find_mymeta_requires { my $self = shift; my $mod = $self->parent; + my %hash = @_; + + my ($meta); + my $href = {}; + + my $tmpl = { + file => { store => \$meta }, + }; + + check( $tmpl, \%hash ) or return; + my $meth = 'prereqs'; - - ### the prereqs as we have them now - my @args = ( + + { + + ### the prereqs as we have them now + my @args = ( defaults => $mod->status->$meth || {}, - keys => [qw|requires build_requires|], - ); + ); + + my @possibles = do { defined $mod->status->extract + ? ( MYMETA_JSON->( $mod->status->extract ), + MYMETA_YML->( $mod->status->extract ) ) + : () + }; + + unshift @possibles, $meta if $meta; + + META: foreach my $mfile ( grep { -e } @possibles ) { + push @args, ( file => $mfile ); + if ( $mfile =~ /\.json/ ) { + $href = $self->_prereqs_from_meta_json( @args, + keys => [ qw|build test runtime| ] ); + } + else { + $href = $self->_prereqs_from_meta_file( @args, + keys => [ qw|build_requires requires| ] ); + } + last META; + } - ### the default file to use, which may be overriden - push @args, ( file => MYMETA_YML->( $mod->status->extract ) ) - if defined $mod->status->extract; - - my $href = $self->_prereqs_from_meta_file( @args, @_ ); + } ### and store it in the module $mod->status->$meth( $href ); return { %$href }; } - + sub _prereqs_from_meta_file { my $self = shift; - my $mod = $self->parent; + my $mod = $self->parent; my %hash = @_; my( $meta, $defaults, $keys ); - my $tmpl = { ### check if we have an extract path. if not, we + my $tmpl = { ### check if we have an extract path. if not, we ### get 'undef value' warnings from file::spec file => { default => do { defined $mod->status->extract ? META_YML->( $mod->status->extract ) @@ -353,17 +409,17 @@ sub _prereqs_from_meta_file { store => \$defaults }, keys => { required => 1, default => [], strict_type => 1, store => \$keys }, - }; - + }; + check( $tmpl, \%hash ) or return; - + ### if there's a meta file, we read it; if( -e $meta ) { ### Parse::CPAN::Meta uses exceptions for errors ### hash returned in list context!!! my ($doc) = eval { Parse::CPAN::Meta::LoadFile( $meta ) }; - + unless( $doc ) { error(loc( "Could not read %1: '%2'", $meta, $@ )); return $defaults; @@ -378,7 +434,61 @@ sub _prereqs_from_meta_file { } if $doc->{ $key }; } } - + + ### and return a copy + return \%{ $defaults }; +} + +sub _prereqs_from_meta_json { + my $self = shift; + my $mod = $self->parent; + my %hash = @_; + + my( $meta, $defaults, $keys ); + my $tmpl = { ### check if we have an extract path. if not, we + ### get 'undef value' warnings from file::spec + file => { default => do { defined $mod->status->extract + ? META_JSON->( $mod->status->extract ) + : '' }, + store => \$meta, + }, + defaults => { required => 1, default => {}, strict_type => 1, + store => \$defaults }, + keys => { required => 1, default => [], strict_type => 1, + store => \$keys }, + }; + + check( $tmpl, \%hash ) or return; + + ### if there's a meta file, we read it; + if( -e $meta ) { + + ### Parse::CPAN::Meta uses exceptions for errors + ### hash returned in list context!!! + my ($doc) = eval { Parse::CPAN::Meta->load_file( $meta ) }; + + unless( $doc ) { + error(loc( "Could not read %1: '%2'", $meta, $@ )); + return $defaults; + } + + ### read the keys now, make sure not to throw + ### away anything that was already added + #for my $key ( @$keys ) { + # $defaults = { + # %$defaults, + # %{ $doc->{$key} }, + # } if $doc->{ $key }; + #} + my $prereqs = $doc->{prereqs} || {}; + for my $key ( @$keys ) { + $defaults = { + %$defaults, + %{ $prereqs->{$key}->{requires} }, + } if $prereqs->{ $key }->{requires}; + } + } + ### and return a copy return \%{ $defaults }; } @@ -451,7 +561,7 @@ sub _resolve_prereqs { PREREQ_IGNORE, TARGET_IGNORE, PREREQ_INSTALL, TARGET_INSTALL, }->{ $conf->get_conf('prereqs') } || ''; - + ### XXX BIG NASTY HACK XXX FIXME at some point. ### when installing Bundle::CPANPLUS::Dependencies, we want to ### install all packages matching 'cpanplus' to be installed last, @@ -466,7 +576,7 @@ sub _resolve_prereqs { ### we got a transparent implementation.. that would mean we would ### just have to remove the 'sort' here, and all will be well my @sorted_prereqs; - + ### use regex, could either be a module name, or a package name if( $self->module =~ /^Bundle(::|-)CPANPLUS(::|-)Dependencies/ ) { my (@first, @last); @@ -483,13 +593,13 @@ sub _resolve_prereqs { ### first, transfer this key/value pairing into a ### list of module objects + desired versions my @install_me; - + for my $mod ( @sorted_prereqs ) { - my $version = $prereqs->{$mod}; - + ( my $version = $prereqs->{$mod} ) =~ s#[^0-9\._]+##g; + ### 'perl' is a special case, there's no mod object for it if( $mod eq PERL_CORE ) { - + ### run a CLI invocation to see if the perl you specified is ### uptodate my $ok = run( command => "$^X -M$version -e1", verbose => 0 ); @@ -497,14 +607,14 @@ sub _resolve_prereqs { unless( $ok ) { error(loc( "Module '%1' needs perl version '%2', but you ". "only have version '%3' -- can not proceed", - $self->module, $version, + $self->module, $version, $cb->_perl_version( perl => $^X ) ) ); - return; + return; } next; } - + my $modobj = $cb->module_tree($mod); #### XXX we ignore the version, and just assume that the latest @@ -514,14 +624,14 @@ sub _resolve_prereqs { my $sub = CPANPLUS::Module->can( 'module_is_supplied_with_perl_core' ); my $core = $sub->( $mod ); - unless ( $core ) { + unless ( defined $core ) { error( loc( "No such module '%1' found on CPAN", $mod ) ); next; } if ( $cb->_vcmp( $version, $core ) > 0 ) { error(loc( "Version of core module '%1' ('%2') is too low for ". - "'%3' (needs '%4') -- carrying on but this may be a problem", - $mod, $core, + "'%3' (needs '%4') -- carrying on but this may be a problem", + $mod, $core, $self->module, $version )); } next; @@ -583,7 +693,7 @@ sub _resolve_prereqs { ### see bug [#11840] ### if either force or prereq_build are given, the prereq ### should be built anyway - next if (!$force and !$prereq_build) && + next if (!$force and !$prereq_build) && $dist->prereq_satisfied(modobj => $modobj, version => $version); ### either we're told to ignore the prereq, @@ -611,10 +721,10 @@ sub _resolve_prereqs { ### part of core? if( $modobj->package_is_perl_core ) { error(loc("Prerequisite '%1' is perl-core (%2) -- not ". - "installing that. Aborting install", + "installing that. -- Note that the overall ". + "install may fail due to this.", $modobj->module, $modobj->package ) ); - $flag++; - last; + next; } ### circular dependency code ### @@ -663,7 +773,7 @@ sub _resolve_prereqs { "-- weird", $modobj->module)); $modobj->add_to_includepath(); - + next; } } @@ -672,7 +782,7 @@ sub _resolve_prereqs { keys %$prereqs; ### chdir back to where we started - chdir $original_wd; + $cb->_chdir( dir => $original_wd ); return 1 unless $flag; return; diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Autobundle.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Autobundle.pm index 16638b258f8..9561dd9f325 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Autobundle.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Autobundle.pm @@ -16,7 +16,7 @@ CPANPLUS::Dist::Autobundle $modobj = $cb->parse_module( module => 'file://path/to/Snapshot_XXYY.pm' ); $modobj->install; - + =head1 DESCRIPTION C<CPANPLUS::Dist::Autobundle> is a distribution class for installing installation diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Base.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Base.pm index c7108ed1392..904ab172266 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Base.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Base.pm @@ -97,14 +97,14 @@ For example, you might want to add extra accessors to the C<status> object, which you might do as follows: $dist->status->mk_accessors( qw[my_implementation_accessor] ); - + The C<status> object is implemented as an instance of the C<Object::Accessor> class. Please refer to its documentation for details. - -Return true if the initialization was successul, and false if it was + +Return true if the initialization was successful, and false if it was not. - + The C<CPANPLUS::Dist::Base> implementation does not alter your object and always returns true. diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build.pm index 0f27639cda5..164bcb0a9ec 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build.pm @@ -30,7 +30,7 @@ use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; local $Params::Check::VERBOSE = 1; -$VERSION = '0.46'; +$VERSION = '0.54'; =pod @@ -98,7 +98,7 @@ BOOL indicating if the C<Build test> command was successful. =item C<prepared ()> -BOOL indicating if the C<prepare> call exited succesfully +BOOL indicating if the C<prepare> call exited successfully This gets set after C<perl Build.PL> =item C<distdir ()> @@ -108,7 +108,7 @@ set after a call to C<prepare>. =item C<created ()> -BOOL indicating if the C<create> call exited succesfully. This gets +BOOL indicating if the C<create> call exited successfully. This gets set after C<Build> and C<Build test>. =item C<installed ()> @@ -145,8 +145,8 @@ to create and install modules in your environment. ### check if the format is available ### sub format_available { - my $mod = "Module::Build"; - unless( can_load( modules => { $mod => '0.2611' } ) ) { + my $mod = 'Module::Build'; + unless( can_load( modules => { $mod => '0.2611' }, nocache => 1 ) ) { error( loc( "You do not have '%1' -- '%2' not available", $mod, __PACKAGE__ ) ); return; @@ -192,7 +192,7 @@ The variable C<PERL5_CPANPLUS_IS_EXECUTING> will be set to the full path of the C<Build.PL> that is being executed. This enables any code inside the C<Build.PL> to know that it is being installed via CPANPLUS. -After a succcesfull C<prepare> you may call C<create> to create the +After a successful C<prepare> you may call C<create> to create the distribution, followed by C<install> to actually install it. Returns true on success and false on failure. @@ -275,9 +275,9 @@ sub prepare { ### we resolve 'configure requires' here, so we can run the 'perl ### Makefile.PL' command ### XXX for tests: mock f_c_r to something that *can* resolve and - ### something that *doesnt* resolve. Check the error log for ok + ### something that *doesn't* resolve. Check the error log for ok ### on this step or failure - ### XXX make a seperate tarball to test for this scenario: simply + ### XXX make a separate tarball to test for this scenario: simply ### containing a makefile.pl/build.pl for test purposes? my $safe_ver = version->new('0.85_01'); if ( version->new($CPANPLUS::Internals::VERSION) >= $safe_ver ) @@ -426,8 +426,12 @@ sub _find_prereqs { $prereqs->{$_} = $bphash->{$type}->{$_} for keys %{ $bphash->{$type} }; } } - # Temporary fix - delete $prereqs->{'perl'}; + + { + delete $prereqs->{'perl'} + unless version->new($CPANPLUS::Internals::VERSION) + >= version->new('0.9102'); + } ### allows for a user defined callback to filter the prerequisite ### list as they see fit, to remove (or add) any prereqs they see diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build/Constants.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build/Constants.pm index 1ac02108e44..ba1ca8665c0 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build/Constants.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build/Constants.pm @@ -9,7 +9,7 @@ BEGIN { require Exporter; use vars qw[$VERSION @ISA @EXPORT]; - $VERSION = '0.46'; + $VERSION = '0.54'; @ISA = qw[Exporter]; @EXPORT = qw[ BUILD_DIR BUILD ]; } diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/MM.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/MM.pm index be65cd43cc8..b2205e46f0b 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/MM.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/MM.pm @@ -32,7 +32,7 @@ CPANPLUS::Dist::MM $mm->create; # runs make && make test $mm->install; # runs make install - + =head1 DESCRIPTION C<CPANPLUS::Dist::MM> is a distribution class for MakeMaker related @@ -78,7 +78,7 @@ successful. =item prepared () -BOOL indicating if the C<prepare> call exited succesfully +BOOL indicating if the C<prepare> call exited successfully This gets set after C<perl Makefile.PL> =item distdir () @@ -88,7 +88,7 @@ set after a call to C<prepare>. =item created () -BOOL indicating if the C<create> call exited succesfully. This gets +BOOL indicating if the C<create> call exited successfully. This gets set after C<make> and C<make test>. =item installed () @@ -154,7 +154,9 @@ sub format_available { return 1; } -=pod $bool = $dist->init(); +=pod + +=head2 $bool = $dist->init(); Sets up the C<CPANPLUS::Dist::MM> object for use. Effectively creates all the needed status accessors. @@ -174,7 +176,9 @@ sub init { return 1; } -=pod $bool = $dist->prepare([perl => '/path/to/perl', makemakerflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL]) +=pod + +=head2 $bool = $dist->prepare([perl => '/path/to/perl', makemakerflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL]) C<prepare> preps a distribution for installation. This means it will run C<perl Makefile.PL> and determine what prerequisites this distribution @@ -258,9 +262,9 @@ sub prepare { ### we resolve 'configure requires' here, so we can run the 'perl ### Makefile.PL' command ### XXX for tests: mock f_c_r to something that *can* resolve and - ### something that *doesnt* resolve. Check the error log for ok + ### something that *doesn't* resolve. Check the error log for ok ### on this step or failure - ### XXX make a seperate tarball to test for this scenario: simply + ### XXX make a separate tarball to test for this scenario: simply ### containing a makefile.pl/build.pl for test purposes? { my $configure_requires = $dist->find_configure_requires; my $ok = $dist->_resolve_prereqs( @@ -694,7 +698,7 @@ sub create { $dist->status->test(1); } else { - error( loc( "MAKE TEST failed: %1 %2", $!, $captured ) ); + error( loc( "MAKE TEST failed: %1", $captured ) ); ### send out error report here? or do so at a higher level? ### --higher level --kane. diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Error.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Error.pm index 38710a8a857..c42435f1922 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Error.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Error.pm @@ -100,7 +100,9 @@ BEGIN { } sub flush { - return reverse $log->flush; + my @foo = $log->flush; + return unless @foo; + return reverse @foo; } sub stack { @@ -133,7 +135,10 @@ printed. This defaults to C<*STDERR>. This is the filehandle all the messages sent to C<msg()> are being printed. This default to C<*STDOUT>. +=back + =cut + local $| = 1; $ERROR_FH = \*STDERR; $MSG_FH = \*STDOUT; diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Hacking.pod b/Master/tlpkg/tlperl/lib/CPANPLUS/Hacking.pod index 1a28b9e5b05..6a754fb25ee 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Hacking.pod +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Hacking.pod @@ -49,7 +49,7 @@ from there. =head1 RUNNING CPANPLUS TESTS Tests are what tells us if CPANPLUS is working. If a test is not working, -try to run it explicilty like this: +try to run it explicitly like this: perl -I/path/to/cpanplus/lib t/XX_name_of_test.t 1 diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals.pm index fedcb670aa4..4756421a4ad 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals.pm @@ -42,7 +42,7 @@ use vars qw[@ISA $VERSION]; CPANPLUS::Internals::Report ]; -$VERSION = "0.90"; +$VERSION = "0.9103"; =pod @@ -104,6 +104,7 @@ You have to pass it a valid C<CPANPLUS::Configure> object. Returns the object on success, or dies on failure. =cut + { ### NOTE: ### if extra callbacks are added, don't forget to update the ### 02-internals.t test script with them! @@ -182,7 +183,7 @@ Returns the object on success, or dies on failure. ### create a selfupdate object $args->_selfupdate( CPANPLUS::Selfupdate->new( $args ) ); - ### initalize it as an empty hashref ### + ### initialize it as an empty hashref ### $args->_status->pending_prereqs( {} ); $conf->_set_build( startdir => cwd() ), @@ -255,7 +256,7 @@ be flushed. @INC = @{$conf->_lib}; ### give all modules a new status object -- this is slightly - ### costly, but the best way to make sure all statusses are + ### costly, but the best way to make sure all statuses are ### forgotten --kane } elsif ( $what eq 'modules' ) { for my $modobj ( values %{$self->module_tree} ) { diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Constants.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Constants.pm index 1a38200dfb7..443d5a4ca8a 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Constants.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Constants.pm @@ -154,6 +154,16 @@ use constant MYMETA_YML => sub { return @_ : 'MYMETA.yml'; }; +use constant META_JSON => sub { return @_ + ? File::Spec->catfile( @_, 'META.json' ) + : 'META.json'; + }; + +use constant MYMETA_JSON => sub { return @_ + ? File::Spec->catfile( @_, 'MYMETA.json' ) + : 'MYMETA.json'; + }; + use constant BLIB => sub { return @_ ? File::Spec->catfile(@_, 'blib') : 'blib'; diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Constants/Report.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Constants/Report.pm index 59a41a6083b..abdb3c98dd0 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Constants/Report.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Constants/Report.pm @@ -80,10 +80,10 @@ use constant RELEVANT_TEST_RESULT my $name = $mod->module; my $specific; for my $platform (keys %OS) { - if( $name =~ /\b$platform\b/i ) { + if( $name =~ /^$platform\b/i ) { # beware the Mac != MAC next if($platform eq 'Mac' && - $name !~ /\b$platform\b/); + $name !~ /^$platform\b/); $specific++; return 1 if $^O =~ /^(?:$OS{$platform})$/ diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Extract.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Extract.pm index 84a48a50dea..f30911bab88 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Extract.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Extract.pm @@ -36,12 +36,12 @@ CPANPLUS::Internals::Extract extracts compressed files for CPANPLUS. It can do this by either a pure perl solution (preferred) with the use of C<Archive::Tar> and C<Compress::Zlib>, or with binaries, like C<gzip> and C<tar>. - + The flow looks like this: $cb->_extract Delegate to Archive::Extract - + =head1 METHODS =head2 $dir = _extract( module => $modobj, [perl => '/path/to/perl', extractdir => '/path/to/extract/to', prefer_bin => BOOL, verbose => BOOL, force => BOOL] ) @@ -165,7 +165,7 @@ sub _extract { ### extracted.. try to offer a suggestion and bail :( unless ( $ae->files ) { error( loc( "'%1' was not able to determine extracted ". - "files from the archive. Instal '%2' and ensure ". + "files from the archive. Install '%2' and ensure ". "it works properly and try again", $ae->is_zip ? 'Archive::Zip' : 'Archive::Tar' ) ); return; @@ -178,7 +178,7 @@ sub _extract { ### set them all to be +w for the owner, so we don't get permission ### denied for overwriting files that are just +r - ### this is to rigurous -- just change to +w for the owner [cpan #13358] + ### this is too rigorous -- just change to +w for the owner [cpan #13358] #chmod 0755, map { File::Spec->rel2abs( File::Spec->catdir($to, $_) ) } # @{$ae->files}; diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Fetch.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Fetch.pm index 395965bab60..7dcb3c366bb 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Fetch.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Fetch.pm @@ -122,7 +122,7 @@ sub _fetch { my ($remote_file, $local_file, $local_path); - ### build the local path to downlaod to ### + ### build the local path to download to ### { $local_path = $args->{fetchdir} || File::Spec->catdir( @@ -280,7 +280,7 @@ sub _fetch { ### 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 + ### The RFC doesn't seem to address Windows volume ### descriptors but it does address VMS volume ### descriptors, however wikipedia covers a bit of ### history regarding win32 diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Report.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Report.pm index 774c6b91a02..73a2d297e2d 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Report.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Report.pm @@ -11,6 +11,7 @@ use Data::Dumper; use Params::Check qw[check]; use Module::Load::Conditional qw[can_load]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; +use version; $Params::Check::VERBOSE = 1; @@ -25,7 +26,7 @@ CPANPLUS::Internals::Report ### enable test reporting $cb->configure_object->set_conf( cpantest => 1 ); - + ### set custom mx host, shouldn't normally be needed $cb->configure_object->set_conf( cpantest_mx => 'smtp.example.com' ); @@ -63,7 +64,7 @@ otherwise. my $send_list = { %$query_list, - 'Test::Reporter' => '1.34', + 'Test::Reporter' => '1.54', }; sub _have_query_report_modules { @@ -103,7 +104,7 @@ otherwise. This function queries the CPAN testers database at I<http://testers.cpan.org/> for test results of specified module objects, -module names or distributions. +module names or distributions. The optional argument C<all_versions> controls whether all versions of a given distribution should be grabbed. It defaults to false @@ -184,7 +185,7 @@ sub _query_report { my $res = do { my $tempdir = File::Temp::tempdir(); my $where = $ff->fetch( to => $tempdir ); - + unless( $where ) { error( loc( "Fetching report for '%1' failed: %2", $url, $ff->error ) ); @@ -192,7 +193,7 @@ sub _query_report { } my $fh = OPEN_FILE->( $where ); - + do { local $/; <$fh> }; }; @@ -208,11 +209,11 @@ sub _query_report { my @rv; for my $href ( @$aref ) { - next unless $all or defined $href->{'distversion'} && + next unless $all or defined $href->{'distversion'} && $href->{'distversion'} eq $dist; $href->{'details'} = $details; - + ### backwards compatibility :( $href->{'dist'} ||= $href->{'distversion'}; $href->{'grade'} ||= $href->{'action'} || $href->{'status'}; @@ -295,7 +296,7 @@ sub _send_report { } ### check arguments ### - my ($buffer, $failed, $mod, $verbose, $force, $address, $save, + my ($buffer, $failed, $mod, $verbose, $force, $address, $save, $tests_skipped ); my $tmpl = { module => { required => 1, store => \$mod, allow => IS_MODOBJ }, @@ -307,7 +308,7 @@ sub _send_report { store => \$verbose }, force => { default => $conf->get_conf('force'), store => \$force }, - tests_skipped + tests_skipped => { default => 0, store => \$tests_skipped }, }; @@ -317,6 +318,7 @@ sub _send_report { my $name = $mod->module; my $dist = $mod->package_name . '-' . $mod->package_version; my $author = $mod->author->author; + my $distfile= $mod->author->cpanid . "/" . $mod->package; my $email = $mod->author->email || CPAN_MAIL_ACCOUNT->( $author ); my $cp_conf = $conf->get_conf('cpantest') || ''; my $int_ver = $CPANPLUS::Internals::VERSION; @@ -330,27 +332,43 @@ sub _send_report { my $grade; ### check if this is a platform specific module ### - ### if we failed the test, there may be reasons why - ### an 'NA' might have to be insted + ### if we failed the test, there may be reasons why + ### an 'NA' might have to be instead GRADE: { if ( $failed ) { - + ### XXX duplicated logic between this block ### and REPORTED_LOADED_PREREQS :( - + ### figure out if the prereqs are on CPAN at all ### -- if not, send NA grade ### Also, if our version of prereqs is too low, ### -- send NA grade. - ### This is to address bug: #25327: do not count + ### This is to address bug: #25327: do not count ### as FAIL modules where prereqs are not filled { my $prq = $mod->status->prereqs || {}; - - while( my($prq_name,$prq_ver) = each %$prq ) { + + PREREQ: while( my($prq_name,$prq_ver) = each %$prq ) { + + # 'perl' listed as prereq + + if ( $prq_name eq 'perl' ) { + my $req_ver = eval { version->new( $prq_ver ) }; + next PREREQ unless $req_ver; + if ( version->new( $] ) < $req_ver ) { + msg(loc("'%1' requires a higher version of perl than your current ". + "version -- sending N/A grade.", $name), $verbose); + + $grade = GRADE_NA; + last GRADE; + } + next PREREQ; + } + my $obj = $cb->module_tree( $prq_name ); - my $sub = CPANPLUS::Module->can( + my $sub = CPANPLUS::Module->can( 'module_is_supplied_with_perl_core' ); - + ### if we can't find the module and it's not supplied with core. ### this addresses: #32064: NA reports generated for failing ### tests where core prereqs are specified @@ -358,62 +376,62 @@ sub _send_report { ### version of perl (5.8.6+ and 5.9.2-4 at the time of writing) ### 'Config' is not recognized as a core module. See this bug: ### http://rt.cpan.org/Ticket/Display.html?id=32155 - if( !$obj and !$sub->( $prq_name ) ) { + if( !$obj and !defined $sub->( $prq_name ) ) { msg(loc( "Prerequisite '%1' for '%2' could not be obtained". - " from CPAN -- sending N/A grade", + " from CPAN -- sending N/A grade", $prq_name, $name ), $verbose ); $grade = GRADE_NA; - last GRADE; + last GRADE; } if ( !$obj ) { my $vcore = $sub->( $prq_name ); if ( $cb->_vcmp( $prq_ver, $vcore ) > 0 ) { msg(loc( "Version of core module '%1' ('%2') is too low for ". - "'%3' (needs '%4') -- sending N/A grade", - $prq_name, $vcore, + "'%3' (needs '%4') -- sending N/A grade", + $prq_name, $vcore, $name, $prq_ver ), $verbose ); - + $grade = GRADE_NA; - last GRADE; + last GRADE; } } if( $obj and $cb->_vcmp( $prq_ver, $obj->installed_version ) > 0 ) { msg(loc( "Installed version of '%1' ('%2') is too low for ". - "'%3' (needs '%4') -- sending N/A grade", - $prq_name, $obj->installed_version, + "'%3' (needs '%4') -- sending N/A grade", + $prq_name, $obj->installed_version, $name, $prq_ver ), $verbose ); - + $grade = GRADE_NA; - last GRADE; - } + last GRADE; + } } } - + unless( RELEVANT_TEST_RESULT->($mod) ) { msg(loc( "'%1' is a platform specific module, and the test results on". " your platform are not relevant --sending N/A grade.", $name), $verbose); - + $grade = GRADE_NA; - + } elsif ( UNSUPPORTED_OS->( $buffer ) ) { msg(loc( "'%1' is a platform specific module, and the test results on". " your platform are not relevant --sending N/A grade.", $name), $verbose); - + $grade = GRADE_NA; - - ### you dont have a high enough perl version? + + ### you dont have a high enough perl version? } elsif ( PERL_VERSION_TOO_LOW->( $buffer ) ) { msg(loc("'%1' requires a higher version of perl than your current ". "version -- sending N/A grade.", $name), $verbose); - - $grade = GRADE_NA; + + $grade = GRADE_NA; ### perhaps where were no tests... ### see if the thing even had tests ### @@ -425,7 +443,7 @@ sub _send_report { $grade = GRADE_UNKNOWN } else { - + $grade = GRADE_FAIL; } @@ -488,7 +506,7 @@ sub _send_report { } elsif ( $tests_skipped ) { $message .= REPORT_TESTS_SKIPPED->(); } elsif( $grade eq GRADE_NA) { - + ### the bit where we inform what went wrong $message .= REPORT_MESSAGE_FAIL_HEADER->( $stage, $buffer ); @@ -502,32 +520,33 @@ sub _send_report { ### reporter object ### my $reporter = do { my $args = $conf->get_conf('cpantest_reporter_args') || {}; - + unless( UNIVERSAL::isa( $args, 'HASH' ) ) { error(loc("'%1' must be a hashref, ignoring...", 'cpantest_reporter_args')); $args = {}; } - + Test::Reporter->new( grade => $grade, distribution => $dist, + distfile => $distfile, via => "CPANPLUS $int_ver", timeout => $conf->get_conf('timeout') || 60, debug => $conf->get_conf('debug'), %$args, ); }; - + ### set a custom mx, if requested - $reporter->mx( [ $conf->get_conf('cpantest_mx') ] ) + $reporter->mx( [ $conf->get_conf('cpantest_mx') ] ) if $conf->get_conf('cpantest_mx'); ### set the from address ### $reporter->from( $conf->get_conf('email') ) if $conf->get_conf('email') !~ /\@example\.\w+$/i; - ### give the user a chance to programattically alter the message + ### give the user a chance to programatically alter the message $message = $self->_callbacks->munge_test_report->($mod, $message, $grade); ### add the body if we have any ### @@ -567,10 +586,10 @@ sub _send_report { ### XXX should we do an 'already sent' check? ### ### something broke :( ### - } + } else { my $status; - eval { + eval { $status = $reporter->send(); }; if ( $@ ) { @@ -602,7 +621,7 @@ sub _verify_missing_prereqs { check( $tmpl, \%hash ) or return; - + my %missing = map {$_ => 1} @$missing; my $conf = $self->configure_object; my $extract = $mod->status->extract; @@ -622,9 +641,9 @@ sub _verify_missing_prereqs { for my $file ( @search ) { if(-e $file and -r $file) { my $slurp = $self->_get_file_contents(file => $file); - my ($prereq) = + my ($prereq) = ($slurp =~ /'?(?:PREREQ_PM|requires)'?\s*=>\s*{(.*?)}/s); - my @prereq = + my @prereq = ($prereq =~ /'?([\w\:]+)'?\s*=>\s*'?\d[\d\.\-\_]*'?/sg); delete $missing{$_} for(@prereq); } diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Search.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Search.pm index 63c4da64d92..a93626b618e 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Search.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Search.pm @@ -337,7 +337,7 @@ sub _all_installed { my $modobj = $self->module_tree($mod); - ### seperate return, a list context return with one '' + ### separate return, a list context return with one '' ### in it, is also true! return unless $modobj; diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source.pm index 54e9d710cfd..96370046255 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source.pm @@ -204,7 +204,7 @@ sub _build_trees { ### XXX unpleasant hack. since custom sources uses ->parse_module, we ### already have a special module object with extra meta data. that ### doesn't gelwell with the sqlite storage engine. So, we check 'normal' - ### trees from seperate trees, so the engine can treat them differently. + ### trees from separate trees, so the engine can treat them differently. ### Effectively this means that with the SQLite engine, for now, custom ### sources are continuously reparsed =/ -kane if( not $self->_custom_trees_completed ) { @@ -890,7 +890,7 @@ sub _dslip_defs { d => loc('Developer'), u => loc('Usenet newsgroup comp.lang.perl.modules'), n => loc('None known, try comp.lang.perl.modules'), - a => loc('Abandoned; volunteers welcome to take over maintainance'), + a => loc('Abandoned; volunteers welcome to take over maintenance'), }], # L @@ -1340,7 +1340,7 @@ Returns true on success, false on failure. =cut -### use $auth_obj as a persistant version, so we don't have to recreate +### use $auth_obj as a persistent version, so we don't have to recreate ### modules all the time { my $auth_obj; @@ -1391,7 +1391,7 @@ Returns true on success, false on failure. $mod->author( $auth_obj ); - ### and now add it to the modlue tree -- this MAY + ### and now add it to the module tree -- this MAY ### override things of course if( my $old_mod = $self->module_tree( $mod->module ) ) { diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source/SQLite.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source/SQLite.pm index a0ddf499bf6..556be6456d5 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source/SQLite.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source/SQLite.pm @@ -51,9 +51,17 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation { AutoCommit => 1 } ); #$Dbh->dbh->trace(1); + $Dbh->query(qq{PRAGMA synchronous = OFF}); return $Dbh; }; + + sub __sqlite_disconnect { + return unless $Dbh; + $Dbh->disconnect; + $Dbh = undef; + return; + } } { my $used_old_copy = 0; @@ -79,6 +87,7 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation $used_old_copy = 0; ### chuck the file + $self->__sqlite_disconnect; 1 while unlink $self->__sqlite_file; ### and create a new one @@ -118,7 +127,7 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation sub _standard_trees_completed { return $used_old_copy } sub _custom_trees_completed { return } ### finish transaction - sub _finalize_trees { $_[0]->__sqlite_dbh->query('COMMIT'); return 1 } + sub _finalize_trees { $_[0]->__sqlite_dbh->commit; return 1 } ### saves current memory state, but not implemented in sqlite sub _save_state { @@ -155,8 +164,8 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation ### keep counting how many we inserted unless( ++$txn_count % TXN_COMMIT ) { #warn "Committing transaction $txn_count"; - $dbh->query('COMMIT') or error( $dbh->error ); # commit previous transaction - $dbh->query('BEGIN') or error( $dbh->error ); # and start a new one + $dbh->commit or error( $dbh->error ); # commit previous transaction + $dbh->begin_work or error( $dbh->error ); # and start a new one } $dbh->query( @@ -201,8 +210,8 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation ### keep counting how many we inserted unless( ++$txn_count % TXN_COMMIT ) { #warn "Committing transaction $txn_count"; - $dbh->query('COMMIT') or error( $dbh->error ); # commit previous transaction - $dbh->query('BEGIN') or error( $dbh->error ); # and start a new one + $dbh->commit or error( $dbh->error ); # commit previous transaction + $dbh->begin_work or error( $dbh->error ); # and start a new one } $dbh->query( @@ -264,7 +273,7 @@ sub __sqlite_create_db { my $self = shift; my $dbh = $self->__sqlite_dbh; - ### we can ignore the result/error; not all sqlite implemantation + ### we can ignore the result/error; not all sqlite implementations ### support this $dbh->query( qq[ DROP TABLE IF EXISTS author; @@ -319,7 +328,46 @@ sub __sqlite_create_db { error( $dbh->error ); return; }; - + + $dbh->query( qq[ + /* the module index */ + CREATE INDEX IX_module_module ON module ( + module + ); + + \n] + + ) or do { + error( $dbh->error ); + return; + }; + + $dbh->query( qq[ + /* the version index */ + CREATE INDEX IX_module_version ON module ( + version + ); + + \n] + + ) or do { + error( $dbh->error ); + return; + }; + + $dbh->query( qq[ + /* the module-version index */ + CREATE INDEX IX_module_module_version ON module ( + module, version + ); + + \n] + + ) or do { + error( $dbh->error ); + return; + }; + return 1; } diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Utils.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Utils.pm index 27d2abcdad1..31abaffed4d 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Utils.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Utils.pm @@ -5,7 +5,7 @@ use strict; use CPANPLUS::Error; use CPANPLUS::Internals::Constants; -use Cwd qw[chdir]; +use Cwd qw[chdir cwd]; use File::Copy; use Params::Check qw[check]; use Module::Load::Conditional qw[can_load]; @@ -238,7 +238,9 @@ sub _get_file_contents { return $contents; } -=pod $cb->_move( from => $file|$dir, to => $target ); +=pod + +=head2 $cb->_move( from => $file|$dir, to => $target ); Moves a file or directory to the target. @@ -267,7 +269,9 @@ sub _move { } } -=pod $cb->_copy( from => $file|$dir, to => $target ); +=pod + +=head2 $cb->_copy( from => $file|$dir, to => $target ); Moves a file or directory to the target. diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Module.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Module.pm index 9e4b67e4a38..8d237efc050 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Module.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Module.pm @@ -447,7 +447,7 @@ L<Module::ThirdParty> for more details. my $core = $self->module_is_supplied_with_perl_core; ### ok, so it's found in the core, BUT it could be dual-lifed - if ($core) { + if (defined $core) { ### if the package is newer than installed, then it's dual-lifed return if $cb->_vcmp($self->version, $self->installed_version) > 0; @@ -480,8 +480,13 @@ L<Module::ThirdParty> for more details. ### broken for perl 5.10: Module::CoreList's version key for the ### hash has a different number of trailing zero than $] aka ### $PERL_VERSION. - my $core = $Module::CoreList::version{ 0+$ver }->{ $name }; + my $core; + + if ( exists $Module::CoreList::version{ 0+$ver }->{ $name } ) { + $core = $Module::CoreList::version{ 0+$ver }->{ $name }; + $core = 0 unless $core; + } return $core; } @@ -775,7 +780,7 @@ sub dist { "available, but is not! -- aborting", $type)); return; } else { - msg(loc("Installer '%1' succesfully bootstrapped", $type)); + msg(loc("Installer '%1' successfully bootstrapped", $type)); } ### some other plugin you dont have. Abort @@ -828,7 +833,7 @@ sub dist { =pod =head2 $bool = $mod->prepare( ) - + Convenience method around C<install()> that prepares a module without actually building it. This is equivalent to invoking C<install> with C<target> set to C<prepare> @@ -1001,6 +1006,7 @@ sub install { $self->extract( %$params ) or return; } + $args->{'prereq_format'} = $format if $format; $format ||= $self->status->installer_type; unless( $format ) { @@ -1444,7 +1450,7 @@ sub uninstall { my $dirs = $self->directory_tree( type => $type ) or return; my $sudo = $conf->get_program('sudo'); - ### just in case there's no file; M::B doensn't provide .packlists yet ### + ### just in case there's no file; M::B doesn't provide .packlists yet ### my $pack = $self->packlist; $pack = $pack->[0]->packlist_file() if $pack; diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Author.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Author.pm index 92940fa51ff..0daac6716d7 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Author.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Author.pm @@ -131,7 +131,7 @@ sub modules { my $aref = $cb->_search_module_tree( type => 'author', ### XXX, depending on backend, this is either an object - ### or the cpanid string. Dont know an elegant way to + ### or the cpanid string. Don't know an elegant way to ### solve this right now, so passing both allow => [$self, $self->cpanid], ); diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Checksums.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Checksums.pm index e1a2bbdb6ad..3f9561e2dfe 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Checksums.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Checksums.pm @@ -75,7 +75,7 @@ sub _validate_checksum { ### if we can't check it, we must assume it's ok ### return $self->status->checksum_ok(1) - unless can_load( modules => { 'Digest::MD5' => '0.0' } ); + unless can_load( modules => { 'Digest::SHA' => '0.0' } ); #class CPANPLUS::Module::Status is runtime-generated my $file = $self->_get_checksums_file( verbose => $verbose ) or ( @@ -103,29 +103,30 @@ sub _validate_checksum { msg(loc("Archive size is not known for '%1'",$self->package),$verbose); } - my $md5 = $href->{ $self->package }->{'md5'}; + my $sha = $href->{ $self->package }->{'sha256'}; - unless( defined $md5 ) { - msg(loc("No 'md5' checksum known for '%1'",$self->package),$verbose); + unless( defined $sha ) { + msg(loc("No 'sha256' checksum known for '%1'",$self->package),$verbose); return $self->status->checksum_ok(1); } - $self->status->checksum_value($md5); + $self->status->checksum_value($sha); my $fh = FileHandle->new( $self->status->fetch ) or return; binmode $fh; - my $ctx = Digest::MD5->new; + my $ctx = Digest::SHA->new(256); $ctx->addfile( $fh ); - my $flag = $ctx->hexdigest eq $md5; + my $hexdigest = $ctx->hexdigest; + my $flag = $hexdigest eq $sha; $flag ? msg(loc("Checksum matches for '%1'", $self->package),$verbose) : error(loc("Checksum does not match for '%1': " . - "MD5 is '%2' but should be '%3'", - $self->package, $ctx->hexdigest, $md5),$verbose); + "SHA256 is '%2' but should be '%3'", + $self->package, $hexdigest, $sha),$verbose); return $self->status->checksum_ok(1) if $flag; diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Selfupdate.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Selfupdate.pm index 48f918ce82e..6f2015c504c 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Selfupdate.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Selfupdate.pm @@ -4,6 +4,7 @@ use strict; use Params::Check qw[check]; use IPC::Cmd qw[can_run]; use CPANPLUS::Error qw[error msg]; +use Module::Load::Conditional qw[check_install]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use CPANPLUS::Internals::Constants; @@ -46,7 +47,7 @@ CPANPLUS::Selfupdate 'Locale::Maketext::Simple' => '0.01', 'Log::Message' => '0.01', 'Module::Load' => '0.10', - 'Module::Load::Conditional' => '0.31_01', # returns dir for loaded + 'Module::Load::Conditional' => '0.38', # returns dir for loaded # modules 'version' => '0.73', # needed for M::L::C # addresses #24630 and @@ -65,8 +66,10 @@ CPANPLUS::Selfupdate 'Module::CoreList' => '2.22', # deprecated core modules 'Module::Pluggable' => '2.4', 'Module::Loaded' => '0.01', - 'Parse::CPAN::Meta' => '0.02', # config_requires support + 'Parse::CPAN::Meta' => '1.4200', # config_requires support 'ExtUtils::Install' => '1.42', # uninstall outside @INC + ( check_install( module => 'CPANPLUS::Dist::Build' ) + ? ( 'CPANPLUS::Dist::Build' => '0.24' ) : () ), }, features => { @@ -85,7 +88,7 @@ CPANPLUS::Selfupdate ], cpantest => [ { 'Test::Reporter' => '1.34', - 'Parse::CPAN::Meta' => '0.0' + 'Parse::CPAN::Meta' => '1.4200' }, sub { my $cb = shift; @@ -107,7 +110,7 @@ CPANPLUS::Selfupdate md5 => [ { - 'Digest::MD5' => '0.0', + 'Digest::SHA' => '0.0', }, sub { my $cb = shift; @@ -233,7 +236,7 @@ See C<selfupdate> for details. sub list_categories { return sort keys %$cache } =head2 %list = $self->list_modules_to_update( update => "core|dependencies|enabled_features|features|all", [latest => BOOL] ) - + List which modules C<selfupdate> would upgrade. You can update either the core (CPANPLUS itself), the core dependencies, all features you have currently turned on, or all features available, or everything. @@ -246,11 +249,11 @@ Returns a hash of feature names and lists of module objects to be upgraded based on the category you provided. For example: %list = $self->list_modules_to_update( update => 'core' ); - + Would return: ( core => [ $module_object_for_cpanplus ] ); - + =cut sub list_modules_to_update { @@ -287,7 +290,7 @@ Would return: return %list; } - + =head2 $bool = $self->selfupdate( update => "core|dependencies|enabled_features|features|all", [latest => BOOL, force => BOOL] ) Selfupdate CPANPLUS. You can update either the core (CPANPLUS itself), diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Shell.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Shell.pm index 854d46b16a4..e3eb181c6dc 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Shell.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Shell.pm @@ -299,7 +299,7 @@ sub _pager_close { my $self = shift; my $fmt = shift; - ### MUST specify $fmt as a seperate param, and not as part + ### MUST specify $fmt as a separate param, and not as part ### of @_, as it will then miss the $fmt and return the ### number of elements in the list... =/ --kane $self->__print( sprintf( $fmt, @_ ) ); diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Shell/Default.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Shell/Default.pm index a9d51422f66..35c02aff2b7 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Shell/Default.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Shell/Default.pm @@ -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.90"; + $VERSION = "0.9103"; } load CPANPLUS::Shell; @@ -142,7 +142,7 @@ CPANPLUS::Shell::Default cpanp> q # quit the shell - cpanp> /plugins # list avialable plugins + cpanp> /plugins # list available plugins cpanp> /? PLUGIN # list help test of <PLUGIN> ### common options: @@ -1222,6 +1222,7 @@ sub _set_conf { my ($type,$key,$value) = $input =~ m/(\w+)\s*(\w*)\s*(.*?)$/; $value =~ s/\s+$//g if $value; + $type = '' unless defined $type; $type = lc $type; if( $type eq 'reconfigure' ) { diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Shell/Default/Plugins/CustomSource.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Shell/Default/Plugins/CustomSource.pm index ad4701a488c..7b546819075 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Shell/Default/Plugins/CustomSource.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Shell/Default/Plugins/CustomSource.pm @@ -12,7 +12,7 @@ use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; CPANPLUS::Shell::Default::Plugins::CustomSource =head1 SYNOPSIS - + ### elaborate help text CPAN Terminal> /? cs |