#!/usr/bin/perl
# vim: set ai et sw=3 ts=3 nu:
#
# Updates Solr with repository metadata
#
# by Pascal Bleser <pascal.bleser@opensuse.org>
#
#     This library is free software; you can redistribute it and/or modify it
#     under the terms of the GNU Lesser General Public License as published by
#     the Free Software Foundation; either version 2.1 of the License, or (at
#     your option) any later version.
#                 
#     This library is distributed in the hope that it will be useful, but
#     WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#     Lesser General Public License for more details.
#      
#     You should have received a copy of the GNU Lesser General Public
#     License along with this library; if not, write to the Free Software
#     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307,
#     USA.

use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Date;
use File::Spec;
use File::Basename;
use HTML::Entities ();
use XML::LibXML;
use POSIX;
use IO::Uncompress::Gunzip;
use Term::ProgressBar;
use WebService::Solr;
use Getopt::Long;

use lib './lib';
use RPM_MD;
use YaST2_MD;

my $repos = "./repos.d";
my $cache_dir = "./cache.d";
my $verbose = undef;
my $force = undef;
my $validate_introspect = undef;

GetOptions(
   'v|verbose' => \$verbose,
   'f|force'   => \$force,
);

my $solr_escape_chars = quotemeta( '+-&|!(){}[]^"~*?:\\' );
my @repos = ();

my @rfiles = ();
if (scalar(@ARGV) > 0) {
   push(@rfiles, @ARGV);
} else {
   @rfiles = grep { -f } glob($repos.'/*.conf');
}

foreach my $rfile (@rfiles) {
   open(my $fh, '<', $rfile) or die "failed to open $rfile: $!";
   while (<$fh>) {
      chomp;
      s/#.*$//;
      s/^\s*//;
      s/\s*//;
      next if /^$/;
      if (/^(\S+)\s+(\S+)\s+(\S+)(?:\s+(\S+))?(?:\s+(\S+))?$/) {
         my $r = {
            repoid         => $1,
            distribution   => $2,
            baseurl        => $3,
            configfile     => $rfile,
         };
         $r->{mdtype} = defined $4 ? $4 : 'rpmmd';
         if (defined $5) {
            my %flags = map { $_ => 1 } split(/\s*,\s*/, $5);
            $r->{flags} = \%flags;
         } else {
            $r->{flags} = {};
         }

         push(@repos, $r);
      } else {
         die "invalid repo spec in $rfile at line $.";
      }
   }
   close($fh);
}

my $ua = LWP::UserAgent->new(
   timeout      => 10,
   agent        => "webpin-repomanager/1.0",
   max_redirect => 4,
);
$ua->env_proxy();

my $solr = WebService::Solr->new("http://localhost:8983/solr", {
    autocommit => 0,
});
$solr->ping() or die "failed to ping Solr";

sub f($$) {
    my $name = shift;
    my $value = shift;
    my $field = WebService::Solr::Field->new($name => $value);
    return $field;
}

sub solr_escape($) {
   my $v = shift;
   die "null value passed to solr_escape" unless defined $v;
   $v =~ s{([$solr_escape_chars])}{\\$1}g;
   return $v;
}

my @gone = ();
my $total = 0;
foreach my $r (@repos) {
   print $r->{repoid}, "\n" if $verbose;

   my $cache = File::Spec->catfile($cache_dir, $r->{repoid}.".cache");
   {
      my $dir = dirname($cache);
      mkdir($dir, 0750) unless -d $dir;
   }

   my $timestamp = undef;
   my $last_modified = undef;
   my $etag = undef;
   {
      if (-e $cache) {
         open(my $fh, '<', $cache) or die "failed to open cache file $cache: $!";
         chomp($timestamp = <$fh>);
         chomp($last_modified = <$fh>);
         chomp($etag = <$fh>);
         close($fh);
      }
   }

   my $h = {
      last_modified => $last_modified,
      etag          => $etag,
      timestamp     => $timestamp,
   };

   my @docs = ();
   my $packages = undef;
   my $repoheaders = undef;
   {
      my $pr = undef;
      if ($r->{mdtype} eq 'rpmmd' or $r->{mdtype} eq 'rpm-md') {
         eval {
            $pr = parse_rpmmd($r, $h, $ua, $verbose);
            #($packages, $repoheaders) = parse_rpmmd($r, $h, $ua, $verbose);
         };
         if ($@) {
            warn "failed to parse repository ".$r->{repoid}.": ".$@;
            next;
         }
      } elsif ($r->{mdtype} eq 'yast2') {
         eval {
            $pr = parse_y2md($r, $h, $ua, $verbose);
         };
         if ($@) {
            warn "failed to parse repository ".$r->{repoid}.": ".$@;
            next;
         }
      } else {
         warn "unsupported repository type \"".$r->{mdtype}."\"";
         next;
      }

      if (ref($pr) eq 'ARRAY') {
         $packages = $pr->[0];
         $repoheaders = $pr->[1];
      } elsif (ref($pr) eq 'HASH') {
         push(@gone, $r);
         next;
      } elsif (not defined($pr)) {
         next;
      } else {
         warn "unsupported scalar returned by parser: $pr";
         next;
      }

      if ($validate_introspect) {
         foreach my $p (@$packages) {
            die "missing summary in ".join('-', map { $p->{$_} } qw(name version release arch)) unless exists $p->{summary};
            while (my ($k, $v) = each(%$p)) {
               die "found undef for $k in package ".join('-', map { $p->{$_} } qw(name version release arch)) unless defined $v;
               if (ref($v) eq 'ARRAY') {
                  foreach (@$v) {
                     die "found undef in list $k in package ".join('-', map { $p->{$_} } qw(name version release arch)) unless defined $_;
                  }
               }
            }
         }
         foreach my $p (@$packages) {
            if (not exists $p->{id} or not defined $p->{id}) {
               use Data::Dumper;
               die "no id: " . Dumper($p);
            }
         }
      }

      my %source_rpm_index = ();
      foreach my $p (@$packages) {
         if ($p->{arch} eq "src") {
            my $k = basename($p->{location});
            die "no id for $k" unless exists $p->{id} and defined $p->{id};
            $source_rpm_index{$k} = $p;
         }
      }

      foreach my $p (@$packages) {
         foreach (qw(repoid distribution)) {
            $p->{$_} = $r->{$_};
         }
         $p->{repourl} = $r->{baseurl};

         if (exists $p->{sourcerpm} and $p->{arch} ne "src" and $p->{arch} ne "nosrc") {
            my $srpm = $p->{sourcerpm};
            my $s = $source_rpm_index{$srpm};
            if (defined $s) {
               my $sid = $s->{id};
               die "undefined id for $srpm" unless defined $sid;
               $p->{sourcerpmid} = $sid;
            } else {
               #warn "failed to find source rpm $srpm";
            }
         }

         {
            my $g = $p->{rpmgroup};
            delete $p->{rpmgroup};
            $p->{group_exact} = $g;
            $p->{group_last} = $g;
         }

         # post-process
         if (exists $p->{description} and defined $p->{description}) {
            $p->{description} =~ s/\s*\bAuthors?:?.*$//ms;
         }
         
         if (exists $p->{packager} and defined $p->{packager}) {
            $p->{packager} =~ s/\s*<.+@.+>//;
            $p->{packager} =~ s/\w.+@.+\w//;
            $p->{packager} = HTML::Entities::encode_numeric($p->{packager});
         }

         {
            foreach my $tag (qw(requires provides)) {
               my @pp = grep { not /^(rpmlib|libc\.so|debuginfo\()/ } @{$p->{$tag}};
               $p->{$tag} = \@pp;
            }
         }

         $p->{mime} = [];
         $p->{perl} = [];
         foreach ($p->{provides}) {
            push(@{$p->{mime}}, $1) if /^(?:mimetype|mimehandler)\(.+?\)/;
            push(@{$p->{perl}}, $1) if /^perl\(.+?\)/;
         }

         $p->{tag} = [];
         push(@{$p->{tag}}, 'doc') if $p->{name} =~ /-doc$/;
         push(@{$p->{tag}}, 'lang') if $p->{name} =~ /-lang$/;
         push(@{$p->{tag}}, 'devel') if $p->{name} =~ /-devel$/;
         push(@{$p->{tag}}, 'perl') if $p->{name} =~ /^perl-\D$/;
         push(@{$p->{tag}}, 'python') if $p->{name} =~ /^python-\D$/;
         push(@{$p->{tag}}, 'ruby') if $p->{name} =~ /^ruby(gem)?-\D$/;
         push(@{$p->{tag}}, 'lib') if $p->{name} =~ /^lib/;
         push(@{$p->{tag}}, 'debug') if $p->{name} =~ /\-debug(info|source)$/;
         push(@{$p->{tag}}, 'src') if $p->{arch} eq "src" or $p->{arch} eq "nosrc";

         # make a Solr document from that
         my @fields = ();
         while (my ($k, $v) = each(%$p)) {
            next if $k eq 'configfile';

            if (ref($v) eq 'ARRAY') {
               foreach (@$v) {
                  die "undef found for $k in ".join("-", ($p->{name}, $p->{version}, $p->{release})) if not defined $_;
                  push(@fields, f($k, $_));
               }
            } elsif (ref($v) eq '') {
               push(@fields, f($k, $v));
            } else {
               die "wtf, a ref ? ($k)";
            }
         }
         my $doc = WebService::Solr::Document->new;
         $doc->add_fields(@fields);
         push(@docs, $doc);
      }

      my $solr_repoid = solr_escape($r->{repoid});

      my @missing;
      my @newones;
      {
         # load all the documents in Solr for the current repoid
         my $exres = $solr->search('', {
            'q.alt'  => 'repoid:'.$solr_repoid,
            'fl'     => 'id,name,version,release,arch,sha',
            'rows'   => '9999999',
            'start'  => 0,
         });
         my @exdocs = $exres->docs;

         {
            my %index = map { $_->value_for('sha') => 1 } @docs;
            @missing = grep { not exists $index{$_->value_for('sha')} } @exdocs;
         }
         {
            my %index = map { $_->value_for('sha') => 1 } @exdocs;
            @newones = grep { not exists $index{$_->value_for('sha')} } @docs;
         }
      }
      if ($verbose) {
         print "\n";
         print "\t", scalar(@newones), " new packages", "\n";
         print "\t", scalar(@missing), " packages have gone missing", "\n";
      }

      if (scalar(@missing) > 0) {
         print "\t", "deleting ", scalar(@missing), " packages", "\n" if $verbose;
         foreach my $p (@missing) {
            my $solr_id = solr_escape($p->value_for('id'));
            $solr->delete_by_query('id:'.$solr_id) or die "failed to delete id:".$solr_id;
         }
      }
      if (scalar(@newones) > 0) {
         my $progress = undef;
         if ($verbose) {
            print "\t", "adding ", scalar(@newones), " documents to Solr", "\n";
            $progress = Term::ProgressBar->new({
               count => scalar(@newones),
               name  => "adding to Solr",
               ETA   => 'linear',
            });
            $progress->minor(0);
         }
         my $chunk = [];
         my $i = 0;
         foreach my $d (@newones) {
            push(@$chunk, $d);
            if (($i % 10) == 0) {
               $solr->add($chunk, { overwrite => 1 });
               $chunk = [];
               $progress->update($i) if $progress;
            }
            $i++;
         }
         if (scalar(@$chunk) > 0) {
            $solr->add($chunk, { overwrite => 1 });
         }
         $progress->update(scalar(@newones)) if $progress;

         #$solr->add(\@newones, { overwrite => 1 });
         $total += scalar(@newones);
      }
      print "\t", "committing Solr", "\n" if $verbose;
      $solr->commit();
      print "\n" if $verbose;
   }

   # save to cache
   if (exists $repoheaders->{timestamp} and defined $repoheaders->{timestamp} and exists $repoheaders->{last_modified} and defined $repoheaders->{last_modified}) {
      open(my $fh, '>', $cache) or die "failed to open cache for write: $cache: $!";
      print $fh $repoheaders->{timestamp}, "\n";
      print $fh $repoheaders->{last_modified}, "\n";
      if (exists $repoheaders->{etag} and defined $repoheaders->{etag}) {
         print $fh $repoheaders->{etag}, "\n"; #->header("etag"), "\n";
      } else {
         print $fh "\n";
      }
      close($fh);
      print "\t", "saved cache to ", $cache, "\n" if $verbose;
   }

}

if ($total > 0) {
   print "\n", "optimizing Solr index", "\n" if $verbose;
   $solr->optimize();
}

if (scalar(@gone) > 0) {
   print "The following repositories have disappeared:", "\n";
   foreach my $r (@gone) {
      print join("    ", map { $r->{$_} } qw(configfile repoid distribution baseurl)), "\n";
   }
}