From: Don Armstrong Date: Sat, 25 Feb 2017 23:43:34 +0000 (-0800) Subject: load_packages now only changes rows it has to X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=59b992d70a956b900026e5dd6e19b01fa3b4b6bd;p=debbugs.git load_packages now only changes rows it has to - Use ResultSet operations to do most of the insertion - Add select_one routine to Debbugs::DB::Util --- diff --git a/Debbugs/DB/Load.pm b/Debbugs/DB/Load.pm index 9af8b56e..f583f51b 100644 --- a/Debbugs/DB/Load.pm +++ b/Debbugs/DB/Load.pm @@ -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 index 00000000..d0e6aa21 --- /dev/null +++ b/Debbugs/DB/ResultSet/Arch.pm @@ -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 . +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 index 00000000..5756199f --- /dev/null +++ b/Debbugs/DB/ResultSet/BinAssociation.pm @@ -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 . +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 index 00000000..b89cb40f --- /dev/null +++ b/Debbugs/DB/ResultSet/BinPkg.pm @@ -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 . +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 index 00000000..fcd8b59d --- /dev/null +++ b/Debbugs/DB/ResultSet/BinVer.pm @@ -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 . +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 index 00000000..7638a522 --- /dev/null +++ b/Debbugs/DB/ResultSet/Correspondent.pm @@ -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 . +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 =~ /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 index 00000000..280a6e5a --- /dev/null +++ b/Debbugs/DB/ResultSet/Maintainer.pm @@ -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 . +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 index 00000000..047c54de --- /dev/null +++ b/Debbugs/DB/ResultSet/SrcAssociation.pm @@ -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 . +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 index 00000000..c9db9a42 --- /dev/null +++ b/Debbugs/DB/ResultSet/SrcPkg.pm @@ -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 . +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 index 00000000..254816cb --- /dev/null +++ b/Debbugs/DB/ResultSet/SrcVer.pm @@ -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 . +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 index 00000000..c920080f --- /dev/null +++ b/Debbugs/DB/ResultSet/Suite.pm @@ -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 . +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 index 00000000..55652441 --- /dev/null +++ b/Debbugs/DB/Util.pm @@ -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 . + +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__ diff --git a/bin/debbugs-loadsql b/bin/debbugs-loadsql index e9b62ef9..957d190f 100755 --- a/bin/debbugs-loadsql +++ b/bin/debbugs-loadsql @@ -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++;