#!/usr/bin/perl
# DocumentId:	$Id: debarchiver.pl,v 1.25 2002/01/26 22:59:04 ola Exp $
# Author:	$Author: ola $
# Date:		$Date: 2002/01/26 22:59:04 $
# Version:	$Revision: 1.25 $
# Summary:
#	This program reads a config file, traverse through all .changes files
#	in the specified directory and puts the files into the right place.
#

###############################################################################
############################# USES ############################################
###############################################################################

use File::Path qw(mkpath);
#use File::Copy qw(copy move);
use OpaL::action qw(pdebug action cmdaction
		    setDebugLevel
		    setQuitLevel
		    setErrorHandler);
use OpaL::read qw(readfile readcommand);

###############################################################################
########################### CONSTANTS #########################################
###############################################################################

$copycmd = "cp -af";
$rmcmd = "rm -f";
$movecmd = "mv";
$inputdir = "/var/lib/debarchiver/incoming";
$destdir = "/var/lib/debarchiver/dists";
$cinstall = "installed";
$lockfile = "debarchiver.lock";
$etcconfigfile = "/etc/debarchiver.conf";
$inputconfigfile = "input.conf";
$userconfigfile = "$ENV{HOME}/.debarchiver.conf";

###############################################################################
########################## DECLARATION ########################################
###############################################################################

# Indexed by config name.
%CConf = ();
# Indexed by file name.
%CFiles = ();
# Indexed by package name.
%CDesc = ();
# Just a string describing what has changed.
$CChanges = "";
# Destination directories that should be scanned.
%dests = ();
# The criteria to use for which binary packages that does not need a .changes
# file.
$distinputcriteria = "^kernel.*\\.deb\$";
# Extra directories with specified destination.
%distinputdirs = (
		  stable => 'stable',
		  unstable => 'unstable'
		 );

@distributions = ('stable', 'testing', 'unstable');

%distmapping = (
		stable => 'potato',
		testing => 'woody',
		unstable => 'sid'
	       );

@architectures = ('i386');

@sections = ('main', 'contrib', 'non-free');

@ARGS1 = @ARGV;
@ARGS2 = ();

$sortpackages = 1;
$fixstructure = 1;

###############################################################################
############################# ARGS ############################################
###############################################################################

while ($_ = shift @ARGS1) {
  if (/^--/) {
    if (/^--dl$/ || /^--debug-level$/) {
      setDebugLevel(shift @ARGS1);
    }
    elsif (/^--ql$/ || /^--quit-level$/) {
      setQuitLevel(shift @ARGS1);
    }
    elsif (/^--input$/ || /^--indir$/ || /^--inputdir$/) {
      $inputdir = shift @ARGS1;
      $inputdir =~ s/\/$//;
    }
    else {
      push @ARGS2, $_;
    }
  }
  else {
    push @ARGS2, $_;
  }
}

###############################################################################
############################ CONFIG ###########################################
###############################################################################

if (-e $etcconfigfile) {
  my $t = do $etcconfigfile;
  unless ($t) {
    pdebug(4, "Loading config file $etcconfigfile:\n\t$!\n\t$@");
  }
}

if (-e $userconfigfile) {
  my $t = do $userconfigfile;
  unless ($t) {
    pdebug(4, "Loading config file $userconfigfile:\n\t$!\n\t$@");
  }
}

action(! chdir $inputdir, "Change to dir $inputdir", 2);

if (-e $inputconfigfile) {
  my $t = do $inputconfigfile;
  unless ($t) {
    pdebug(4, "Loading config file $inputconfigfile:\n\t$!\n\t$@");
  }
}

###############################################################################
############################# HELP ############################################
###############################################################################

$version = "0.0.3";
$versionstring = "Debian package archiver, version $version";

$help =
"Usage: debarchiver [option(s)]

options:
 --debug-level level	What information that should be printed.
  --dl level		 1 = critical, 2 = error, 3 = normal,
			 4 = message, 5 = debug, 6 = verbose debug (modules).
 --quit-level level	On what level to quit the application, see debug level.
 --version		Prints the version string.
 --help			Prints this information.
 --copycmd		The install command to use, default $copycmd.
			 Both packages and .changes files are installed using
			 this command.
 --movecmd		Command to move files (currently not used at all).
 --rmcmd		The remove command to use, default $rmcmd.
			 This can be used to move away the old packages to
			 some other place.
 --instcmd		DEPRICATED!
 --dest dir		Destination directory. The base directory where all
  --destdir dir		 the distribution packages reside. Here the
			 \$distrib/\$major/\$arch/\$section directory structure
			 will be created. Default $destdir, relative to the
			 input directory.
 --input dir		This is the directory where the all packages and
  --indir dir		 corresponding *.changes files that should be
  --inputdir dir	 installed to the --dest directory,
			 default $instdir.
 --lockfile file	The lockfile to use, default $lockfile.
 --cinstall dir		Where the .changes file will be installed to,
			 empty string to remove it instead, default $cinstall.
 --distinputcritera     The criteria for which binary packages that should be
			 installed even if it does not have a .changes file,
			 default $distinputcriteria.
 --addoverride		Automaticly add new packages to the override file.
 --autoscanpackages	Automaticly run dpkg-scanpackages after all new
			 packages are installed.
 --autoscansources	Automaticly run dpkg-scansources after all new
			 packages are installed.
 --autoscan		Does both --autoscanpackages and --autoscansources.
 --scanall		Scan all distributions, sections, etc.
 --autoscanall		Same as --scanall --autoscan.
 --nosort		Do not sort packages.
 --nostructurefix	Do not create directories and touch Package files.
 --scanonly		Same as --nosort --nostructurefix.

You can also place config files with the following names (in following order)
$etcconfigfile, $userconfigfile and $inputconfigfile".
"(relative to input dir) that will be read before the arguments to this program
will be parsed. Here you can change the following variables
	\$destdir      	The destination directory (see --destdir above).
	\$inputdir	The input directory (no effect in $inputconfigfile).
	\$copycmd	The install command (see --copycmd).
	\$movecmd	The move command (see --movecmd).
	\$rmcmd		The remove command (see --rmcmd above).
	\$cinstall	Where the .changes files are installed
			 (see --cinstall above).
        \$distinputcritera The criteria for which packages that should be
			 installed even if it does not have a .changes file,
			 default $distinputcriteria.
        \%distinputdirs The directories (distribution => dir) that should be
			 searched for extra bianry packages that does not need
			a .changes file to be installed.
	\$lockfile	The lockfile to use, default $lockfile.
";

###############################################################################
############################# ARGS ############################################
###############################################################################

while ($_ = shift @ARGS2) {
  if (/^--/) {
    if (/^--version$/) {
      print("$versionstring\n");
      exit(0);
    }
    elsif (/^--help$/) {
      print($help);
      exit(0);
    }
    elsif (/^--copycmd$/) {
      $copycmd = shift @ARGS2;
    }
    elsif (/^--movecmd$/) {
      $movecmd = shift @ARGS2;
    }
    elsif (/^--rmcmd$/) {
      $rmcmd = shift @ARGS2;
    }
    elsif (/^--destdir$/ || /^--dest$/) {
      $destdir = shift @ARGS2;
      $destdir =~ s/\/$//;
    }
    elsif (/^--lockfile$/) {
      $lockfile = shift @ARGS2;
    }
    elsif (/^--cinstall$/) {
      $cinstall = shift @ARGS2;
      $cinstall =~ s/\/$//;
    }
    elsif (/^--addoverride$/) {
      $addoverride = 1;
    }
    elsif (/^--autoscanpackages$/) {
      $autoscanpackages = 1;
    }
    elsif (/^--autoscansources$/) {
      $autoscansources = 1;
    }
    elsif (/^--autoscan$/) {
      $autoscanpackages = 1;
      $autoscansources = 1;
    }
    elsif (/^--scanall$/) {
      handleScanAll();
    }
    elsif (/^--autoscanall$/) {
      handleScanAll();
      $autoscanpackages = 1;
      $autoscansources = 1;
    }
    elsif (/^--scanonly$/) {
      undef $sortpackages;
      undef $fixstructure;
    }
    elsif (/^--nosort$/) {
      undef $sortpackages;
    }
    elsif (/^--nostructurefix$/) {
      undef $fixstructure;
    }
    else {
      pdebug(2, "Unknown option $_\n");
    }
  }
  else {
    pdebug(2, "Unknown option $_\n");
  }
}

###############################################################################
############################# START ###########################################
###############################################################################

###############################################################################
# Now create the directory structure and files that are needed.
###############################################################################

action(! chdir $destdir, "Change to dir $destdir", 2);

handleStructureFix();

###############################################################################
# Sort packages.
###############################################################################

action(! chdir $inputdir, "Change to dir $inputdir", 2);
handleSorting();

handleScan();

###############################################################################
########################### FUNCTIONS #########################################
###############################################################################

###############################################################################
# Name:		createPF
# Description:	Create the directory and file if it does not exist,
#		including the .gz file.
# Dates:	2001-07-14	Written.
# Arguments:	directory, filename
###############################################################################

sub createPF($$) {
  my ($dir, $file) = @_;
  if (! -d "$dir") {
    action(! mkpath($dir, 0, 0755),
	   "Create directory $dir",
	   2);
  }
  if (! -e "$dir/$file") {
    cmdaction("touch $dir/$file",
	      "Create file $dir/$file.",
	      2);
  }
  if (! -e "$dir/${file}.gz") {
    cmdaction("gzip -c $dir/$file > $dir/${file}.gz",
	      "Create file $dir/$file.gz from $dir/$file.",
	      3);
  }
}

###############################################################################
########################### HANDLERS ##########################################
###############################################################################

###############################################################################
# Name:		handleScanAll
# Description:	Fix so that it scan all distributions, sections and so on.
# Dates:	2001-07-23	Written.
# Changes:	%dests
# Uses:		@distributions, @sections, @architectures, $destdir.
###############################################################################

sub handleScanAll() {
  my ($d, $s, $a);
  foreach $d (@distributions) {
    foreach $s (@sections) {
      if (-e "$destdir/$d/$s/override") {
	foreach $a (@architectures) {
	  $dests{"$d/$s/binary-$a"} = 1;
	}
	$dests{"$d/$s/binary-all"} = 1;
      }
      if (-e "$destdir/$d/$s/override.src") {
	$dests{"$d/$s/source"} = 1;
      }
    }
  }
}

###############################################################################
# Name:		handleScan
# Description:	Handles the autoscan.
# Dates:	2001-06-26	Written.
#		2001-07-23	Added lockfile check to distr directory.
#				Improved documentation.
#		2002-01-22	Moved lock file checking to its own function.
# Uses:		%dests, $destdir,
#		$autoscanpackages, $autoscansources.
# Changes:	$ENV{PWD}
###############################################################################

sub handleScan() {
  if (defined $autoscansources || defined $autoscanpackages) {
    $destdir =~ s|/$||;

    action(! chdir $destdir, "Change to dir $destdir", 2);
    destinationLock();

    my $destddir = $destdir;
    $destddir =~ s|^.*/([^/]+)$|$1|;
    my $destcdir = $destdir;
    $destcdir =~ s|^(.*)/[^/]+$|$1|;
    action(! chdir $destcdir, "Change to dir $destcdir", 2);

    foreach $_ (keys %dests) {
      my $archdest = $_;
      $archdest = "$destddir/$archdest";
      my $over = $_;
      $over =~ s/^(.*)\/[^\/]+$/$1/;
      $over = "$destddir/$over";
      if ($archdest =~ /source$/ && defined $autoscansources) {
	cmdaction("dpkg-scansources $archdest $over/override.src > $archdest/Sources",
		  "Scan source files in $archdest, $over/override.src",
		  3);
	cmdaction("gzip $archdest/Sources -c > $archdest/Sources.gz",
		  "Zip it",
		  3);
      }
      elsif (defined $autoscanpackages) {
	cmdaction("dpkg-scanpackages $archdest $over/override > $archdest/Packages.gen",
		  "Scan package files in $archdest, $over/override",
		  3);
	if ($archdest =~ /binary-all$/) {
	  opendir DD, $over;
	  my $d;
	  while ($d = readdir(DD)) {
	    if (! ($d =~ /^binary-all/) &&
		$d =~ /^binary-/ &&
		-d "$over/$d") {
#            if (-f "$over/$d/Packages" && ! -f "$over/$d/Packages.gen") {
#              cmdaction("mv $over/$d/Packages $over/$d/Packages.gen",
#                        "Move packges file to packages.gen file.",
#                        3);
#            }
	      if (-f "$over/$d/Packages.gen") {
		cmdaction("cat $over/$d/Packages.gen $archdest/Packages.gen > $over/$d/Packages",
			  "Concatenate packages files from binary-all and $d.",
			  3);
	      }
	      else {
		cmdaction("cat $archdest/Packages.gen > $over/$d/Packages",
			  "Copy packages file from binary-all to $d.",
			  3);
	      }
	      cmdaction("gzip $over/$d/Packages -c > $over/$d/Packages.gz",
			"Zip it",
			3);
	    }
	  }
	  closedir DD;
	}
	else {
	  if (-f "$over/binary-all/Packages.gen") {
	    cmdaction("cat $archdest/Packages.gen $over/binary-all/Packages.gen > $archdest/Packages",
		      "Concatenate packages files from binary-all and $d.",
		      3);
	  }
	  cmdaction("gzip $archdest/Packages -c > $archdest/Packages.gz",
		    "Zip it",
		    3);
	}
      }
    }

    &destinationRelease();
  }
}

###############################################################################
# Name:		handleSorting
# Description:	Sort packages into the right place.
# Dates:	2001-07-23	Moved from START section to this subprocedure.
# Uses:		A lot.
###############################################################################

sub handleSorting() {
  if (defined $sortpackages) {
    # First check if a lockfile is created.
      
    incomingLock();

    # Read the content of this directory.
    opendir(D, ".");

    my $found = 1;

    while ($found) {
      # go through all .changes files:
      $found = 0;
      while($cfile = readdir(D)) {
	# Only .changes files.
	if ($cfile =~ /\.changes$/) {
	  handleChangesFile($cfile);
	  $found = 1;
	}
      }
    }

    closedir(D);

    my $kdir;
    foreach $kdir (keys %distinputdirs) {
      $distinputdirs{$kdir} =~ s/\n$//;
      if (-d $distinputdirs{$kdir}) {
	opendir(D, $distinputdirs{$kdir});
	my $kfile;
	while ($kfile = readdir(D)) {
	  if ($kfile =~ /$distinputcriteria/) {
	    handleDebOnlyFile("$distinputdirs{$kdir}/$kfile", $kdir);
	  }
	}
      }
    }

    incomingRelease();
  }
}

###############################################################################
# Name:		handleStructureFix
# Description:	Fix the distribution directory structure.
# Dates:	2001-07-23	Moved from START section to this subprocedure.
# Uses:		@distributions, @sections, @architectures, $fixstructure
###############################################################################

sub handleStructureFix() {
  if (defined $fixstructure) {
    my ($di, $se, $ar);
    for $di (@distributions) {
      my $dis = $distmapping{$di};
      if (! defined($dis)) {
	$dis = $di;
      }
      elsif ($dis =~ /^\s*$/) {
	$dis = $di;
      }
      if ((! -l "$di") &&
	  $dis !~ /^$di$/) {
	cmdaction("ln -s $dis $di",
		  "Link $dis to $di.",
		  2);
      }
      for $se (@sections) {
	if (! -d "$dis/$se/binary-all") {
	  action(! mkpath("$dis/$se/binary-all", 0, 0755),
		 "Create binary-all directory $dis/$se/binary-all",
		 2);
	}
	for $ar (@architectures) {
	  createPF("$dis/$se/binary-$ar", "Packages");
	}
	createPF("$dis/$se/source", "Sources");
      }
    }
  }
}

###############################################################################
# Name:		handleDebOnlyFile
# Description:	Handles installation of a deb image.
# Dates:	2001-06-29	Written.
# Arguments:	A deb file.
#		The distribution to install to.
# Changes:	see parseKernelFile
###############################################################################

sub handleDebOnlyFile($$) {
  my ($kfile, $distr) = @_;

  parseDebOnlyFile($kfile, $distr);
  my $file;
  foreach $file (keys %CFiles) {
    handlePackageFile($file);
  }
}


###############################################################################
# Name:		handleChangesFile
# Description:	Handles the .changes file.
# Dates:	2001-06-26	Taken from the main script. Cut and paste with
#				simple changes.
# Uses:		parseChanges, pdebug, $copycmd, $rmcmd
# Changes:	See parseChanges.
# Arguments:	The .changes file.
# Returns:	nothing
###############################################################################

sub handleChangesFile($) {
  my ($cfile) = @_;

  parseChanges($cfile);
  my $file;
  foreach $file (keys %CFiles) {
    handlePackageFile($file);
  }
  installChangesFile($cfile);
}

###############################################################################
# Name:		handlePackageFile
# Description:	Handles the package file.
# Dates:	2001-06-26	Taken from the main script. Cut and paste with
#				simple changes.
# Uses:		Same as parseChanges produces.
# Changes:	%dests
# Arguments:	The package file (the key in CFiles).
# Returns:	nothing
###############################################################################

sub handlePackageFile ($) {
  my ($file) = @_;
  my $distrd = $CConf{Distribution};

  pdebug(5, "File $_:  $CFiles{$file}");
  my ($hash, $size, $section, $prio) =
    parseFileStruct($CFiles{$file});
  my ($pkgname, $ver, $arch, $ext) =
    parseFileName($file);
  my $archsec = "source";
  if ($arch !~ /^source$/) {
    $archsec = "binary-$arch";
  }
  my ($major, $section) = parseSection($section);

  # OVERRIDES

  my $distr;
  foreach $distr (split /\s+/, $distrd) {
    my $srcext = ".src" if ($arch =~ /^source$/);
    parseOverrideFile($distr, $major, $srcext);
    if (defined $Override{$distr, $major, "$pkgname$srcext"}) {
      pdebug(5, "Defined in override, $pkgname$srcext");
      $section = secondIfNotEmpty($section,
				  $Override{$distr,
					    $major,
					    "$pkgname$srcext",
					    Section});
    }
    elsif (defined $addoverride) {
      pdebug(5, "Add to override$srcext, $pkgname $prio $section");
      open F, ">>$destdir/$distr/$major/override$srcext";
      print(F  "$pkgname $prio $section\n");
      close(F);
      $Override{$distr,
		$major,
		"$pkgname$srcext"} = 1;
    }

    # Note to the autoscan that files are installed to this dir.
    $dests{"$distr/$major/$archsec"} = 1;

    my $installto = "$destdir/$distr/$major/$archsec/$section";
    if (! -d $installto) {
      action(! mkpath ($installto, 0, 0755),
	     "Making directory $installto",
	     2);
    }
    else {
      if ($arch =~ /^source$/) {
	cmdaction("$rmcmd $installto/${pkgname}_*$ext",
		  "Delete $installto/${pkgname}_*$ext",
		  2);
      }
      else {
	# This will not work but tells what to do.
	cmdaction("$rmcmd $installto/${pkgname}_*_$arch$ext",
		  "Delete $installto/${pkgname}_*_$arch$ext",
		  2);
      }
    }
    cmdaction("$copycmd $file $installto",
	      "Installing $file to $installto.",
	      2);
  }
  cmdaction("$rmcmd $file",
	    "Removing $file after it has been installed.",
	    2);
}

###############################################################################
# Name:		installChangesFile
# Description:	Moves the changes file to the right place, or remove it.
# Dates:	2001-06-10	
# Arguments:	The .changes file.
#		Where to place it.
# Returns:	($major, $section)
#		if on the form foo/bar it returns (foo, bar) and if it
#		is on the form foo it returns (main, foo).
###############################################################################

sub installChangesFile ($) {
  my ($cfile) = @_;

  my $distrd = $CConf{Distribution};
  my $distr;
  foreach $distr (split /\s+/, $distrd) {
    my $todir = relativePath($cinstall, "$destdir/$distr");
    if ($cinstall !~ /^\s*$/) {
      # Now remove or move away the .changes file (if $cinstall not empty).
      if (! -d $todir) {
	action(! mkpath ($todir, 0, 0755),
	       "Making directory $todir",
	       2);
      }
      cmdaction("$copycmd $cfile $todir",
		"Copy $cfile to $todir.",
		2);
    }
  }
  cmdaction("$rmcmd $cfile",
	    "Remove changes file $cfile after installation.",
	    2);
}

###############################################################################
######################### LOCK HANDLERS #######################################
###############################################################################

sub incomingLock() {
    &createLockExit("$lockfile");
    &setErrorHandler(\&incomingError);
}

sub incomingRelease() {
    &setErrorHandler(undef);
    &removeLockfile("$lockfile");
}

sub incomingError() {
    &setErrorHandler(undef);
    &removeLockfile("$lockfile");    
}

sub destinationLock() {
    &createLockExit("$destdir/$lockfile");
    &setErrorHandler(\&destinationError);
}

sub destinationRelease() {
    &setErrorHandler(undef);
    &removeLockfile("$destdir/$lockfile");
}

sub destinationError() {
    &setErrorHandler(undef);
    &removeLockExit("$destdir/$lockfile");    
}

###############################################################################
######################### LOCK FUNCTIONS ######################################
###############################################################################

###############################################################################
# Name:		createLockExit
# Description:	creates a lockfile, but exits if it can't.
# Dates:	2002-01-22	Written.
# Arguments:   	$lockfile
# Returns:	nothing
###############################################################################
sub createLockExit($) {
    my ($lockfile) = @_;
    if (-e $lockfile) {
      pdebug(2, "Lockfile exists in distribution directory, skipping.");
    }
    cmdaction("touch $lockfile",
	      "Creating lockfile $lockfile",
	      2);
}

###############################################################################
# Name:		removeLockfile
# Description:	Removes the lockfile.
# Dates:	2002-01-22	Written.
# Arguments:	none
# Needs:	$rmcmd $lockfile
# Returns:	nothing
###############################################################################
sub removeLockExit() {
    my ($lockfile) = @_;
    removeLockfile($lockfile);
    exit;
}

###############################################################################
# Name:		removeLockfile
# Description:	Removes the lockfile.
# Dates:	2002-01-22	Written.
# Arguments:    $lockfile
# Returns:	nothing
###############################################################################
sub removeLockfile() {
    my ($lockfile) = @_;
    cmdaction("rm $lockfile",
	      "Removing lockfile $lockfile.",
	      2);
}

###############################################################################
############################ PARSERS ##########################################
###############################################################################

###############################################################################
# Name:		parseSection
# Description:	Takes a section and convert that into the used ones.
# Dates:	2001-06-10	Written.
# Arguments:	A section on the form foo/bar or foo.
# Returns:	($major, $section)
#		if on the form foo/bar it returns (foo, bar) and if it
#		is on the form foo it returns (main, foo).
###############################################################################

sub parseSection($) {
  my ($major, $section) = split /\//, shift @_;
  if ($section =~ /^\s*$/) {
    # on the foo form.
    $section = $major;
    $major = "main";
  }
  return ($major, $section);
}

###############################################################################
# Name:		parseFileStruct
# Description:	Parses a hash size section prio string.
#		It is a simple split...
# Dates:	2001-06-10	Written.
# Arguments:	The string.
# Returns:	($hash, $size, $section, $prio)
###############################################################################

sub parseFileStruct($) {
  return split / /, shift @_;
}

###############################################################################
# Name:		parseFileName
# Description:	Parses a file name and splits into $pkgname, $version, $arch
# Dates:	2001-06-10	Written.
# Arguments:	deb filename.
# Returns:	($pkgname, $version, $arch, $ext)
###############################################################################

sub parseFileName($) {
  my ($file) = @_;
  my ($pkgname, $ver, $arch) = split /_/, $file;
  $pkgname =~ s/^.*\///;
  my $ext;
  if ($arch !~ /^\s*$/) {
    $ext = $arch;
    $arch =~ s/\..*$//;
    $ext =~ s/^[^\.]*\./\./;
  }
  else {
    $ext = $ver;
    $ver = $CConf{Version};
    $ext =~ s/$ver//;
    $arch = "source";
  }
  return ($pkgname, $ver, $arch, $ext);
}

###############################################################################
# Name:		parseDebOnlyFile
# Description:	Parses a debian deb file and extracs the information in the
#		way that parseChanges does.
# Dates:	2001-06-29	Written with info from parseChanges.
# Arguments:	A deb file name.
# Changes:	see parseChanges
###############################################################################

sub parseDebOnlyFile($$) {
  my ($kfile, $distr) = @_;
  my $state = "";
  my $line;
  my $section;
  my $priority;
  my $size;
  my $desc;
  %CConf = (Distribution => $distr);
  %CFiles = ();
  %CDesc = ();
  my @cmdres = readcommand("dpkg-deb -f $kfile");
  foreach $line (@cmdres) {
    # The state to just put the line in the hash.
    if ($line =~ /^\s*$/) {
      next;
    }
    $line =~ s/\n$//;
    if ($line =~ /^Provides:/ ||
	$line =~ /^Suggests:/ ||
	$line =~ /^Depends:/) {
      #next;
    }
    elsif ($line =~ /^Package:/) {
      $line =~ s/^[^:]*:\s//;
      $CConf{Binary} = $line;
    }
    elsif ($line =~ /^Section:/) {
      $line =~ s/^[^:]*:\s//;
      $section = $line;
    }
    elsif ($line =~ /^Priority:/) {
      $line =~ s/^[^:]*:\s//;
      $priority = $line;
    }
    elsif ($line =~ /^Installed-Size:/) {
      $line =~ s/^[^:]*:\s//;
      $size = $line;
    }
    elsif ($line =~ /^Description:/) {
      $line =~ s/^[^:]*:\s//;
      $desc = $line;
    }
    elsif ($line =~ /^ ./) {
      pdebug(6, "Do nothing with description.");
    }
    else {
      my $pre = $line;
      $pre =~ s/:.*$//;
      $line =~ s/^[^:]*:\s//;
      $CConf{$pre} = $line;
    }
  }
  $CDesc{$CConf{Binary}} = $desc;
  $CFiles{$kfile} = "0 $size $section $priority";
}

###############################################################################
# Name:		parseChanges
# Description:	Parses a debian changelog file and extracs the information.
# Dates:	2001-06-10	Written.
#		2001-06-26	Changed print to pdebug.
# Arguments:	.changes file name.
# Changes:	
#	%CConf
#		'Format' => The file format.
#		'Source' => The source packages
#		'Binary' => The binary packages
#		'Architecture' => [source] [all] or other
#		'Version' => The packages version.
#		'Distribution' => The intended distribution.
#		'Urgency' => How urgent the package installation is.
#		'Maintainer' => The package maintainer.
#	%CFiles
#		$filename => "$hash $size $section $type"
#	%CDesc
#		$pkgname => "The short description of the package."
###############################################################################

sub parseChanges($) {
  my ($file) = @_;
  open (F, $file);
  my $state = "";
  my $line;
  %CConf = ();
  %CFiles = ();
  %CDesc = ();
  while ($line = <F>) {
    # The state to just put the line in the hash.
    if ($line =~ /^\s*$/) {
      next;
    }
    $line =~ s/\n$//;
    if ($line =~ /^[^:]+:\s*$/) {
      $line =~ s/^([^:]+):\s*$/$1/;
      $state = $line;
      pdebug(6, "State change to $state\n");
    }
    elsif ($line =~ /^\-+BEGIN PGP SIGNED MESSAGE\-+/) {
      $state = "";
      pdebug(6, "State change to normal state.\n");
    }
    elsif ($line =~ /^\-+BEGIN PGP SIGNATURE\-+/) {
      $state = "PGP";
      pdebug(6, "State change to $state\n");
    }
    elsif ($line =~ /^\-+END PGP SIGNATURE\-+/) {
      $state = "END";
      pdebug(6, "State change to $state\n");
    }
    # The default state.
    elsif ($state =~ /^$/) {
      my $pre = $line;
      $pre =~ s/:.*$//;
      $line =~ s/^[^:]*:\s//;
      $CConf{$pre} = $line;
    }
    # Description state.
    elsif ($state =~ /Description/) {
      my ($pkg, $desc) = split /\s+\-\s+/, $line;
      $pkg =~ s/^\s*//;
      $desc =~ s/\s*$//;
      $CDesc{$pkg} = $desc;
      pdebug(6, "Saving desc '$desc' indexed by $pkg.\n");
    }
    # PGP Sign
    elsif ($state =~ /PGP/) {
      pdebug(6, "Do nothing with $line\n");
    }
    # Changes state.
    elsif ($state =~ /Changes/) {
      pdebug(6, "Do nothing with $line\n");
    }
    # Files state.
    elsif ($state =~ /Files/) {
      my @f = split / /, $line;
      shift @f;
      my $file = pop @f;
      $CFiles{$file} = "$f[0] $f[1] $f[2] $f[3]";#[ @f ];
      pdebug (6, "Saving file $file.\n");
    }
  }
}

###############################################################################
# Name:		parseOverrideFile
# Description:	Parses the override file.
# Dates:	2001-06-26	Written.
# Arguments:	The distribution (like unstable)
#		The major dir (like main or contrib)
#		The src extention (undef or .src)
# Changes:	%Override	The override structure this overrides the
#				packages information.
###############################################################################

sub parseOverrideFile($$$) {
  my ($distr, $major, $srcext) = @_;
  my $def = ".pkg";
  if (defined $srcext && $srcext !~ /^\s*$/) {
    $def = $srcext;
  }
  pdebug(5, "override $def");
  if (! defined $Override{$distr, $major, $def}) {
    pdebug(5, "Load override file for $distr, $major");
    my $odir = "$destdir/$distr/$major";
    my @o = readfile("$odir/override$srcext");
    my $tmp;
    $Override{$distr,$major, $def} = 1;
    foreach $tmp (@o) {
      my ($pkg, $prio, $section, $maint) = split(/\s+/, $tmp, 4);
      $pkg = "$pkg$srcext";
      $Override{$distr, $major, $pkg, Priority} = $prio
	if ($prio    !~ /^\s*$/ && defined $prio   );
      $Override{$distr, $major, $pkg, Section} = $section
	if ($section !~ /^\s*$/ && defined $section);
      $Override{$distr, $major, $pkg, Maintainer} = $maint
	if ($maint   !~ /^\s*$/ && defined $maint  );
      $Override{$distr, $major, $pkg} = 1;
    }
  }
}

###############################################################################
# Name:		relativePath
# Description:	Returns the relative path to another path.
# Dates:	2001-06-26	Written.
# Arguments:	path to check for
#		path to give it against.
# Returns:	($pkgname, $version, $arch, $ext)
###############################################################################

sub relativePath ($$) {
  my ($p1, $p2) = @_;
  if ($p1 =~ /^\//) {
    return $p1;
  }
  elsif ($p1 =~ /^\~\//) {
    $p1 =~ s/^~\//$ENV{HOME}\//;
    return $p1;
  }
  $p2 =~ s/\/$//;
  return "$p2/$p1";
}

###############################################################################
# Name:		secondIfNotEmpty
# Description:	Returns the relative path to another path.
# Dates:	2001-06-26	Written.
# Arguments:	two arguments
# Returns:	the second one if it is not empty, else the first one.
###############################################################################

sub secondIfNotEmpty ($$) {
  my ($p1, $p2) = @_;
  if (defined $p2 && $p2 !~ /^\s*$/) {
    return $p2;
  }
  return $p1;
}

__END__

###############################################################################
############################# DOCUMENTATION ###################################
###############################################################################

=head1 NAME

debarchiver - Tool to sort debian packages.

=head1 SYNOPSIS

debarchiver [options]

=head1 DESCRIPTION


=head1 OPTIONS

 --debug-level level	What information that should be printed.
  --dl level		 1 = critical, 2 = error, 3 = normal,
			 4 = message, 5 = debug, 6 = verbose debug (modules).
 --quit-level level	On what level to quit the application, see debug level.
 --version		Prints the version string.
 --help			Prints this information.
 --copycmd		The install command to use, default $copycmd.
			 Both packages and .changes files are installed using
			 this command.
 --movecmd		Command to move files (currently not used at all).
 --rmcmd		The remove command to use, default $rmcmd.
			 This can be used to move away the old packages to
			 some other place.
 --instcmd		DEPRICATED!
 --dest dir		Destination directory. The base directory where all
  --destdir dir		 the distribution packages reside. Here the
			 \$distrib/\$major/\$arch/\$section directory structure
			 will be created. Default $destdir, relative to the
			 input directory.
 --input dir		This is the directory where the all packages and
  --indir dir		 corresponding *.changes files that should be
  --inputdir dir	 installed to the --dest directory,
			 default $instdir.
 --lockfile file	The lockfile to use, default $lockfile.
 --cinstall dir		Where the .changes file will be installed to,
			 empty string to remove it instead, default $cinstall.
 --distinputcritera     The criteria for which binary packages that should be
			 installed even if it does not have a .changes file,
			 default $distinputcriteria.
 --addoverride		Automaticly add new packages to the override file.
 --autoscanpackages	Automaticly run dpkg-scanpackages after all new
			 packages are installed.
 --autoscansources	Automaticly run dpkg-scansources after all new
			 packages are installed.
 --autoscan		Does both --autoscanpackages and --autoscansources.
 --scanall		Scan all distributions, sections, etc.
 --autoscanall		Same as --scanall --autoscan.
 --nosort		Do not sort packages.
 --nostructurefix	Do not create directories and touch Package files.
 --scanonly		Same as --nosort --nostructurefix.

=head1 CONFIG FILE

You can also place config files with the following names (in following order)
/etc/debarchiver.conf, ~/.debarchiver.conf and input.conf (relative to input
directory) that will be read before, the arguments to this program
will be parsed. Here you can change the following variables:

	$destdir      	The destination directory (see --destdir above).
	$inputdir	The input directory (no effect in $inputconfigfile).
	$copycmd	The install command (see --copycmd).
	$movecmd	The move command (see --movecmd).
	$rmcmd		The remove command (see --rmcmd above).
	$cinstall	Where the .changes files are installed
			 (see --cinstall above).
        $distinputcritera The criteria for which packages that should be
			 installed even if it does not have a .changes file,
			 default $distinputcriteria.
        %distinputdirs The directories (distribution => dir) that should be
			 searched for extra bianry packages that does not need
			a .changes file to be installed.
	$lockfile	The lockfile to use, default $lockfile.


=head1 AUTHOR

Ola Lundqvist <opal@debian.org>

=head1 SEE ALSO

=cut
