]> git.donarmstrong.com Git - debbugs.git/commitdiff
merge changes from dla source
authorDebian BTS <debbugs@rietz>
Mon, 10 Aug 2009 20:09:25 +0000 (20:09 +0000)
committerDebian BTS <debbugs@rietz>
Mon, 10 Aug 2009 20:09:25 +0000 (20:09 +0000)
16 files changed:
Debbugs/CGI/Bugreport.pm
Debbugs/Common.pm
Debbugs/Control.pm
Debbugs/Packages.pm
Debbugs/Recipients.pm
Debbugs/Status.pm
bin/local-debbugs
cgi/bugreport.cgi
cgi/soap.cgi
debian/changelog
debian/control
debian/rules
scripts/process
scripts/service
templates/en_US/mail/message_body.tmpl
templates/en_US/mail/process_ack.tmpl

index 57f8d8fe647838babaaf7859a284e64466b663a3..c9103ba470bdc8cb6797a9da1f59d90c9ae78b9d 100644 (file)
@@ -34,7 +34,7 @@ use IO::Scalar;
 use Params::Validate qw(validate_with :types);
 use Debbugs::MIME qw(convert_to_utf8 decode_rfc1522 create_mime_message);
 use Debbugs::CGI qw(:url :html :util);
-use Debbugs::Common qw(globify_scalar);
+use Debbugs::Common qw(globify_scalar english_join);
 use POSIX qw(strftime);
 
 BEGIN{
@@ -319,7 +319,7 @@ sub handle_record{
          $output .= decode_rfc1522($record->{text});
          # Link to forwarded http:// urls in the midst of the report
          # (even though these links already exist at the top)
-         $output =~ s,((?:ftp|http|https)://[\S~-]+?/?)([\)\'\:\.\,]?(?:\s|\.<|$)),<a href=\"$1\">$1</a>$2,go;
+         $output =~ s,((?:ftp|http|https)://[\S~-]+?/?)((?:[\)\'\:\.\,]|\&\#39;)?(?:\s|\.<|$)),<a href=\"$1\">$1</a>$2,go;
          # Add links to the cloned bugs
          $output =~ s{(Bug )(\d+)( cloned as bugs? )(\d+)(?:\-(\d+)|)}{$1.bug_links(bug=>$2).$3.bug_links(bug=>(defined $5)?[$4..$5]:$4)}eo;
          # Add links to merged bugs
@@ -327,7 +327,11 @@ sub handle_record{
          # Add links to blocked bugs
          $output =~ s{(?<=Blocking bugs)(?:( of )(\d+))?( (?:added|set to|removed):\s+)([\d\s\,]+)}
                      {(defined $2?$1.bug_links(bug=>$2):'').$3.
-                           join(' ',map {bug_links(bug=>$_)} (split /\,?\s+/, $4))}eo;
+                          english_join([map {bug_links(bug=>$_)} (split /\,?\s+/, $4)])}eo;
+         $output =~ s{((?:[Aa]dded|[Rr]emoved)\ blocking\ bug(?:\(s\))?)(?:(\ of\ )(\d+))?(:?\s+)
+                      (\d+(?:,\s+\d+)*(?:\,?\s+and\s+\d+)?)}
+                     {$1.(defined $3?$2.bug_links(bug=>$3):'').$4.
+                          english_join([map {bug_links(bug=>$_)} (split /\,?\s+(?:and\s+)?/, $5)])}xeo;
          # Add links to reassigned packages
          $output =~ s{(Bug reassigned from package \`)([^']+?)((?:'|\&\#39;) to \`)([^']+?)((?:'|\&\#39;))}
          {$1.q(<a href=").html_escape(pkg_url(pkg=>$2)).qq(">$2</a>).$3.q(<a href=").html_escape(pkg_url(pkg=>$4)).qq(">$4</a>).$5}eo;
index ecd46076eafa1a109250f7e19b5e0e7e654f033f..0917c6570b7860e0098a1309617c5dc3846788c9 100644 (file)
@@ -43,6 +43,7 @@ BEGIN{
                                qw(bug_status),
                                qw(getmaintainers_reverse),
                                qw(getpseudodesc),
+                               qw(package_maintainer),
                               ],
                     misc   => [qw(make_list globify_scalar english_join checkpid),
                                qw(cleanup_eval_fail),
@@ -248,29 +249,11 @@ Returns a hashref of package => maintainer pairs.
 
 =cut
 
-our $_maintainer;
-our $_maintainer_rev;
+our $_maintainer = undef;
+our $_maintainer_rev = undef;
 sub getmaintainers {
-    return $_maintainer if $_maintainer;
-    my %maintainer;
-    my %maintainer_rev;
-    for my $file (@config{qw(maintainer_file maintainer_file_override pseduo_maint_file)}) {
-        next unless defined $file;
-        my $maintfile = IO::File->new($file,'r') or
-             die "Unable to open maintainer file $file: $!";
-        while(<$maintfile>) {
-             next unless m/^(\S+)\s+(\S.*\S)\s*$/;
-             ($a,$b)=($1,$2);
-             $a =~ y/A-Z/a-z/;
-             $maintainer{$a}= $b;
-             for my $maint (map {lc($_->address)} getparsedaddrs($b)) {
-                  push @{$maintainer_rev{$maint}},$a;
-             }
-        }
-        close($maintfile);
-    }
-    $_maintainer = \%maintainer;
-    $_maintainer_rev = \%maintainer_rev;
+    return $_maintainer if defined $_maintainer;
+    package_maintainer(rehash => 1);
     return $_maintainer;
 }
 
@@ -283,11 +266,142 @@ Returns a hashref of maintainer => [qw(list of packages)] pairs.
 =cut
 
 sub getmaintainers_reverse{
-     return $_maintainer_rev if $_maintainer_rev;
-     getmaintainers();
+     return $_maintainer_rev if defined $_maintainer_rev;
+     package_maintainer(rehash => 1);
      return $_maintainer_rev;
 }
 
+=head2 package_maintainer
+
+     my @s = package_maintainer(source => [qw(foo bar baz)],
+                                binary => [qw(bleh blah)],
+                               );
+
+=over
+
+=item source -- scalar or arrayref of source package names to return
+maintainers for, defaults to the empty arrayref.
+
+=item binary -- scalar or arrayref of binary package names to return
+maintainers for; automatically returns source package maintainer if
+the package name starts with 'src:', defaults to the empty arrayref.
+
+=item reverse -- whether to return the source/binary packages a
+maintainer maintains instead
+
+=item rehash -- whether to reread the maintainer and source maintainer
+files; defaults to 0
+
+=back
+
+=cut
+
+our $_source_maintainer = undef;
+our $_source_maintainer_rev = undef;
+sub package_maintainer {
+    my %param = validate_with(params => \@_,
+                             spec   => {source => {type => SCALAR|ARRAYREF,
+                                                   default => [],
+                                                  },
+                                        binary => {type => SCALAR|ARRAYREF,
+                                                   default => [],
+                                                  },
+                                        rehash => {type => BOOLEAN,
+                                                   default => 0,
+                                                  },
+                                        reverse => {type => BOOLEAN,
+                                                    default => 0,
+                                                   },
+                                       },
+                            );
+    if ($param{rehash}) {
+       $_source_maintainer = undef;
+       $_source_maintainer_rev = undef;
+       $_maintainer = undef;
+       $_maintainer_rev = undef;
+    }
+    if (not defined $_source_maintainer or
+       not defined $_source_maintainer_rev) {
+       $_source_maintainer = {};
+       $_source_maintainer_rev = {};
+       for my $fn (@config{('source_maintainer_file',
+                            'source_maintainer_file_override',
+                            'pseduo_maint_file')}) {
+           next unless defined $fn;
+           __add_to_hash($fn,$_source_maintainer,
+                         $_source_maintainer_rev);
+       }
+    }
+    if (not defined $_maintainer or
+       not defined $_maintainer_rev) {
+       $_maintainer = {};
+       $_maintainer_rev = {};
+       for my $fn (@config{('maintainer_file',
+                            'maintainer_file_override',
+                            'pseduo_maint_file')}) {
+           next unless defined $fn;
+           __add_to_hash($fn,$_maintainer,
+                             $_maintainer_rev);
+       }
+    }
+    my @return;
+    my @extra_source;
+    my $b = $param{reverse}?$_maintainer_rev:$_maintainer;
+    for my $binary (make_list($param{binary})) {
+       if (not $param{reverse} and $binary =~ /^src:/) {
+           push @extra_source,$binary;
+           next;
+       }
+       push @return,grep {defined $_} make_list($b->{$binary});
+    }
+    my $s = $param{reverse}?$_source_maintainer_rev:$_source_maintainer;
+    for my $source (make_list($param{source},@extra_source)) {
+       push @return,grep {defined $_} make_list($s->{$source});
+    }
+    return @return;
+}
+
+#=head2 __add_to_hash
+#
+#     __add_to_hash($file,$forward_hash,$reverse_hash,'address');
+#
+# Reads a maintainer/source maintainer/pseudo desc file and adds the
+# maintainers from it to the forward and reverse hashref; assumes that
+# the forward is unique; makes no assumptions of the reverse.
+#
+#=cut
+
+sub __add_to_hash {
+    my ($fn,$forward,$reverse,$type) = @_;
+    if (ref($forward) ne 'HASH') {
+       croak "__add_to_hash must be passed a hashref for the forward";
+    }
+    if (defined $reverse and not ref($reverse) eq 'HASH') {
+       croak "if reverse is passed to __add_to_hash, it must be a hashref";
+    }
+    $type //= 'address';
+    my $fh = IO::File->new($fn,'r') or
+       die "Unable to open $fn for reading: $!";
+    while (<$fh>) {
+       chomp;
+       next unless m/^(\S+)\s+(\S.*\S)\s*$/;
+       my ($key,$value)=($1,$2);
+       $key = lc $key;
+       $forward->{$key}= $value;
+       if (defined $reverse) {
+           if ($type eq 'address') {
+               for my $m (map {lc($_->address)} (getparsedaddrs($value))) {
+                   push @{$reverse->{$m}},$key;
+               }
+           }
+           else {
+               push @{$reverse->{$value}}, $key;
+           }
+       }
+    }
+}
+
+
 =head2 getpseudodesc
 
      my $pseudopkgdesc = getpseudodesc(...);
@@ -301,23 +415,12 @@ pseudopackage or not.
 
 =cut
 
-our $_pseudodesc;
+our $_pseudodesc = undef;
 sub getpseudodesc {
-    return $_pseudodesc if $_pseudodesc;
-    my %pseudodesc;
-
-    if (not defined $config{pseudo_desc_file}) {
-        $_pseudodesc = {};
-        return $_pseudodesc;
-    }
-    my $pseudo = IO::File->new($config{pseudo_desc_file},'r')
-        or die "Unable to open $config{pseudo_desc_file}: $!";
-    while(<$pseudo>) {
-       next unless m/^(\S+)\s+(\S.*\S)\s*$/;
-       $pseudodesc{lc $1} = $2;
-    }
-    close($pseudo);
-    $_pseudodesc = \%pseudodesc;
+    return $_pseudodesc if defined $_pseudodesc;
+    $_pseudodesc = {};
+    __add_to_hash($config{pseudo_desc_file},$_pseudodesc) if
+       defined $config{pseudo_desc_file};
     return $_pseudodesc;
 }
 
index ac0e0e3bf105fbe7635cef8211fe4c43fe8d383a..f7c74d55fa4227eb2af3d2d5d99fd8b4d5a8cb79 100644 (file)
@@ -436,8 +436,8 @@ sub set_blocks {
            print {$transcript} "Was blocked by: $data->{blockedby}\n";
        }
        my @changed;
-       push @changed, 'added blocking bug(s) '.english_join([keys %added_blockers]) if keys %added_blockers;
-       push @changed, 'removed blocking bug(s) '.english_join([keys %removed_blockers]) if keys %removed_blockers;
+       push @changed, 'added blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %added_blockers]) if keys %added_blockers;
+       push @changed, 'removed blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %removed_blockers]) if keys %removed_blockers;
        $action = ucfirst(join ('; ',@changed)) if @changed;
        if (not @changed) {
            print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n"
@@ -1950,7 +1950,7 @@ sub summary {
              # pseudo-headers
              if ($line =~ m{^\s*(?:(?:Package|Source|Version)\:| #pseudo headers
                                 (?:package|(?:no|)owner|severity|tag|summary| #control
-                                     reopen|close|(?:not|)(?:fixed|found)|clone|
+                                     \#|reopen|close|(?:not|)(?:fixed|found)|clone|
                                      (?:force|)merge|user(?:category|tag|)
                                 )
                            )\s+\S}x) {
@@ -2586,7 +2586,7 @@ C<__PACKAGE__>.
 sub __internal_request{
     my ($l) = @_;
     $l = 0 if not defined $l;
-    if (defined +(caller(2+$l))[0] and +(caller(2+$l))[0] eq __PACKAGE__) {
+    if (defined((caller(1+$l))[0]) and (caller(1+$l))[0] eq __PACKAGE__) {
        return 1;
     }
     return 0;
@@ -2685,6 +2685,13 @@ sub __begin_control {
     if (not @data) {
        die "Unable to read any bugs successfully.";
     }
+    if (not $param{archived}) {
+       for my $data (@data) {
+           if ($data->{archived}) {
+               die "Not altering archived bugs; see unarchive.";
+           }
+       }
+    }
     if (not __check_limit(data => \@data,
                          exists $param{limit}?(limit => $param{limit}):(),
                         )) {
@@ -2703,7 +2710,7 @@ sub __begin_control {
                   recipients => $param{recipients},
                   (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
                   debug      => $debug,
-                  transcript => $transcript,
+                  (__internal_request()?(transcript => $transcript):()),
                  );
 
     print {$debug} "$param{bug} read done\n";
index f9020bae8095aab35aa7db4557ceb31b50be9ac4..a7bf363d8ef5ead440e98f8f3fd0ae595a3b4360 100644 (file)
@@ -144,6 +144,9 @@ sub binarytosource {
     # need an extra cache for speed here.
     return () unless defined $gBinarySourceMap;
 
+    if ($binname =~ m/^src:(.+)$/) {
+       return $1;
+    }
     if (not tied %_binarytosource) {
         tie %_binarytosource, MLDBM => $gBinarySourceMap, O_RDONLY or
              die "Unable to open $gBinarySourceMap for reading";
index a73bbd9a91bc933df62b45fa0ad0beb16f62835a..572f6e758a7a8778b31cdd6cc73e051098ff9634 100644 (file)
@@ -140,18 +140,18 @@ sub add_recipients {
                            type  => 'bcc',
                           );
          }
-         if (defined(getmaintainers()->{$p})) {
-              $addmaint= getmaintainers()->{$p};
-              print {$param{debug}} "MR|$addmaint|$p|$ref|\n";
-              _add_address(recipients => $param{recipients},
-                           address => $addmaint,
-                           reason => $p,
-                           bug_num => $param{data}{bug_num},
-                           type  => 'cc',
-                          );
-              print {$param{debug}} "maintainer add >$p|$addmaint<\n";
+         my @maints = package_maintainer(binary => $p);
+         if (@maints) {
+             print {$param{debug}} "MR|".join(',',@maints)."|$p|$ref|\n";
+             _add_address(recipients => $param{recipients},
+                          address => \@maints,
+                          reason => $p,
+                          bug_num => $param{data}{bug_num},
+                          type  => 'cc',
+                         );
+             print {$param{debug}} "maintainer add >$p|".join(',',@maints)."<\n";
          }
-         else { 
+         else {
               print {$param{debug}} "maintainer none >$p<\n";
               print {$param{transcript}} "Warning: Unknown package '$p'\n";
               print {$param{debug}} "MR|unknown-package|$p|$ref|\n";
index 9bb7ce812c9d377a9b38a1bda5ad07c5c864e7dd..6e21f99cff7ee3de8ec61aa5513cfc2222db1dd6 100644 (file)
@@ -316,12 +316,7 @@ sub split_status_fields {
                      ) {
                    @elements = split $split_fields{$field}, $data->{$field};
                }
-               if (@elements != 1) {
-                   $data->{$field} = \@elements;
-               }
-               else {
-                   $data->{$field} = $elements[0];
-               }
+               $data->{$field} = \@elements;
            }
        }
     }
index 86f83a97ff9142535fca529548e026f8094b51d2..acdfa2eb6b47e90877a4dfa48cf3d5a339ec718a 100755 (executable)
@@ -8,7 +8,7 @@
 use warnings;
 use strict;
 
-use Getopt::Long;
+use Getopt::Long qw(:config no_ignore_case);
 use Pod::Usage;
 
 =head1 NAME
@@ -63,6 +63,17 @@ the configuration file, or 8080 if nothing is set.
 File which contains the set of bugs to get.
 Defaults to ~/.debbugs/bugs_to_get
 
+=item B<--bug-site>
+
+Hostname for a site which is running a debbugs install
+Defaults to bugs.debian.org
+
+=item B<--bug-mirror>
+
+Hostname for a site which is running an rsyncable mirror of the
+debbugs install above.
+Defaults to bugs-mirror.debian.org
+
 =item B<--debug, -d>
 
 Debug verbosity. (Default 0)
@@ -90,7 +101,13 @@ use Config::Simple;
 use File::Temp qw(tempdir);
 use Params::Validate qw(validate_with :types);
 use POSIX 'setsid';
-use Debbugs::Common qw(checkpid lockpid);
+use Debbugs::Common qw(checkpid lockpid get_hashname);
+use Debbugs::Mail qw(get_addresses);
+use SOAP::Lite;
+use IPC::Run;
+use IO::File;
+use File::Path;
+
 
 my %options = (debug           => 0,
               help            => 0,
@@ -98,13 +115,15 @@ my %options = (debug           => 0,
               verbose         => 0,
               quiet           => 0,
               detach          => 1,
-              cgi_bin         => '/var/lib/debbugs/www/cgi-bin',
+              cgi_bin         => '/var/lib/debbugs/www/cgi',
               css             => '/var/lib/debbugs/www/bugs.css',
+              bug_site        => 'bugs.debian.org',
+              bug_mirror      => 'bugs-mirror.debian.org',
               );
 
 my %option_defaults = (port => 8080,
                       debbugs_config => User->Home.'/.debbugs/debbugs_config',
-                      mirror_location => User->Home.'/.debbugs/mirror/',
+                      mirror_location => User->Home.'/.debbugs/mirror',
                       bugs_to_get => User->Home.'/.debbugs/bugs_to_get',
                      );
 
@@ -113,6 +132,8 @@ GetOptions(\%options,
           'detach!',
           'css=s','cgi_bin|cgi-bin|cgi=s',
           'verbose|v+','quiet|q+',
+          'bug_site|bug-site=s',
+          'bug_mirror|bug-mirror=s',
           'debug|d+','help|h|?','man|m');
 
 pod2usage() if $options{help};
@@ -133,6 +154,8 @@ pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 
 local_config(\%options);
 
+mkpath($options{mirror_location});
+
 if ($options{daemon}) {
      # daemonize, do stuff
      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
@@ -264,31 +287,21 @@ elsif ($options{stop}) {
 elsif ($options{mirror}) {
      # run the mirror jobies
      # figure out which bugs we need
-     my @bugs = select_bugs(\%options);
+     my $bugs = select_bugs(\%options);
      # get them
-     my $tempdir = tempdir(CLEANUP => 1);
-     my $mirror_log = IO::File->new($options{mirror_location}.'/mirror.log') or
+     my $tempdir = tempdir();#CLEANUP => 1);
+     my $mirror_log = IO::File->new($options{mirror_location}.'/mirror.log','>') or
          die "Unable to open $options{mirror_location}/mirror.log for writing: $!";
-     my $inc_fh = IO::File->new("$tempdir/include_list",'w') or
-         die "Unable to open $tempdir/include_list for writing: $!";
-     foreach my $bug (@bugs) {
-         print {$inc_fh} "*/${bug}.*\n" or
-              die "Unable to write to $tempdir/include_list: $!";
-     }
-     close $inc_fh or
-         die "Unable to close $tempdir/include_list: $!";
-     my ($wrf,$rfh);
+     write_bug_list("$tempdir/unarchived_bug_list",$bugs->{unarchived});
+     write_bug_list("$tempdir/archived_bug_list",$bugs->{archived});
+     my ($wrf,$rfh,$efh);
      my @common_rsync_options = ('-avz','--partial');
      print "Rsyncing bugs\n" if not $options{quiet};
      run_rsync(log => $mirror_log,
               ($options{debug}?(debug => \*STDERR):()),
               options => [@common_rsync_options,
                           '--delete-after',
-                          '--include-from',"$tempdir/include_list",
-                          # skip things not specifically included
-                          '--exclude','*/*',
-                          # skip the -1,-2,-3.log files
-                          '--exclude','*.log',
+                          '--files-from',"$tempdir/unarchived_bug_list",
                           'rsync://'.$options{bug_mirror}.'/bts-spool-db/',
                           $options{mirror_location}.'/db-h/']
              );
@@ -297,11 +310,7 @@ elsif ($options{mirror}) {
               ($options{debug}?(debug => \*STDERR):()),
               options => [@common_rsync_options,
                           '--delete-after',
-                          '--include-from',"$tempdir/include_list",
-                          # skip things not specifically included
-                          '--exclude','*/*',
-                          # skip the -1,-2,-3.log files
-                          '--exclude','*.log',
+                          '--files-from',"$tempdir/archived_bug_list",
                           'rsync://'.$options{bug_mirror}.'/bts-spool-archive/',
                           $options{mirror_location}.'/archive/',
                          ],
@@ -324,7 +333,7 @@ elsif ($options{mirror}) {
                           '--delete-after',
                           '--exclude','*old',
                           '--exclude','*.bak',
-                          'rsync://'.$options{bug_mirror}.'/bts-spool-versions/',
+                          'rsync://'.$options{bug_mirror}.'/bts-versions/',
                           $options{mirror_location}.'/versions/',
                          ],
              );
@@ -387,6 +396,19 @@ sub local_config{
      }
 }
 
+sub write_bug_list {
+    my ($file,$bug_list) = @_;
+    my $inc_fh = IO::File->new($file,'w') or
+       die "Unable to open $file for writing: $!";
+    foreach my $bug (keys %{$bug_list}) {
+       my $file_loc = get_hashname($bug).'/'.$bug;
+       print {$inc_fh} map {$file_loc.'.'.$_.qq(\n)} qw(log summary report status) or
+           die "Unable to write to $file: $!";
+    }
+    close $inc_fh or
+       die "Unable to close $file: $!";
+}
+
 # actually run rsync with the passed options
 sub run_rsync{
      my %param = validate_with(params => \@_,
@@ -399,18 +421,19 @@ sub run_rsync{
                                                     },
                                         }
                              );
-     my ($output_fh,@rsync_options) = @_;
-     my ($wfh,$rfh);
-     my $pid = open3($wfh,$rfh,
-                    'rsync',
-                    @{$param{options}}
-                   ) or die "Unable to start rsync: $!";
-     close $wfh or die "Unable to close the writer filehandle $?";
-     while (<$rfh>) {
-         print {$param{log}} $_;
-         if (exists $param{debug}) {
-              print {$param{debug}} $_;
-         }
+     my ($output,$error) = ('','');
+     my $h = IPC::Run::start(['rsync',@{$param{options}}],
+                            \undef,\$output,\$error);
+     while ($h->pump) {
+        print {$param{log}} $output,$error;
+        #print {$param{debug}} $error if defined $param{debug};
+     }
+     $h->finish();
+     my $exit = $h->result(0);
+     # this is suboptimal, but we currently don't know whether we've
+     # selected an archive or unarchived bug, so..
+     if (defined $exit and not ($exit == 0 or $exit == 3 or $exit == 23)) {
+        print STDERR "Rsync exited with non-zero status: $exit\n";
      }
 }
 
@@ -445,7 +468,7 @@ sub select_bugs{
 
      my $soap = SOAP::Lite
          -> uri('Debbugs/SOAP/V1')
-              -> proxy("http://$options{bug_mirror}/cgi-bin/soap.cgi");
+              -> proxy("http://$options{bug_site}/cgi-bin/soap.cgi");
      my @bugs;
      my @bug_selections = ();
      if (not -e $options{bugs_to_get}) {
@@ -456,10 +479,10 @@ sub select_bugs{
          # maintained by this user, submitted by this user, and rc
          # bugs
          push @bug_selections,
-              ("correspondent:$addr archive:both",
-               "maint:$addr archive:both",
-               "submitter:$addr archive:both",
-               "severity:serious severity:grave severity:critical archive:both",
+              ("correspondent:$addr archive:0",
+               "maint:$addr archive:0",
+               "submitter:$addr archive:0",
+               "severity:serious severity:grave severity:critical archive:0",
               );
      }
      else {
@@ -476,35 +499,56 @@ sub select_bugs{
               }
          }
      }
+     # Split archive:both into archive:1 and archive:0
+     @bug_selections =
+        map {
+            if (m/archive:both/) {
+                my $y_archive = $_;
+                my $n_archive = $_;
+                $y_archive =~ s/archive:both/archive:1/;
+                $n_archive =~ s/archive:both/archive:0/;
+                ($y_archive,$n_archive);
+            }
+            else {
+                $_;
+            }
+        } @bug_selections;
+     my %bugs;
      for my $selection (@bug_selections) {
-         my @subselects = split /\s+/,$selection;
-         my %search_parameters;
-         my %users;
-         for my $subselect (@subselects) {
-              my ($key,$value) = split /:/, $subselect, 2;
-              next unless $key;
-              if (exists $valid_keys{$key}) {
-                   push @{$search_parameters{$valid_keys{$key}}},
-                        $value if $value;
-              } elsif ($key =~/users?$/) {
-                   $users{$value} = 1 if $value;
-              }
-         }
-         my %usertags;
-         for my $user (keys %users) {
-              my $ut = $soap->get_usertag($user)->result();
-              next unless defined $ut and $ut ne "";
-              for my $tag (keys %{$ut}) {
-                   push @{$usertags{$tag}},
-                        @{$ut->{$tag}};
-              }
-         }
-         my $bugs = $soap->get_bugs(%search_parameters,
-                                    (keys %usertags)?(usertags=>\%usertags):()
-                                   )->result();
-         push @bugs,@{$bugs} if defined $bugs and @{$bugs};
+        my $archived_bugs = "unarchived";
+        if ($selection =~ /archive:(\S+)/ and $1) {
+            $archived_bugs = "archived";
+        }
+        my @subselects = split /\s+/,$selection;
+        my %search_parameters;
+        my %users;
+        for my $subselect (@subselects) {
+            my ($key,$value) = split /:/, $subselect, 2;
+            next unless $key;
+            if (exists $valid_keys{$key}) {
+                push @{$search_parameters{$valid_keys{$key}}},
+                    $value if $value;
+            } elsif ($key =~/users?$/) {
+                $users{$value} = 1 if $value;
+            }
+        }
+        my %usertags;
+        for my $user (keys %users) {
+            my $ut = $soap->get_usertag($user)->result();
+            next unless defined $ut and $ut ne "";
+            for my $tag (keys %{$ut}) {
+                push @{$usertags{$tag}},
+                    @{$ut->{$tag}};
+            }
+        }
+        my $bugs = $soap->get_bugs(%search_parameters,
+                                   (keys %usertags)?(usertags=>\%usertags):()
+                                  )->result();
+        if (defined $bugs and @{$bugs}) {
+            $bugs{$archived_bugs}{$_} = 1 for @{$bugs};
+        }
      }
-     return @bugs;
+     return \%bugs;
 }
 
 
index 790e1a2ce5dc1a23f9eb385f45ba6f3792e189b7..d6d5cf20f7430ef5e558a573bcd7bf713910a241 100755 (executable)
@@ -17,7 +17,7 @@ use Debbugs::CGI qw(:url :html :util);
 use Debbugs::CGI::Bugreport qw(:all);
 use Debbugs::Common qw(buglog getmaintainers make_list bug_status);
 use Debbugs::Packages qw(getpkgsrc);
-use Debbugs::Status qw(splitpackages get_bug_status isstrongseverity);
+use Debbugs::Status qw(splitpackages split_status_fields get_bug_status isstrongseverity);
 
 use Scalar::Util qw(looks_like_number);
 
@@ -137,9 +137,10 @@ if ($buglog =~ m/\.gz$/) {
 }
 
 
-my %status = %{get_bug_status(bug=>$ref,
-                             bugusertags => \%bugusertags,
-                            )};
+my %status =
+    %{split_status_fields(get_bug_status(bug=>$ref,
+                                        bugusertags => \%bugusertags,
+                                       ))};
 
 my @records;
 eval{
@@ -309,9 +310,9 @@ foreach my $pkg (@packages) {
 }
 
 # fixup various bits of the status
-$status{tags_array} = [sort(split(/\s+/, $status{tags}))];
+$status{tags_array} = [sort(make_list($status{tags}))];
 $status{date_text} = strftime('%a, %e %b %Y %T UTC', gmtime($status{date}));
-$status{mergedwith_array} = [split(/ /,$status{mergedwith})];
+$status{mergedwith_array} = [make_list($status{mergedwith})];
 
 
 my $version_graph = '';
@@ -335,7 +336,7 @@ if (@{$status{found_versions}} or @{$status{fixed_versions}}) {
 
 
 
-my @blockedby= split(/ /, $status{blockedby});
+my @blockedby= make_list($status{blockedby});
 $status{blockedby_array} = [];
 if (@blockedby && $status{"pending"} ne 'fixed' && ! length($status{done})) {
     for my $b (@blockedby) {
@@ -345,7 +346,7 @@ if (@blockedby && $status{"pending"} ne 'fixed' && ! length($status{done})) {
    }
 }
 
-my @blocks= split(/ /, $status{blocks});
+my @blocks= make_list($status{blocks});
 $status{blocks_array} = [];
 if (@blocks && $status{"pending"} ne 'fixed' && ! length($status{done})) {
     for my $b (@blocks) {
@@ -376,6 +377,7 @@ print fill_in_template(template => 'cgi/bugreport',
                                     isstrongseverity => \&Debbugs::Status::isstrongseverity,
                                     html_escape   => \&Debbugs::CGI::html_escape,
                                     looks_like_number => \&Scalar::Util::looks_like_number,
+                                    make_list        => \&Debbugs::Common::make_list,
                                    },
                       hole_var  => {'&package_links' => \&Debbugs::CGI::package_links,
                                     '&bug_links'     => \&Debbugs::CGI::bug_links,
index 31b43bab1367681681234c4d07a55252ef259a1c..53f7368536f4327b4a71b60acd59a9ce811250d8 100755 (executable)
@@ -19,6 +19,10 @@ my $soap = Debbugs::SOAP::Server
 # soapy is stupid, and is using the 1999 schema; override it.
 *SOAP::XMLSchema1999::Serializer::as_base64Binary = \&SOAP::XMLSchema2001::Serializer::as_base64Binary;
 *SOAP::Serializer::as_anyURI       = \&SOAP::XMLSchema2001::Serializer::as_string;
+# do this twice to avoid the warning if the serializer doesn't get
+# used
+*SOAP::XMLSchema1999::Serializer::as_base64Binary = \&SOAP::XMLSchema2001::Serializer::as_base64Binary;
+*SOAP::Serializer::as_anyURI       = \&SOAP::XMLSchema2001::Serializer::as_string;
 # to work around the serializer improperly using date/time stuff
 # (Nothing in Debbugs should be looked at as if it were date/time) we
 # kill off all of the date/time related bits in the serializer.
index 832a5dbf79b0184741d37b0ae74b43e7807f8612..44cf90bc3b510565f01e87246eb6265444c0e7e4 100644 (file)
@@ -1,4 +1,4 @@
-debbugs (2.4.2~exp0) UNRELEASED; urgency=low
+debbugs (2.4.2~exp0) experimental; urgency=low
 
   [ Anthony Towns ]
   * Add "package" command to service (control@) to limit the bugs that
@@ -253,9 +253,11 @@ debbugs (2.4.2~exp0) UNRELEASED; urgency=low
   * Allow for tag nnn = baz + foo - bar in service (closes: #505189)
   * Allow trailinng periods after the control stop commands (closes:
     #517834)
+  * Ditch extra blank lines (closes: #494843)
+  * Handle &#39; ending links in Debbugs::CGI::Bugreport (closes: #539020)
 
   
- -- Colin Watson <cjwatson@debian.org>  Fri, 20 Jun 2003 18:57:25 +0100
+ -- Don Armstrong <don@debian.org>  Sun, 26 Jul 2009 05:48:16 -0700
 
 debbugs (2.4.1) unstable; urgency=low
 
index 786a0ef22285be91601da104b023f50c7130de17..0716ee5a3a3ab4e2406600b04d6d1dc039129e24 100644 (file)
@@ -2,9 +2,10 @@ Source: debbugs
 Section: misc
 Priority: extra
 Maintainer: Debbugs developers <debian-debbugs@lists.debian.org>
-Uploaders: Josip Rodin <joy-packages@debian.org>, Colin Watson <cjwatson@debian.org>, Don Armstrong <don@debian.org>
+Uploaders: Colin Watson <cjwatson@debian.org>, Don Armstrong <don@debian.org>
 Standards-Version: 3.8.1
-Build-Depends-Indep: debhelper, libparams-validate-perl,
+Build-Depends: debhelper (>= 5)
+Build-Depends-Indep: libparams-validate-perl,
  libmailtools-perl, libmime-tools-perl, libio-stringy-perl, libmldbm-perl,
  liburi-perl, libsoap-lite-perl, libcgi-simple-perl,
  libhttp-server-simple-perl, libtest-www-mechanize-perl,
index 7d6f7d68acae293781990f5d826aa0912f6ea3a2..26f01bee11f043359713450c1c2f1e0ade59c6fc 100755 (executable)
@@ -22,8 +22,11 @@ clean:
        dh_testdir
        dh_testroot
        rm -f *-stamp;
-       -$(MAKE) -f Makefile.perl clean;
+       if [ -e Makefile.perl ]; then  \
+               $(MAKE) -f Makefile.perl clean; \
+       fi;
        #something to remove all trace and *.trace files?
+       rm -f debbugs.trace Makefile.perl.old
        dh_clean
 
 install: install-stamp
index e3243caa3c60093babf8ecd4729e983d5e7ffe12..c4c0ffeabb36880a5f80184eba6032f46041150c 100755 (executable)
@@ -17,7 +17,7 @@ use Debbugs::Mail qw(send_mail_message encode_headers get_addresses);
 use Debbugs::Packages qw(getpkgsrc);
 use Debbugs::User qw(read_usertags write_usertags);
 use Debbugs::Common qw(:lock get_hashname);
-use Debbugs::Status qw(writebug isstrongseverity lockreadbugmerge lockreadbug read_bug :versions);
+use Debbugs::Status qw(writebug isstrongseverity lockreadbugmerge lockreadbug read_bug splitpackages :versions);
 
 use Debbugs::CGI qw(html_escape bug_url);
 
@@ -1083,7 +1083,7 @@ sub checkmaintainers {
     }
     close(SOURCES);
     my $anymaintfound=0; my $anymaintnotfound=0;
-    for my $p (split(m/[ \t?,():]+/,$data->{package})) {
+    for my $p (splitpackages($data->{package})) {
         $p =~ y/A-Z/a-z/;
        $p =~ /([a-z0-9.+-]+)/;
        $p = $1;
index 429a7cde985d9222df62d5bb46ea267e9909e1df..8d9875d00e7f104e05a3d31d2b4b61142a9e985c 100755 (executable)
@@ -127,8 +127,7 @@ my %limit = ();
 
 
 my @common_control_options =
-    (($dl > 0 ? (debug => $transcript):()),
-     transcript        => $transcript,
+    (transcript        => $transcript,
      requester         => $header{from},
      request_addr      => $controlrequestaddr,
      request_msgid     => $header{'message-id'},
@@ -209,7 +208,10 @@ for ($procline=0; $procline<=$#bodylines; $procline++) {
         last;
     } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
         $dl= $1+0;
-        print {$transcript} "Debug level $dl.\n\n";
+       if ($dl > 0 and not grep /debug/,@common_control_options) {
+           push @common_control_options,(debug => $transcript);
+       }
+       print {$transcript} "Debug level $dl.\n\n";
     } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
         $ref= $2+0;
         &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
@@ -555,8 +557,8 @@ END
            # to set_found
            if (defined($version) && length $version) {
                set_found(@common_control_options,
-                         bug          => $ref,
-                         version      => $version,
+                         bug   => $ref,
+                         found => $version,
                         );
            }
        };
@@ -1109,11 +1111,16 @@ END
        if (scalar(@pkgs) > 0) {
                %limit_pkgs = map { ($_, 1) } @pkgs;
                $limit{package} = [@pkgs];
-               print {$transcript} "Ignoring bugs not assigned to: " .
-                       join(" ", keys(%limit_pkgs)) . "\n\n";
+               print {$transcript} "Limiting to bugs with field 'package' containing at least one of ".join(', ',map {qq('$_')} @pkgs)."\n";
+               print {$transcript} "Limit currently set to ";
+               for my $limit_field (keys %limit) {
+                   print {$transcript} "  '$limit_field':".join(', ',map {qq('$_')} @{$limit{$limit_field}})."\n";
+               }
+               print {$transcript} "\n";
        } else {
-               %limit_pkgs = ();
-               print {$transcript} "Not ignoring any bugs.\n\n";
+           %limit_pkgs = ();
+           $limit{package} = [];
+           print {$transcript} "Limit cleared.\n\n";
        }
     } elsif (m/^limit\:?\s+(\S.*\S)\s*$/) {
        $ok++;
@@ -1131,7 +1138,7 @@ END
            print {$transcript} "Limiting to bugs with field '$field' containing at least one of ".join(', ',map {qq('$_')} @options)."\n";
            print {$transcript} "Limit currently set to ";
            for my $limit_field (keys %limit) {
-               print {$transcript} "  '$limit_field':".join(', ',map {qq('$_')} @options)."\n";
+               print {$transcript} "  '$limit_field':".join(', ',map {qq('$_')} @{$limit{$limit_field}})."\n";
            }
            print {$transcript} "\n";
        }
index 6dfd6acf46d38cd3d0c0d96bb2ff1af308352ee8..b2f7c4dc1b3cfe7c0f0ffb4726d16d501bd93523 100644 (file)
@@ -1,3 +1,2 @@
-{include('mail/header')}
-{$body}
+{include('mail/header')}{$body}
 {include('mail/footer')}
\ No newline at end of file
index a7394de7429f924850e0a2292790b1c6d102e064..e15ea5a55cf9e53fec1ba5b90544f7b7d1bf1737 100644 (file)
@@ -7,4 +7,4 @@ send it to { $refreplyto }.
 
 Please do not send mail to {$config{maintainer_email}} unless you wish
 to report a problem with the {ucfirst($config{bug})}-tracking system.
-{$brokenness}
+{$brokenness}
\ No newline at end of file