#!perl

use strict;
use warnings;
use App::CPANIDX::Tables;
use DBI;
use URI;
use Config::Tiny;
use CPAN::DistnameInfo;
use Date::Parse qw[str2time];
use Parse::CPAN::MirroredBy;
use Module::CoreList::DBSchema;
use IO::Zlib;
use File::Fetch;
use File::Spec;
use File::Path qw[mkpath];
use File::Spec::Unix;
use Getopt::Long;

my $verbose;
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;
    last if /^\s*$/;
    my($field,$data) = split /\:\s+/;
    $time = str2time($data) if $field eq 'Last-Updated';
  }
  while (<$fh>) {
    chomp;
    my ($module,$version,$package_path) = split ' ', $_;
    my $d = CPAN::DistnameInfo->new( $package_path );
    next unless $d;
    my $metaname = $d->pathname;
    my $extension = $d->extension;
    next unless $extension;
    unless ( exists $dists{$package_path} ) {
      $dists{$package_path} = [ $d->dist, $d->cpanid, $d->pathname, $d->version ];
    }
    push @mods, [ $module, $d->dist, $d->version, $d->cpanid, $version ];
  }

  $handle->begin_work;

  create_table( $handle, 'tmp_dists' );
  foreach my $dist ( keys %dists ) {
      my $sth = $handle->prepare_cached(qq{INSERT INTO tmp_dists values (?,?,?,?)}) or die $handle->errstr;
      $sth->execute( @{ $dists{ $dist } } );
  }
  create_table( $handle, 'tmp_mods' );
  foreach my $mod ( @mods ) {
    my $sth = $handle->prepare_cached(qq{INSERT INTO tmp_mods values (?,?,?,?,?)}) or die $handle->errstr;
    $sth->execute( @{ $mod } );
  }

  $handle->do(qq{DROP TABLE IF EXISTS dists}) or die $handle->errstr;
  $handle->do(qq{ALTER TABLE tmp_dists RENAME TO dists}) or die $handle->errstr;
  $handle->do(qq{DROP TABLE IF EXISTS mods}) or die $handle->errstr;
  $handle->do(qq{ALTER TABLE tmp_mods RENAME TO mods}) or die $handle->errstr;

  foreach my $table ( qw( dists mods ) ) {
    foreach my $sql ( @{ App::CPANIDX::Tables->index( $table ) } ) {
      $handle->do( $sql ) or die $handle->errstr;
    }
  }

  $handle->commit;

  return $time;
}

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

  while (<$fh>) {
    last if /^\s*$/;
  }

  $handle->begin_work;

  create_table( $handle, 'tmp_perms' );

  while (<$fh>) {
    chomp;
    my ($mod,$id,$perm) = split /,/;
    my $sth = $handle->prepare_cached(qq{INSERT INTO tmp_perms values (?,?,?)}) or die $handle->errstr;
    $sth->execute( $mod, $id, $perm ) or die $handle->errstr;
  }

  $handle->do(qq{DROP TABLE IF EXISTS perms}) or die $handle->errstr;
  $handle->do(qq{ALTER TABLE tmp_perms RENAME TO perms}) or die $handle->errstr;

  foreach my $sql ( @{ App::CPANIDX::Tables->index( 'perms' ) } ) {
    $handle->do( $sql ) or die $handle->errstr;
  }

  $handle->commit;

  return 1;
}

sub populate_auths {
  my ($handle,$dir,$mfile) = @_;
  my $fh = IO::Zlib->new( File::Spec->catfile($dir,$mfile), "rb" ) or die "$!\n";
  my @auths;
  while (<$fh>) {
    chomp;
    my ( $alias, $pauseid, $long ) = split ' ', $_, 3;
    $long =~ s/^"//;
    $long =~ s/"$//;
    my ($name, $email) = $long =~ /(.*) <(.+)>$/;
    push @auths, [ $pauseid, $name, $email ];
  }

  $handle->begin_work;

  create_table( $handle, 'tmp_auths' );
  foreach my $auth ( @auths ) {
    my $sth = $handle->prepare_cached(qq{INSERT INTO tmp_auths values (?,?,?)}) or die $handle->errstr;
    $sth->execute( @{ $auth } ) or die $handle->errstr;
  }

  $handle->do(qq{DROP TABLE IF EXISTS auths}) or die $handle->errstr;
  $handle->do(qq{ALTER TABLE tmp_auths RENAME TO auths}) or die $handle->errstr;

  foreach my $sql ( @{ App::CPANIDX::Tables->index( 'auths' ) } ) {
    $handle->do( $sql ) or die $handle->errstr;
  }

  $handle->commit;

  return 1;
}

sub populate_mirrors {
  my ($handle,$dir,$mfile) = @_;

  my $pm = Parse::CPAN::MirroredBy->new();

  $handle->begin_work;

  create_table( $handle, 'tmp_mirrors' );

  foreach my $mirror ( $pm->parse_file( File::Spec->catfile($dir,$mfile) ) ) {
    $mirror->{$_} = '' for grep { !$mirror->{$_} } @{ $mirror_fields };
    my $hostname = delete $mirror->{hostname};
    my $sth = $handle->prepare_cached(qq{INSERT INTO tmp_mirrors values(?,?,?,?,?,?,?,?,?,?,?,?)})
                or die $DBI::errstr;
    $sth->execute( $hostname, ( map { $mirror->{$_} } sort keys %{ $mirror } ) ) or die $handle->errstr;
  }

  $handle->do(qq{DROP TABLE IF EXISTS mirrors}) or die $handle->errstr;
  $handle->do(qq{ALTER TABLE tmp_mirrors RENAME TO mirrors}) or die $handle->errstr;

  $handle->commit;

  return 1;
}

sub populate_corelist {
  my ($handle) = @_;

  my $mcdbs = Module::CoreList::DBSchema->new();
  my %tables = $mcdbs->tables();

  $handle->begin_work;

  create_table( $handle, 'tmp_' . $_ ) for keys %tables;

  foreach my $row ( $mcdbs->data( prefix => 'tmp_' ) ) {
    my $sql = shift @{ $row };
    my $sth = $handle->prepare_cached($sql) or die $handle->errstr;
    $sth->execute( @{ $row } ) or die $handle->errstr;
  }

  foreach my $table ( keys %tables ) {
    $handle->do(qq{DROP TABLE IF EXISTS $table}) or die $handle->errstr;
    $handle->do(qq{ALTER TABLE tmp_$table RENAME TO $table}) or die $handle->errstr;
  }

  $handle->commit;

  return 1;
}

sub fetch_indexes {
  my ($location,$mirror,$mailrc,$packages,$perms) = @_;

  my $mailurl = URI->new($mirror);
  my $packurl = URI->new($mirror);
  my $mirrord = URI->new($mirror);
  my $permurl = URI->new($mirror);

  $mailurl->path_segments( ( grep { $_ } $mailurl->path_segments ), 'authors', $mailrc );
  $packurl->path_segments( ( grep { $_ } $packurl->path_segments ), 'modules', $packages );
  $permurl->path_segments( ( grep { $_ } $permurl->path_segments ), 'modules', $perms );
  $mirrord->path_segments( ( grep { $_ } $mirrord->path_segments ), 'MIRRORED.BY' );

  foreach my $file ( $mailurl, $packurl, $permurl, $mirrord ) {
    my $url = $file->as_string;
    print "Fetching '$url' to '$location'\n";
    my $ff = File::Fetch->new( uri => $url );
    print $ff->output_file, "\n";
    my $stat = $ff->fetch( to => $location );
    next unless $stat;
    print "Downloaded '$url' to '$stat'\n";
  }
}

sub poll_server {
  my $url = shift;
  my $uri = URI->new($url);
  $uri->path_segments( ( grep { $_ } $uri->path_segments ), 'yaml', 'timestamp' );
  my $string;
  my $ff = File::Fetch->new( uri => $uri->as_string );
  $ff->fetch( to => \$string );
  print $string, "\n";
}

sub _cpanidx_dir {
  return $ENV{PERL5_CPANIDX_DIR}
     if  exists $ENV{PERL5_CPANIDX_DIR}
     && defined $ENV{PERL5_CPANIDX_DIR};

  my @os_home_envs = qw( APPDATA HOME USERPROFILE WINDIR SYS$LOGIN );

  for my $env ( @os_home_envs ) {
      next unless exists $ENV{ $env };
      next unless defined $ENV{ $env } && length $ENV{ $env };
      my $idx = File::Spec->catdir( $ENV{ $env }, '.cpanidx' );
      return $idx if -d $ENV{ $env };
  }

  return cwd();
}