diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPANPLUS/Configure.pm')
| -rw-r--r-- | Master/tlpkg/tlperl/lib/CPANPLUS/Configure.pm | 140 |
1 files changed, 70 insertions, 70 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Configure.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Configure.pm index ba1ca0785ac..04a08753d55 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Configure.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Configure.pm @@ -26,12 +26,12 @@ $VERSION = $CPANPLUS::Internals::VERSION = $CPANPLUS::Internals::VERSION; ### the config options. for my $meth ( qw[conf _lib _perl5lib]) { no strict 'refs'; - + *$meth = sub { my $self = shift; $self->{'_'.$meth} = $_[0] if @_; return $self->{'_'.$meth}; - } + } } @@ -39,7 +39,7 @@ for my $meth ( qw[conf _lib _perl5lib]) { =head1 NAME -CPANPLUS::Configure +CPANPLUS::Configure - configuration for CPANPLUS =head1 SYNOPSIS @@ -74,7 +74,7 @@ a method call on a C<CPANPLUS::Backend> object. =item load_configs -Controls whether or not additional user configurations are to be loaded +Controls whether or not additional user configurations are to be loaded or not. Defaults to C<true>. =back @@ -89,7 +89,7 @@ or not. Defaults to C<true>. sub new { my $class = shift; my %hash = @_; - + ### XXX pass on options to ->init() like rescan? my ($load); my $tmpl = { @@ -99,7 +99,7 @@ or not. Defaults to C<true>. check( $tmpl, \%hash ) or ( warn Params::Check->last_error, return ); - + $Config ||= CPANPLUS::Config->new; my $self = bless {}, $class; $self->conf( $Config ); @@ -108,11 +108,11 @@ or not. Defaults to C<true>. ### these can override things in the default config $self->init if $load; - ### after processing the config files, check what + ### after processing the config files, check what ### @INC and PERL5LIB are set to. $self->_lib( \@INC ); $self->_perl5lib( $ENV{'PERL5LIB'} ); - + return $self; } } @@ -143,21 +143,21 @@ Returns true on success, false on failure. my $self = shift; my $obj = $self->conf; my %hash = @_; - + my ($rescan); my $tmpl = { rescan => { default => 0, store => \$rescan }, }; - + check( $tmpl, \%hash ) or ( warn Params::Check->last_error, return - ); - + ); + ### if the base dir is changed, we have to rescan it ### for any CPANPLUS::Config::* files as well, so keep ### track of it my $cur_base = $self->get_conf('base'); - + ### warn if we find an old style config specified ### via environment variables { my $env = ENV_CPANPLUS_CONFIG; @@ -169,17 +169,17 @@ Returns true on success, false on failure. "in the default shell to use custom config files.", $env, "CPANPLUS::Configure->save", 's save')); } - } - + } + { ### make sure that the homedir is included now local @INC = ( LIB_DIR->($cur_base), @INC ); - + ### only set it up once - if( !$loaded++ or $rescan ) { + if( !$loaded++ or $rescan ) { ### find plugins & extra configs ### check $home/.cpanplus/lib as well require Module::Pluggable; - + Module::Pluggable->import( search_path => ['CPANPLUS::Config'], search_dirs => [ LIB_DIR->($cur_base) ], @@ -187,54 +187,54 @@ Returns true on success, false on failure. sub_name => 'configs' ); } - - + + ### do system config, user config, rest.. in that order ### apparently, on a 2nd invocation of -->configs, a ### ::ISA::CACHE package can appear.. that's bad... - my %confs = map { $_ => $_ } + my %confs = map { $_ => $_ } grep { $_ !~ /::ISA::/ } __PACKAGE__->configs; - my @confs = grep { defined } + my @confs = grep { defined } map { delete $confs{$_} } CONFIG_SYSTEM, CONFIG_USER; - push @confs, sort keys %confs; - + push @confs, sort keys %confs; + for my $plugin ( @confs ) { msg(loc("Found config '%1'", $plugin),0); - - ### if we already did this the /last/ time around dont + + ### if we already did this the /last/ time around dont ### run the setup agian. if( my $loc = Module::Loaded::is_loaded( $plugin ) ) { msg(loc(" Already loaded '%1' (%2)", $plugin, $loc), 0); next; } else { msg(loc(" Loading config '%1'", $plugin),0); - + if( eval { load $plugin; 1 } ) { - msg(loc(" Loaded '%1' (%2)", + msg(loc(" Loaded '%1' (%2)", $plugin, Module::Loaded::is_loaded( $plugin ) ), 0); } else { error(loc(" Error loading '%1': %2", $plugin, $@)); - } - } - + } + } + if( $@ ) { error(loc("Could not load '%1': %2", $plugin, $@)); next; - } - + } + my $sub = $plugin->can('setup'); $sub->( $self ) if $sub; } } - + ### did one of the plugins change the base dir? then we should ### scan the dirs again if( $cur_base ne $self->get_conf('base') ) { msg(loc("Base dir changed from '%1' to '%2', rescanning", $cur_base, $self->get_conf('base')), 0); $self->init( @_, rescan => 1 ); - } - + } + ### clean up the paths once more, just in case $obj->_clean_up_paths; @@ -244,10 +244,10 @@ Returns true on success, false on failure. my %inc = map { $_ => $_ } @INC; for my $l ( @$lib ) { push @INC, $l unless $inc{$l}; - } + } $self->_lib( \@INC ); } - + return 1; } } @@ -265,7 +265,7 @@ Returns true if the file can be saved, false otherwise. sub can_save { my $self = shift; my $file = shift || CONFIG_USER_FILE->(); - + return 1 unless -e $file; chmod 0644, $file; @@ -284,7 +284,7 @@ be attempted to be saved in the system wide directory. If no argument is provided, it will default to your personal config. -Returns the full path to the file if the config was saved, +Returns the full path to the file if the config was saved, false otherwise. =cut @@ -298,12 +298,12 @@ sub _config_pm_to_file { ### so figure out where to save them based on their type my $file; if( $pm eq CONFIG_USER ) { - $file = CONFIG_USER_FILE->(); + $file = CONFIG_USER_FILE->(); } elsif ( $pm eq CONFIG_SYSTEM ) { $file = CONFIG_SYSTEM_FILE->(); - - ### third party file + + ### third party file } else { my $cfg_pkg = CONFIG . '::'; unless( $pm =~ /^$cfg_pkg/ ) { @@ -311,13 +311,13 @@ sub _config_pm_to_file { "WARNING: Your config package '%1' is not in the '%2' ". "namespace and will not be automatically detected by %3", $pm, $cfg_pkg, 'CPANPLUS' - )); - } - + )); + } + $file = File::Spec->catfile( $dir, split( '::', $pm ) - ) . '.pm'; + ) . '.pm'; } return $file; @@ -328,16 +328,16 @@ sub save { my $self = shift; my $pm = shift || CONFIG_USER; my $savedir = shift || ''; - + my $file = $self->_config_pm_to_file( $pm, $savedir ) or return; my $dir = dirname( $file ); - + unless( -d $dir ) { $self->_mkdir( dir => $dir ) or ( error(loc("Can not create directory '%1' to save config to",$dir)), return ) - } + } return unless $self->can_save($file); ### find only accessors that are not private @@ -345,18 +345,18 @@ sub save { ### for dumping the values use Data::Dumper; - + my @lines; for my $acc ( @acc ) { - + push @lines, "### $acc section", $/; - + for my $key ( $self->conf->$acc->ls_accessors ) { my $val = Dumper( $self->conf->$acc->$key ); - + $val =~ s/\$VAR1\s+=\s+//; $val =~ s/;\n//; - + push @lines, '$'. "conf->set_${acc}( $key => $val );", $/; } push @lines, $/,$/; @@ -368,13 +368,13 @@ sub save { ### use a variable to make sure the pod parser doesn't snag it my $is = '='; my $time = gmtime; - - + + my $msg = <<_END_OF_CONFIG_; ############################################### -### -### Configuration structure for $pm -### +### +### Configuration structure for $pm +### ############################################### #last changed: $time GMT @@ -399,11 +399,11 @@ use strict; sub setup { my \$conf = shift; - + $str - return 1; -} + return 1; +} 1; @@ -447,7 +447,7 @@ sub options { my %seen; return sort grep { !$seen{$_}++ } - map { $_->$type->ls_accessors if $_->can($type) } + map { $_->$type->ls_accessors if $_->can($type) } $self->conf; return; } @@ -546,9 +546,9 @@ sub AUTOLOAD { ### cpanplus 0.04x; we renamed ->_get_build('base') to ### ->get_conf('base') } elsif ( $type eq '_build' and $key eq 'base' ) { - return $self->get_conf($key); - - } else { + return $self->get_conf($key); + + } else { error( loc(q[No such key '%1' in field '%2'], $key, $type) ); return; } @@ -564,7 +564,7 @@ sub AUTOLOAD { if( $conf->can($type) and $conf->$type->can($key) ) { $conf->$type->$key( $val ); - + } else { error( loc(q[No such key '%1' in field '%2'], $key, $type) ); return; @@ -613,10 +613,10 @@ This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. =head1 COPYRIGHT -The CPAN++ interface (of which this module is a part of) is copyright (c) +The CPAN++ interface (of which this module is a part of) is copyright (c) 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. -This library is free software; you may redistribute and/or modify it +This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =head1 SEE ALSO |