]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/DB/Load.pm
delete associations in a transaction by 1000
[debbugs.git] / Debbugs / DB / Load.pm
index d3328ecadc165ed7d30ac975782e2e4f7ab72419..a85a4ec28eaaa97a3876c1c9258aebbe8d070a27 100644 (file)
@@ -101,6 +101,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}) {
@@ -119,8 +123,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
@@ -162,14 +166,42 @@ sub load_bug {
          submitter => 'originator',
         );
     for my $addr_type (keys %addr_map) {
+       $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($addr_map{$addr_type})
+           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 {
+                $b->set_related_packages('binpackages',
+                                         [grep {defined $_ and
+                                                  length $_ and $_ !~ /^src:/}
+                                          make_list($data->{package})],
+                                         $param{packages},
+                                        );
+                $b->set_related_packages('srcpackages',
+                                         [grep {defined $_ and
+                                                  $_ =~ /^src:/}
+                                          make_list($data->{package})],
+                                         $param{packages},
+                                        );
+                $b->set_related_packages('affects_binpackages',
+                                         [grep {defined $_ and
+                                                  length $_ and $_ !~ /^src:/}
+                                          make_list($data->{affects})
+                                         ],
+                                         $param{packages},
+                                        );
+                $b->set_related_packages('affects_srcpackages',
+                                         [grep {defined $_ and
+                                                  $_ =~ /^src:/}
+                                          make_list($data->{affects})],
+                                         $param{packages},
+                                        );
+                for my $ff (qw(found fixed)) {
                       my @elements = $s->resultset('BugVer')->search({bug => $data->{bug_num},
                                                                       found  => $ff eq 'found'?1:0,
                                                                      });
@@ -319,18 +351,75 @@ 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:');
+       $msg_id =~ s/^\s*\<//;
+       $msg_id =~ 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*$)/$1/g;
+       my $to = decode_rfc1522($entity->head->get('To:'));
+       $to =~ s/\n(?:(\s)\s*|\s*$)/$1/g;
+       my $from = decode_rfc1522($entity->head->get('From:'));
+       $from =~ s/\n(?:(\s)\s*|\s*$)/$1/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 {
+               $m->sent_date(DateTime::Format::Mail->
+                             parse_datetime($entity->head->get('Date:',0)));
+           };
+           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}}) {
+                   push @cors,
+                       {correspondent => $s->resultset('Correspondent')->
+                        get_correspondent_id($addr),
+                        correspondent_type => $type,
+                       };
+               }
+           }
+           $m->update();
+           $s->txn_do(sub {
+                          $m->message_correspondents()->delete();
+                          $m->add_to_message_correspondents(@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});
     }
 
 }
@@ -368,7 +457,7 @@ sub load_debinfo {
 
 =back
 
-=head Packages
+=head2 Packages
 
 =over
 
@@ -482,8 +571,15 @@ sub load_packages {
     }
     # remove associations for packages not in this suite
     if (@sa_to_del) {
-       $schema->resultset('SrcAssociation')->
-           search_rs({id => \@sa_to_del})->delete();
+        $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')->
@@ -546,8 +642,15 @@ sub load_packages {
                   scalar @v) if defined $p;
     }
     if (@bin_to_del) {
-       $schema->resultset('BinAssociation')->
-           search_rs({id => \@bin_to_del})->delete();
+        $it = natatime 1000, @bin_to_del;
+        while (my @v = $it->()) {
+            $schema->
+                txn_do(sub {
+                           $schema->resultset('BinAssociation')->
+                               search_rs({id => \@v})->
+                               delete();
+                       });
+        }
     }
     $schema->resultset('BinAssociation')->
        search_rs({suite => $suite_id})->
@@ -560,7 +663,7 @@ sub load_packages {
 
 =cut
 
-=head Suites
+=head2 Suites
 
 =over
 
@@ -594,3 +697,7 @@ sub load_suite {
 
 
 __END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End: