view release on metacpan or  search on metacpan

bin/cpanidx-gendb  view on Meta::CPAN

my $config = 'cpanidx.ini';

my $mirror_fields = [qw(
dst_bandwidth
dst_contact
dst_ftp
dst_http
dst_location
dst_notes
dst_organisation
dst_rsync
dst_src
dst_timezone
frequency
hostname
)];

GetOptions( 'config=s', \$config, 'verbose', \$verbose );

my $ini = Config::Tiny->new();

my $dsn;
my $user;
my $pass;
my $url;
my $corelist;
my $mirrorlist;
my $cpanperms;
my $mirror = 'ftp://ftp.funet.fi/pub/CPAN/';

my $cfg = $ini->read( $config ) or warn $ini->errstr, "\n";

if ( $cfg ) {
  $dsn = $cfg->{_}->{dsn};
  $user = $cfg->{_}->{user};
  $pass = $cfg->{_}->{pass};
  $url = $cfg->{_}->{url};
  $corelist = $cfg->{_}->{skipcore};
  $mirrorlist = $cfg->{_}->{skipmirrors};
  $cpanperms = $cfg->{_}->{skipperms};
  $mirror = $cfg->{_}->{mirror} || 'ftp://ftp.funet.fi/pub/CPAN/';
}

unless ( $dsn ) {
  $dsn = 'dbi:SQLite:dbname=cpanidx.db';
  warn "Using '$dsn'\n";
}

$|=1;

my $packages_file = '02packages.details.txt.gz';
my $mailrc_file   = '01mailrc.txt.gz';
my $perms_file    = '06perms.txt.gz';
my $mirrord_file  = 'MIRRORED.BY';

my $idxdir = _cpanidx_dir();
mkpath( $idxdir ) unless -d $idxdir;
fetch_indexes($idxdir,$mirror,$mailrc_file,$packages_file,$perms_file);
my $dbh = DBI->connect($dsn,$user,$pass);
if ( $dsn =~ /^dbi\:SQLite/i ) {
  $dbh->do(qq{PRAGMA synchronous = OFF}) or die $dbh->errstr;
}
print "Populating auths ... ";
populate_auths($dbh,$idxdir,$mailrc_file);
print "DONE\nPopulating dists and mods ... ";
my $packtime = populate_dists($dbh,$idxdir,$packages_file);
unless ( $mirrorlist ) {
  print "DONE\nPopulating mirrors ... ";
  populate_mirrors($dbh,$idxdir,$mirrord_file);
}
else {
  print "DONE\nSkipping mirrors ... ";
}
unless ( $cpanperms ) {
  print "DONE\nPopulating CPAN perms ... ";
  populate_perms($dbh,$idxdir,$perms_file);
}
else {
  print "DONE\nSkipping CPAN perms ... ";
}
unless ( $corelist ) {
  print "DONE\nPopulating corelist ... ";
  populate_corelist($dbh);
}
else {
  print "DONE\nSkipping corelist ... ";
}
print "DONE\n";
timestamp($dbh,$packtime);
poll_server($url) if $url;
exit 0;

sub timestamp {
  my $handle = shift;
  my $packages = shift;
  $handle->do(qq{DROP TABLE IF EXISTS timestamp}) or die $handle->errstr;
  create_table( $handle, 'timestamp' );
  my $sth = $handle->prepare_cached(qq{INSERT INTO timestamp values (?,?)}) or die $handle->errstr;
  $sth->execute( time, $packages );
  return 1;
}

sub create_table {
  my $handle = shift;
  my $table  = shift;
  my $sql = App::CPANIDX::Tables->table( $table );
  $handle->do($sql) or die $handle->errstr;
  $handle->do('DELETE FROM ' . $table) or die $handle->errstr;
  return 1;
}

sub populate_dists {
  my ($handle,$dir,$pfile) = @_;
  my $fh = IO::Zlib->new( File::Spec->catfile($dir,$pfile), "rb" ) or die "$!\n";
  my %dists;
  my @mods;

  my $time;

  while (<$fh>) {
    chomp;