# Hey emacs! This is a -*- Perl -*- script!
# Read_pkglists -- Perl utility functions to read Maemian's package lists

# Copyright (C) 1998 Christian Schwarz
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, you can find it on the World Wide
# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.

use strict;
use warnings;
use lib "$ENV{'MAEMIAN_ROOT'}/lib";
use Util;

use vars qw($BINLIST_FORMAT $SRCLIST_FORMAT $UDEBLIST_FORMAT %source_info %binary_info %udeb_info %bin_src_ref);

# these banner lines have to be changed with every incompatible change of the
# binary and source list file formats
$BINLIST_FORMAT = "Maemian's list of binary packages in the archive--V3";
$SRCLIST_FORMAT = "Maemian's list of source packages in the archive--V3";
$UDEBLIST_FORMAT = "Maemian's list of udeb packages in the archive--V2";

%source_info = ();
%binary_info = ();
%udeb_info = ();
%bin_src_ref = ();

sub read_src_list {
  my ($src_list,$quiet) = @_;
  my $MAEMIAN_LAB = $ENV{'MAEMIAN_LAB'};

  if (%source_info) {
    warn "\%source_info exists, nothing to do in read_src_list\n" unless $quiet;
    return;
  }

  $src_list or ($src_list = "$MAEMIAN_LAB/info/source-packages");
  return unless -s $src_list;

  open(IN, '<', $src_list) or fail("cannot open source list file $src_list: $!");

  # compatible file format?
  my $f;
  chop($f = <IN>);
  if ($f ne $SRCLIST_FORMAT) {
    close(IN);
    return 0 if $quiet;
    fail("the source list file $src_list has an incompatible file format (run lintian --setup-lab)");
  }

  # compatible format, so read file
  while (<IN>) {
    chop;
    next if /^\s*$/o;
    my ($src,$ver,$maint,$uploaders,$arch,$std,$bin,$files,$file,$timestamp) = split(/\;/,$_);

    my $src_struct;
    %$src_struct =
      (
       'source' => $src,
       'version' => $ver,
       'maintainer' => $maint,
       'uploaders' => $uploaders,
       'architecture' => $arch,
       'standards-version' => $std,
       'binary' => $bin,
       'files' => $files,
       'file' => $file,
       'timestamp' => $timestamp,
       );

    $source_info{$src} = $src_struct;
  }

  close(IN);
}

sub read_bin_list {
  my ($bin_list,$quiet) = @_;
  my $MAEMIAN_LAB = $ENV{'MAEMIAN_LAB'};

  if (%binary_info) {
    warn "\%binary_info exists, nothing to do in read_bin_list\n" unless $quiet;
    return;
  }

  $bin_list or ($bin_list = "$MAEMIAN_LAB/info/binary-packages");
  return unless -s $bin_list;

  open(IN, '<', $bin_list) or fail("cannot open binary list file $bin_list: $!");

  # compatible file format?
  my $f;
  chop($f = <IN>);
  if ($f ne $BINLIST_FORMAT) {
    close(IN);
    return 0 if $quiet;
    fail("the binary list file $bin_list has an incompatible file format (run lintian --setup-lab)");
  }

  # compatible format, so read file
  while (<IN>) {
    chop;

    next if /^\s*$/o;
    my ($bin,$ver,$source,$source_ver,$file,$timestamp) = split(/\;/o,$_);

    my $bin_struct;
    %$bin_struct =
      (
       'package' => $bin,
       'version' => $ver,
       'source' => $source,
       'source-version' => $source_ver,
       'file' => $file,
       'timestamp' => $timestamp,
       );

    $binary_info{$bin} = $bin_struct;
  }

  close(IN);
}

sub read_udeb_list {
  my ($udeb_list,$quiet) = @_;
  my $MAEMIAN_LAB = $ENV{'MAEMIAN_LAB'};
  
  if (%udeb_info) {
    warn "\%udeb_info exists, nothing to do in read_bin_list\n" unless $quiet;
    return;
  }
  
  $udeb_list or ($udeb_list = "$MAEMIAN_LAB/info/udeb-packages");
  return unless -s $udeb_list;
  
  open(IN, '<', $udeb_list) or fail("cannot open udeb list file $udeb_list: $!");
  
  # compatible file format?
  my $f;
  chop($f = <IN>);
  if ($f ne $UDEBLIST_FORMAT) {
    close(IN);
    return 0 if $quiet;
    fail("the udeb list file $udeb_list has an incompatible file format (run lintian --setup-lab)");
  }
  
  # compatible format, so read file
  while (<IN>) {
    chop;
    
    next if /^\s*$/o;
    my ($udeb,$ver,$source,$source_ver,$file,$timestamp) = split(/\;/o,$_);
    
    my $udeb_struct;
    %$udeb_struct =
      (
       'package' => $udeb,
       'version' => $ver,
       'source' => $source,
       'source-version' => $source_ver,
       'file' => $file,
       'timestamp' => $timestamp,
      );
    
    $udeb_info{$udeb} = $udeb_struct;
  }

  close(IN);
}

sub get_bin_src_ref {
  read_src_list();
  for my $source (keys %source_info) {
    for my $binary (split(/,\s+/o,$source_info{$source}->{'binary'})) {
      $bin_src_ref{$binary} = $source;
    }
  }
}

1;
__END__
