Commit to mainline by don@debian.org -- merge changes from dla source

[Debbugs Maintainers]

------------------------------------------------------------
revno: 904
committer: Debian BTS <debb...@rietz>
branch nick: mainline
timestamp: Tue 2009-09-01 01:56:42 +0000
message:
  merge changes from dla source
    ------------------------------------------------------------
    revno: 738.3.180
    committer: Don Armstrong <d...@donarmstrong.com>
    branch nick: source
    timestamp: Mon 2009-08-31 18:56:26 -0700
    message:
      add more information about failing limits

=== modified file 'Debbugs/Control.pm'
--- Debbugs/Control.pm  2009-08-28 23:24:06 +0000
+++ Debbugs/Control.pm  2009-09-01 01:56:41 +0000
@@ -2697,6 +2697,7 @@
     }
     if (not __check_limit(data => \...@data,
                          exists $param{limit}?(limit => $param{limit}):(),
+                         transcript => $transcript,
                         )) {
        die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
     }
@@ -2784,6 +2785,9 @@
                                                  },
                                         limit => {type => HASHREF|UNDEF,
                                                  },
+                                        transcript  => {type => 
SCALARREF|HANDLE,
+                                                        optional => 1,
+                                                       },
                                        },
                             );
     my @data = make_list($param{data});
@@ -2792,6 +2796,8 @@
        not keys %{$param{limit}}) {
        return 1;
     }
+    my $transcript = globify_scalar(exists 
$param{transcript}?$param{transcript}:undef);
+    my $going_to_fail = 0;
     for my $data (@data) {
        for my $field (keys %{$param{limit}}) {
            next unless exists $param{limit}{$field};
@@ -2814,11 +2820,13 @@
                }
            }
            if (not $match) {
-               return 0;
+               $going_to_fail = 1;
+               print {$transcript} "$field: '$data->{$field}' does not match 
at least one of ".
+                   join(', ',map {ref($_)?'(regex)':$_} 
make_list($param{limit}{$field}))."\n";
            }
        }
     }
-    return 1;
+    return $going_to_fail?0:1;
 }