view release on metacpan or  search on metacpan

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

#pod
#pod * C<skip_perl>
#pod
#pod If true, CPAN::Mini will skip the major language distributions: perl, parrot,
#pod and ponie.  It will also skip embperl, sybperl, bioperl, and kurila.
#pod
#pod * C<log_level>
#pod
#pod This defines the minimum level of message to log: debug, info, warn, or fatal
#pod
#pod * C<errors>
#pod
#pod If true, CPAN::Mini will warn with status messages on errors.  (default: true)
#pod
#pod * C<path_filters>
#pod
#pod This options provides a set of rules for filtering paths.  If a distribution
#pod matches one of the rules in C<path_filters>, it will not be mirrored.  A regex
#pod rule is matched if the path matches the regex; a code rule is matched if the
#pod code returns 1 when the path is passed to it.  For example, the following
#pod setting would skip all distributions from RJBS and SUNGO:
#pod
#pod  path_filters => [
#pod    qr/RJBS/,
#pod    sub { $_[0] =~ /SUNGO/ }
#pod  ]
#pod
#pod * C<module_filters>
#pod
#pod This option provides a set of rules for filtering modules.  It behaves like
#pod path_filters, but acts only on module names.  (Since most modules are in
#pod distributions with more than one module, this setting will probably be less
#pod useful than C<path_filters>.)  For example, this setting will skip any
#pod distribution containing only modules with the word "Acme" in them:
#pod
#pod  module_filters => [ qr/Acme/i ]
#pod
#pod * C<also_mirror>
#pod
#pod This option should be an arrayref of extra files in the remote CPAN to mirror
#pod locally.
#pod
#pod * C<skip_cleanup>
#pod
#pod If this option is true, CPAN::Mini will not try delete unmirrored files when it
#pod has finished mirroring
#pod
#pod * C<offline>
#pod
#pod If offline, CPAN::Mini will not attempt to contact remote resources.
#pod
#pod * C<no_conn_cache>
#pod
#pod If true, no connection cache will be established.  This is mostly useful as a
#pod workaround for connection cache failures.
#pod
#pod =end :list
#pod
#pod =cut

sub update_mirror {
  my $self = shift;
  $self = $self->new(@_) unless ref $self;

  unless ($self->{offline}) {
    my $local = $self->{local};

    $self->log("Updating $local");
    $self->log("Mirroring from $self->{remote}");
    $self->log("=" x 63);

    die "local mirror target $local is not writable" unless -w $local;

    # mirrored tracks the already done, keyed by filename
    # 1 = local-checked, 2 = remote-mirrored
    $self->mirror_indices;

    return unless $self->{force} or $self->{changes_made};

    # mirror all the files
    $self->_mirror_extras;
    $self->mirror_file($_, 1) for @{ $self->_get_mirror_list };

    # install indices after files are mirrored in case we're interrupted
    # so indices will seem new again when continuing
    $self->_install_indices;

    $self->_write_out_recent;

    # eliminate files we don't need
    $self->clean_unmirrored unless $self->{skip_cleanup};
  }

  return $self->{changes_made};
}

sub _recent { $_[0]->{recent}{ $_[1] } = 1 }

sub _write_out_recent {
  my ($self) = @_;
  return unless my @keys = keys %{ $self->{recent} };

  my $recent = File::Spec->catfile($self->{local}, 'RECENT');
  open my $recent_fh, '>', $recent or die "can't open $recent for writing: $!";

  for my $file (sort keys %{ $self->{recent} }) {
    print {$recent_fh} "$file\n" or die "can't write to $recent: $!";
  }

  die "error closing $recent: $!" unless close $recent_fh;
  return;
}

sub _get_mirror_list {
  my $self = shift;

  my %mirror_list;

  # now walk the packages list
  my $details = File::Spec->catfile(
    $self->_scratch_dir,