#!perl

use strict;
use warnings;
use DBI;
use URI;
use Config::Tiny;
use CPAN::DistnameInfo;
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';

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

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

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

my $dsn = $cfg->{_}->{dsn};
my $user = $cfg->{_}->{user};
my $pass = $cfg->{_}->{pass};
my $url = $cfg->{_}->{url};
my $mirror = $cfg->{_}->{mirror} || 'ftp://ftp.funet.fi/pub/CPAN/';

die "No 'dsn' was specified in the config file '$config', aborting\n" unless $dsn;
die "No 'url' was specified in the config file '$config', aborting\n" unless $url;

$|=1;

my $tables = {
   mods => [
      'mod_name VARCHAR(300) NOT NULL',
      'dist_name VARCHAR(190) NOT NULL',
      'dist_vers VARCHAR(20)',
      'cpan_id VARCHAR(20) NOT NULL',
      'mod_vers VARCHAR(30)',
    ],
   dists => [
      'dist_name VARCHAR(190) NOT NULL',
      'cpan_id VARCHAR(20) NOT NULL',
      'dist_file VARCHAR(400) NOT NULL',
      'dist_vers VARCHAR(20)',
    ],
   auths => [
      'cpan_id VARCHAR(20) NOT NULL',
      'fullname VARCHAR(60) NOT NULL',
      'email TEXT',
    ],
   timestamp => [
      'timestamp VARCHAR(30) NOT NULL',
   ],
};

my $packages_file = '02packages.details.txt.gz';
my $mailrc_file = '01mailrc.txt.gz';

my $idxdir = _cpanidx_dir();
mkpath( $idxdir ) unless -d $idxdir;
fetch_indexes($idxdir,$mirror,$mailrc_file,$packages_file);
my $dbh = DBI->connect($dsn,$user,$pass);
print "Populating auths ... ";
populate_auths($dbh,$idxdir,$mailrc_file);
print "DONE\nPopulating dists and mods ... ";
populate_dists($dbh,$idxdir,$packages_file);
print "DONE\n";
timestamp($dbh);
poll_server($url);
exit 0;

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

sub create_table {
  my $handle = shift;
  my $table  = shift;
  my $sql = 'CREATE TABLE IF NOT EXISTS ' . $table . ' ( ';
  $sql .= join ', ', @{ $tables->{$table} };
  $sql .= ' )';
  $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;

  while (<$fh>) {
    last if /^\s*$/;
  }
  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 ];
  }
  create_table( $handle, 'dists' );
  foreach my $dist ( keys %dists ) {
      my $sth = $handle->prepare_cached(qq{INSERT INTO dists values (?,?,?,?)}) or die $handle->errstr;
      $sth->execute( @{ $dists{ $dist } } );
  }
  create_table( $handle, 'mods' );
  foreach my $mod ( @mods ) {
    my $sth = $handle->prepare_cached(qq{INSERT INTO mods values (?,?,?,?,?)}) or die $handle->errstr;
    $sth->execute( @{ $mod } );
  }
  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 ];
  }
  create_table( $handle, 'auths' );
  foreach my $auth ( @auths ) {
    my $sth = $handle->prepare_cached(qq{INSERT INTO auths values (?,?,?)}) or die $handle->errstr;
    $sth->execute( @{ $auth } ) or die $handle->errstr;
  }
  return 1;
}

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

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

$mailurl->path_segments( ( grep { $_ } $mailurl->path_segments ), 'authors', $mailrc );
$packurl->path_segments( ( grep { $_ } $packurl->path_segments ), 'modules', $packages );

foreach my $file ( $mailurl, $packurl ) {
  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();
}
