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 )