vcs.maemo.org Git - maemian/blob - nokia-lintian/lib/Read_pkglists.pm

   1 # Hey emacs! This is a -*- Perl -*- script!
   2 # Read_pkglists -- Perl utility functions to read Lintian's package lists
   3
   4 # Copyright (C) 1998 Christian Schwarz
   5 #
   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.
  10 #
  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.
  15 #
  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,
  20 # MA 02110-1301, USA.
  21
  22 use strict;
  23
  24 use lib "$ENV{'LINTIAN_ROOT'}/lib";
  25 use Util;
  26
  27 use vars qw($BINLIST_FORMAT $SRCLIST_FORMAT $UDEBLIST_FORMAT %source_info %binary_info %udeb_info %bin_src_ref);
  28
  29 # these banner lines have to be changed with every incompatible change of the
  30 # binary and source list file formats
  31 $BINLIST_FORMAT = "Lintian's list of binary packages in the archive--V2";
  32 $SRCLIST_FORMAT = "Lintian's list of source packages in the archive--V3";
  33 $UDEBLIST_FORMAT = "Lintian's list of udeb packages in the archive--V1";
  34
  35 %source_info = ();
  36 %binary_info = ();
  37 %udeb_info = ();
  38 %bin_src_ref = ();
  39
  40 sub read_src_list {
  41   my ($src_list,$quiet) = @_;
  42   my $LINTIAN_LAB = $ENV{'LINTIAN_LAB'};
  43
  44   if (%source_info) {
  45     warn "\%source_info exists, nothing to do in read_src_list\n" unless $quiet;
  46     return;
  47   }
  48
  49   $src_list or ($src_list = "$LINTIAN_LAB/info/source-packages");
  50   return unless -s $src_list;
  51
  52   open(IN, '<', $src_list) or fail("cannot open source list file $src_list: $!");
  53
  54   # compatible file format?
  55   my $f;
  56   chop($f = <IN>);
  57   if ($f ne $SRCLIST_FORMAT) {
  58     close(IN);
  59     return 0 if $quiet;
  60     fail("the source list file $src_list has an incompatible file format (run lintian --setup-lab)");
  61   }
  62
  63   # compatible format, so read file
  64   while (<IN>) {
  65     chop;
  66     next if /^\s*$/o;
  67     my ($src,$ver,$maint,$uploaders,$arch,$std,$bin,$files,$file,$timestamp) = split(/\;/,$_);
  68
  69     my $src_struct;
  70     %$src_struct =
  71       (
  72        'source' => $src,
  73        'version' => $ver,
  74        'maintainer' => $maint,
  75        'uploaders' => $uploaders,
  76        'architecture' => $arch,
  77        'standards-version' => $std,
  78        'binary' => $bin,
  79        'files' => $files,
  80        'file' => $file,
  81        'timestamp' => $timestamp,
  82        );
  83
  84     $source_info{$src} = $src_struct;
  85   }
  86
  87   close(IN);
  88 }
  89
  90 sub read_bin_list {
  91   my ($bin_list,$quiet) = @_;
  92   my $LINTIAN_LAB = $ENV{'LINTIAN_LAB'};
  93
  94   if (%binary_info) {
  95     warn "\%binary_info exists, nothing to do in read_bin_list\n" unless $quiet;
  96     return;
  97   }
  98
  99   $bin_list or ($bin_list = "$LINTIAN_LAB/info/binary-packages");
 100   return unless -s $bin_list;
 101
 102   open(IN, '<', $bin_list) or fail("cannot open binary list file $bin_list: $!");
 103
 104   # compatible file format?
 105   my $f;
 106   chop($f = <IN>);
 107   if ($f ne $BINLIST_FORMAT) {
 108     close(IN);
 109     return 0 if $quiet;
 110     fail("the binary list file $bin_list has an incompatible file format (run lintian --setup-lab)");
 111   }
 112
 113   # compatible format, so read file
 114   while (<IN>) {
 115     chop;
 116
 117     next if /^\s*$/o;
 118     my ($bin,$ver,$source,$file,$timestamp) = split(/\;/o,$_);
 119
 120     my $bin_struct;
 121     %$bin_struct =
 122       (
 123        'package' => $bin,
 124        'version' => $ver,
 125        'source' => $source,
 126        'file' => $file,
 127        'timestamp' => $timestamp,
 128        );
 129
 130     $binary_info{$bin} = $bin_struct;
 131   }
 132
 133   close(IN);
 134 }
 135
 136 sub read_udeb_list {
 137   my ($udeb_list,$quiet) = @_;
 138   my $LINTIAN_LAB = $ENV{'LINTIAN_LAB'};
 139
 140   if (%udeb_info) {
 141     warn "\%udeb_info exists, nothing to do in read_bin_list\n" unless $quiet;
 142     return;
 143   }
 144
 145   $udeb_list or ($udeb_list = "$LINTIAN_LAB/info/udeb-packages");
 146   return unless -s $udeb_list;
 147
 148   open(IN, '<', $udeb_list) or fail("cannot open udeb list file $udeb_list: $!");
 149
 150   # compatible file format?
 151   my $f;
 152   chop($f = <IN>);
 153   if ($f ne $UDEBLIST_FORMAT) {
 154     close(IN);
 155     return 0 if $quiet;
 156     fail("the udeb list file $udeb_list has an incompatible file format (run lintian --setup-lab)");
 157   }
 158
 159   # compatible format, so read file
 160   while (<IN>) {
 161     chop;
 162
 163     next if /^\s*$/o;
 164     my ($udeb,$ver,$source,$file,$timestamp) = split(/\;/o,$_);
 165
 166     my $udeb_struct;
 167     %$udeb_struct =
 168       (
 169        'package' => $udeb,
 170        'version' => $ver,
 171        'source' => $source,
 172        'file' => $file,
 173        'timestamp' => $timestamp,
 174        );
 175
 176     $udeb_info{$udeb} = $udeb_struct;
 177   }
 178
 179   close(IN);
 180 }
 181
 182
 183
 184 sub get_bin_src_ref {
 185   read_src_list();
 186   for my $source (keys %source_info) {
 187     for my $binary (split(/,\s+/o,$source_info{$source}->{'binary'})) {
 188       $bin_src_ref{$binary} = $source;
 189     }
 190   }
 191 }
 192
 193 1;
 194
 195 # Local Variables:
 196 # indent-tabs-mode: nil
 197 # cperl-indent-level: 2
 198 # End:
 199 # vim: syntax=perl sw=2 sts=2 ts=2 et shiftround