]> git.donarmstrong.com Git - debbugs.git/blob - Debbugs/DebArchive.pm
get_bug_status can now accept a schema to pull from DB
[debbugs.git] / Debbugs / DebArchive.pm
1 # This module is part of debbugs, and is released
2 # under the terms of the GPL version 2, or any later
3 # version at your option.
4 # See the file README and COPYING for more information.
5 #
6 # Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
7
8 package Debbugs::DebArchive;
9
10 use warnings;
11 use strict;
12
13 =head1 NAME
14
15 Debbugs::DebArchive -- Routines for reading files from Debian archives
16
17 =head1 SYNOPSIS
18
19 use Debbugs::DebArchive;
20
21    read_packages('/srv/mirrors/ftp.debian.org/ftp/dist',
22                  sub { print map {qq($_\n)} @_ },
23                  Term::ProgressBar->new(),
24                 );
25
26
27 =head1 DESCRIPTION
28
29 This module implements a set of routines for reading Packages.gz, Sources.gz and
30 Release files from the dists directory of a Debian archive.
31
32 =head1 BUGS
33
34 None known.
35
36 =cut
37
38
39 use vars qw($DEBUG $VERSION @EXPORT_OK %EXPORT_TAGS @EXPORT);
40 use base qw(Exporter);
41
42 BEGIN {
43     $VERSION = 1.00;
44     $DEBUG = 0 unless defined $DEBUG;
45
46     @EXPORT = ();
47     %EXPORT_TAGS = (read => [qw(read_release_file read_packages),
48                             ],
49                    );
50     @EXPORT_OK = ();
51     Exporter::export_ok_tags(keys %EXPORT_TAGS);
52     $EXPORT_TAGS{all} = [@EXPORT_OK];
53 }
54
55 use File::Spec qw();
56 use File::Basename;
57 use Debbugs::Config qw(:config);
58 use Debbugs::Common qw(open_compressed_file make_list);
59 use IO::Dir;
60
61 use Carp;
62
63 =over
64
65 =item read_release_file
66
67      read_release_file('stable/Release')
68
69 Reads a Debian release file and returns a hashref of information about the
70 release file, including the Packages and Sources files for that distribution
71
72 =cut
73
74 sub read_release_file {
75     my ($file) = @_;
76     # parse release
77     my $rfh =  open_compressed_file($file) or
78         die "Unable to open $file for reading: $!";
79     my %dist_info;
80     my $in_sha1;
81     my %p_f;
82     while (<$rfh>) {
83         chomp;
84         if (s/^(\S+):\s*//) {
85             if ($1 eq 'SHA1'or $1 eq 'SHA256') {
86                 $in_sha1 = 1;
87                 next;
88             }
89             $dist_info{$1} = $_;
90         } elsif ($in_sha1) {
91             s/^\s//;
92             my ($sha,$size,$f) = split /\s+/,$_;
93             next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
94             next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$};
95             my ($component,$arch,$package_source) = ($1,$2,$3);
96             $arch =~ s/binary-//;
97             next if exists $p_f{$component}{$arch} and
98                 $p_f{$component}{$arch} =~ /\.xz$/;
99             $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f);
100         }
101     }
102     return (\%dist_info,\%p_f);
103 }
104
105 =item read_packages
106
107      read_packages($dist_dir,$callback,$progress)
108
109 =over
110
111 =item dist_dir
112
113 Path to dists directory
114
115 =item callback
116
117 Function which is called with key, value pairs of suite, arch, component,
118 Package, Source, Version, and Maintainer information for each package in the
119 Packages file.
120
121 =item progress
122
123 Optional Term::ProgressBar object to output progress while reading packages.
124
125 =back
126
127
128 =cut
129
130 sub read_packages {
131     my ($dist_dir,$callback,$p) = @_;
132
133     my %s_p;
134     my $tot = 0;
135     for my $dist (make_list($dist_dir)) {
136         my $dist_dir_h = IO::Dir->new($dist);
137         my @dist_names =
138             grep { $_ !~ /^\./ and
139                    -d $dist.'/'.$_ and
140                    not -l $dist.'/'.$_
141                } $dist_dir_h->read or
142                die "Unable to read from dir: $!";
143         $dist_dir_h->close or
144             die "Unable to close dir: $!";
145         while (my $dist = shift @dist_names) {
146             my $dir = $dist_dir.'/'.$dist;
147             my ($dist_info,$package_files) =
148                 read_release_file(File::Spec->catfile($dist_dir,
149                                                       $dist,
150                                                       'Release'));
151             $s_p{$dist_info->{Codename}} = $package_files;
152         }
153         for my $suite (keys %s_p) {
154             for my $component (keys %{$s_p{$suite}}) {
155                 $tot += scalar keys %{$s_p{$suite}{$component}};
156             }
157         }
158     }
159     $p->target($tot) if $p;
160     my $done_archs = 0;
161     # parse packages files
162     for my $suite (keys %s_p) {
163         my $pkgs = 0;
164         for my $component (keys %{$s_p{$suite}}) {
165             my @archs = keys %{$s_p{$suite}{$component}};
166             if (grep {$_ eq 'source'} @archs) {
167                 @archs = ('source',grep {$_ ne 'source'} @archs);
168             }
169             for my $arch (@archs) {
170                 my $pfh =  open_compressed_file($s_p{$suite}{$component}{$arch}) or
171                     die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
172                 local $_;
173                 local $/ = '';  # paragraph mode
174                 while (<$pfh>) {
175                     my %pkg;
176                     for my $field (qw(Package Maintainer Version Source)) {
177                         /^\Q$field\E: (.*)/m;
178                         $pkg{$field} = $1;
179                     }
180                     next unless defined $pkg{Package} and
181                         defined $pkg{Version};
182                     $pkg{suite} = $suite;
183                     $pkg{arch} = $arch;
184                     $pkg{component} = $component;
185                     $callback->(%pkg);
186                 }
187                 $p->update(++$done_archs) if $p;
188             }
189         }
190     }
191     $p->remove() if $p;
192 }
193
194 =back
195
196 =cut
197
198 1;
199
200 __END__
201 # Local Variables:
202 # indent-tabs-mode: nil
203 # cperl-indent-level: 4
204 # End: