diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPANPLUS/Internals.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/CPANPLUS/Internals.pm | 66 |
1 files changed, 33 insertions, 33 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals.pm index 4756421a4ad..e9f97bfa2a1 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals.pm @@ -42,13 +42,13 @@ use vars qw[@ISA $VERSION]; CPANPLUS::Internals::Report ]; -$VERSION = "0.9103"; +$VERSION = "0.9121"; =pod =head1 NAME -CPANPLUS::Internals +CPANPLUS::Internals - CPANPLUS internals =head1 SYNOPSIS @@ -109,7 +109,7 @@ Returns the object on success, or dies on failure. ### if extra callbacks are added, don't forget to update the ### 02-internals.t test script with them! my $callback_map = { - ### name default value + ### name default value install_prerequisite => 1, # install prereqs when 'ask' is set? edit_test_report => 0, # edit the prepared test report? send_test_report => 1, # send the test report? @@ -121,7 +121,7 @@ Returns the object on success, or dies on failure. proceed_on_test_failure => sub { return 0 }, munge_dist_metafile => sub { return $_[1] }, }; - + my $status = Object::Accessor->new; $status->mk_accessors(qw[pending_prereqs]); @@ -169,14 +169,14 @@ Returns the object on success, or dies on failure. for my $name ( $callback->ls_accessors ) { my $rv = ref $callback_map->{$name} ? 'sub return value' : $callback_map->{$name} ? 'true' : 'false'; - + $args->_callbacks->$name( sub { msg(loc("DEFAULT '%1' HANDLER RETURNING '%2'", - $name, $rv), $args->_conf->get_conf('debug')); - return ref $callback_map->{$name} + $name, $rv), $args->_conf->get_conf('debug')); + return ref $callback_map->{$name} ? $callback_map->{$name}->( @_ ) : $callback_map->{$name}; - } + } ); } @@ -199,24 +199,24 @@ Returns the object on success, or dies on failure. } ### different source engines available now, so set them here - { my $store = $conf->get_conf( 'source_engine' ) + { my $store = $conf->get_conf( 'source_engine' ) || DEFAULT_SOURCE_ENGINE; unless( can_load( modules => { $store => '0.0' }, verbose => 1 ) ) { error( loc( "Could not load source engine '%1'", $store ) ); - + if( $store ne DEFAULT_SOURCE_ENGINE ) { msg( loc("Falling back to %1", DEFAULT_SOURCE_ENGINE), 1 ); - + load DEFAULT_SOURCE_ENGINE; - + base->import( DEFAULT_SOURCE_ENGINE ); } else { return; - } + } } else { base->import( $store ); - } + } } return $args; @@ -268,7 +268,7 @@ be flushed. ### File::Fetch's method fail list } elsif ( $what eq 'methods' ) { - ### still fucking p4 :( ### + ### still unbelievably p4 :( ### $File'Fetch::METHOD_FAIL = $File'Fetch::METHOD_FAIL = {}; ### blow away the m::l::c cache, so modules can be (re)loaded @@ -293,7 +293,7 @@ be flushed. ### if extra callbacks are added, don't forget to update the ### 02-internals.t test script with them! -=pod +=pod =head2 $bool = $internals->_register_callback( name => CALLBACK_NAME, code => CODEREF ); @@ -312,20 +312,20 @@ the prerequisite and false to skip it. =item send_test_report Is called when the user should be prompted if he wishes to send the -test report. Should return a boolean indicating true to send the +test report. Should return a boolean indicating true to send the test report and false to skip it. =item munge_test_report Is called when the test report message has been composed, giving -the user a chance to programatically alter it. Should return the +the user a chance to programatically alter it. Should return the (munged) message to be sent. =item edit_test_report Is called when the user should be prompted to edit test reports -about to be sent out by Test::Reporter. Should return a boolean -indicating true to edit the test report in an editor and false +about to be sent out by Test::Reporter. Should return a boolean +indicating true to edit the test report in an editor and false to skip it. =item proceed_on_test_failure @@ -365,36 +365,36 @@ written to the metafile. } # =head2 $bool = $internals->_add_callback( name => CALLBACK_NAME, code => CODEREF ); -# +# # Adds a new callback to be used from anywhere in the system. If the callback # is already known, an error is raised and false is returned. If the callback # is not yet known, it is added, and the corresponding coderef is registered # using the -# +# # =cut -# +# # sub _add_callback { # my $self = shift or return; # my %hash = @_; -# +# # my ($name,$code); # my $tmpl = { # name => { required => 1, store => \$name, }, # code => { required => 1, allow => IS_CODEREF, # store => \$code }, # }; -# +# # check( $tmpl, \%hash ) or return; -# +# # if( $callback->can( $name ) ) { # error(loc("Callback '%1' is already registered")); # return; # } -# +# # $callback->mk_accessor( $name ); -# +# # $self->_register_callback( name => $name, code => $code ) or return; -# +# # return 1; # } @@ -424,14 +424,14 @@ sub _add_to_includepath { check( $tmpl, \%hash ) or return; my $s = $Config{'path_sep'}; - + ### only add if it's not added yet for my $lib (@$dirs) { push @INC, $lib unless grep { $_ eq $lib } @INC; # - ### it will be complaining if $ENV{PERL5LIB] is not defined (yet). - local $^W; - $ENV{'PERL5LIB'} .= $s . $lib + ### it will be complaining if $ENV{PERL5LIB] is not defined (yet). + local $^W; + $ENV{'PERL5LIB'} .= $s . $lib unless $ENV{'PERL5LIB'} =~ qr|\Q$s$lib\E|; } |