scripts/dd-list.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # dd-list: Generate a list of maintainers of packages.
   4 #
   5 # Written by Joey Hess <joeyh@debian.org>
   6 # Based on a python implementation by Lars Wirzenius.
   7 # Copyright 2005 Lars Wirzenius, Joey Hess
   8 #
   9 # This program is free software; you can redistribute it and/or modify
  10 # it under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 2 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # This program is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with this program. If not, see <http://www.gnu.org/licenses/>.
  21
  22 use strict;
  23 use Getopt::Long;
  24
  25 my $version='###VERSION###';
  26
  27 sub get_developers_given_package {
  28         my ($package_name,$print_binary) = @_;
  29
  30         my $developer;
  31         my $print_name;
  32         my $uploaders;
  33         my @uploaders;
  34         open (F, "apt-cache showsrc '$package_name' |");
  35         while (<F>) {
  36                 chomp;
  37                 if (/^Maintainer: (.*)/) {
  38                         $developer=$1;
  39                 }
  40                 elsif (/^Uploaders: (.*)/) {
  41                         $uploaders=$1;
  42                         @uploaders = split /\s*,\s*/, $uploaders;
  43
  44                 }
  45                 elsif (/^Package: (.*)/) {
  46                         $print_name = $print_binary ? $package_name : $1 ;
  47                 }
  48         }
  49         close F;
  50         return ($developer, \@uploaders, $print_name);
  51 }
  52
  53 sub parse_developer {
  54         my $developer=shift;
  55
  56         my ($name, $domain) = $developer=~/^(.*)\s+<.*@(.*)>\s*$/i;
  57         if (defined $domain && $domain !~ /^(lists(\.alioth)?\.debian\.org|teams\.debian\.net)$/) {
  58                 return join " ", reverse split " ", $name;
  59         }
  60         elsif (defined $name) {
  61                 return $name;
  62         }
  63         else {
  64                 return $developer;
  65         }
  66 }
  67
  68 sub sort_developers {
  69         sort { uc(parse_developer($a)) cmp uc(parse_developer($b)) } @_;
  70 }
  71
  72 sub help {
  73         print <<"EOF"
  74 Usage: dd-list [options] [package ...]
  75
  76     -h, --help
  77         Print this help text.
  78
  79     -i, --stdin
  80         Read package names from the standard input.
  81
  82     -d, --dctrl
  83         Read package list in Debian control data from standard input.
  84
  85     -u, --uploaders
  86         Also list Uploaders of packages, not only the listed Maintainers
  87         (this is the default behaviour, use --nouploaders to prevent this).
  88
  89     -nou, --nouploaders
  90         Only list package Maintainers, do not list Uploaders.
  91
  92     -b, --print-binary
  93         If binary package names are given as input, print these names
  94         in the output instead of corresponding source packages.
  95
  96     -V, --version
  97         Print version (it\'s $version by the way).
  98 EOF
  99 }
 100
 101 my $use_stdin=0;
 102 my $use_dctrl=0;
 103 my $show_uploaders=1;
 104 my $print_binary=0;
 105 if (! GetOptions(
 106         "help" => sub { help(); exit },
 107         "stdin|i" => \$use_stdin,
 108         "dctrl|d" => \$use_dctrl,
 109         "uploaders|u!" => \$show_uploaders,
 110         "print-binary|b" => \$print_binary,
 111         "version" => sub { print "dd-list version $version\n" })) {
 112         exit(1);
 113 }
 114
 115 my %dict;
 116 my $errors=0;
 117
 118 if ($use_dctrl) {
 119         local $/="\n\n";
 120         while (<>) {
 121                 my ($package, $maintainer, $uploaders, @uploaders);
 122
 123                 if (/^Package:\s+(.*)$/m) {
 124                         $package=$1;
 125                 }
 126                 if (/^Source:\s+(.*)$/m && ! $print_binary ) {
 127                         $package=$1;
 128                 }
 129                 if (/^Maintainer:\s+(.*)$/m) {
 130                         $maintainer=$1;
 131                 }
 132                 if (/^Uploaders:\s+(.*)$/m) {
 133                         $uploaders=$1;
 134                         @uploaders = split /\s*,\s*/, $uploaders;
 135                 }
 136
 137                 if (defined $maintainer && defined $package) {
 138                         push @{$dict{$maintainer}}, $package;
 139                         if ($show_uploaders && defined $uploaders) {
 140                                 foreach my $uploader (@uploaders) {
 141                                         push @{$dict{$uploader}}, "$package (U)";
 142                                 }
 143                         }
 144                 }
 145                 else {
 146                         print STDERR "E: parse error in stanza $.\n";
 147                         $errors=1;
 148                 }
 149         }
 150 }
 151 else {
 152         my @package_names;
 153         if ($use_stdin) {
 154                 while (<>) {
 155                         chomp;
 156                         s/^\s+//;
 157                         s/\s+$//;
 158                         push @package_names, split ' ', $_;
 159                 }
 160         }
 161         else {
 162                 @package_names=@ARGV;
 163         }
 164
 165         foreach my $package_name (@package_names) {
 166                 my ($developer, $uploaders, $print_name)=get_developers_given_package($package_name,$print_binary);
 167                 if (defined $developer) {
 168                         push @{$dict{$developer}}, $print_name;
 169                         if ($show_uploaders && @$uploaders) {
 170                                 foreach my $uploader (@$uploaders) {
 171                                         push @{$dict{$uploader}}, "$print_name (U)";
 172                                 }
 173                         }
 174                 }
 175                 else {
 176                         print STDERR "E: Unknown package: $package_name\n";
 177                         $errors=1;
 178                 }
 179         }
 180 }
 181
 182 foreach my $developer (sort_developers(keys %dict)) {
 183         print "$developer\n";
 184         my %seen;
 185         foreach my $package (sort @{$dict{$developer}}) {
 186                 next if $seen{$package};
 187                 $seen{$package}=1;
 188                 print "   $package\n";
 189         }
 190         print "\n";
 191 }
 192
 193 exit($errors);