]> git.donarmstrong.com Git - debbugs.git/commitdiff
load_packages now only changes rows it has to
authorDon Armstrong <don@donarmstrong.com>
Sat, 25 Feb 2017 23:43:34 +0000 (15:43 -0800)
committerDon Armstrong <don@donarmstrong.com>
Sat, 25 Feb 2017 23:43:34 +0000 (15:43 -0800)
 - Use ResultSet operations to do most of the insertion
 - Add select_one routine to Debbugs::DB::Util

13 files changed:
Debbugs/DB/Load.pm
Debbugs/DB/ResultSet/Arch.pm [new file with mode: 0644]
Debbugs/DB/ResultSet/BinAssociation.pm [new file with mode: 0644]
Debbugs/DB/ResultSet/BinPkg.pm [new file with mode: 0644]
Debbugs/DB/ResultSet/BinVer.pm [new file with mode: 0644]
Debbugs/DB/ResultSet/Correspondent.pm [new file with mode: 0644]
Debbugs/DB/ResultSet/Maintainer.pm [new file with mode: 0644]
Debbugs/DB/ResultSet/SrcAssociation.pm [new file with mode: 0644]
Debbugs/DB/ResultSet/SrcPkg.pm [new file with mode: 0644]
Debbugs/DB/ResultSet/SrcVer.pm [new file with mode: 0644]
Debbugs/DB/ResultSet/Suite.pm [new file with mode: 0644]
Debbugs/DB/Util.pm [new file with mode: 0644]
bin/debbugs-loadsql

index 9af8b56e74439d05aa4b3ca84878334b1ab60b66..f583f51be704c99d62b82a877ca48f9392e4ab64 100644 (file)
@@ -33,7 +33,7 @@ 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)],
+                    load_package => [qw(load_packages)],
                     load_suite => [qw(load_suite)],
                    );
      @EXPORT_OK = ();
@@ -42,6 +42,7 @@ BEGIN{
 }
 
 use Params::Validate qw(validate_with :types);
+use List::MoreUtils qw(natatime);
 
 use Debbugs::Status qw(read_bug split_status_fields);
 use Debbugs::DB;
@@ -405,363 +406,160 @@ sub load_packages {
                  page => 1
                 }
                 )->single();
-    print STDERR time." handling packages\n";
+    my %maints;
+    my %sources;
+    my %bins;
     for my $pkg_tuple (@{$pkgs}) {
        my ($arch,$component,$pkg) = @{$pkg_tuple};
-       $p->update() if $p;
+       $maints{$pkg->{Maintainer}} = $pkg->{Maintainer};
        if ($arch eq 'source') {
            my $source = $pkg->{Package};
            my $source_ver = $pkg->{Version};
-           if (not exists $maint_cache{$pkg->{Maintainer}}) {
-               my @addrs = getparsedaddrs($pkg->{Maintainer} // '');
-               if (@addrs) {
-                   my $mc = $schema->resultset('Correspondent')->
-                       find_or_create({addr => lc($addrs[0]->address())},
-                                     {key => 'correspondent_addr_idx'}
-                                     );
-                   my $full_name = $addrs[0]->phrase();
-                   $full_name =~ s/^\"|\"$//g;
-                   $full_name =~ s/^\s+|\s+$//g;
-                   # $sv->discard_changes;
-                   my $maint = $schema->resultset('Maintainer')->
-                       find_or_create({name => $pkg->{Maintainer},
-                                       correspondent => $mc->id},
-                                     {key => 'maintainer_name_idx'},
-                                     );
-                   $mc->find_or_create_related('correspondent_full_names',
-                                              {full_name => $full_name},
-                                              {key => 'correspondent_full_name_correspondent_full_name_idx'}
-                                              );
-                   $mc->update;
-                   $maint_cache{$pkg->{Maintainer}} = $maint;
-               }
-           }
-           if (not exists $source_cache{$source}{$source_ver}) {
-               my $sp = $schema->resultset('SrcPkg')->
-                   find_or_create({pkg => $source});
-               my $sv = $sp->find_or_create_related('src_vers',
-                                                   {ver => $source_ver});
-               $source_cache{$source}{$source_ver} = $sv;
-               if (exists $maint_cache{$pkg->{Maintainer}}) {
-                   $source_cache{$source}{$source_ver}->
-                       set_from_related('maintainer',
-                                        $maint_cache{$pkg->{Maintainer}}
-                                       );
-                   $source_cache{$source}{$source_ver}->update;
-               }
-           }
-           $schema->resultset('SrcAssociation')->
-               update_or_create({suite => $suite_id,
-                                 source => $source_cache{$source}{$source_ver}->id,
-                                 modified => 'NOW()',
-                                },
-                               {key => 'src_associations_source_suite'}
-                               );
+           $sources{$source}{$source_ver} = $pkg->{Maintainer};
        } else {
-           my $ar = $schema->resultset('Arch')->
-               find_or_create(arch => $arch);
-           my $bp = $schema->resultset('BinPkg')->
-               find_or_create({pkg => $pkg->{Package}});
            my $source = $pkg->{Source} // $pkg->{Package};
            my $source_ver = $pkg->{Version};
            if ($source =~ /^\s*(\S+) \(([^\)]+)\)\s*$/) {
                ($source,$source_ver) = ($1,$2);
            }
-           if (not exists $source_cache{$source}{$source_ver}) {
-               my $sp = $schema->resultset('SrcPkg')->
-                   find_or_create({pkg => $source});
-               my $sv = $sp->find_or_create_related('src_vers',
-                                                   {ver => $source_ver});
-               $source_cache{$source}{$source_ver} = $sv;
+           $sources{$source}{$source_ver} = $pkg->{Maintainer};
+           $bins{$arch}{$pkg->{Package}} =
+              {arch => $arch,
+               bin => $pkg->{Package},
+               bin_ver => $pkg->{Version},
+               src_ver => $source_ver,
+               source  => $source,
+               maint   => $pkg->{Maintainer},
+              };
+       }
+    }
+    # Retrieve and Insert new maintainers
+    my $maints =
+       $schema->resultset('Maintainer')->
+       get_maintainers(keys %maints);
+    my $archs =
+       $schema->resultset('Arch')->
+       get_archs(keys %bins);
+    # We want all of the source package/versions which are in this suite to
+    # start with
+    my @sa_to_add;
+    my @sa_to_del;
+    my %included_sa;
+    # Calculate which source packages are no longer in this suite
+    for my $s ($schema->resultset('SrcPkg')->
+              src_pkg_and_ver_in_suite($suite)) {
+       if (not exists $sources{$s->{pkg}} or
+           not exists $sources{$s->{pkg}}{$s->{src_vers}{ver}}
+          ) {
+           push @sa_to_del,
+               $s->{src_associations}{id};
+       }
+       $included_sa{$s->{pkg}}{$s->{src_vers}} = 1;
+    }
+    # Calculate which source packages are newly in this suite
+    for my $s (keys %sources) {
+       for my $v (keys %{$sources{$s}}) {
+           if (not exists $included_sa{$s} and
+               not $included_sa{$s}{$v}) {
+               push @sa_to_add,
+                   [$s,$v,$sources{$s}{$v}];
+           } else {
+               $p->update() if defined $p;
            }
-           my $bv = $bp->find_or_create_related('bin_vers',
-                                               {ver => $pkg->{Version},
-                                                src_ver => $source_cache{$source}{$source_ver}->id,
-                                                arch => $ar->id,
-                                               });
-           $schema->resultset('BinAssociation')->
-               update_or_create({suite => $suite_id,
-                                 bin => $bv->id,
-                                 modified => 'NOW()',
-                                },
-                               {key => 'bin_associations_bin_suite'}
-                               );
        }
     }
-    print STDERR time." deleting associations\n";
-    # delete old binary associations in this suite which have not recently been
-    # modified
-    $schema->resultset('BinAssociation')->
-       search_rs({suite => $suite_id,
-                  modified => {'<',$bin_max_last_modified->modified()},
-                 }) if defined
-                     $bin_max_last_modified;
+    # add new source packages
+    my $it = natatime 100, @sa_to_add;
+    while (my @v = $it->()) {
+       $schema->txn_do(
+           sub {
+               for my $svm (@_) {
+                   my $s_id = $schema->resultset('SrcPkg')->
+                       get_src_pkg_id($svm->[0]);
+                   my $sv_id = $schema->resultset('SrcVer')->
+                       get_src_ver_id($s_id,$svm->[1],$maints->{$svm->[2]});
+                   $schema->resultset('SrcAssociation')->
+                       insert_suite_src_ver_association($suite_id,$sv_id);
+               }
+           },
+                       @v
+                      );
+       $p->update($p->last_update()+
+                  scalar @v) if defined $p;
+    }
+    # remove associations for packages not in this suite
+    if (@sa_to_del) {
+       $schema->resultset('SrcAssociation')->
+           search_rs({id => \@sa_to_del})->delete();
+    }
+    # update packages in this suite to have a modification time of now
     $schema->resultset('SrcAssociation')->
-       search_rs({suite => $suite_id,
-                  modified => {'<',$src_max_last_modified->modified()},
-                 }) if defined
-                     $src_max_last_modified;
-}
-
-sub load_packages_dbi {
-    my ($schema,$suite,$pkgs,$p) = @_;
-    my $suite_id = $schema->resultset('Suite')->
-       find_or_create({codename => $suite})->id;
-    my %maint_cache;
-    my %arch_cache;
-    my %source_cache;
-    my $src_max_last_modified = $schema->resultset('SrcAssociation')->
-       search_rs({suite => $suite_id},
-                {order_by => {-desc => ['me.modified']},
-                 rows => 1,
-                 page => 1
-                }
-                )->single();
-    my $bin_max_last_modified = $schema->resultset('BinAssociation')->
-       search_rs({suite => $suite_id},
-                {order_by => {-desc => ['me.modified']},
-                 rows => 1,
-                 page => 1
-                }
-                )->single();
-    print STDERR time." handling packages\n";
-    # prepare SQL
-    my $st = {};
-    my $dbi = $schema->storage()->dbh();
-    my %s =
-        (insert_correspondent => <<'EOF',
-WITH ins AS (
-INSERT INTO correspondent (addr) VALUES (?)
- ON CONFLICT (addr) DO NOTHING RETURNING id
-)
-SELECT id FROM ins
-UNION ALL
-SELECT id FROM correspondent WHERE addr = ?
-LIMIT 1;
-EOF
-         insert_maintainer => <<'EOF',
-WITH ins AS (
-INSERT INTO maintainer (name,correspondent) VALUES (?,?)
-ON CONFLICT (name) DO NOTHING RETURNING id
-)
-SELECT id FROM ins
-UNION ALL
-SELECT id FROM maintainer WHERE name = ?
-LIMIT 1;
-EOF
-         insert_correspondent_full_name => <<'EOF',
-WITH ins AS (
-INSERT INTO correspondent_full_name (correspondent,full_name)
-   VALUES (?,?) ON CONFLICT (correspondent,full_name) DO NOTHING RETURNING id
-)
-SELECT id FROM ins
-UNION ALL
-SELECT id FROM correspondent_full_name WHERE correspondent=? AND full_name = ?
-LIMIT 1;
-EOF
-         insert_src_pkg => <<'EOF',
-WITH ins AS (
-INSERT INTO src_pkg (pkg)
-   VALUES (?) ON CONFLICT (pkg,disabled) DO NOTHING RETURNING id
-)
-SELECT id FROM ins
-UNION ALL
-SELECT id FROM src_pkg where pkg = ? AND disabled = 'infinity'::timestamptz
-LIMIT 1;
-EOF
-         insert_src_ver => <<'EOF',
-INSERT INTO src_ver (src_pkg,ver,maintainer)
-   VALUES (?,?,?) ON CONFLICT (src_pkg,ver) DO
-     UPDATE SET maintainer = ?
-   RETURNING id;
-EOF
-         insert_src_associations => <<'EOF',
-INSERT INTO src_associations (suite,source)
-   VALUES (?,?) ON CONFLICT (suite,source) DO
-     UPDATE SET modified = NOW()
-RETURNING id;
-EOF
-        insert_bin_pkg => <<'EOF',
-WITH ins AS (
-INSERT INTO bin_pkg (pkg)
-VALUES (?) ON CONFLICT (pkg) DO NOTHING RETURNING id
-)
-SELECT id FROM ins
-UNION ALL
-SELECT id FROM bin_pkg where pkg = ?
-LIMIT 1;
-EOF
-        insert_bin_ver => <<'EOF',
-WITH ins AS (
-INSERT INTO bin_ver (bin_pkg,src_ver,arch,ver)
-VALUES (?,?,?,?) ON CONFLICT (bin_pkg,arch,ver) DO NOTHING RETURNING id
-)
-SELECT id FROM ins
-UNION ALL
-SELECT id FROM bin_ver WHERE bin_pkg = ? AND arch = ? AND ver = ?
-LIMIT 1;
-EOF
-        insert_bin_associations => <<'EOF',
-INSERT INTO bin_associations (suite,bin)
-   VALUES (?,?) ON CONFLICT (suite,bin) DO
-    UPDATE SET modified = NOW()
-   RETURNING id;
-EOF
-       );
-    _prepare_sql_statements($dbi,$st,\%s);
-    for my $pkg_tuple (@{$pkgs}) {
-       my ($arch,$component,$pkg) = @{$pkg_tuple};
-       $p->update() if $p;
-       sub _get_maintainer {
-           my ($addr,$dbi,$st,$schema) = @_;
-           my $rs =
-               $schema->resultset('Maintainer')->
-               search({name => $addr},
-                     {result_class => 'DBIx::Class::ResultClass::HashRefInflator',
-                     }
-                     )->first();
-           if (defined $rs) {
-               return $rs->{id};
-           }
-           my @addrs = getparsedaddrs($addr // '');
-           my $m_id;
-           my $c_id;
-           if (@addrs) {
-               $c_id = _select_one($dbi,$st,
-                                   'insert_correspondent',
-                                   lc($addrs[0]->address()),
-                                   lc($addrs[0]->address()),
-                                  );
-               my $full_name = $addrs[0]->phrase();
-               $full_name =~ s/^\"|\"$//g;
-               $full_name =~ s/^\s+|\s+$//g;
-               _select_one($dbi,$st,
-                           'insert_correspondent_full_name',
-                           $c_id,
-                           $full_name,
-                           $c_id,
-                           $full_name,
-                          );
+       search_rs({suite => $suite_id})->
+       update({modified => 'NOW()'});
+    ## Handle binary packages
+    my @bin_to_del;
+    my @bin_to_add;
+    my %included_bin;
+    # calculate which binary packages are no longer in this suite
+    for my $b ($schema->resultset('BinPkg')->
+              bin_pkg_and_ver_in_suite($suite)) {
+       if (not exists $bins{$b->{arch}{arch}} or
+           not exists $bins{$b->{arch}{arch}}{$b->{pkg}} or
+           ($bins{$b->{arch}{arch}}{$b->{pkg}}{bin_ver} ne
+            $b->{bin_vers}{ver}
+           )
+          ) {
+           push @bin_to_del,
+               $b->{bin_associations}{id};
+       }
+       $included_bin{$b->{arch}{arch}}{$b->{pkg}} =
+           $b->{bin_vers}{ver};
+    }
+    # calculate which binary packages are newly in this suite
+    for my $a (keys %bins) {
+       for my $pkg (keys %{$bins{$a}}) {
+           if (not exists $included_bin{$a} or
+               not exists $included_bin{$a}{$pkg} or
+               $bins{$a}{$pkg}{bin_ver} ne
+               $included_bin{$a}{$pkg}) {
+               push @bin_to_add,
+                   $bins{$a}{$pkg};
+           } else {
+               $p->update() if defined $p;
            }
-           $m_id =
-               _select_one($dbi,$st,
-                           'insert_maintainer',
-                           $addr,
-                           $c_id,
-                           $addr,
-                          );
-           return $m_id;
        }
-       if ($arch eq 'source') {
-           my $source = $pkg->{Package};
-           my $source_ver = $pkg->{Version};
-           if (not exists $maint_cache{$pkg->{Maintainer}}) {
-               $maint_cache{$pkg->{Maintainer}} =
-                   _get_maintainer($pkg->{Maintainer},$dbi,$st,$schema);
+    }
+    $it = natatime 100, @bin_to_add;
+    while (my @v = $it->()) {
+       $schema->txn_do(
+       sub {
+           for my $bvm (@_) {
+               my $s_id = $schema->resultset('SrcPkg')->
+                   get_src_pkg_id($bvm->{source});
+               my $sv_id = $schema->resultset('SrcVer')->
+                   get_src_ver_id($s_id,$bvm->{src_ver},$maints->{$bvm->{maint}});
+               my $b_id = $schema->resultset('BinPkg')->
+                   get_bin_pkg_id($bvm->{bin});
+               my $bv_id = $schema->resultset('BinVer')->
+                   get_bin_ver_id($b_id,$bvm->{bin_ver},
+                                  $archs->{$bvm->{arch}},$sv_id);
+               $schema->resultset('BinAssociation')->
+                   insert_suite_bin_ver_association($suite_id,$bv_id);
            }
-           if (not exists $source_cache{$source}{$source_ver}) {
-            my $sp_id =
-                _select_one($dbi,$st,'insert_src_pkg',
-                            $source,
-                            $source,
-                           );
-            my $sv_id =
-                _select_one($dbi,$st,'insert_src_ver',
-                            $sp_id,
-                            $source_ver,
-                            $maint_cache{$pkg->{Maintainer}},
-                            $maint_cache{$pkg->{Maintainer}});
-            $source_cache{$source}{$source_ver} = $sv_id;
-        }
-           _select_one($dbi,$st,'insert_src_associations',
-                       $suite_id,
-                       $source_cache{$source}{$source_ver}
+       },
+                       @v
                       );
-       } else {
-           if (not exists $arch_cache{$arch}) {
-            my $ar = $schema->resultset('Arch')->
-                find_or_create(arch => $arch);
-            $arch_cache{$arch} = $ar->id;
-           }
-           my $bp =
-            _select_one($dbi,$st,
-                        'insert_bin_pkg',
-                        $pkg->{Package},
-                        $pkg->{Package},
-                       );
-           my $source = $pkg->{Source} // $pkg->{Package};
-           my $source_ver = $pkg->{Version};
-           if ($source =~ /^\s*(\S+) \(([^\)]+)\)\s*$/) {
-            ($source,$source_ver) = ($1,$2);
-           }
-           if (not exists $source_cache{$source}{$source_ver}) {
-            my $sp_id =
-                _select_one($dbi,$st,'insert_src_pkg',
-                            $source,
-                            $source,
-                           );
-            if (not exists $maint_cache{$pkg->{Maintainer}}) {
-                $maint_cache{$pkg->{Maintainer}} =
-                    _get_maintainer($pkg->{Maintainer},$dbi,$st,$schema);
-            }
-            my $sv_id =
-                _select_one($dbi,$st,'insert_src_ver',
-                            $sp_id,
-                            $source_ver,
-                            $maint_cache{$pkg->{Maintainer}},
-                            $maint_cache{$pkg->{Maintainer}});
-            $source_cache{$source}{$source_ver} = $sv_id;
-           }
-           my $bv =
-            _select_one($dbi,$st,'insert_bin_ver',
-                        $bp,
-                        $source_cache{$source}{$source_ver},
-                        $arch_cache{$arch},
-                        $pkg->{Version},
-                        $bp,
-                        $arch_cache{$arch},
-                        $pkg->{Version},
-                       );
-        my $ba =
-            _select_one($dbi,$st,'insert_bin_associations',
-                        $suite_id,
-                        $bv,
-                       );
-       }
+       $p->update($p->last_update()+
+                  scalar @v) if defined $p;
     }
-    print STDERR time." deleting associations\n";
-    # delete old binary associations in this suite which have not recently been
-    # modified
-    $schema->resultset('BinAssociation')->
-        search_rs({suite => $suite_id,
-                   modified => {'<',$bin_max_last_modified->modified()},
-                  }) if defined
-                      $bin_max_last_modified;
-    $schema->resultset('SrcAssociation')->
-        search_rs({suite => $suite_id,
-                   modified => {'<',$src_max_last_modified->modified()},
-                  }) if defined
-                      $src_max_last_modified;
-}
-
-sub _select_one {
-    my ($dbh,$sth,$s,@bind_vals) = @_;
-    if (not defined $sth->{$s}) {
-        die "No such statement '$s'";
+    if (@bin_to_del) {
+       $schema->resultset('BinAssociation')->
+           search_rs({id => \@bin_to_del})->delete();
     }
-    $sth->{$s}->execute(@bind_vals) or
-        die "Unable to select one: ".$dbh->errstr();
-    my $results = $sth->{$s}->fetchall_arrayref([0]);
-    $sth->{$s}->finish();
-    return (ref($results) and ref($results->[0]))?$results->[0][0]:undef;
-}
+    $schema->resultset('BinAssociation')->
+       search_rs({suite => $suite_id})->
+       update({modified => 'NOW()'});
 
-sub _prepare_sql_statements {
-    my ($dbi,$st,$s) = @_;
-    for my $key (keys %{$s}) {
-        $st->{$key} = $dbi->prepare($s->{$key}) //
-            die "Unable to prepare sql statement: ".$dbi->errstr;
-    }
 }
 
 
diff --git a/Debbugs/DB/ResultSet/Arch.pm b/Debbugs/DB/ResultSet/Arch.pm
new file mode 100644 (file)
index 0000000..d0e6aa2
--- /dev/null
@@ -0,0 +1,56 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2016 by Don Armstrong <don@donarmstrong.com>.
+use utf8;
+package Debbugs::DB::ResultSet::Arch;
+
+=head1 NAME
+
+Debbugs::DB::ResultSet::Arch - Architecture result set operations
+
+=head1 SYNOPSIS
+
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::ResultSet';
+
+# required for hash slices
+use v5.20;
+
+sub get_archs {
+    my ($self,@archs) = @_;
+    my %archs;
+    for my $a ($self->result_source->schema->resultset('Arch')->
+              search(undef,
+                    {result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+                     columns => [qw[id arch]],
+                    })->all()) {
+       $archs{$a->{arch}} = $a->{id};
+    }
+    for my $a (grep {not exists $archs{$_}} @archs) {
+       $archs{$a} =
+           $self->result_source->schema->resultset('Arch')->
+           find_or_create({arch => $a},
+                         {result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+                          columns => [qw[id arch]],
+                         }
+                         )->{id};
+    }
+
+    return {%archs{@archs}};
+}
+
+
+1;
+
+__END__
diff --git a/Debbugs/DB/ResultSet/BinAssociation.pm b/Debbugs/DB/ResultSet/BinAssociation.pm
new file mode 100644 (file)
index 0000000..5756199
--- /dev/null
@@ -0,0 +1,48 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
+use utf8;
+package Debbugs::DB::ResultSet::BinAssociation;
+
+=head1 NAME
+
+Debbugs::DB::ResultSet::BinAssociation - Binary/Suite Associations
+
+=head1 SYNOPSIS
+
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::ResultSet';
+
+use Debbugs::DB::Util qw(select_one);
+
+
+sub insert_suite_bin_ver_association {
+    my ($self,$suite_id,$bin_ver_id) = @_;
+    return $self->result_source->schema->storage->
+       dbh_do(sub {
+                  my ($s,$dbh,$s_id,$bv_id) = @_;
+                  return select_one($dbh,<<'SQL',$s_id,$bv_id);
+INSERT INTO bin_associations (suite,bin)
+   VALUES (?,?) ON CONFLICT (suite,bin) DO
+    UPDATE SET modified = NOW()
+   RETURNING id;
+SQL
+              },
+              $suite_id,$bin_ver_id
+             );
+}
+
+1;
+
+__END__
diff --git a/Debbugs/DB/ResultSet/BinPkg.pm b/Debbugs/DB/ResultSet/BinPkg.pm
new file mode 100644 (file)
index 0000000..b89cb40
--- /dev/null
@@ -0,0 +1,66 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
+use utf8;
+package Debbugs::DB::ResultSet::BinPkg;
+
+=head1 NAME
+
+Debbugs::DB::ResultSet::BinPkg - Source Package
+
+=head1 SYNOPSIS
+
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::ResultSet';
+
+use Debbugs::DB::Util qw(select_one);
+
+sub bin_pkg_and_ver_in_suite {
+    my ($self,$suite) = @_;
+    $suite = $self->result_source->schema->
+       resultset('Suite')->get_suite_id($suite);
+    return
+       $self->search_rs({'bin_associations.suite' => $suite,
+                        },
+                       {join => {bin_vers => ['bin_associations','arch']},
+                        result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+                        columns => [qw(me.pkg  bin_vers.ver arch.arch bin_associations.id)]
+                       },
+                       )->all;
+}
+
+
+sub get_bin_pkg_id {
+    my ($self,$pkg) = @_;
+    return $self->result_source->schema->storage->
+       dbh_do(sub {
+                  my ($s,$dbh,$bin_pkg) = @_;
+                  return select_one($dbh,<<'SQL',$bin_pkg,$bin_pkg);
+WITH ins AS (
+INSERT INTO bin_pkg (pkg)
+VALUES (?) ON CONFLICT (pkg) DO NOTHING RETURNING id
+)
+SELECT id FROM ins
+UNION ALL
+SELECT id FROM bin_pkg where pkg = ?
+LIMIT 1;
+SQL
+              },
+              $pkg
+             );
+}
+
+1;
+
+__END__
diff --git a/Debbugs/DB/ResultSet/BinVer.pm b/Debbugs/DB/ResultSet/BinVer.pm
new file mode 100644 (file)
index 0000000..fcd8b59
--- /dev/null
@@ -0,0 +1,56 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
+use utf8;
+package Debbugs::DB::ResultSet::BinVer;
+
+=head1 NAME
+
+Debbugs::DB::ResultSet::BinVer - Source Version association
+
+=head1 SYNOPSIS
+
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::ResultSet';
+
+use Debbugs::DB::Util qw(select_one);
+
+
+sub get_bin_ver_id {
+    my ($self,$bin_pkg_id,$bin_ver,$arch_id,$src_ver_id) = @_;
+    return $self->result_source->schema->storage->
+       dbh_do(sub {
+                  my ($s,$dbh,$bp_id,$bv,$a_id,$sv_id) = @_;
+                  return select_one($dbh,<<'SQL',
+WITH ins AS (
+INSERT INTO bin_ver (bin_pkg,src_ver,arch,ver)
+VALUES (?,?,?,?) ON CONFLICT (bin_pkg,arch,ver) DO NOTHING RETURNING id
+)
+SELECT id FROM ins
+UNION ALL
+SELECT id FROM bin_ver WHERE bin_pkg = ? AND arch = ? AND ver = ?
+LIMIT 1;
+SQL
+                                    $bp_id,$sv_id,
+                                    $a_id,$bv,
+                                    $bp_id,$a_id,
+                                    $bv);
+              },
+              $bin_pkg_id,$bin_ver,$arch_id,$src_ver_id
+             );
+}
+
+1;
+
+__END__
diff --git a/Debbugs/DB/ResultSet/Correspondent.pm b/Debbugs/DB/ResultSet/Correspondent.pm
new file mode 100644 (file)
index 0000000..7638a52
--- /dev/null
@@ -0,0 +1,86 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
+use utf8;
+package Debbugs::DB::ResultSet::Correspondent;
+
+=head1 NAME
+
+Debbugs::DB::ResultSet::Correspondent - Correspondent table actions
+
+=head1 SYNOPSIS
+
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::ResultSet';
+
+use Debbugs::DB::Util qw(select_one);
+
+use Debbugs::Common qw(getparsedaddrs);
+use Debbugs::DB::Util qw(select_one);
+
+sub get_correspondent_id {
+    my ($self,$addr) = @_;
+    my $full_name;
+    if ($addr =~ /</) {
+       $addr = getparsedaddrs($addr);
+       $full_name = $addr->phrase();
+       $full_name =~ s/^\"|\"$//g;
+       $full_name =~ s/^\s+|\s+$//g;
+       $addr = $addr->address();
+    }
+    my $rs =
+       $self->
+       search({addr => $addr},
+             {result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+             }
+             )->first();
+    if (defined $rs) {
+       return $rs->{id};
+    }
+    return $self->result_source->schema->storage->
+       dbh_do(sub {
+                  my ($s,$dbh,$addr,$full_name) = @_;
+                  my $ci = select_one($dbh,<<'SQL',$addr,$addr);
+WITH ins AS (
+INSERT INTO correspondent (addr) VALUES (?)
+ ON CONFLICT (addr) DO NOTHING RETURNING id
+)
+SELECT id FROM ins
+UNION ALL
+SELECT id FROM correspondent WHERE addr = ?
+LIMIT 1;
+SQL
+                  select_one($dbh,<<'SQL',$ci,$full_name,$ci,$full_name);
+WITH ins AS (
+INSERT INTO correspondent_full_name (correspondent,full_name)
+   VALUES (?,?) ON CONFLICT (correspondent,full_name) DO NOTHING RETURNING id
+)
+SELECT id FROM ins
+UNION ALL
+SELECT id FROM correspondent_full_name WHERE correspondent=? AND full_name = ?
+LIMIT 1;
+SQL
+                  return $ci;
+},
+              $addr,
+              $full_name
+             );
+
+}
+
+
+
+1;
+
+__END__
diff --git a/Debbugs/DB/ResultSet/Maintainer.pm b/Debbugs/DB/ResultSet/Maintainer.pm
new file mode 100644 (file)
index 0000000..280a6e5
--- /dev/null
@@ -0,0 +1,90 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2016 by Don Armstrong <don@donarmstrong.com>.
+use utf8;
+package Debbugs::DB::ResultSet::Maintainer;
+
+=head1 NAME
+
+Debbugs::DB::ResultSet::Maintainer - Package maintainer result set operations
+
+=head1 SYNOPSIS
+
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::ResultSet';
+
+use Debbugs::DB::Util qw(select_one);
+
+
+
+sub get_maintainers {
+    my ($self,@maints) = @_;
+    my %maints;
+    for my $m ($self->result_source->schema->resultset('Maintainer')->
+              search(undef,
+                    {result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+                     columns => [qw[id name] ]
+                    })->all()) {
+       $maints{$m->{name}} = $m->{id};
+    }
+    my @maint_names = grep {not exists $maints{$_}} @maints;
+    my @maint_ids = $self->result_source->schema->
+       txn_do(sub {
+                  my @ids;
+                  for my $name (@_) {
+                      push @ids,
+                          $self->result_source->schema->
+                          resultset('Maintainer')->get_maintainer_id($name);
+                  }
+                  return @ids;
+              },@maint_names);
+    @maints{@maint_names} = @maint_ids;
+    return \%maints;
+}
+
+sub get_maintainer_id {
+    my ($self,$maint) = @_;
+    my $rs =
+       $self->
+       search({name => $maint},
+             {result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+             }
+             )->first();
+    if (defined $rs) {
+       return $rs->{id};
+    }
+    my $ci =
+       $self->result_source->schema->resultset('Correspondent')->
+       get_correspondent_id($maint);
+    return $self->result_source->schema->storage->
+       dbh_do(sub {
+                  my ($s,$dbh,$maint,$ci) = @_;
+                  return select_one($dbh,<<'SQL',$maint,$ci,$maint);
+WITH ins AS (
+INSERT INTO maintainer (name,correspondent) VALUES (?,?)
+ON CONFLICT (name) DO NOTHING RETURNING id
+)
+SELECT id FROM ins
+UNION ALL
+SELECT id FROM maintainer WHERE name = ?
+LIMIT 1;
+SQL
+              },
+              $maint,$ci
+             );
+}
+
+1;
+
+__END__
diff --git a/Debbugs/DB/ResultSet/SrcAssociation.pm b/Debbugs/DB/ResultSet/SrcAssociation.pm
new file mode 100644 (file)
index 0000000..047c54d
--- /dev/null
@@ -0,0 +1,48 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
+use utf8;
+package Debbugs::DB::ResultSet::SrcAssociation;
+
+=head1 NAME
+
+Debbugs::DB::ResultSet::SrcAssociation - Source/Suite Associations
+
+=head1 SYNOPSIS
+
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::ResultSet';
+
+use Debbugs::DB::Util qw(select_one);
+
+
+sub insert_suite_src_ver_association {
+    my ($self,$suite_id,$src_ver_id) = @_;
+    return $self->result_source->schema->storage->
+       dbh_do(sub {
+                  my ($s,$dbh,$suite_id,$src_ver_id) = @_;
+                  return select_one($dbh,<<'SQL',$suite_id,$src_ver_id);
+INSERT INTO src_associations (suite,source)
+   VALUES (?,?) ON CONFLICT (suite,source) DO
+     UPDATE SET modified = NOW()
+RETURNING id;
+SQL
+              },
+              $suite_id,$src_ver_id
+             );
+}
+
+1;
+
+__END__
diff --git a/Debbugs/DB/ResultSet/SrcPkg.pm b/Debbugs/DB/ResultSet/SrcPkg.pm
new file mode 100644 (file)
index 0000000..c9db9a4
--- /dev/null
@@ -0,0 +1,82 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
+use utf8;
+package Debbugs::DB::ResultSet::SrcPkg;
+
+=head1 NAME
+
+Debbugs::DB::ResultSet::SrcPkg - Source Package
+
+=head1 SYNOPSIS
+
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::ResultSet';
+
+use Debbugs::DB::Util qw(select_one);
+
+sub src_pkg_and_ver_in_suite {
+    my ($self,$suite) = @_;
+    if (ref($suite)) {
+       if (ref($suite) eq 'HASH') {
+           $suite = $suite->{id}
+       } else {
+          $suite = $suite->id();
+       }
+    } else {
+       if ($suite !~ /^\d+$/) {
+           $suite = $self->result_source->schema->
+               resultset('Suite')->
+               search_rs({codename => $suite},
+                        {result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+                        })->first();
+           if (defined $suite) {
+               $suite = $suite->{id};
+           }
+       }
+    }
+    return
+       $self->search_rs({'src_associations.suite' => $suite,
+                        },
+                       {join => {src_vers => 'src_associations'},
+                        result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+                        columns => [qw(me.pkg src_vers.ver src_associations.id)]
+                       },
+                       )->all;
+}
+
+
+sub get_src_pkg_id {
+    my ($self,$source) = @_;
+    return $self->result_source->schema->storage->
+       dbh_do(sub {
+                  my ($s,$dbh,$source) = @_;
+                  return select_one($dbh,<<'SQL',$source,$source);
+WITH ins AS (
+INSERT INTO src_pkg (pkg)
+   VALUES (?) ON CONFLICT (pkg,disabled) DO NOTHING RETURNING id
+)
+SELECT id FROM ins
+UNION ALL
+SELECT id FROM src_pkg where pkg = ? AND disabled = 'infinity'::timestamptz
+LIMIT 1;
+SQL
+              },
+              $source
+             );
+}
+
+1;
+
+__END__
diff --git a/Debbugs/DB/ResultSet/SrcVer.pm b/Debbugs/DB/ResultSet/SrcVer.pm
new file mode 100644 (file)
index 0000000..254816c
--- /dev/null
@@ -0,0 +1,50 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
+use utf8;
+package Debbugs::DB::ResultSet::SrcVer;
+
+=head1 NAME
+
+Debbugs::DB::ResultSet::SrcVer - Source Version association
+
+=head1 SYNOPSIS
+
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::ResultSet';
+
+use Debbugs::DB::Util qw(select_one);
+
+
+sub get_src_ver_id {
+    my ($self,$src_pkg_id,$src_ver,$maint_id) = @_;
+    return $self->result_source->schema->storage->
+       dbh_do(sub {
+                  my ($s,$dbh,$src_pkg_id,$src_ver,$maint_id) = @_;
+                  return select_one($dbh,<<'SQL',
+INSERT INTO src_ver (src_pkg,ver,maintainer)
+   VALUES (?,?,?) ON CONFLICT (src_pkg,ver) DO
+     UPDATE SET maintainer = ?
+   RETURNING id;
+SQL
+                                    $src_pkg_id,$src_ver,
+                                    $maint_id,$maint_id);
+              },
+              $src_pkg_id,$src_ver,$maint_id
+             );
+}
+
+1;
+
+__END__
diff --git a/Debbugs/DB/ResultSet/Suite.pm b/Debbugs/DB/ResultSet/Suite.pm
new file mode 100644 (file)
index 0000000..c920080
--- /dev/null
@@ -0,0 +1,53 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
+use utf8;
+package Debbugs::DB::ResultSet::Suite;
+
+=head1 NAME
+
+Debbugs::DB::ResultSet::Suite - Suite table actions
+
+=head1 SYNOPSIS
+
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::ResultSet';
+
+sub get_suite_id {
+    my ($self,$suite) = @_;
+    if (ref($suite)) {
+       if (ref($suite) eq 'HASH') {
+           $suite = $suite->{id}
+       } else {
+           $suite = $suite->id();
+       }
+    }
+    else {
+       if ($suite !~ /^\d+$/) {
+           $suite = $self->result_source->schema->
+               resultset('Suite')->
+               search_rs({codename => $suite},
+                        {result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+                        })->first();
+           if (defined $suite) {
+               $suite = $suite->{id};
+           }
+       }
+    }
+    return $suite;
+}
+
+1;
+
+__END__
diff --git a/Debbugs/DB/Util.pm b/Debbugs/DB/Util.pm
new file mode 100644 (file)
index 0000000..5565244
--- /dev/null
@@ -0,0 +1,76 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
+
+package Debbugs::DB::Util;
+
+=head1 NAME
+
+Debbugs::DB::Util -- Utility routines for the database
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+
+=head1 BUGS
+
+None known.
+
+=cut
+
+use warnings;
+use strict;
+use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
+use base qw(Exporter);
+
+BEGIN{
+     ($VERSION) = q$Revision$ =~ /^Revision:\s+([^\s+])/;
+     $DEBUG = 0 unless defined $DEBUG;
+
+     @EXPORT = ();
+     %EXPORT_TAGS = (select => [qw(select_one)],
+                   );
+     @EXPORT_OK = ();
+     Exporter::export_ok_tags(keys %EXPORT_TAGS);
+     $EXPORT_TAGS{all} = [@EXPORT_OK];
+}
+
+=head2 select
+
+Routines for select requests
+
+=over
+
+=item select_one
+
+       select_one($dbh,$sql,@bind_vals)
+
+Returns the first column from the first row returned from a select statement
+
+=cut
+
+sub select_one {
+    my ($dbh,$sql,@bind_vals) = @_;
+    my $sth = $dbh->
+        prepare_cached($sql,
+                      {dbi_dummy => __FILE__.__LINE__ })
+        or die "Unable to prepare statement: $sql";
+    $sth->execute(@bind_vals) or
+        die "Unable to select one: ".$dbh->errstr();
+    my $results = $sth->fetchall_arrayref([0]);
+    $sth->finish();
+    return (ref($results) and ref($results->[0]))?$results->[0][0]:undef;
+}
+
+
+=back
+
+=cut
+
+1;
+
+
+__END__
index e9b62ef9016ed7b9d5620d32c58fc00894d7e040..957d190ff3a19134b5cefd28100f70de508cf9e8 100755 (executable)
@@ -543,7 +543,6 @@ sub add_packages {
     my $completed_pkgs=0;
     # parse packages files
     for my $suite (keys %s_p) {
-       print STDERR "working on $suite\n";
        my @pkgs;
        for my $component (keys %{$s_p{$suite}}) {
            my @archs = keys %{$s_p{$suite}{$component}};
@@ -573,12 +572,10 @@ sub add_packages {
        }
         $p->target($avg_pkgs*($tot_suites-$done_suites-1)+
                   $completed_pkgs+@pkgs) if $p;
-       $s->txn_do(sub {
-                      Debbugs::DB::Load::load_packages($s,
-                                                       $suite,
-                                                       \@pkgs,
-                                                       $p)
-                      });
+       load_packages($s,
+                     $suite,
+                     \@pkgs,
+                     $p);
        $avg_pkgs=($avg_pkgs*$done_suites + @pkgs)/($done_suites+1);
        $completed_pkgs += @pkgs;
        $done_suites++;