X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FDB%2FLoad.pm;h=03ab770636eb8ec3a1d554ad78815f1f17794d8f;hb=466f7faff129a5699c7674f59900a92aa256175d;hp=9af8b56e74439d05aa4b3ca84878334b1ab60b66;hpb=51b1ce55975fd092354f28b92942eaa39640063d;p=debbugs.git diff --git a/Debbugs/DB/Load.pm b/Debbugs/DB/Load.pm index 9af8b56..03ab770 100644 --- a/Debbugs/DB/Load.pm +++ b/Debbugs/DB/Load.pm @@ -23,6 +23,7 @@ None known. use warnings; use strict; +use v5.10; use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); use base qw(Exporter); @@ -33,7 +34,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,12 +43,15 @@ BEGIN{ } use Params::Validate qw(validate_with :types); +use List::AllUtils qw(natatime); use Debbugs::Status qw(read_bug split_status_fields); use Debbugs::DB; use DateTime; use Debbugs::Common qw(make_list getparsedaddrs); use Debbugs::Config qw(:config); +use Debbugs::MIME qw(parse_to_mime_entity decode_rfc1522); +use DateTime::Format::Mail; use Carp; =head2 Bug loading @@ -98,6 +102,10 @@ sub load_bug { }, queue => {type => HASHREF, optional => 1}, + packages => {type => HASHREF, + default => sub {return {}}, + optional => 1, + }, }); my $s = $param{db}; if (not exists $param{data} and not exists $param{bug}) { @@ -116,8 +124,8 @@ sub load_bug { $queue = {}; } my %tags; - my $s_data = split_status_fields($data); - for my $tag (make_list($s_data->{keywords})) { + $data = split_status_fields($data); + for my $tag (make_list($data->{keywords})) { next unless defined $tag and length $tag; # this allows for invalid tags. But we'll use this to try to # find those bugs and clean them up @@ -127,20 +135,23 @@ sub load_bug { } $tags{$tag} = $tags->{$tag}; } - my $severity = length($data->{severity}) ? $data->{severity} : $config{default_severity}; - if (exists $severities->{$severity}) { - $severity = $severities->{$severity}; - } else { - $severity = $s->resultset('Severity')-> - find_or_create({severity => $severity}); + my $severity = length($data->{severity}) ? $data->{severity} : + $config{default_severity}; + if (not exists $severities->{$severity}) { + $severities->{$severity} = + $s->resultset('Severity')-> + find_or_create({severity => $severity}, + ); } + $severity = $severities->{$severity}; my $bug = {id => $data->{bug_num}, creation => DateTime->from_epoch(epoch => $data->{date}), log_modified => DateTime->from_epoch(epoch => $data->{log_modified}), last_modified => DateTime->from_epoch(epoch => $data->{last_modified}), archived => $data->{archived}, - (defined $data->{unarchived} and length($data->{unarchived}))?(unarchived => DateTime->from_epoch(epoch => $data->{unarchived})):(), + (defined $data->{unarchived} and length($data->{unarchived}))? + (unarchived => DateTime->from_epoch(epoch => $data->{unarchived})):(), forwarded => $data->{forwarded} // '', summary => $data->{summary} // '', outlook => $data->{outlook} // '', @@ -156,28 +167,60 @@ sub load_bug { submitter => 'originator', ); for my $addr_type (keys %addr_map) { - my @addrs = getparsedaddrs($data->{$addr_map{$addr_type}} // ''); - next unless @addrs; - $bug->{$addr_type} = $s->resultset('Correspondent')->find_or_create({addr => lc($addrs[0]->address())}); - # insert the full name as well - my $full_name = $addrs[0]->phrase(); - $full_name =~ s/^\"|\"$//g; - $full_name =~ s/^\s+|\s+$//g; - if (length $full_name) { - $bug->{$addr_type}-> - update_or_create_related('correspondent_full_names', - {full_name=>$full_name, - last_seen => 'NOW()'}); - } + $bug->{$addr_type} = undef; + next unless defined $data->{$addr_map{$addr_type}} and + length($data->{$addr_map{$addr_type}}); + $bug->{$addr_type} = + $s->resultset('Correspondent')-> + get_correspondent_id($data->{$addr_map{$addr_type}}) } my $b = $s->resultset('Bug')->update_or_create($bug) or die "Unable to update or create bug $bug->{id}"; - $s->txn_do(sub { - for my $ff (qw(found fixed)) { + $s->txn_do(sub { + my @unknown_packages; + my @unknown_affects_packages; + push @unknown_packages, + $b->set_related_packages('binpackages', + [grep {defined $_ and + length $_ and $_ !~ /^src:/} + make_list($data->{package})], + $param{packages}, + ); + push @unknown_packages, + $b->set_related_packages('srcpackages', + [map {s/src://; + $_} + grep {defined $_ and + $_ =~ /^src:/} + make_list($data->{package})], + $param{packages}, + ); + push @unknown_affects_packages, + $b->set_related_packages('affects_binpackages', + [grep {defined $_ and + length $_ and $_ !~ /^src:/} + make_list($data->{affects}) + ], + $param{packages}, + ); + push @unknown_affects_packages, + $b->set_related_packages('affects_srcpackages', + [map {s/src://; + $_} + grep {defined $_ and + $_ =~ /^src:/} + make_list($data->{affects})], + $param{packages}, + ); + $b->unknown_packages(join(', ',@unknown_packages)); + $b->unknown_affects(join(', ',@unknown_affects_packages)); + $b->update(); + for my $ff (qw(found fixed)) { my @elements = $s->resultset('BugVer')->search({bug => $data->{bug_num}, found => $ff eq 'found'?1:0, }); - my %elements_to_delete = map {($elements[$_]->ver_string(),$elements[$_])} 0..$#elements; + my %elements_to_delete = map {($elements[$_]->ver_string(), + $elements[$_])} 0..$#elements; my %elements_to_add; my @elements_to_keep; for my $version (@{$data->{"${ff}_versions"}}) { @@ -214,27 +257,27 @@ sub load_bug { } } }); - $s->txn_do(sub { - my $t = $s->resultset('BugTag')->search({bug => $data->{bug_num}}); - $t->delete() if defined $t; - $s->populate(BugTag => [[qw(bug tag)], map {[$data->{bug_num}, $_->id()]} values %tags]); - }); + ### set bug tags + $s->txn_do(sub {$b->set_tags([values %tags ] )}); # because these bugs reference other bugs which might not exist # yet, we can't handle them until we've loaded all bugs. queue # them up. - for my $merge_block (qw(merged block)) { - my $data_key = $merge_block; - $data_key .= 'with' if $merge_block eq 'merged'; - if (@{$data->{$data_key}||[]}) { - my $count = $s->resultset('Bug')->search({id => [@{$data->{$data_key}}]})->count(); - if ($count == @{$data->{$data_key}}) { - handle_load_bug_queue(db=>$s, - queue => {$merge_block, - {$data->{bug_num},[@{$data->{$data_key}}]} - }); - } else { - $queue->{$merge_block}{$data->{bug_num}} = [@{$data->{$data_key}}]; - } + for my $merge_block (qw(mergedwith blocks)) { + my $count = 0; + if (@{$data->{$merge_block}}) { + $count = + $s->resultset('Bug')-> + search({id => [@{$data->{$merge_block}}]})-> + count(); + } + # if all of the bugs exist, immediately fix the merge/blocks + if ($count == @{$data->{$merge_block}}) { + handle_load_bug_queue(db=>$s, + queue => {$merge_block, + {$data->{bug_num},[@{$data->{$merge_block}}]} + }); + } else { + $queue->{$merge_block}{$data->{bug_num}} = [@{$data->{$merge_block}}]; } } @@ -266,26 +309,33 @@ sub handle_load_bug_queue{ my $s = $param{db}; my $queue = $param{queue}; my %queue_types = - (merged => {set => 'BugMerged', - columns => [qw(bug merged)], - bug => 'bug', - }, + (mergedwith => {set => 'BugMerged', + columns => [qw(bug merged)], + bug => 'bug', + }, blocks => {set => 'BugBlock', - columns => [qw(bug blocks)], - bug => 'bug', - }, + columns => [qw(bug blocks)], + bug => 'bug', + }, ); for my $queue_type (keys %queue_types) { - for my $bug (%{$queue->{$queue_type}}) { - my $qt = $queue_types{$queue_type}; - $s->txn_do(sub { - $s->resultset($qt->{set})->search({$qt->{bug},$bug})->delete(); - $s->populate($qt->{set},[[@{$qt->{columns}}], - map {[$bug,$_]} @{$queue->{$queue_type}{$bug}}]) if - @{$queue->{$queue_type}{$bug}//[]}; + my $qt = $queue_types{$queue_type}; + my @bugs = keys %{$queue->{$queue_type}}; + next unless @bugs; + my @entries; + for my $bug (@bugs) { + push @entries, + map {[$bug,$_]} + @{$queue->{$queue_type}{$bug}}; + } + $s->txn_do(sub { + $s->resultset($qt->{set})-> + search({$qt->{bug}=>\@bugs})->delete(); + $s->resultset($qt->{set})-> + populate([[@{$qt->{columns}}], + @entries]) if @entries; } - ); - } + ); } } @@ -325,18 +375,84 @@ sub load_bug_log { next if defined $msg_id and exists $seen_msg_ids{$msg_id}; $seen_msg_ids{$msg_id} = 1 if defined $msg_id; next if defined $msg_id and $msg_id =~ /handler\..+\.ack(?:info)?\@/; - my $message = parse($record->{text}); + my $entity = parse_to_mime_entity($record); # search for a message with this message id in the database - - # check to see if the subject, to, and from match. if so, it's + $msg_id = $entity->head->get('Message-Id') // + $entity->head->get('Resent-Message-ID') // + ''; + $msg_id =~ s/^\s*\\s*$//; + # check to see if the subject, to, and from match. if so, it's # probably the same message. - - # if not, create a new message - - # add correspondents if necessary - + my $subject = decode_rfc1522($entity->head->get('Subject')//''); + $subject =~ s/\n(?:(\s)\s*|\s*$)//g; + my $to = decode_rfc1522($entity->head->get('To')//''); + $to =~ s/\n(?:(\s)\s*|\s*$)//g; + my $from = decode_rfc1522($entity->head->get('From')//''); + $from =~ s/\n(?:(\s)\s*|\s*$)//g; + my $m = $s->resultset('Message')-> + find({msgid => $msg_id, + from_complete => $from, + to_complete => $to, + subject => $subject + }); + if (not defined $m) { + # if not, create a new message + $m = $s->resultset('Message')-> + find_or_create({msgid => $msg_id, + from_complete => $from, + to_complete => $to, + subject => $subject + }); + eval { + my $date = DateTime::Format::Mail-> + parse_datetime($entity->head->get('Date',0)); + if (abs($date->offset) >= 60 * 60 * 12) { + $date = $date->set_time_zone('UTC'); + } + $m->sent_date($date); + }; + my $spam = $entity->head->get('X-Spam-Status',0)//''; + if ($spam=~ /score=([\d\.]+)/) { + $m->spam_score($1); + } + my %corr; + @{$corr{from}} = getparsedaddrs($from); + @{$corr{to}} = getparsedaddrs($to); + @{$corr{cc}} = getparsedaddrs($entity->head->get('Cc')); + # add correspondents if necessary + my @cors; + for my $type (keys %corr) { + for my $addr (@{$corr{$type}}) { + my $cor = $s->resultset('Correspondent')-> + get_correspondent_id($addr); + next unless defined $cor; + push @cors, + {correspondent => $cor, + correspondent_type => $type, + }; + } + } + $m->update(); + $s->txn_do(sub { + $m->message_correspondents()->delete(); + $m->add_to_message_correspondents(@cors) if + @cors; + } + ); + } + my $recv; + if ($entity->head->get('Received',0) + =~ /via spool by (\S+)/) { + $recv = $s->resultset('Correspondent')-> + get_correspondent_id($1); + $m->add_to_message_correspondents({correspondent=>$recv, + correspondent_type => 'recv'}); + } # link message to bugs if necessary - + $m->find_or_create_related('bug_messages', + {bug=>$param{bug}, + message_number => $msg_num}); } } @@ -358,23 +474,58 @@ Commands to handle src and package version loading from debinfo files =cut 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=>$sp->id(), - ver => $srcver}); - my $arch = $schema->resultset('Arch')->find_or_create({arch => $binarch}); - my $bp = $schema->resultset('BinPkg')->find_or_create({pkg => $binname}); - $schema->resultset('BinVer')->find_or_create({bin_pkg_id => $bp->id(), - src_ver_id => $sv->id(), - arch_id => $arch->id(), - ver => $binver, - }); + my ($s,$binname, $binver, $binarch, $srcname, $srcver,$ct_date,$cache) = @_; + $cache //= {}; + my $sp; + if (not defined $cache->{sp}{$srcname}) { + $cache->{sp}{$srcname} = + $s->resultset('SrcPkg')->find_or_create({pkg => $srcname}); + } + $sp = $cache->{sp}{$srcname}; + # update the creation date if the data we have is earlier + if (defined $ct_date and + (not defined $sp->creation or + $ct_date < $sp->creation)) { + $sp->creation($ct_date); + $sp->last_modified(DateTime->now); + $sp->update; + } + my $sv; + if (not defined $cache->{sv}{$srcname}{$srcver}) { + $cache->{sv}{$srcname}{$srcver} = + $s->resultset('SrcVer')-> + find_or_create({src_pkg =>$sp->id(), + ver => $srcver}); + } + $sv = $cache->{sv}{$srcname}{$srcver}; + if (defined $ct_date and + (not defined $sv->upload_date() or $ct_date < $sv->upload_date())) { + $sv->upload_date($ct_date); + $sv->update; + } + my $arch; + if (not defined $cache->{arch}{$binarch}) { + $cache->{arch}{$binarch} = + $s->resultset('Arch')-> + find_or_create({arch => $binarch}, + )->id(); + } + $arch = $cache->{arch}{$binarch}; + my $bp; + if (not defined $cache->{bp}{$binname}) { + $cache->{bp}{$binname} = + $s->resultset('BinPkg')-> + get_or_create_bin_pkg_id($binname); + } + $bp = $cache->{bp}{$binname}; + $s->resultset('BinVer')-> + get_bin_ver_id($bp,$binver,$arch,$sv->id()); } =back -=head Packages +=head2 Packages =over @@ -405,363 +556,174 @@ 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_or_create_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) { + $it = natatime 1000, @sa_to_del; + while (my @v = $it->()) { + $schema-> + txn_do(sub { + $schema->resultset('SrcAssociation')-> + search_rs({id => \@v})-> + 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_or_create_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_or_create_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) { + $it = natatime 1000, @bin_to_del; + while (my @v = $it->()) { + $schema-> + txn_do(sub { + $schema->resultset('BinAssociation')-> + search_rs({id => \@v})-> + 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; - } } @@ -769,7 +731,7 @@ sub _prepare_sql_statements { =cut -=head Suites +=head2 Suites =over @@ -803,3 +765,7 @@ sub load_suite { __END__ +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: