]> git.deb.at Git - deb/packages.git/blob - bin/build-maintainerdb
create_index_pages: Fix charset
[deb/packages.git] / bin / build-maintainerdb
1 #! /usr/bin/perl
2
3 #   build-maintainerdb - convert several Packages files to maintainer database
4 #   Copyright (c) 1998,9,2001,3,4,6  Martin Schulze <joey@debian.org>
5 #   Copyright (C) 2007 Joerg Jaspert <joerg@debian.org>
6 #
7 #   This program is free software; you can redistribute it and/or modify
8 #   it under the terms of the GNU General Public License as published by
9 #   the Free Software Foundation; either version 2 of the License, or
10 #   (at your option) any later version.
11 #
12 #   This program is distributed in the hope that it will be useful,
13 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
14 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 #   GNU General Public License for more details.
16 #
17 #   You should have received a copy of the GNU General Public License
18 #   along with this program; if not, write to the Free Software
19 #   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20
21 #   Todo:
22 #    . Read maintainer changes from overrides file(s), need to rub
23 #      out all existing entries
24
25 use strict;
26 use warnings;
27 use DB_File;
28
29 use lib '../lib';
30
31 use Deb::Versions;
32
33 # read the configuration
34 if (!open (C, "../config.sh")) {
35     print "\nInternal Error: Cannot open configuration file.\n\n";
36     exit 0;
37 }
38 my $topdir = "/org/packages.debian.org";
39 while (<C>) {
40     $topdir = $1 if (/^\s*topdir="?(.*)"?\s*$/);
41 }
42 close (C);
43
44 my $maildomain = "packages.debian.org";
45 my $ptsdomain = "packages.qa.debian.org";
46
47
48 my $maintainerfile = "$topdir/../ftp.root/debian/indices/Maintainers";
49 my $maintainerdb = "$topdir/conf/maintainer";
50 my $overridefile = "$topdir/conf/maintainerdb.override";
51 my @postcall = ( "/usr/sbin/postmap", $maintainerdb );
52 my $opt_verbose = 0;
53 my $dbdir = "$topdir/files/db";
54
55 my %maint;
56 my %binsrc;
57
58 # Lets take pdo database input files for the source mapping
59 sub read_bin_src_mapping
60 {
61     tie my %src_packages, 'DB_File', "$dbdir/sources_small.db",
62     O_RDONLY, 0666, $DB_BTREE
63         or die "couldn't tie DB $dbdir/sources_small.db: $!";
64     tie my %src2bin, 'DB_File', "$dbdir/sources_packages.db",
65     O_RDONLY, 0666, $DB_BTREE
66         or die "couldn't open $dbdir/sources_packages.db: $!";
67
68     my %bin;
69     while (my ($source, $data) = each %src_packages) {
70         my @src = map { [ split(/\s+/) ] } split( /\0/, $data );
71         my $newest = (sort( { version_cmp($b->[-1],$a->[-1]) } @src))[0];
72         my ($section, $version) = @{$newest}[2,5];
73         
74         my $bin_data = $src2bin{$source};
75         unless ($bin_data) {
76             warn "no binary data found for $source\n";
77             # source packages without binaries have most
78             # likely been succeded
79             next;
80         }
81         
82         my @bin = map { [ split(/\s+/) ] } split( /\0/, $bin_data );
83         my %seen;
84         foreach (@bin) {
85             my ($pkg, $ver) = @{$_}[2,3];
86             next if $seen{"$pkg/$ver"}++; # weed out multiple arches/suites faster
87             if ($bin{$pkg}
88                 && ($bin{$pkg}{source} ne $source)
89                 && (version_cmp($bin{$pkg}{version},$ver) > 0)) {
90                 next;
91             } else {
92                 $bin{$pkg} = { version => $ver, source => $source,
93                                target => "$section" };
94                 $binsrc{$pkg} = $source;
95             }
96         }
97         $binsrc{$source} = $source;
98     }
99 }
100
101 sub package_maintainer
102 {
103     my $pkg = shift;
104     my $login = shift;
105     my $addr = shift;
106     my $home = "/debian/home/$login";
107
108     if (-d $home) {
109         if (-f "$home/.forward-$pkg") {
110             return "$login-$pkg\@master.debian.org";
111         }
112     }
113     return $addr;
114 }
115
116 sub read_maintainer
117 {
118     my $file = shift;
119     my $package;
120     my $maintainer;
121     my $maint;
122
123     open (F, "$file") || die "Can't open $file, $!";
124     printf "Reading %s\n", $file if ($opt_verbose);
125     while (<F>) {
126         next if (/^#/);
127         next if (/^$/);
128         /(\S+)\s+(.*)/;
129         $package=$1; $maint=$2;
130         if (! exists $maint{$package}) {
131             printf "  EVAL (%s, \"%s\")\n", $package, $maint if ($opt_verbose > 2);
132
133                 if (exists $maint{$package}) {
134                     $maint{$package} .= " ";
135                     printf "  EXPAND (%s)\n", $package if ($opt_verbose > 2);
136                 }
137                 if ($maint =~ /.*<(.*)>/) {
138                     $maint{$package} .= $1;
139                     printf "  ADD (%s, %s)\n", $package, $1 if ($opt_verbose > 2);
140                 } elsif ($maint =~ /\s*(\S+)\s+\(.*\)/) {
141                     $maint{$package} .= $1;
142                     printf "  ADD (%s, %s)\n", $package, $1 if ($opt_verbose > 2);
143                 } else {
144                     $maint{$package} .= $maint;
145                     printf "  ADD (%s, %s)\n", $package, $maint if ($opt_verbose > 2);
146                 }
147
148             printf "  %s: %s\n", $package, $maint{$package} if ($opt_verbose > 1);
149
150 # Short what? Whats this supposed to do, except creating new (and 99% broken) something -> email mappings?
151 #           my $pkgshort = "";
152 #           if ($package =~ /(.*[^\d\.]+)([\d\.]*\d)$/) {
153 #               $pkgshort = $1;
154 #               print "Short what? $pkgshort (long is $package)\n";
155 #               $maint{$pkgshort} = $maint{$package} if (! exists $maint{$pkgshort});
156 #               printf "  %s: %s\n", $pkgshort, $maint{$package} if ($opt_verbose > 1);
157 #           }
158 #           if ($maint{$package} =~ /([^\@]+)\@(master\.)?debian\.org/) {
159 #               my $addrsave = $maint{$package} if ($opt_verbose > 1);
160 #               $maint{$package} = package_maintainer ($package, $1, $maint{$package});
161 #               printf "  Changed to %s\n", $maint{$package} if ($opt_verbose > 1 && ($addrsave ne $maint{$package}));
162 #               if (length ($pkgshort) > 0) {
163 #                   $maint{$pkgshort} = package_maintainer ($pkgshort, $1, $maint{$pkgshort});
164 #               }
165 #           }
166         } else {
167             printf "Skipping double $package\n" if ($opt_verbose);
168             printf "LINE: $_" if ($opt_verbose > 2);
169         }
170     }
171     close (F);
172 }
173
174
175
176 sub write_maintainer
177 {
178     my $file = shift;
179
180     printf "Writing to %s.new\n", $file if ($opt_verbose > 0);
181     open (CONF, ">$file.new") || die "Can't open $file.new, $!";
182     my $forward;
183     foreach my $package (sort(keys(%maint))) {
184 # It is possible that we do not know a source package -> in that case fall back to old behaviour
185 # and only mail the maintainer. Can happen when pdo doesnt know the suite the source is in, like
186 # it doesnt know oldstable-proposed-updates at date of writing this code.
187         $forward = "$maint{$package}";
188         if ($binsrc{$package}) {
189             $forward .= ", $binsrc{$package}_contact\@$ptsdomain";
190         }
191         printf "%s -> %s\n", $package, $forward if ($opt_verbose);
192         printf CONF "%s@%s\t%s\n", $package, $maildomain, $forward;
193 #       printf "%s -> %s and pts: %s\n", $package, $maint{$package}, $binsrc{$package} if ($opt_verbose);
194 #       printf CONF "%s@%s\t%s, %s_contact@%s\n", $package, $maildomain, $maint{$package}, $binsrc{$package}, $ptsdomain;
195     }
196     close (CONF);
197     printf "Renaming to %s\n", $file if ($opt_verbose > 0);
198     system "mv -f $file.new $file";
199     printf "Executing @postcall\n" if ($opt_verbose > 0);
200     system @postcall;
201 }
202
203 sub help
204 {
205     print "build-maintainerdb - Build the maintainer db for packages.debian.org.\n";
206     print "-d     debug, changes output file to ./maintainerdb\n";
207     print "-h     This help\n";
208     print "-v     Increase verbosity by 1\n";
209     print "-vv    Increase verbosity by 2\n";
210     print "-vvv   Increase verbosity by 3\n";
211 }
212
213
214 # Main program
215 #
216 while ($#ARGV > -1) {
217     if ($ARGV[0] eq "-v") {
218         $opt_verbose++;
219     } elsif ($ARGV[0] eq "-vv") {
220         $opt_verbose+= 2;
221     } elsif ($ARGV[0] eq "-vvv") {
222         $opt_verbose+= 3;
223     } elsif ($ARGV[0] eq "-h") {
224         help();
225     } elsif ($ARGV[0] eq "-d") {
226         $maintainerdb = "./maintainerdb";
227     }
228     shift;
229 }
230
231 &read_bin_src_mapping();
232
233 &read_maintainer ($overridefile);
234 &read_maintainer ($maintainerfile);
235
236 &write_maintainer ($maintainerdb);
237