2 # build-versions-db builds the versions mldmb database
3 # and is released under the terms of the GNU GPL version 3, or any
4 # later version, at your option. See the file README and COPYING for
6 # Copyright 2016 by Don Armstrong <don@donarmstrong.com>.
17 build-versions-db -- builds source and source maintainers file
21 build-versions-db [options] versions.idx.new versions.idx.new \
22 /srv/bugs.debian.org/versions/indices/ftp
25 --debug, -d debugging level (Default 0)
26 --help, -h display this help
27 --man, -m display manual
35 Debug verbosity. (Default 0)
39 Display brief usage information.
49 build-versions-db versions.idx.new versions.idx.new \
50 /srv/bugs.debian.org/versions/indices/ftp \
57 use Debbugs::Versions::Dpkg;
58 use MLDBM qw(DB_File Storable);
61 my %options = (debug => 0,
67 'debug|d+','help|h|?','man|m');
69 pod2usage() if $options{help};
70 pod2usage({verbose=>2}) if $options{man};
72 $DEBUG = $options{debug};
78 "You must provide at least four arguments, two databases, ".
79 "a top level directory and at least one suite";
82 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
85 my $versions = shift @ARGV;
86 my $versions_time = shift @ARGV;
87 my $toplevel = shift @ARGV;
90 $MLDBM::DumpMeth=q(portable);
96 tie %db, "MLDBM", $versions, O_CREAT|O_RDWR, 0664
97 or die "tie $versions: $!";
98 tie %db2, "MLDBM", $versions_time,O_CREAT|O_RDWR, 0664
99 or die "tie $versions_time failed: $!";
101 sub open_compressed_file {
104 my $mode = '<:encoding(UTF-8)';
106 if ($file =~ /\.gz$/) {
107 $mode = '-|:encoding(UTF-8)';
108 push @opts,'gzip','-dc';
110 if ($file =~ /^\.xz$/) {
111 $mode = '-|:encoding(UTF-8)';
112 push @opts,'xz','-dc';
114 open($fh,$mode,@opts,$file);
118 # Read Package, Version, and Source fields from a Packages.gz file.
120 my ($packages, $component,$arch,$dist) = @_;
121 my $PACKAGES = open_compressed_file($packages)
122 die "Unable to open $packages for reading: $!";
124 local $/ = ''; # paragraph mode
126 print STDERR "reading packages $packages\n" if $DEBUG;
128 /^Package: (.+)/im or next;
130 /^Version: (.+)/im or next;
132 my $extra_source_only = 0;
133 if (/^Extra-Source-Only: yes/im) {
134 $extra_source_only = 1;
136 update_package_version($dist,$arch,$pkg,$ver,$time) unless
142 sub update_package_version {
143 my ($d,$a,$p,$v,$t) = @_;
144 # see MLDBM(3pm)/BUGS
146 # we allow multiple versions in an architecture now; this
147 # should really only happen in the case of source, however.
148 push @{$tmp->{$d}{$a}}, $v;
151 $tmp->{$d}{$a}{$v} = $time if not exists
156 # Iterate through all Packages and Sources files.
157 for my $suite (@suites) {
158 my $suitedir = "$toplevel/$suite";
160 for my $component ('main', 'main/debian-installer',
161 'contrib', 'non-free') {
162 my $componentdir = "$suitedir/$component";
163 next unless -d $componentdir;
165 opendir $COMPONENT, $componentdir or die "opendir $componentdir: $!";
167 # debian-installer is really a section rather than a component
169 (my $viscomponent = $component) =~ s[/.*][];
171 my $sources = (grep { -f $_ } glob "$suitedir/$component/source/Sources.*")[0];
172 next unless defined $sources;
173 read_packages($sources, $viscomponent,'source',$suite);
175 for my $arch (readdir $COMPONENT) {
176 next unless $arch =~ s/^binary-//;
177 my $archdir = "$componentdir/binary-$arch";
179 my $packages = (grep { -f $_ } glob("$archdir/Packages.*"))[0];
180 next unless defined $packages;
181 read_packages($packages, $viscomponent,$arch,$suite);