From 29b55e4d5535a68cc6d2294f5c362d271b53c6d2 Mon Sep 17 00:00:00 2001
From: Don Armstrong <don@donarmstrong.com>
Date: Thu, 29 Dec 2016 13:10:33 -0800
Subject: [PATCH] add update and --no-update options

 + Abstract out main routine
 + move versions time cleanup here
 + Hopefully this will avoid the issues of failures screwing up the
   database
---
 examples/debian/versions/build-versions-db | 75 ++++++++++++++++++----
 1 file changed, 61 insertions(+), 14 deletions(-)

diff --git a/examples/debian/versions/build-versions-db b/examples/debian/versions/build-versions-db
index 10fb32c..8456bfe 100755
--- a/examples/debian/versions/build-versions-db
+++ b/examples/debian/versions/build-versions-db
@@ -30,6 +30,11 @@ build-versions-db -- builds source and source maintainers file
 
 =over
 
+=item B<--update>
+
+Update an existing database; the default. B<--no-update> will regenerate an
+existing database from scratch.
+
 =item B<--debug, -d>
 
 Debug verbosity. (Default 0)
@@ -55,15 +60,19 @@ Display this manual.
 
 use vars qw($DEBUG);
 use Debbugs::Versions::Dpkg;
+use Debbugs::Config qw(:config);
+use File::Copy;
 use MLDBM qw(DB_File Storable);
 use Fcntl;
 
 my %options = (debug           => 0,
                help            => 0,
                man             => 0,
+	       update          => 1,
               );
 
 GetOptions(\%options,
+	   'update!',
            'debug|d+','help|h|?','man|m');
 
 pod2usage() if $options{help};
@@ -79,11 +88,14 @@ if (not @ARGV >= 4) {
         "a top level directory and at least one suite";
 }
 
+
 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 
 
 my $versions = shift @ARGV;
 my $versions_time = shift @ARGV;
+my $versions_new = $versions."_".$$."_".time;
+my $versions_time_new = $versions_time."_".$$."_".time;
 my $toplevel = shift @ARGV;
 my @suites = @ARGV;
 
@@ -93,11 +105,21 @@ my $time = time;
 
 my %db;
 my %db2;
-tie %db, "MLDBM", $versions, O_CREAT|O_RDWR, 0664
+if ($options{update}) {
+    copy($versions,$versions_new);
+    copy($versions_time,$versions_time_new);
+}
+tie %db, "MLDBM", $versions_new, O_CREAT|O_RDWR, 0664
     or die "tie $versions: $!";
-tie %db2, "MLDBM", $versions_time,O_CREAT|O_RDWR, 0664
+tie %db2, "MLDBM", $versions_time_new,O_CREAT|O_RDWR, 0664
      or die "tie $versions_time failed: $!";
 
+update_versions_suites(\%db,\%db2,\@suites);
+versions_time_cleanup(\%db2) if $options{update};
+
+move($versions_new,$versions);
+move($versions_time_new,$versions_time);
+
 sub open_compressed_file {
     my ($file) = @_;
     my $fh;
@@ -117,8 +139,8 @@ sub open_compressed_file {
 
 # Read Package, Version, and Source fields from a Packages.gz file.
 sub read_packages {
-    my ($packages, $component,$arch,$dist) = @_;
-    my $PACKAGES = open_compressed_file($packages)
+    my ($db,$db2,$packages, $component,$arch,$dist) = @_;
+    my $PACKAGES = open_compressed_file($packages) or
         die "Unable to open $packages for reading: $!";
     local $_;
     local $/ = '';	# paragraph mode
@@ -133,28 +155,30 @@ sub read_packages {
 	if (/^Extra-Source-Only: yes/im) {
 	    $extra_source_only = 1;
 	}
-	update_package_version($dist,$arch,$pkg,$ver,$time) unless
+	update_package_version($db,$db2,$dist,$arch,$pkg,$ver,$time) unless
 	    $extra_source_only;
     }
 }
 
 
 sub update_package_version {
-    my ($d,$a,$p,$v,$t) = @_;
+    my ($db,$db2,$d,$a,$p,$v,$t) = @_;
     # see MLDBM(3pm)/BUGS
-    my $tmp = $db{$p};
+    my $tmp = $db->{$p};
     # we allow multiple versions in an architecture now; this
     # should really only happen in the case of source, however.
     push @{$tmp->{$d}{$a}}, $v;
-    $db{$p} = $tmp;
-    $tmp = $db2{$p};
+    $db->{$p} = $tmp;
+    $tmp = $db2->{$p};
     $tmp->{$d}{$a}{$v} = $time if not exists
 	$tmp->{$d}{$a}{$v};
-    $db2{$p} = $tmp;
+    $db2->{$p} = $tmp;
 }
 
+sub update_versions_suites {
+    my ($db,$db2,$suites) = @_;
 # Iterate through all Packages and Sources files.
-for my $suite (@suites) {
+for my $suite (@{$suites}) {
     my $suitedir = "$toplevel/$suite";
 
     for my $component ('main', 'main/debian-installer',
@@ -170,7 +194,7 @@ for my $suite (@suites) {
 
 	my $sources = (grep { -f $_ } glob "$suitedir/$component/source/Sources.*")[0];
 	next unless defined $sources;
-	read_packages($sources, $viscomponent,'source',$suite);
+	read_packages($db,$db2,$sources, $viscomponent,'source',$suite);
 
 	for my $arch (readdir $COMPONENT) {
 	    next unless $arch =~ s/^binary-//;
@@ -178,11 +202,34 @@ for my $suite (@suites) {
 
 	    my $packages = (grep { -f $_ } glob("$archdir/Packages.*"))[0];
 	    next unless defined $packages;
-	    read_packages($packages, $viscomponent,$arch,$suite);
+	    read_packages($db,$db2,$packages, $viscomponent,$arch,$suite);
 	}
 
 	closedir $COMPONENT;
     }
 }
+}
 
-
+sub versions_time_cleanup {
+    my ($db) = @_;
+    my $time = time;
+    for my $package (keys %{$db}) {
+	my $temp = $db->{$package};
+	for my $dist (keys %{$temp}) {
+	    for my $arch (keys %{$temp->{$dist}}) {
+		my @versions =  (sort {$temp->{$dist}{$arch}{$a} <=>
+					   $temp->{$dist}{$arch}{$b}
+				       }
+				 keys %{$temp->{$dist}{$arch}});
+		next unless @versions > 1;
+		for my $i (0 .. ($#versions-1)) {
+		    last if $temp->{$dist}{$arch}{$versions[$i+1]} >
+			($time - $config{remove_age}*60*60*24);
+		    last if keys %{$temp->{$dist}{$arch}} <= 1;
+		    delete $temp->{$dist}{$arch}{$versions[$i]};
+		}
+	    }
+	}
+	$db->{$package} = $temp;
+    }
+}
-- 
2.39.2