implement --remote-from to get config from CPAN(?:PLUS)?

3 files changed, 101 insertions, 4 deletions

diff --git a/bin/minicpan b/bin/minicpan
index 81b7992..32bf0b3 100644
--- a/bin/minicpan
+++ b/bin/minicpan
@@ -30,6 +30,7 @@ __END__
    -t SEC      - timeout in sec. Defaults to 180 sec
    --offline   - operate in offline mode (generally: do nothing)
    --log-level - provide a log level; instead of --debug, -q, or -qq
+   --remote-from TYPE - cpan remote from 'cpan' or 'cpanplus' configs
 
 =head1 DESCRIPTION
 
diff --git a/lib/CPAN/Mini.pm b/lib/CPAN/Mini.pm
index 83c0d2f..83df8b1 100644
--- a/lib/CPAN/Mini.pm
+++ b/lib/CPAN/Mini.pm
@@ -60,7 +60,7 @@ use Compress::Zlib 1.20 ();
   );
 
 This is the only method that need be called from outside this module.  It will
-update the local mirror with the files from the remote mirror.   
+update the local mirror with the files from the remote mirror.
 
 If called as a class method, C<update_mirror> creates an ephemeral CPAN::Mini
 object on which other methods are called.  That object is used to store mirror
@@ -574,7 +574,7 @@ sub file_allowed {
 
 This method looks through the local mirror's files.  If it finds a file that
 neither belongs in the mirror nor is allowed (see the C<file_allowed> method),
-C<clean_file> is called on the file. 
+C<clean_file> is called on the file.
 
 If you set C<ignore_source_control> to a true value, then this doesn't clean
 up files that belong to source control systems. Currently this ignores:
@@ -783,7 +783,7 @@ variable, then the default F<~/.minicpanrc>, and finally the
 F<CPAN/Mini/minicpan.conf>. It uses the first defined value it finds.
 If the filename it selects does not exist, it returns false.
 
-OPTIONS is an optional hash reference of the C<CPAN::Mini> config hash. 
+OPTIONS is an optional hash reference of the C<CPAN::Mini> config hash.
 
 =cut
 
@@ -811,6 +811,91 @@ sub config_file {
   );
 }
 
+=head2 remote_from
+
+  my $remote = CPAN::Mini->remote_from( $remote_from, $orig_remote, $quiet );
+
+This routine take an string argument and turn it into a method
+call to handle to retrieve the a cpan mirror url from a source.
+Currently supported methods:
+
+    cpan     - fetch the first mirror from your CPAN.pm config
+    cpanplus - fetch the first mirror from your CPANPLUS.pm config
+
+=cut
+
+sub remote_from {
+  my ( $class, $remote_from, $orig_remote, $quiet ) = @_;
+
+  my $method = lc "remote_from_" . $remote_from;
+
+  Carp::croak "unknown remote_from value: $remote_from"
+    unless $class->can($method);
+
+  my $new_remote = $class->$method;
+
+  warn "overriding '$orig_remote' with '$new_remote' via $method\n"
+    if !$quiet && $orig_remote;
+
+  return $new_remote;
+}
+
+=head2 remote_from_cpan
+
+  my $remote = CPAN::Mini->remote_from_cpan;
+
+This routine loads your CPAN.pm config and returns the first mirror in mirror
+list.  You can set this as your default by setting remote_from:cpan in your
+F<.minicpanrc> file.
+
+=cut
+
+sub remote_from_cpan {
+  my ($self) = @_;
+
+  Carp::croak "unable find a CPAN, maybe you need to install it"
+    unless eval { require CPAN; 1 };
+
+  CPAN::HandleConfig::require_myconfig_or_config();
+
+  Carp::croak "unable to find mirror list in your CPAN config"
+    unless exists $CPAN::Config->{urllist};
+
+  Carp::croak "unable to find first mirror url in your CPAN config"
+    unless ref( $CPAN::Config->{urllist} ) eq 'ARRAY' && $CPAN::Config->{urllist}[0];
+
+  return $CPAN::Config->{urllist}[0];
+}
+
+=head2 remote_from_cpanplus
+
+  my $remote = CPAN::Mini->remote_from_cpanplus;
+
+This routine loads your CPANPLUS.pm config and returns the first mirror in
+mirror list.  You can set this as your default by setting remote_from:cpanplus
+in your F<.minicpanrc> file.
+
+=cut
+
+sub remote_from_cpanplus {
+  my ($self) = @_;
+
+  Carp::croak "unable find a CPANPLUS, maybe you need to install it"
+    unless eval { require CPANPLUS::Backend };
+
+  my $cb = CPANPLUS::Backend->new;
+  my $hosts = $cb->configure_object->get_conf('hosts');
+
+  Carp::croak "unable to find mirror list in your CPANPLUS config"
+    unless $hosts;
+
+  Carp::croak "unable to find first mirror in your CPANPLUS config"
+    unless ref($hosts) eq 'ARRAY' && $hosts->[0];
+
+  my $url_parts = $hosts->[0];
+  return $url_parts->{scheme} . "://" . $url_parts->{host} . ( $url_parts->{path} || '' );
+}
+
 =head1 SEE ALSO
 
 Randal Schwartz's original article on minicpan, here:
diff --git a/lib/CPAN/Mini/App.pm b/lib/CPAN/Mini/App.pm
index 817bedb..be7a6be 100644
--- a/lib/CPAN/Mini/App.pm
+++ b/lib/CPAN/Mini/App.pm
@@ -84,7 +84,6 @@ sub initialize_minicpan {
     %commandline
   });
 
-  $config{remote} ||= 'http://www.cpan.org/';
   $config{class} ||= 'CPAN::Mini';
 
   # Override config with commandline options
@@ -97,6 +96,17 @@ sub initialize_minicpan {
   die $@ if $@;
 
   _display_version($config{class}) if $version;
+
+  if ($config{remote_from} && ! $config{remote}) {
+    $config{remote} = $config{class}->remote_from(
+      $config{remote_from},
+      $config{remote},
+      $config{quiet},
+    );
+  }
+
+  $config{remote} ||= 'http://www.cpan.org/';
+
   pod2usage(2) unless $config{local} and $config{remote};
 
   $|++;
@@ -128,6 +138,7 @@ sub _option_spec {
     exact_mirror|x
     timeout|t=i
     config_file|config|C=s
+    remote-from=s
   >;
 }