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);