X-Git-Url: https://git.deb.at/?a=blobdiff_plain;f=bin%2Fcreate_changelogs_map;fp=bin%2Fcreate_changelogs_map;h=fbee3f2ff1393699a56347f0195633be5c183615;hb=da0b1ee79860ccd17033f11da212178d51ce9f47;hp=0000000000000000000000000000000000000000;hpb=a59f992384193557112a964aecd13fbe013c9447;p=deb%2Fpackages.git

diff --git a/bin/create_changelogs_map b/bin/create_changelogs_map
new file mode 100755
index 0000000..fbee3f2
--- /dev/null
+++ b/bin/create_changelogs_map
@@ -0,0 +1,81 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use DB_File;
+
+use lib './lib';
+
+use Deb::Versions;
+
+unless (@ARGV == 2) {
+	die "Usage: create_changelogs_map <db_dir> <changelogs_map_file>\n";
+}
+
+my ($dbdir, $outfile) = @ARGV;
+
+tie my %src_packages, 'DB_File', "$dbdir/sources_small.db",
+    O_RDONLY, 0666, $DB_BTREE
+    or die "couldn't tie DB $dbdir/sources_small.db: $!";
+tie my %src2bin, 'DB_File', "$dbdir/sources_packages.db",
+    O_RDONLY, 0666, $DB_BTREE
+    or die "couldn't open $dbdir/sources_packages.db: $!";
+
+open my $out, '>', "$outfile.new"
+    or die "couldn't open $outfile.new: $!";
+
+sub get_dir_from_name {
+    my $name = shift;
+
+    if ($name =~ /^(lib.)/o) {
+	return "$1/$name";
+    } else {
+	return substr( $name, 0, 1 )."/$name";
+    }
+}
+
+use Data::Dumper;
+my %bin;
+while (my ($source, $data) = each %src_packages) {
+    my @src = map { [ split(/\s+/) ] } split( /\0/, $data );
+    my $newest = (sort( { version_cmp($b->[-1],$a->[-1]) } @src))[0];
+    my ($section, $version) = @{$newest}[2,5];
+    my $directory = get_dir_from_name($source);
+#    warn "src=$source sect=$section v=$version dir=$directory\n";
+
+    my $bin_data = $src2bin{$source};
+    unless ($bin_data) {
+	warn "no binary data found for $source\n";
+	# source packages without binaries have most
+	# likely been succeded
+	next;
+    }
+
+    print $out "$source\tpool/$section/$directory/current/changelog\n";
+
+    my @bin = map { [ split(/\s+/) ] } split( /\0/, $bin_data );
+    my %seen;
+    foreach (@bin) {
+	my ($pkg, $ver) = @{$_}[2,3];
+	next if $seen{"$pkg/$ver"}++; # weed out multiple arches/suites faster
+	if ($bin{$pkg}
+	    && ($bin{$pkg}{source} ne $source)
+	    && (version_cmp($bin{$pkg}{version},$ver) > 0)) {
+	    warn "ignore $pkg/$ver from $source for ".
+		"$pkg/$bin{$pkg}{version} from $bin{$pkg}{source}\n";
+	    next;
+	} else {
+	    $bin{$pkg} = { version => $ver, source => $source,
+			   target => "$section/$directory" };
+	}
+    }
+}
+
+while (my ($pkg, $data) = each %bin) {
+#    warn "pkg=$pkg v=$data->{version} src=$data->{source} tgt=$data->{target}\n";
+    print $out "$pkg\tpool/$data->{target}/current/changelog\n";
+}
+
+close $out or warn $!;
+rename("$outfile.new", $outfile);