MOON
Server: Apache/2.2.21 (Unix) mod_ssl/2.2.21 OpenSSL/0.9.8e-fips-rhel5 mod_auth_passthrough/2.1 mod_bwlimited/1.4
System: Linux vps.panamaemb.org.sg 3.10.0-1160.80.1.vz7.191.4 #1 SMP Thu Dec 15 20:31:06 MSK 2022 x86_64
User: panama (500)
PHP: 5.2.17
Disabled: NONE
Upload Files
File: //installd/perl588installer/CPAN-SQLite-0.196/lib/CPAN/SQLite/Index.pm
package CPAN::SQLite::Index;
use strict;
use warnings;
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 LWP::Simple qw(getstore is_success);

our $VERSION = '0.196';
unless ($ENV{CPAN_SQLITE_NO_LOG_FILES}) {
  $ENV{CPAN_SQLITE_DEBUG} = 1;
}

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

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};
  bless $self, $class;
}

sub index {
  my ($self, %args) = @_;
  my $setup = $self->{setup};

  if ($setup) {
    my $db_name = catfile($self->{db_dir}, $self->{db_name});
    if (-f $db_name) {
      warn qq{Removing existing $db_name\n};
      unlink $db_name or warn qq{Cannot unlink $db_name: $!};
    }
  }
  my $log = catfile($self->{log_dir}, $log_file);
  unless ($ENV{CPAN_SQLITE_NO_LOG_FILES}) {
    $oldout = error_fh($log);
  }

  if ($self->{update_indices}) {
    warn qq{Fetching index files ...\n};
    $self->fetch_cpan_indices();
  }

  warn qq{Gathering information from index files ...\n};
  $self->fetch_info or do {
    warn qq{fetch_info() failed!};
    return;
  };
  unless ($setup) {
    warn qq{Obtaining current state of database ...\n};
    $self->state or do {
      warn qq{state() failed!};
      return;
    };
  }
  warn qq{Populating database tables ...\n};
  $self->populate or do {
    warn qq{populate() failed!};
    return;
  };
  return 1;
}

sub fetch_cpan_indices {
  my ($self, %args) = @_;
  my $CPAN = $self->{CPAN};
  my $indices = {'01mailrc.txt.gz' => 'authors',
		 '02packages.details.txt.gz' => 'modules',
		 '03modlist.data.gz' => 'modules',
		};
  foreach my $index (keys %$indices) {
    my $file = catfile($CPAN, $indices->{$index}, $index);
    next if (-e $file and -M $file < 1);
    my $dir = dirname($file);
    unless (-d $dir) {
      mkpath($dir, 1, 0755) or die "Cannot mkpath $dir: $!";
    }
    my @urllist = @{$self->{urllist}};
    foreach my $cpan(@urllist) {
      my $from = join '/', ($cpan, $indices->{$index}, $index);
      last if is_success(getstore($from, $file));
    }
    die qq{Cannot retrieve $file} unless -f $file;
  }
  return 1;
}

sub fetch_info {
  my $self = shift;
  my %wanted = map {$_ => $self->{$_}} qw(CPAN ignore keep_source_where);
  my $info = CPAN::SQLite::Info->new(%wanted);
  $info->fetch_info() or return;
  my @tables = qw(dists mods auths);
  my $index;
  foreach my $table(@tables) {
    my $class = __PACKAGE__ . '::' . $table;
    my $this = {info => $info->{$table}};
    $index->{$table} = bless $this, $class;
  }
  $self->{index} = $index;
  return 1;
}

sub state {
  my $self = shift;

  my %wanted = map {$_ => $self->{$_}} 
    qw(db_name index setup reindex db_dir);
  my $state = CPAN::SQLite::State->new(%wanted);
  $state->state() or return;
  $self->{state} = $state;
  return 1;
}

sub populate {
  my $self = shift;
  my %wanted = map {$_ => $self->{$_}} 
    qw(db_name index setup state db_dir);
  my $db = CPAN::SQLite::Populate->new(%wanted);
  $db->populate() or return;
  return 1;
}

sub error_fh {
  my $file = shift;
  open(my $tmp, '>', $file) or die "Cannot open $file: $!";
  close $tmp;
  open(my $oldout, '>&STDOUT');
  open(STDOUT, '>', $file) or die "Cannot tie STDOUT to $file: $!";
  select STDOUT; $| = 1;
  return $oldout;
}

sub DESTROY {
  unless ($ENV{CPAN_SQLITE_NO_LOG_FILES}) {
    close STDOUT;
    open(STDOUT, ">&$oldout");
  }
}

1;

__END__

=head1 NAME

CPAN::SQLite::Index - set up or update database tables.

=head1 SYNOPSIS

 my $index = CPAN::SQLite::Index->new(setup => 1);
 $index->index();

=head1 DESCRIPTION

This is the main module used to set up or update the
database tables used to store information from the
CPAN and ppm indices. The creation of the object

 my $index = CPAN::SQLite::Index->new(%args);

accepts two possible arguments:

=over 3

=item * setup =E<gt> 1

This (optional) argument specifies that the database is being set up.
Any existing tables will be dropped.

=item * reindex =E<gt> value

This (optional) argument specifies distribution names that
one would like to reindex in an existing database. These may
be specified as either a scalar, for a single distribution,
or as an array reference for a list of distributions.

=back

=head1 DETAILS

Calling

  $index->index();

will start the indexing procedure. Various messages
detailing the progress will written to I<STDOUT>,
which by default will be captured into a file 
F<cpan_sqlite_log.dddddddddd>, where the extension
is the C<time> that the method was invoked. Error messages
are not captured, and will appear in I<STDERR>.

The steps of the indexing procedure are as follows.

=over 3

=item * fetch index data

The necessary CPAN index files 
F<$CPAN/authors/01mailrc.txt.gz>,
F<$CPAN/modules/02packages.details.txt.gz>, and
F<$CPAN/modules/03modlist.data.gz> will be fetched
from the CPAN mirror specified by the C<$cpan> variable
at the beginning of L<CPAN::SQLite::Index>. If you are
using this option, it is recommended to use the
same CPAN mirror with subsequent updates, to ensure consistency 
of the database. As well, the information on the locations
of the CPAN mirrors used for Template-Toolkit and GeoIP
is written.

=item * get index information

Information from the CPAN indices is extracted through
L<CPAN::SQLite::Info>.

=item * get state information

Unless the C<setup> argument within the C<new>
method of L<CPAN::SQLite::Index> is specified,
this will get information on the state of the database
through L<CPAN::SQLite::State>.
A comparision is then made between this information
and that gathered from the CPAN indices, and if there's
a discrepency in some items, those items are marked
for either insertion, updating, or deletion, as appropriate.

=item * populate the database

At this stage the gathered information is used to populate
the database, through L<CPAN::SQLite::Populate>,
either inserting new items, updating
existing ones, or deleting obsolete items.

=back

=head1 SEE ALSO

L<CPAN::SQLite::Info>, L<CPAN::SQLite::State>, 
L<CPAN::SQLite::Populate>,
and L<CPAN::SQLite::Util>.
Development takes place on the CPAN-SQLite project
at L<http://sourceforge.net/projects/cpan-search/>.

=head1 COPYRIGHT

This software is copyright 2006 by Randy Kobes
E<lt>r.kobes@uwinnipeg.caE<gt>. Use and
redistribution are under the same terms as Perl itself.

=cut