Support "changelog:" short links
[deb/packages.git] / bin / create_changelogs_map
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use DB_File;
7
8 use lib './lib';
9
10 use Deb::Versions;
11
12 unless (@ARGV == 2) {
13         die "Usage: create_changelogs_map <db_dir> <changelogs_map_file>\n";
14 }
15
16 my ($dbdir, $outfile) = @ARGV;
17
18 tie my %src_packages, 'DB_File', "$dbdir/sources_small.db",
19     O_RDONLY, 0666, $DB_BTREE
20     or die "couldn't tie DB $dbdir/sources_small.db: $!";
21 tie my %src2bin, 'DB_File', "$dbdir/sources_packages.db",
22     O_RDONLY, 0666, $DB_BTREE
23     or die "couldn't open $dbdir/sources_packages.db: $!";
24
25 open my $out, '>', "$outfile.new"
26     or die "couldn't open $outfile.new: $!";
27
28 sub get_dir_from_name {
29     my $name = shift;
30
31     if ($name =~ /^(lib.)/o) {
32         return "$1/$name";
33     } else {
34         return substr( $name, 0, 1 )."/$name";
35     }
36 }
37
38 use Data::Dumper;
39 my %bin;
40 while (my ($source, $data) = each %src_packages) {
41     my @src = map { [ split(/\s+/) ] } split( /\0/, $data );
42     my $newest = (sort( { version_cmp($b->[-1],$a->[-1]) } @src))[0];
43     my ($section, $version) = @{$newest}[2,5];
44     my $directory = get_dir_from_name($source);
45 #    warn "src=$source sect=$section v=$version dir=$directory\n";
46
47     my $bin_data = $src2bin{$source};
48     unless ($bin_data) {
49         warn "no binary data found for $source\n";
50         # source packages without binaries have most
51         # likely been succeded
52         next;
53     }
54
55     print $out "$source\tpool/$section/$directory/current/changelog\n";
56
57     my @bin = map { [ split(/\s+/) ] } split( /\0/, $bin_data );
58     my %seen;
59     foreach (@bin) {
60         my ($pkg, $ver) = @{$_}[2,3];
61         next if $seen{"$pkg/$ver"}++; # weed out multiple arches/suites faster
62         if ($bin{$pkg}
63             && ($bin{$pkg}{source} ne $source)
64             && (version_cmp($bin{$pkg}{version},$ver) > 0)) {
65             warn "ignore $pkg/$ver from $source for ".
66                 "$pkg/$bin{$pkg}{version} from $bin{$pkg}{source}\n";
67             next;
68         } else {
69             $bin{$pkg} = { version => $ver, source => $source,
70                            target => "$section/$directory" };
71         }
72     }
73 }
74
75 while (my ($pkg, $data) = each %bin) {
76 #    warn "pkg=$pkg v=$data->{version} src=$data->{source} tgt=$data->{target}\n";
77     print $out "$pkg\tpool/$data->{target}/current/changelog\n";
78 }
79
80 close $out or warn $!;
81 rename("$outfile.new", $outfile);