1 # Hey emacs! This is a -*- Perl -*- script!
2 # Read_pkglists -- Perl utility functions to read Maemian's package lists
4 # Copyright (C) 1998 Christian Schwarz
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with this program. If not, you can find it on the World Wide
18 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
19 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
24 use lib "$ENV{'MAEMIAN_ROOT'}/lib";
27 use vars qw($BINLIST_FORMAT $SRCLIST_FORMAT $UDEBLIST_FORMAT %source_info %binary_info %udeb_info %bin_src_ref);
29 # these banner lines have to be changed with every incompatible change of the
30 # binary and source list file formats
31 $BINLIST_FORMAT = "Maemian's list of binary packages in the archive--V3";
32 $SRCLIST_FORMAT = "Maemian's list of source packages in the archive--V3";
33 $UDEBLIST_FORMAT = "Maemian's list of udeb packages in the archive--V2";
41 my ($src_list,$quiet) = @_;
42 my $MAEMIAN_LAB = $ENV{'MAEMIAN_LAB'};
45 warn "\%source_info exists, nothing to do in read_src_list\n" unless $quiet;
49 $src_list or ($src_list = "$MAEMIAN_LAB/info/source-packages");
50 return unless -s $src_list;
52 open(IN, '<', $src_list) or fail("cannot open source list file $src_list: $!");
54 # compatible file format?
57 if ($f ne $SRCLIST_FORMAT) {
60 fail("the source list file $src_list has an incompatible file format (run lintian --setup-lab)");
63 # compatible format, so read file
67 my ($src,$ver,$maint,$uploaders,$arch,$std,$bin,$files,$file,$timestamp) = split(/\;/,$_);
74 'maintainer' => $maint,
75 'uploaders' => $uploaders,
76 'architecture' => $arch,
77 'standards-version' => $std,
81 'timestamp' => $timestamp,
84 $source_info{$src} = $src_struct;
91 my ($bin_list,$quiet) = @_;
92 my $MAEMIAN_LAB = $ENV{'MAEMIAN_LAB'};
95 warn "\%binary_info exists, nothing to do in read_bin_list\n" unless $quiet;
99 $bin_list or ($bin_list = "$MAEMIAN_LAB/info/binary-packages");
100 return unless -s $bin_list;
102 open(IN, '<', $bin_list) or fail("cannot open binary list file $bin_list: $!");
104 # compatible file format?
107 if ($f ne $BINLIST_FORMAT) {
110 fail("the binary list file $bin_list has an incompatible file format (run lintian --setup-lab)");
113 # compatible format, so read file
118 my ($bin,$ver,$source,$source_ver,$file,$timestamp) = split(/\;/o,$_);
126 'source-version' => $source_ver,
128 'timestamp' => $timestamp,
131 $binary_info{$bin} = $bin_struct;
138 my ($udeb_list,$quiet) = @_;
139 my $MAEMIAN_LAB = $ENV{'MAEMIAN_LAB'};
142 warn "\%udeb_info exists, nothing to do in read_bin_list\n" unless $quiet;
146 $udeb_list or ($udeb_list = "$MAEMIAN_LAB/info/udeb-packages");
147 return unless -s $udeb_list;
149 open(IN, '<', $udeb_list) or fail("cannot open udeb list file $udeb_list: $!");
151 # compatible file format?
154 if ($f ne $UDEBLIST_FORMAT) {
157 fail("the udeb list file $udeb_list has an incompatible file format (run lintian --setup-lab)");
160 # compatible format, so read file
165 my ($udeb,$ver,$source,$source_ver,$file,$timestamp) = split(/\;/o,$_);
173 'source-version' => $source_ver,
175 'timestamp' => $timestamp,
178 $udeb_info{$udeb} = $udeb_struct;
184 sub get_bin_src_ref {
186 for my $source (keys %source_info) {
187 for my $binary (split(/,\s+/o,$source_info{$source}->{'binary'})) {
188 $bin_src_ref{$binary} = $source;