CPAN-SQLite

 view release on metacpan or  search on metacpan

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

# $Id: Index.pm 85 2022-10-29 05:44:36Z stro $

package CPAN::SQLite::Index;
use strict;
use warnings;

our $VERSION = '0.220';

use English qw/-no_match_vars/;

use CPAN::SQLite::Info;
use CPAN::SQLite::State;
use CPAN::SQLite::Populate;
use CPAN::SQLite::DBI qw($tables);
use File::Spec::Functions qw(catfile);
use File::Basename;
use File::Path;
use HTTP::Tiny;

use Scalar::Util 'weaken';

unless ($ENV{CPAN_SQLITE_NO_LOG_FILES}) {
  $ENV{CPAN_SQLITE_DEBUG} = 1;
}

our ($oldout);
my $log_file = 'cpan_sqlite_log.' . time;

# This is usually already defined in real life, but tests need it to be set
$CPAN::FrontEnd ||= "CPAN::Shell";

sub new {
  my ($class, %args) = @_;
  if ($args{setup} and $args{reindex}) {
    die "Reindexing must be done on an exisiting database";
  }

  my $self = { index => undef, state => undef, %args };

  return bless $self, $class;
}

sub download_index {
  my $self = shift;

  if ($ENV{'CPAN_SQLITE_DOWNLOAD'}) {
    $ENV{'CPAN_SQLITE_DOWNLOAD_URL'} = 'http://cpansqlite.trouchelle.com/' unless $ENV{'CPAN_SQLITE_DOWNLOAD_URL'};
  }

  return 0 unless $ENV{'CPAN_SQLITE_DOWNLOAD_URL'};

  $CPAN::FrontEnd->myprint("Downloading the compiled index db ... ");

  if (my $response =
    HTTP::Tiny->new->mirror($ENV{'CPAN_SQLITE_DOWNLOAD_URL'} => catfile($self->{'db_dir'}, $self->{'db_name'})))
  {
    if ($response->{'success'} and $response->{'status'} and $response->{'status'} eq '200') {
      if (my $type = $response->{'headers'}->{'content-type'}) {
        if ($type eq 'application/x-sqlite3') {
          return 1;
        }
      }
    }
  }

  $CPAN::FrontEnd->mywarn('Cannot download the compiled index db');
  return 0;
}

sub index {
  my $self  = shift;
  my $setup = $self->{'setup'};

  if ($setup) {
    my $db_name = catfile($self->{'db_dir'}, $self->{db_name});
    if (-f $db_name) {
      $CPAN::FrontEnd->myprint("Removing existing $db_name ... ");
      if (unlink $db_name) {
        $CPAN::FrontEnd->myprint("Done.\n");
      } else {



( run in 1.918 second using v1.01-cache-2.11-cpan-39bf76dae61 )