]> git.donarmstrong.com Git - debbugs.git/commitdiff
* Add the Debian specific scripts to the debbugs repository so we can
authorDon Armstrong <don@donarmstrong.com>
Sun, 20 May 2007 07:10:12 +0000 (00:10 -0700)
committerDon Armstrong <don@donarmstrong.com>
Sun, 20 May 2007 07:10:12 +0000 (00:10 -0700)
   at least start to keep track of them.

14 files changed:
examples/debian/postpa/10mirrors [new file with mode: 0755]
examples/debian/postpa/20impbugs [new file with mode: 0755]
examples/debian/postpa/20impbugs-versioned [new file with mode: 0755]
examples/debian/postpa/21bugclosers [new file with mode: 0755]
examples/debian/postpa/22oldbugs [new file with mode: 0755]
examples/debian/versions/debbugs-makeversions [new file with mode: 0755]
examples/debian/versions/merge-one-debinfo [new file with mode: 0755]
examples/debian/versions/merge-one-version [new file with mode: 0755]
examples/debian/versions/merge-versions.pl [new file with mode: 0755]
examples/debian/versions/queue-debinfo [new file with mode: 0755]
examples/debian/versions/queue-versions [new file with mode: 0755]
examples/debian/versions/test-versions.pl [new file with mode: 0755]
examples/debian/versions/update-packages [new file with mode: 0755]
examples/debian/versions/update-versions [new file with mode: 0755]

diff --git a/examples/debian/postpa/10mirrors b/examples/debian/postpa/10mirrors
new file mode 100755 (executable)
index 0000000..9afcc80
--- /dev/null
@@ -0,0 +1,26 @@
+#! /bin/sh
+
+# This script signals merkel.debian.org to mirror debbugs at most once
+# every 800 seconds
+
+set -e
+
+umask 002
+
+cd /org/bugs.debian.org
+
+[ $(( $(date +%s) - $(stat -c %Y /org/bugs.debian.org/log/mirrors.log) )) -gt 800 ] || exit 0;
+
+exec >>log/mirrors.log 2>&1
+
+signal () {
+  if [ $# = 2 ]; then
+    echo Signalling $1: $2@$1 > log/$1.log
+    key="$HOME/.ssh/bts-mirror"
+    ssh -i "$key" -o"user $2" "$1" sleep 1 &
+  fi
+}
+
+date
+
+signal merkel debbugs
diff --git a/examples/debian/postpa/20impbugs b/examples/debian/postpa/20impbugs
new file mode 100755 (executable)
index 0000000..40f21c6
--- /dev/null
@@ -0,0 +1,37 @@
+#! /usr/bin/perl -w
+
+use warnings;
+use strict;
+
+use Debbugs::Config qw(:globals);
+use Debbugs::Common qw(splitpackages);
+use Debbugs::Status qw(get_bug_status);
+use Debbugs::Bugs qw(count_bugs);
+
+my %strong = map { $_ => 1 } @gStrongSeverities;
+
+my %impbugs = count_bugs(function => sub {
+    my %d = @_;
+
+    # Fast checks.
+    return () if $d{status} eq 'done' or not $strong{$d{severity}};
+    my %tags = map { $_ => 1 } split ' ', $d{tags};
+    return () if $tags{fixed} or $tags{'etch-ignore'};
+    return () if ($tags{potato} or $tags{woody} or $tags{sarge} or $tags{etch} or $tags{experimental}) and not $tags{sid};
+
+    # Unfortunately mergedwith isn't indexed.
+    my $status = get_bug_status(bug => $d{bug});
+    my @merged = sort split ' ', $status->{mergedwith};
+    return () if @merged and $merged[0] < $d{bug};
+
+    return splitpackages($d{pkg});
+});
+
+open IMPBUGS, '> /org/bugs.debian.org/www/stats/impbugs.txt.new'
+    or die "can't open impbugs.txt.new: $!";
+for my $pkg (reverse sort keys %impbugs) {
+    print IMPBUGS "$pkg $impbugs{$pkg}\n" or die "can't write to impbugs.txt.new: $!";
+}
+close IMPBUGS or die "can't close impbugs.txt.new: $!";
+rename '/org/bugs.debian.org/www/stats/impbugs.txt.new', '/org/bugs.debian.org/www/stats/impbugs.txt'
+    or die "can't rename impbugs.txt.new to impbugs.txt: $!";
diff --git a/examples/debian/postpa/20impbugs-versioned b/examples/debian/postpa/20impbugs-versioned
new file mode 100755 (executable)
index 0000000..65a2b6a
--- /dev/null
@@ -0,0 +1,72 @@
+#! /usr/bin/perl
+
+use warnings;
+use strict;
+use Debbugs::Config qw(:globals);
+use Debbugs::Status qw(splitpackages buggy);
+use Debbugs::Packages qw(getversions makesourceversions);
+use Debbugs::Bugs qw(count_bugs);
+
+my %strong = map { $_ => 1 } @gStrongSeverities;
+my $pkgsrc = getpkgsrc();
+my $version_cache = {};
+# love my do nothing warn handler?
+$SIG{__WARN__} = sub {};
+for my $dist ('testing', 'unstable') {
+  # no locking, so don't run this multiple times mmkay
+  open IMPBUGS, "> /org/bugs.debian.org/www/stats/impbugs.$dist.txt.new"
+    or die "can't open impbugs.$dist.txt.new: $!";
+
+  my @merged;
+  my %impbugs = count_bugs(function => sub {
+    my %d = @_;
+
+    # Fast checks.
+    return () if $d{status} eq 'done' or not $strong{$d{severity}};
+    my %tags = map { $_ => 1 } split ' ', $d{tags};
+    return () if $tags{fixed} or $tags{'etch-ignore'};
+    return () if (grep /^$d{bug}$/, @merged);
+
+    # Unfortunately mergedwith isn't indexed.
+    my $status = getbugstatus($d{bug});
+    push(@merged, split(' ', $status->{'mergedwith'}));
+
+    #set_option('dist', $dist);
+    my %affected=();
+
+    foreach my $pkg (splitpackages($d{pkg})) {
+        my @versions = getversions($pkg, $dist, 'source');
+        if (defined $versions[0]) {
+            if (not $pkgsrc->{$pkg} or $pkg eq $pkgsrc->{$pkg}) { # if it has source and is source-only, the makesourceversions fails ...
+               @versions = map { "$pkg/$_" unless /^\//} @versions;
+            } else {
+               @versions = makesourceversions($pkg, 'source', @versions);
+            }
+        } else {
+            @versions = getversions($pkg, $dist, 'i386');
+            ## ^ buggy! fix me!
+            @versions = makesourceversions($pkg, 'i386', @versions);
+        }
+        for my $version (@versions) {
+           my $buggy = buggy(bug => $d{bug}, version => $version,
+                            found => $status->{found_versions},
+                            fixed => $status->{fixed_versions},
+                            version_cache => $version_cache,
+                            package => $pkg);
+           if ($buggy eq 'found') {
+               $affected{$pkg}=1;
+               last;
+           }
+        }
+    }
+    return keys %affected;
+  });
+
+  print "warnings/errors: $@" if $@;
+  for my $pkg (reverse sort keys %impbugs) {
+    print IMPBUGS "$pkg $impbugs{$pkg}\n" or die "can't write to impbugs.$dist.txt.new: $!";
+  }
+  close IMPBUGS or die "can't close impbugs.$dist.txt.new: $!";
+  rename "/org/bugs.debian.org/www/stats/impbugs.$dist.txt.new", "/org/bugs.debian.org/www/stats/impbugs.$dist.txt"
+    or die "can't rename impbugs.$dist.txt.new to impbugs.$dist.txt: $!";
+}
diff --git a/examples/debian/postpa/21bugclosers b/examples/debian/postpa/21bugclosers
new file mode 100755 (executable)
index 0000000..382b779
--- /dev/null
@@ -0,0 +1,49 @@
+#! /usr/bin/perl -w
+
+use warnings;
+use strict;
+
+use Debbugs::Config qw(:globals);
+
+use Debbugs::Bugs qw(count_bugs);
+use Debbugs::Status qw(get_bug_status);
+
+require '/org/bugs.debian.org/cgi-bin/common.pl';
+
+package main;
+
+my $startdate = time;
+die "failed to get time: $!" unless defined $startdate;
+
+# check the ctime of '/org/bugs.debian.org/www/stats/bugclosers.txt'
+use File::stat;
+my $ob = stat '/org/bugs.debian.org/www/stats/bugclosers.txt';
+if (defined $ob and (time - $ob->ctime) < 60*60*12) {
+     # If less than 12 hours have passed since we last ran this file,
+     # don't rebuild it.
+     exit 0;
+}
+      
+
+my %bugclosers = count_bugs(function => sub {
+    my %d = @_;
+    return () unless $d{status} eq 'done';
+
+    my $status = get_bug_status(bug => $d{bug});
+    return () unless %$status;
+    my @merged = sort split ' ', $status->{mergedwith};
+    return () if @merged and $merged[0] < $d{bug};
+
+    return ($status->{done});
+});
+
+open BUGCLOSERS, '> /org/bugs.debian.org/www/stats/bugclosers.txt.new'
+    or die "can't open bugclosers.txt.new: $!";
+for my $closer (sort { $bugclosers{$a} <=> $bugclosers{$b} } keys %bugclosers) {
+    printf BUGCLOSERS "%4d %s\n", $bugclosers{$closer}, $closer
+       or die "can't write to bugclosers.txt.new: $!";
+}
+close BUGCLOSERS or die "can't close bugclosers.txt.new: $!";
+rename '/org/bugs.debian.org/www/stats/bugclosers.txt.new',
+       '/org/bugs.debian.org/www/stats/bugclosers.txt'
+    or die "can't rename bugclosers.txt.new to bugclosers.txt: $!";
diff --git a/examples/debian/postpa/22oldbugs b/examples/debian/postpa/22oldbugs
new file mode 100755 (executable)
index 0000000..09428a1
--- /dev/null
@@ -0,0 +1,97 @@
+#! /usr/bin/perl
+
+use warnings;
+use strict;
+
+use Debbugs::Config qw(:globals);
+use Debbugs::Bugs qw(count_bugs);
+use Debbugs::CGI qw(html_escape);
+use Debbugs::Status qw(get_bug_status);
+
+
+# Derived from the 'summary' script in the debbugs package, via
+# ~ajt/bugscan.
+
+my $startdate = time;
+die "failed to get time: $!" unless defined $startdate;
+
+# check the ctime of '/org/bugs.debian.org/www/stats/oldbugs.html'
+use File::stat;
+my $ob = stat '/org/bugs.debian.org/www/stats/oldbugs.html';
+if (defined $ob and (time - $ob->ctime) < 60*60*12) {
+  # If less than 12 hours have passed since we last ran this file,
+  # don't rebuild it.
+  exit 0;
+}
+
+my %excludepackage = ();
+for (qw(bugs.debian.org ftp.debian.org lists.debian.org)) {
+    $excludepackage{$_} = 1;
+}
+
+my (%oldpackage, %olddesc, %oldage);
+
+count_bugs(function => sub {
+    my %d = @_;
+
+    # Fast checks.
+    return () if $d{status} eq 'done' or
+                $d{severity} eq 'fixed' or $d{severity} eq 'wishlist';
+    my %tags = map { $_ => 1 } split ' ', $d{tags};
+    return () if $tags{fixed};
+
+    my $status = get_bug_status($d{bug});
+    my @merged = sort split ' ', $status->{mergedwith};
+    return () if @merged and $merged[0] < $d{bug};
+
+    # 3600*24*30 (30 days)
+    my $cmonths = int(($startdate - $status->{date}) / 2592000);
+    if ($cmonths >= 24 && !length($status->{forwarded}) &&
+           !$excludepackage{$d{pkg}}) {
+       $oldpackage{$d{bug}} = $d{pkg};
+       $olddesc{$d{bug}} = (length($d{tags}) ? "$d{tags}/" : '') .
+                           $status->{subject};
+       $oldage{$d{bug}} = $cmonths;
+    }
+});
+
+my $date = `date`;
+chomp $date;
+
+my $nrbugs = keys %oldpackage;
+
+open OLDBUGS, '> /org/bugs.debian.org/www/stats/oldbugs.html.new'
+    or die "can't open oldbugs.html.new: $!";
+print OLDBUGS <<EOF or die "can't write to oldbugs.html.new: $!";
+<html><head><title>Bugs Over Two Years Old</title></head>
+<body>
+<h1>Bugs Over Two Years Old</h1>
+
+<p>Report date: $date<br>
+Number of bugs: $nrbugs
+</p>
+EOF
+
+# TODO: sort optimization would help a lot here
+while (%oldpackage) {
+    my $firstpackage = $oldpackage{(sort { $a <=> $b } keys %oldpackage)[0]};
+
+    print OLDBUGS "<p>Package: <a href=\"http://bugs.debian.org/$firstpackage\">$firstpackage</a><br>\n" or
+        die "can't write to oldbugs.html.new: $!";
+    # TODO: maintainer
+    # TODO: comments
+    for (sort { $a <=> $b } keys %oldpackage) {
+       if ($oldpackage{$_} eq $firstpackage) {
+           printf OLDBUGS "<a href=\"http://bugs.debian.org/%d\">%d</a> %s<br>\n", $_, $_, html_escape($olddesc{$_}) or
+                die "can't write to oldbugs.html.new: $!";;
+           # TODO: comments
+           delete $oldpackage{$_};
+       }
+    }
+    print OLDBUGS "\n";
+}
+
+close OLDBUGS or die "can't close oldbugs.html.new: $!";
+rename '/org/bugs.debian.org/www/stats/oldbugs.html.new',
+       '/org/bugs.debian.org/www/stats/oldbugs.html'
+    or die "can't rename oldbugs.html.new to oldbugs.html: $!";
diff --git a/examples/debian/versions/debbugs-makeversions b/examples/debian/versions/debbugs-makeversions
new file mode 100755 (executable)
index 0000000..949e76a
--- /dev/null
@@ -0,0 +1,197 @@
+#! /usr/bin/perl -w
+# Extract version information from an existing non-versioned database by
+# guesswork, based on Version: pseudo-headers and closing mails that look
+# like Debian changelogs. The latter in particular is somewhat heuristic.
+
+use strict;
+use Debbugs::Log;
+use Debbugs::MIME;
+
+if (@ARGV != 2) {
+    print <<EOF;
+Usage: $0 db-directory versions-directory
+
+EOF
+    exit 0;
+}
+
+sub getbuginfo ($)
+{
+    my $log = shift;
+    #print "Processing $log ...\n";
+
+    open LOG, "< $log" or die "Can't open $log: $!";
+    my @records = read_log_records(*LOG);
+    close LOG;
+
+    my (@found_versions, @fixed_versions);
+    my (%found_versions, %fixed_versions);
+
+    for my $record (@records) {
+       if ($record->{type} eq 'html') {
+           # Reassigns zap the found and fixed version list. Reopens will
+           # zap the fixed list too in the full deployment, but doing that
+           # here causes problems in case of accidental reopens and
+           # recloses.
+           if ($record->{text} =~ /assigned/) {
+               @found_versions = ();
+               %found_versions = ();
+               @fixed_versions = ();
+               %fixed_versions = ();
+           }
+           next;
+       }
+
+       next unless $record->{type} eq 'autocheck' or
+                   $record->{type} eq 'incoming-recv';
+       my $decoded = Debbugs::MIME::parse($record->{text});
+       next unless defined $decoded;
+
+       # Was it sent to -done or -close?
+       my $closing = 0;
+       my $firstreceived = $decoded->{header}[0];
+       if ($firstreceived =~ /\(at [^)]*-(?:done|close)\)/) {
+           $closing = 1;
+       }
+
+       # Get Version: pseudo-headers.
+       my $i;
+       my ($source, $sourcever, $ver);
+       for ($i = 0; $i < @{$decoded->{body}}; ++$i) {
+           last if $decoded->{body}[$i] !~ /^(\S+):\s*(.*)/;
+           my ($fn, $fv) = (lc $1, $2);
+           if ($fn eq 'source') {
+               $source = $fv;
+           } elsif ($fn eq 'source-version' and
+                    $fv =~ /^(\d[^,\s]*(?:[,\s]+|$))+/) {
+               $sourcever = $fv;
+           } elsif ($fn eq 'version' and $fv =~ /^(\d[^,\s]*(?:[,\s]+|$))+/) {
+               # Deal with reportbug brain-damage.
+               next if $fv =~ /^unavailable/i;
+               $fv =~ s/;.*//;
+               $fv =~ s/ *\(.*\)//;
+               $ver = $fv;
+           }
+       }
+
+       my @parsedvers;
+       if (defined $ver) {
+           push @parsedvers, split /[,\s]+/, $ver;
+       } elsif (defined $source and defined $sourcever) {
+           push @parsedvers, map "$source/$_", split /[,\s]+/, $sourcever;
+       }
+
+       if ($closing) {
+           for my $v (@parsedvers) {
+               push @fixed_versions, $v
+                   unless exists $fixed_versions{$v};
+               $fixed_versions{$v} = 1;
+               @found_versions = grep { $_ ne $v } @found_versions;
+               delete $found_versions{$v};
+           }
+       } else {
+           for my $v (@parsedvers) {
+               push @found_versions, $v
+                   unless exists $found_versions{$v};
+               $found_versions{$v} = 1;
+               @fixed_versions = grep { $_ ne $v } @fixed_versions;
+               delete $fixed_versions{$v};
+           }
+       }
+
+       if ($closing) {
+           # Look for Debian changelogs.
+           for (; $i < @{$decoded->{body}}; ++$i) {
+               if ($decoded->{body}[$i] =~
+                       /(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\) \S+; urgency=\S+/i) {
+                   my ($p, $v) = ($1, $2);
+                   push @fixed_versions, "$p/$v"
+                       unless exists $fixed_versions{"$p/$v"};
+                   $fixed_versions{"$p/$v"} = 1;
+                   @found_versions = grep { $_ ne "$p/$v" } @found_versions;
+                   delete $found_versions{"$p/$v"};
+                   last;
+               }
+           }
+       }
+    }
+
+    return (\@found_versions, \@fixed_versions);
+}
+
+sub mergeinto ($$)
+{
+    my ($target, $source) = @_;
+    my %seen = map { $_ => 1 } @$target;
+    for my $v (@$source) {
+       next if exists $seen{$v};
+       push @$target, $v;
+       $seen{$v} = 1;
+    }
+}
+
+my ($db, $verdb) = @ARGV[0, 1];
+opendir DB, $db or die "Can't opendir $db: $!";
+unless (-d $verdb) {
+    mkdir $verdb or die "Can't mkdir $verdb: $!";
+}
+
+while (defined(my $dir = readdir DB)) {
+    next if $dir =~ /^\.\.?$/ or not -d "$db/$dir";
+    opendir HASH, "$db/$dir" or die "Can't opendir $db/$dir: $!";
+
+    while (defined(my $file = readdir HASH)) {
+       next unless $file =~ /\.log$/;
+       next if -z "$db/$dir/$file";
+       (my $bug = $file) =~ s/\..*//;
+
+       $bug =~ /(..)$/;
+       my $bughash = $1;
+       #next if -e "$verdb/$bughash/$bug.versions" and
+       #       (stat "$verdb/$bughash/$bug.versions")[9] >=
+       #           (stat "$db/$dir/$file")[9];
+
+       print "Processing $bug ...\n" if $ENV{DEBBUGS_VERBOSE};
+
+       open STATUS, "$db/$dir/$bug.status" or next;
+       <STATUS> for 1 .. 6;    # done is field 7
+       chomp (my $done = <STATUS>);
+       <STATUS>;               # mergedwith is field 9
+       chomp (my $mergedwith = <STATUS>);
+       close STATUS;
+
+       my ($found_versions, $fixed_versions) = getbuginfo("$db/$dir/$file");
+
+       if (length $mergedwith) {
+           for my $merge (split ' ', $mergedwith) {
+               $merge =~ /(..)$/;
+               my $mergehash = $1;
+               my ($mfound, $mfixed) =
+                   getbuginfo("$db/$mergehash/$merge.log");
+               mergeinto($found_versions, $mfound);
+               mergeinto($fixed_versions, $mfixed);
+           }
+       }
+
+       @$fixed_versions = () unless length $done;
+
+       for my $out ($bug, (split ' ', $mergedwith)) {
+           $out =~ /(..)$/;
+           my $outhash = $1;
+
+           unless (-d "$verdb/$outhash") {
+               mkdir "$verdb/$outhash" or die "Can't mkdir $verdb/$outhash: $!";
+           }
+
+           open VERSIONS, "> $verdb/$outhash/$out.versions"
+               or die "Can't open $verdb/$outhash/$out.versions: $!";
+           print VERSIONS "Found-in: @$found_versions\n";
+           print VERSIONS "Fixed-in: @$fixed_versions\n";
+           close VERSIONS;
+       }
+    }
+
+    closedir HASH;
+}
+
+closedir DB;
diff --git a/examples/debian/versions/merge-one-debinfo b/examples/debian/versions/merge-one-debinfo
new file mode 100755 (executable)
index 0000000..1ac2268
--- /dev/null
@@ -0,0 +1,28 @@
+#! /usr/bin/perl -w
+use strict;
+use MLDBM qw(DB_File Storable);
+use Fcntl;
+
+$MLDBM::DumpMeth=q(portable);
+
+my (%srcbin, %binsrc);
+tie %srcbin, 'MLDBM', '/org/bugs.debian.org/versions/indices/srcbin.idx',
+            O_CREAT|O_RDWR, 0644
+    or die "tie srcbin.idx: $!";
+tie %binsrc, 'MLDBM', '/org/bugs.debian.org/versions/indices/binsrc.idx',
+            O_CREAT|O_RDWR, 0644
+    or die "tie binsrc.idx: $!";
+
+while (<>) {
+    my ($binname, $binver, $binarch, $srcname, $srcver) = split;
+    print STDERR "$binname/$binver/$binarch => $srcname/$srcver\n";
+
+    # see MLDBM(3pm)/BUGS
+    my $tmp = $srcbin{$srcname};
+    push @{$tmp->{$srcver}}, [$binname, $binver, $binarch];
+    $srcbin{$srcname} = $tmp;
+
+    $tmp = $binsrc{$binname};
+    $tmp->{$binver}{$binarch} = [$srcname, $srcver];
+    $binsrc{$binname} = $tmp;
+}
diff --git a/examples/debian/versions/merge-one-version b/examples/debian/versions/merge-one-version
new file mode 100755 (executable)
index 0000000..7be6f38
--- /dev/null
@@ -0,0 +1,35 @@
+#! /usr/bin/perl -w
+
+use vars qw($gVersionPackagesDir);
+require '/etc/debbugs/config';
+my $root = $gVersionPackagesDir;
+
+use strict;
+use Debbugs::Versions;
+use Debbugs::Versions::Dpkg;
+
+unless (-d $root) {
+    mkdir $root or die "can't mkdir $root: $!\n";
+}
+
+my $tree = Debbugs::Versions->new(\&Debbugs::Versions::Dpkg::vercmp);
+
+my $versions = shift;
+
+(my $pkg = $versions) =~ s{.*/}{};
+$pkg =~ s/_.*//;
+my $pkghash = substr $pkg, 0, 1;
+unless (-d "$root/$pkghash") {
+    mkdir "$root/$pkghash" or die "can't mkdir $root/$pkghash";
+}
+my $outfile = "$root/$pkghash/$pkg";
+if (open PREV, "< $outfile") {
+    $tree->load(*PREV);
+    close PREV;
+}
+
+$tree->load(*STDIN);
+
+open OUT, "> $outfile" or die "can't open $outfile for writing: $!\n";
+$tree->save(*OUT);
+close OUT or die "can't close $outfile: $!\n";
diff --git a/examples/debian/versions/merge-versions.pl b/examples/debian/versions/merge-versions.pl
new file mode 100755 (executable)
index 0000000..057eb19
--- /dev/null
@@ -0,0 +1,41 @@
+#! /usr/bin/perl -w
+use strict;
+use File::Find;
+use Debbugs::Versions;
+use Debbugs::Versions::Dpkg;
+
+my %pkgs;
+
+sub search {
+    return unless -f;
+    my ($pkg) = split /_/;
+    push @{$pkgs{$pkg}}, "$File::Find::dir/$_";
+}
+
+find(\&search, 'cl-data');
+
+for my $pkg (sort keys %pkgs) {
+    print STDERR "$pkg\n";
+    my $tree = Debbugs::Versions->new(\&Debbugs::Versions::Dpkg::vercmp);
+    for my $file (@{$pkgs{$pkg}}) {
+       unless (open FILE, "< $file") {
+           warn "can't open $file: $!\n";
+           next;
+       }
+       $tree->load(*FILE);
+       close FILE;
+    }
+    my $pkghash = substr $pkg, 0, 1;
+    unless (-d "pkg/$pkghash") {
+       unless (mkdir "pkg/$pkghash") {
+           warn "can't mkdir pkg/$pkghash: $!\n";
+           next;
+       }
+    }
+    unless (open OUT, "> pkg/$pkghash/$pkg") {
+       warn "can't open pkg/$pkghash/$pkg for writing: $!\n";
+       next;
+    }
+    $tree->save(*OUT);
+    close OUT;
+}
diff --git a/examples/debian/versions/queue-debinfo b/examples/debian/versions/queue-debinfo
new file mode 100755 (executable)
index 0000000..5216a9a
--- /dev/null
@@ -0,0 +1,17 @@
+#! /bin/sh
+set -e
+
+# Called from update-versions (inside the lock) to process all *.debinfo
+# files in the queue.
+
+SOURCE="$1"
+
+cd "/org/bugs.debian.org/versions/queue/$SOURCE"
+
+find . -maxdepth 1 -name \*.debinfo -printf '%P\n' | while read x; do
+    /org/bugs.debian.org/versions/bin/merge-one-debinfo "$x" || continue
+    pkg="${x%%_*}"
+    pkghash="$(echo "$pkg" | cut -b 1)"
+    mkdir -p "/org/bugs.debian.org/versions/archive/$SOURCE/$pkghash/$pkg"
+    mv "$x" "/org/bugs.debian.org/versions/archive/$SOURCE/$pkghash/$pkg"
+done
diff --git a/examples/debian/versions/queue-versions b/examples/debian/versions/queue-versions
new file mode 100755 (executable)
index 0000000..e27a601
--- /dev/null
@@ -0,0 +1,24 @@
+#! /bin/sh
+set -e
+
+# Called from update-versions (inside the lock) to process all *.versions
+# files in the queue.
+
+SOURCE="$1"
+
+cd "/org/bugs.debian.org/versions/queue/$SOURCE"
+
+find . -maxdepth 1 -name \*.versions -printf '%P\n' | while read x; do
+    perl -ne '
+       if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) {
+           push @v, "$1/$2";
+       }
+       END { print join(" ", @v), "\n"; }
+    ' "$x" \
+       | /org/bugs.debian.org/versions/bin/merge-one-version "$x" \
+       || continue
+    pkg="${x%%_*}"
+    pkghash="$(echo "$pkg" | cut -b 1)"
+    mkdir -p "/org/bugs.debian.org/versions/archive/$SOURCE/$pkghash/$pkg"
+    mv "$x" "/org/bugs.debian.org/versions/archive/$SOURCE/$pkghash/$pkg/$x"
+done
diff --git a/examples/debian/versions/test-versions.pl b/examples/debian/versions/test-versions.pl
new file mode 100755 (executable)
index 0000000..91d9940
--- /dev/null
@@ -0,0 +1,38 @@
+#! /usr/bin/perl -w
+use strict;
+use Benchmark qw(:all);
+use Data::Dumper;
+use lib '/home/cjwatson';
+use Debbugs::Versions;
+use Debbugs::Versions::Dpkg;
+
+my $tree;
+timethis(1, sub {
+    $tree = Debbugs::Versions->new(\&Debbugs::Versions::Dpkg::vercmp);
+});
+timethis(1, sub {
+    #$tree->load(*STDIN);
+    open GLIBC, '<', '/org/bugs.debian.org/versions/pkg/g/glibc';
+    $tree->load(*GLIBC);
+    close GLIBC;
+});
+timethis(1, sub {
+    $tree->save(*STDOUT);
+});
+print $tree->buggy('glibc/2.3.5-3', [qw(glibc/2.1.1-1 glibc/2.1.1-5)], [qw(glibc/2.1.1-3 glibc/2.3.2.ds1-11)]);
+timethis(0, sub {
+    $tree->buggy('glibc/2.3.5-3', [qw(glibc/2.1.1-1 glibc/2.1.1-5)], [qw(glibc/2.1.1-3 glibc/2.3.2.ds1-11)]);
+});
+my %state = $tree->allstates([qw(glibc/2.1.1-1 glibc/2.1.1-5)], [qw(glibc/2.1.1-3 glibc/2.3.2.ds1-11)], [qw(glibc/2.3.2.ds1-22 glibc/2.3.2.ds1-2)]);
+for my $ver (sort keys %state) {
+    print "\$state{$ver} = $state{$ver}\n";
+}
+timethis(0, sub {
+    $tree->allstates([qw(glibc/2.1.1-1 glibc/2.1.1-5)], [qw(glibc/2.1.1-3 glibc/2.3.2.ds1-11)], [qw(glibc/2.3.2.ds1-22 glibc/2.3.2.ds1-2)]);
+});
+#my %versions = map { $_ => 1 } qw( 2.3.1-17 2.3.1-16 2.3.1-15 2.3.1-14 2.3.1-13 2.3.1-12 2.3.1-11 2.3.1-10 2.3.1-9 2.3.1-8 2.3.1-7 2.3.1-6 2.3.1-5 2.3.1-4 2.3.1-3 2.3.1-2 2.3.1-1 2.2.5-15 2.2.5-14.3 2.2.5-14.2 2.2.5-14.1 2.2.5-14 2.2.5-13 2.2.5-12 2.2.5-11 2.2.5-10.0 2.2.5-9 2.2.5-8 2.2.5-7 2.2.5-6 2.2.5-5 2.2.5-4 2.2.5-3 2.2.5-2 2.2.5-1 2.2.4-7 2.2.4-6 2.2.4-5 2.2.4-4 2.2.4-3 2.2.4-2 2.2.4-1 2.2.3-11 2.2.3-10 2.2.3-9 2.2.3-8 2.2.3-7 2.2.3-6 2.2.3-5 2.2.3-4 2.2.3-3 2.2.3-2 2.2.3-1 2.2.2-4 2.2.2-3 2.2.2-2 2.2.2-1 2.2.1-4 2.2.1-3 2.2.1-2 2.2.1-1 2.2-11 2.2-10 2.2-9 2.2-8 2.2-7 2.2-6 2.2-5 2.2-4 2.2-3 2.2-2 2.2-1 2.1.97-1 2.1.96-1 2.1.95-1 2.1.94-3 2.1.94-2 2.1.94-1 2.1.3-14 2.1.3-13 2.1.3-12 2.1.3-11 2.1.3-10 2.1.3-9 2.1.3-8 2.1.3-7 2.1.3-6 2.1.3-5 2.1.3-4 2.1.3-3 2.1.3-2 2.1.3-1 2.1.2-13 2.1.2-12 2.1.2-11.0.1 2.1.2-11 2.1.2-10 2.1.2-9 2.1.2-8 2.1.2-7 2.1.2-6 2.1.2-5 2.1.2-4 2.1.2-3 2.1.2-2 2.1.2-1 2.1.2-0pre12 2.1.2-0pre11 2.1.2-0pre10 2.1.2-0pre9 2.1.2-0pre8 2.1.2-0pre7 2.1.2-0pre6 2.1.2-0pre5 2.1.2-0pre4 2.1.2-0pre3 2.1.2-0pre2 2.1.2-0pre1 2.1.1-13 2.1.1-12.3 2.1.1-12.2 2.1.1-12.1 2.1.1-12 2.1.1-11 2.1.1-10 2.1.1-9 2.1.1-8 2.1.1-7 2.1.1-6 2.1.1-5 2.1.1-4 2.1.1-3 2.1.1-2 2.1.1-1 2.1.1-0.2 2.1.1-0.1 2.1.1-0pre1.3 2.1.1-0pre1.2 2.1.1-0pre1.1 2.1.1-0pre1 2.1-4 2.1-3 2.1-2 2.1-1 2.2.5-11.2 2.2.5-11.1 2.2.5-11 2.2.5-10 2.2.5-9 2.1.3-20 2.1.3-19 2.1.3-18 2.1.3-17 2.1.3-16 2.1.3-15 2.1.3-14);
+#my @versions = sort keys %versions;
+#
+#for my $x (@versions) {
+#    print $tree->buggy($x, [qw(2.2-7 2.1.1-8 2.2.1-4 2.2.5-15 2.1.3-11 2.2.5-9 2.1.3-18)], [qw(2.1.3-20 2.2-7 2.3.1-1)]) ? "$x buggy\n" : "$x not buggy\n";
+#}
diff --git a/examples/debian/versions/update-packages b/examples/debian/versions/update-packages
new file mode 100755 (executable)
index 0000000..502a167
--- /dev/null
@@ -0,0 +1,6 @@
+#!/bin/sh
+
+/home/debbugs/get-packages ftp; 
+/home/debbugs/get-packages nonus; 
+/home/debbugs/get-packages security; 
+/org/bugs.debian.org/versions/indices/update-mldbm >/dev/null
diff --git a/examples/debian/versions/update-versions b/examples/debian/versions/update-versions
new file mode 100755 (executable)
index 0000000..8996b2c
--- /dev/null
@@ -0,0 +1,32 @@
+#! /bin/sh
+set -e
+
+umask 002
+
+exec >>/org/bugs.debian.org/log/update-versions.log 2>&1
+
+LOCK=/org/bugs.debian.org/versions/lock/update-versions.lock
+
+if lockfile -! -l 3600 -r 0 "$LOCK"; then
+    echo "unable to start update-versions, lock file exists"
+    exit 1
+fi
+trap "rm -f \"$LOCK\" >/dev/null 2>&1" exit
+
+cd /org/bugs.debian.org/versions/queue/ftp-master
+
+#~debbugs/ssh-move \
+#      --ssh-identity ~debbugs/.ssh/bts-vt \
+#      --ssh-move-path ~debbugs/ssh-move \
+#      --from-directory /org/ftp.debian.org/queue/bts_version_track \
+#      ftp-master.debian.org \*.debinfo \*.versions
+
+# while ftp-master.debian.org == bugs.debian.org:
+find /org/ftp.debian.org/queue/bts_version_track/ \
+       \( -name \*.debinfo -o -name \*.versions \) -print0 | \
+       xargs -0r mv --target-directory="$(pwd)"
+
+/org/bugs.debian.org/versions/bin/queue-versions ftp-master
+/org/bugs.debian.org/versions/bin/queue-debinfo ftp-master
+
+rm -f "$LOCK" >/dev/null 2>&1