From 8ce4bbed70e19412f396d4416b4c18bc0ac8a6b4 Mon Sep 17 00:00:00 2001
From: Don Armstrong <don@donarmstrong.com>
Date: Fri, 4 Aug 2017 14:56:00 -0700
Subject: [PATCH] add Debbugs::DebArchive to read Packages, Releases, and
 Sources

---
 Debbugs/DebArchive.pm | 204 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 204 insertions(+)
 create mode 100644 Debbugs/DebArchive.pm

diff --git a/Debbugs/DebArchive.pm b/Debbugs/DebArchive.pm
new file mode 100644
index 0000000..ccb321a
--- /dev/null
+++ b/Debbugs/DebArchive.pm
@@ -0,0 +1,204 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
+
+package Debbugs::DebArchive;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+Debbugs::DebArchive -- Routines for reading files from Debian archives
+
+=head1 SYNOPSIS
+
+use Debbugs::DebArchive;
+
+   read_packages('/srv/mirrors/ftp.debian.org/ftp/dist',
+                 sub { print map {qq($_\n)} @_ },
+                 Term::ProgressBar->new(),
+                );
+
+
+=head1 DESCRIPTION
+
+This module implements a set of routines for reading Packages.gz, Sources.gz and
+Release files from the dists directory of a Debian archive.
+
+=head1 BUGS
+
+None known.
+
+=cut
+
+
+use vars qw($DEBUG $VERSION @EXPORT_OK %EXPORT_TAGS @EXPORT);
+use base qw(Exporter);
+
+BEGIN {
+    $VERSION = 1.00;
+    $DEBUG = 0 unless defined $DEBUG;
+
+    @EXPORT = ();
+    %EXPORT_TAGS = (read => [qw(read_release_file read_packages),
+                            ],
+		   );
+    @EXPORT_OK = ();
+    Exporter::export_ok_tags(keys %EXPORT_TAGS);
+    $EXPORT_TAGS{all} = [@EXPORT_OK];
+}
+
+use File::Spec qw();
+use File::Basename;
+use Debbugs::Config qw(:config);
+use Debbugs::Common qw(open_compressed_file make_list);
+use IO::Dir;
+
+use Carp;
+
+=over
+
+=item read_release_file
+
+     read_release_file('stable/Release')
+
+Reads a Debian release file and returns a hashref of information about the
+release file, including the Packages and Sources files for that distribution
+
+=cut
+
+sub read_release_file {
+    my ($file) = @_;
+    # parse release
+    my $rfh =  open_compressed_file($file) or
+	die "Unable to open $file for reading: $!";
+    my %dist_info;
+    my $in_sha1;
+    my %p_f;
+    while (<$rfh>) {
+	chomp;
+	if (s/^(\S+):\s*//) {
+	    if ($1 eq 'SHA1'or $1 eq 'SHA256') {
+		$in_sha1 = 1;
+		next;
+	    }
+	    $dist_info{$1} = $_;
+	} elsif ($in_sha1) {
+	    s/^\s//;
+	    my ($sha,$size,$f) = split /\s+/,$_;
+	    next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
+	    next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$};
+	    my ($component,$arch,$package_source) = ($1,$2,$3);
+	    $arch =~ s/binary-//;
+	    next if exists $p_f{$component}{$arch} and
+                $p_f{$component}{$arch} =~ /\.xz$/;
+	    $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f);
+	}
+    }
+    return (\%dist_info,\%p_f);
+}
+
+=item read_packages
+
+     read_packages($dist_dir,$callback,$progress)
+
+=over
+
+=item dist_dir
+
+Path to dists directory
+
+=item callback
+
+Function which is called with key, value pairs of suite, arch, component,
+Package, Source, Version, and Maintainer information for each package in the
+Packages file.
+
+=item progress
+
+Optional Term::ProgressBar object to output progress while reading packages.
+
+=back
+
+
+=cut
+
+sub read_packages {
+    my ($dist_dir,$callback,$p) = @_;
+
+    my %s_p;
+    my $tot = 0;
+    for my $dist (make_list($dist_dir)) {
+	my $dist_dir_h = IO::Dir->new($dist);
+	my @dist_names =
+	    grep { $_ !~ /^\./ and
+		   -d $dist.'/'.$_ and
+		   not -l $dist.'/'.$_
+	       } $dist_dir_h->read or
+               die "Unable to read from dir: $!";
+        $dist_dir_h->close or
+            die "Unable to close dir: $!";
+	while (my $dist = shift @dist_names) {
+	    my $dir = $dist_dir.'/'.$dist;
+	    my ($dist_info,$package_files) =
+		read_release_file(File::Spec->catfile($dist_dir,
+                                                      $dist,
+                                                      'Release'));
+	    $s_p{$dist_info->{Codename}} = $package_files;
+	}
+	for my $suite (keys %s_p) {
+	    for my $component (keys %{$s_p{$suite}}) {
+		$tot += scalar keys %{$s_p{$suite}{$component}};
+	    }
+	}
+    }
+    $p->target($tot) if $p;
+    my $done_archs = 0;
+    # parse packages files
+    for my $suite (keys %s_p) {
+	my $pkgs = 0;
+	for my $component (keys %{$s_p{$suite}}) {
+	    my @archs = keys %{$s_p{$suite}{$component}};
+	    if (grep {$_ eq 'source'} @archs) {
+		@archs = ('source',grep {$_ ne 'source'} @archs);
+	    }
+	    for my $arch (@archs) {
+		my $pfh =  open_compressed_file($s_p{$suite}{$component}{$arch}) or
+		    die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
+		local $_;
+		local $/ = '';	# paragraph mode
+		while (<$pfh>) {
+		    my %pkg;
+		    for my $field (qw(Package Maintainer Version Source)) {
+			/^\Q$field\E: (.*)/m;
+			$pkg{$field} = $1;
+		    }
+		    next unless defined $pkg{Package} and
+			defined $pkg{Version};
+                    $pkg{suite} = $suite;
+                    $pkg{arch} = $arch;
+                    $pkg{component} = $component;
+		    $callback->(%pkg);
+		}
+                $p->update(++$done_archs) if $p;
+	    }
+	}
+    }
+    $p->remove() if $p;
+}
+
+=back
+
+=cut
+
+1;
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
-- 
2.39.2