view release on metacpan or  search on metacpan

lib/CPAN/SQLite/META.pm  view on Meta::CPAN

  my ($self, $id, $results) = @_;
  my $class     = 'CPAN::Module';
  my $cpan_meta = $self->{cpan_meta};
  my $d         = $cpan_meta->instance($class => $id);
  return $d->set(
    'description'  => $results->{mod_abs},
    'userid'       => $results->{cpanid},
    'CPAN_VERSION' => $results->{mod_vers},
    'CPAN_FILE'    => $results->{download},
    'CPAN_USERID'  => $results->{cpanid},
  );
}

sub set_bundle {
  my ($self, $id, $results) = @_;
  my $class     = 'CPAN::Bundle';
  my $cpan_meta = $self->{cpan_meta};
  my $d         = $cpan_meta->instance($class => $id);
  return $d->set(
    'description'  => $results->{mod_abs},
    'userid'       => $results->{cpanid},
    'CPAN_VERSION' => $results->{mod_vers},
    'CPAN_FILE'    => $results->{download},
    'CPAN_USERID'  => $results->{cpanid},
  );
}

sub set_dist {
  my ($self, $id, $results) = @_;
  my $class     = 'CPAN::Distribution';
  my $cpan_meta = $self->{cpan_meta};
  my $d         = $cpan_meta->instance($class => $id);
  return $d->set(
    'DESCRIPTION'  => $results->{dist_abs},
    'CPAN_USERID'  => $results->{cpanid},
    'CPAN_VERSION' => $results->{dist_vers},
  );
}

sub set_containsmods {
  my ($self, $mods) = @_;
  my $class     = 'CPAN::Distribution';
  my $cpan_meta = $self->{cpan_meta};
  my %containsmods;
  if ($mods and (ref($mods) eq 'ARRAY')) {
    %containsmods = map { $_->{mod_name} => 1 } @$mods;
  }
  my $d = $cpan_meta->instance($class => $global_id);
  return $d->{CONTAINSMODS} = \%containsmods;
}

sub reload {
  my ($self, %args) = @_;

  my $time         = $args{'time'} || time;
  my $force        = $args{force};
  my $db_name      = $CPAN::SQLite::db_name;
  my $db           = File::Spec->catfile($CPAN::Config->{cpan_home}, $db_name);
  my $journal_file = $db . '-journal';
  if (-e $journal_file) {
    $CPAN::FrontEnd->mywarn('Database locked - cannot update.');
    return;
  }
  my @args = ($^X, '-MCPAN::SQLite::META=setup,update,check', '-e');
  if (-e $db && -s _) {
    my $mtime_db    = (stat(_))[9];
    my $time_string = gmtime_string($mtime_db);
    $CPAN::FrontEnd->myprint("Database was generated on $time_string\n");

    # Check for status, force update if it fails
    if (system(@args, 'check')) {
      $force = 1;
      $CPAN::FrontEnd->myprint("Database file requires reindexing\n");
    }

    unless ($force) {
      return if (($time - $mtime_db) < $CPAN::Config->{index_expire} * 86400);
    }
    $CPAN::FrontEnd->myprint('Updating database file ... ');
    push @args, q{update};
  } else {
    unlink($db) if -e _;
    $CPAN::FrontEnd->myprint('Creating database file ... ');
    push @args, q{setup};
  }
  if ($CPAN::SQLite::DBI::dbh) {
    $CPAN::SQLite::DBI::dbh->disconnect();
    $CPAN::SQLite::DBI::dbh = undef;
  }
  system(@args) == 0 or die qq{system @args failed: $?};
  $CPAN::FrontEnd->myprint("Done!\n");
  return 1;
}

sub setup {
  my $obj = CPAN::SQLite->new(setup => 1);
  $obj->index() or die qq{CPAN::SQLite setup failed};
  return;
}

sub update {
  my $obj = CPAN::SQLite->new();
  $obj->index() or die qq{CPAN::SQLite update failed};
  return;
}

sub check {
  my $obj = CPAN::SQLite->new();
  my $db  = File::Spec->catfile($obj->{'db_dir'}, $obj->{'db_name'});
  my $dbh = DBI->connect("DBI:SQLite:$db", '', '', { 'RaiseError' => 0, 'PrintError' => 0, 'AutoCommit' => 1 });
  if (my $sth = $dbh->prepare('SELECT status FROM info WHERE status = 1')) {
    if ($sth->execute()) {
      if ($sth->fetchrow_arrayref()) {
        exit 0;    # status = 1
      } else {
        exit 1;    # status <> 1, need reindexing
      }
    } else {

      # Something's wrong, will be safer to reinitialize
      $dbh->disconnect();