view release on metacpan or  search on metacpan

lib/DarkPAN/Indexer.pm  view on Meta::CPAN

# .gz suffix drives compression in retrieve_index/publish_index.
########################################################################
sub _index_key {
########################################################################
  my ($self) = @_;

  my $key = $self->get_config->{packages_version_index};

  croak "ERROR: packages_version_index not set in config\n"
    if !defined $key || $key eq q{};

  return $key;
}

########################################################################
# create_index: build a fresh index from every distribution in storage.
#   list_distributions -> format->create_index(fh) -> load_index(create)
#   -> publish_index. Full rebuild; authoritative.
########################################################################
sub create_index {
########################################################################
  my ($self) = @_;

  my $storage = $self->get_storage;
  my $format  = $self->get_format;
  my $index   = $self->_index_key;

  my $guard = $storage->lock($index)
    or croak "ERROR: could not acquire lock on $index\n";

  # format writes the neutral TSV interchange for all distributions...
  my ( $tsv_fh, $tsv_file ) = File::Temp::tempfile( DIR => '/tmp', UNLINK => 1 );

  my $stats = $format->create_index(
    output        => $tsv_fh,
    distributions => [ $storage->list_distributions ],
    fetch         => sub { $self->_fetch_dist_to_tmp( $_[0] ) }
  );

  close $tsv_fh;

  # ...then loads that interchange into a fresh database, which we publish.
  my ( undef, $db_file ) = File::Temp::tempfile( DIR => '/tmp', UNLINK => 1, SUFFIX => '.db' );

  $format->load_index(
    input    => $tsv_file,
    database => $db_file,
    create   => $TRUE,
  );

  $storage->publish_index( $db_file, $index );

  return $stats;
}

########################################################################
# update_index: incrementally re-index ONE distribution.
#   retrieve current index -> open it -> format->update_index(that dist)
#   -> publish. Locked for the whole read-modify-write.
########################################################################
sub update_index {
########################################################################
  my ( $self, %args ) = @_;

  my $distribution = $args{distribution}
    or croak "ERROR: update_index requires a distribution\n";

  my $storage = $self->get_storage;
  my $format  = $self->get_format;
  my $index   = $self->_index_key;

  my $guard = $storage->lock($index)
    or croak "ERROR: could not acquire lock on $index\n";

  # bring the current index down to a local, writable db file
  my $db_file = $storage->retrieve_index( $index, '.db' );

  # delete-then-insert for this distribution happens inside update_index;
  # the format opens $db_file, mutates, and (via load) commits.
  $format->update_index(
    distribution => $distribution,
    database     => $db_file,
    fetch        => sub { $self->_fetch_dist_to_tmp( $_[0] ) }

  );

  $storage->publish_index( $db_file, $index );

  unlink $db_file;  # we received ownership from retrieve_index

  return $self;
}

########################################################################
# delete_from_index: remove one distribution's rows from the index.
#   retrieve -> update_index(delete_only) -> publish. Same locked round
#   trip, no re-insert.
########################################################################
sub delete_from_index {
########################################################################
  my ( $self, %args ) = @_;

  my $distribution = $args{distribution}
    or croak "ERROR: delete_from_index requires a distribution\n";

  my $storage = $self->get_storage;
  my $format  = $self->get_format;
  my $index   = $self->_index_key;

  my $guard = $storage->lock($index)
    or croak "ERROR: could not acquire lock on $index\n";

  my $db_file = $storage->retrieve_index( $index, '.db' );

  $format->update_index(
    distribution => $distribution,
    database     => $db_file,
    delete_only  => $TRUE,
    fetch        => sub { $self->_fetch_dist_to_tmp( $_[0] ) }
  );