view release on metacpan or  search on metacpan

lib/CPAN/Mini.pm  view on Meta::CPAN

    qw(modules 02packages.details.txt.gz)
  );

  my $gz = Compress::Zlib::gzopen($details, "rb")
    or die "Cannot open details: $Compress::Zlib::gzerrno";

  my $inheader = 1;
  my $file_ok  = 0;
  while ($gz->gzreadline($_) > 0) {
    if ($inheader) {
      if (/\S/) {
        my ($header, $value) = split /:\s*/, $_, 2;
        chomp $value;
        if ($header eq 'File'
            and ($value eq '02packages.details.txt'
                 or $value eq '02packages.details.txt.gz')) {
          $file_ok = 1;
        }
      } else {
        $inheader = 0;
      }

      next;
    }

    die "02packages.details.txt file is not a valid index\n"
      unless $file_ok;

    my ($module, $version, $path) = split;
    next if $self->_filter_module({
      module  => $module,
      version => $version,
      path    => $path,
    });

    $mirror_list{"authors/id/$path"}++;
  }

  return [ sort keys %mirror_list ];
}

#pod =method new
#pod
#pod   my $minicpan = CPAN::Mini->new;
#pod
#pod This method constructs a new CPAN::Mini object.  Its parameters are described
#pod above, under C<update_mirror>.
#pod
#pod =cut

sub new {
  my $class    = shift;
  my %defaults = (
    changes_made => 0,
    dirmode      => 0711,  ## no critic Zero
    errors       => 1,
    mirrored     => {},
    log_level    => 'info',
  );

  my $self = bless { %defaults, @_ } => $class;

  $self->{dirmode} = $defaults{dirmode} unless defined $self->{dirmode};

  $self->{recent} = {};

  Carp::croak "no local mirror supplied" unless $self->{local};

  substr($self->{local}, 0, 1, $class->__homedir)
    if substr($self->{local}, 0, 1) eq q{~};

  $self->{local} = File::Spec->rel2abs($self->{local});

  Carp::croak "local mirror path exists but is not a directory"
    if (-e $self->{local})
    and not(-d $self->{local});

  unless (-e $self->{local}) {
    File::Path::mkpath(
      $self->{local},
      {
        verbose => $self->{log_level} eq 'debug',
        mode    => $self->{dirmode},
      },
    );
  }

  Carp::croak "no write permission to local mirror" unless -w $self->{local};

  Carp::croak "no remote mirror supplied" unless $self->{remote};

  $self->{remote} = "$self->{remote}/" if substr($self->{remote}, -1) ne '/';

  my $version = $class->VERSION;
  $version = 'v?' unless defined $version;

  $self->{__lwp} = LWP::UserAgent->new(
    agent     => "$class/$version",
    env_proxy => 1,
    ($self->{no_conn_cache} ? () : (keep_alive => 5)),
    ($self->{timeout} ? (timeout => $self->{timeout}) : ()),
  );

  unless ($self->{offline}) {
    my $test_uri = URI->new_abs(
      'modules/02packages.details.txt.gz',
      $self->{remote},
    )->as_string;

    Carp::croak "unable to contact the remote mirror"
      unless eval { $self->__lwp->head($test_uri)->is_success };
  }

  return $self;
}

sub __lwp { $_[0]->{__lwp} }

#pod =method mirror_indices
#pod
#pod   $minicpan->mirror_indices;