add load_package support

diff --git a/Debbugs/DB/Load.pm b/Debbugs/DB/Load.pm
index bb93533e5b6dd212e450eda579ec4d174dd68a72..c4b4ab01e6c1a8ef7d2e3ab400e34594707cdcc0 100644 (file)
--- a/Debbugs/DB/Load.pm
+++ b/Debbugs/DB/Load.pm
@@ -32,6 +32,8 @@ BEGIN{
 
      @EXPORT = ();
      %EXPORT_TAGS = (load_bug    => [qw(load_bug handle_load_bug_queue load_bug_log)],
+                    load_debinfo => [qw(load_debinfo)],
+                    load_package => [qw(load_package)],
                    );
      @EXPORT_OK = ();
      Exporter::export_ok_tags(keys %EXPORT_TAGS);
@@ -357,7 +359,7 @@ Commands to handle src and package version loading from debinfo files
 sub load_debinfo {
     my ($schema,$binname, $binver, $binarch, $srcname, $srcver) = @_;
     my $sp = $schema->resultset('SrcPkg')->find_or_create({pkg => $srcname});
-    my $sv = $schema->resultset('SrcVer')->find_or_create({src_pkg_id=>$sp->id(),
+    my $sv = $schema->resultset('SrcVer')->find_or_create({src_pkg=>$sp->id(),
                                                            ver => $srcver});
     my $arch = $schema->resultset('Arch')->find_or_create({arch => $binarch});
     my $bp = $schema->resultset('BinPkg')->find_or_create({pkg => $binname});
@@ -369,6 +371,78 @@ sub load_debinfo {
 }
 
 
+=back
+
+=head Packages
+
+=over
+
+=item load_package
+
+     load_package($schema,$suite,$component,$arch,$pkg)
+
+=cut
+
+sub load_package {
+    my ($schema,$suite,$component,$arch,$pkg) = @_;
+    if ($arch eq 'source') {
+       my $sp = $schema->resultset('SrcPkg')->find_or_create({pkg => $pkg->{Package}});
+       my $suite = $schema->resultset('Suite')->find_or_create({suite_name => $suite});
+       my $sv = $schema->resultset('SrcVer')->find_or_create({src_pkg =>$sp->id,
+                                                              ver => $pkg->{Version}});
+       my @addrs = getparsedaddrs($pkg->{Maintainer} // '');
+       if (@addrs) {
+           my $mc = $schema->resultset('Correspondent')->
+               find_or_create({addr => lc($addrs[0]->address())});
+           my $full_name = $addrs[0]->phrase();
+           $full_name =~ s/^\"|\"$//g;
+           $full_name =~ s/^\s+|\s+$//g;
+           $sv->discard_changes;
+           $sv->find_or_create_related('maintainer',
+                                      {name => $full_name,
+                                       correspondent => $mc->id},
+                                      );
+           $mc->update_or_create_related('correspondent_full_names',
+                                        {full_name=>$full_name,
+                                         last_seen => 'NOW()'});
+       }
+       # update the link for this source package
+       $schema->
+           txndo(sub {
+                    # delete associations for this source package in this
+                    # suite
+                    $schema->resultset('SrcAssociations')->
+                        search_rs({suite => $suite->id,})->
+                        search_related_rs('src_pkg',
+                                         {src_pkg => $sp->id})->delete;
+                    $schema->resultset('SrcAssociations')->
+                        create({suite => $suite->id,
+                                source => $sv->id,
+                               });
+                });
+    } else {
+       my $bp = $schema->resultset('BinPkg')->find_or_create({pkg => $pkg->{Package}});
+       my $suite = $schema->resultset('Suite')->find_or_create({suite_name => $suite});
+       my ($bv) = $bp->search_related('bin_vers',{ver => $pkg->{Version}});
+       # if there isn't already a binary version for this package, we don't
+       # know what source it belongs to, so we can't associate it with a
+       # release
+       return if (not defined $bv);
+       $schema->
+           txndo(sub {
+                     $schema->resultset('BinAssociations')->
+                         search_rs({suite => $suite->id,})->
+                         search_related_rs('bin_pkg',
+                                          {bin_pkg_id => $bp->id}
+                                          )->delete;
+                     $schema->resultset('BinAssociations')->
+                         create({suite => $suite->id,
+                                 bin => $bv->id
+                                });
+                 });
+    }
+}
+
 =back
 
 =cut

diff --git a/bin/debbugs-loadsql b/bin/debbugs-loadsql
index 7eec783ac10479c7b1e80e1e0149134d24964d49..20f5722b90fa6a87e7d1be034f72de626d0d0c40 100755 (executable)
--- a/bin/debbugs-loadsql
+++ b/bin/debbugs-loadsql
@@ -103,10 +103,11 @@ use Debbugs::Config qw(:config);
 use Debbugs::Status qw(read_bug split_status_fields);
 use Debbugs::Log;
 use Debbugs::DB;
-use Debbugs::DB::Load qw(load_bug handle_load_bug_queue);
+use Debbugs::DB::Load qw(load_bug handle_load_bug_queue :load_package);
 use DateTime;
 use File::stat;
-
+use IO::Dir;
+use IO::Uncompress::AnyUncompress;
 
 my %options =
     (debug           => 0,
@@ -152,6 +153,10 @@ my %subcommands =
                  },
      'logs' => {function => \&add_logs,
                },
+     'packages' => {function => \&add_packages,
+                   arguments => {'ftpdists=s' => 1,
+                                },
+                  },
      'help' => {function => sub {pod2usage({verbose => 2});}}
     );
 
@@ -485,7 +490,80 @@ sub add_logs {
 }
 
 sub add_packages {
+    my ($options,$opts,$p,$config,$argv) = @_;
+
+    my $s = db_connect($options);
 
+    my $dist_dir = IO::Dir->new($opts->{ftpdists});
+    my @dist_names =
+       grep { $_ !~ /^\./ and
+              -d $opts->{ftpdists}.'/'.$_ and
+              not -l $opts->{ftpdists}.'/'.$_
+          } $dist_dir->read;
+    my %s_p;
+    my %s_info;
+    while (my $dist = shift @dist_names) {
+       my $dist_dir = $opts->{ftpdists}.'/'.$dist;
+       # parse release
+       my $rfh =  IO::Uncompress::AnyUncompress->new($dist_dir.'/Release');
+       my %dist_info;
+       my $in_sha1;
+       my %p_f;
+       while (<$rfh>) {
+           chomp;
+           if (s/^(\S+):\s*//) {
+               if ($1 eq 'SHA1'or $1 eq 'SHA256') {
+                   $in_sha1 = 1;
+                   next;
+               }
+               $dist_info{$1} = $_;
+           } elsif ($in_sha1) {
+               s/^\s//;
+               my ($sha,$size,$file) = split /\s+/,$_;
+               next unless $file =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
+               next unless $file =~ m{^([^/]+)/([^/]+)/([^/]+)$};
+               my ($component,$arch,$package_source) = ($1,$2,$3);
+               $arch =~ s/binary-//;
+               next if exists $p_f{$component}{$arch};
+               $p_f{$component}{$arch} = $dist_dir.'/'.$file;
+           }
+       }
+       $s_p{$dist_info{Suite}} = \%p_f;
+       $s_info{$dist_info{Suite}} = \%s_info;
+    }
+    # parse packages files
+    for my $suite (keys %s_p) {
+       for my $component (keys %{$s_p{$suite}}) {
+           for my $arch (keys %{$s_p{$suite}{$component}}) {
+               my $pfh =  IO::Uncompress::AnyUncompress->new($s_p{$suite}{$component}{$arch}) or
+                   die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
+               my $lastkey;
+               my %pkg;
+               while (<$pfh>) {
+                   if (/^$/) {
+                       load_package($s,$suite,$component,$arch,\%pkg);
+                       %pkg = ();
+                       next;
+                   }
+                   if (my ($key, $value) = m/^(\S+): (.*)/) {
+                       $pkg{$key} = $value;
+                       $lastkey=$key;
+                   }
+                   else {
+                       s/ //;
+                       s/^\.$//;
+                       chomp;
+                       $pkg{$lastkey} .= "\n" . $_;
+                   }
+               }
+               if (keys %pkg) {
+                   load_package($s,$suite,$component,$arch,\%pkg);
+               }
+           }
+       }
+    }
+    use Data::Printer;
+    p %s_p;
 }
 
 sub handle_subcommand_arguments {