debian-cd-clone/tools/cds2src

#!/usr/bin/perl -w
#
# Copyright 1999 Raphaël Hertzog <hertzog@debian.org>
# See the README file for the license.
#
# This script will dispatch the source packages on different CD. 
# It will include all the sources corresponding to the binary
# packages that are included in the binary CDs.
#
# In general, I'll follow the same rules than list2cds ...

use strict;

my $deflimit = shift || $ENV{'SRCSIZELIMIT'} || $ENV{'SIZELIMIT'} || 629145600;
my $limit = $ENV{'SRCSIZELIMIT1'} || $deflimit;

my $nonfree = $ENV{'NONFREE'};
my $nonus = $ENV{'NONUS'} || 0;
my $complete = $ENV{'COMPLETE'} || 0;
my $local = $ENV{'LOCAL'} || 0;

my $bdir = "$ENV{'TDIR'}/$ENV{'CODENAME'}-$ENV{'ARCH'}";
my $adir = "$ENV{'APTTMP'}/$ENV{'CODENAME'}-$ENV{'ARCH'}";
my $sdir = "$ENV{'TDIR'}/$ENV{'CODENAME'}-src";
my $verbose = $ENV{'VERBOSE'} || 0;

my $mirror = $ENV{'MIRROR'};
my $codename = $ENV{'CODENAME'};

$| = 1;

open(LOG, ">$sdir/log.cds2src") || die "Can't write in $sdir/log.cds2src !\n";

sub msg {
	my $level= shift;
	if ($verbose >= $level) {
		print @_;
	}
	print LOG @_;
}

my %bin2src;
my %sources;
my %included;

# Get the information from the good Sources.gz files
my @SOURCES = ("$mirror/dists/$codename/main/source/Sources.gz",
               "$mirror/dists/$codename/contrib/source/Sources.gz");

if ($nonus and ($codename ne "slink")) {
	push @SOURCES, 
             "$nonus/dists/$codename/non-US/main/source/Sources.gz",
             "$nonus/dists/$codename/non-US/contrib/source/Sources.gz";
} 
if ($nonfree) {
	push @SOURCES, "$mirror/dists/$codename/non-free/source/Sources.gz";
	if ($nonus and ($codename ne "slink")) {
	  push @SOURCES,
               "$nonus/dists/$codename/non-US/non-free/source/Sources.gz";
	}
}

# Slink special case
if ($nonus and ($codename eq "slink")) {
	push @SOURCES, "$nonus/dists/$codename/non-US/source/Sources.gz";
}

if ($local and -e "$mirror/dists/$codename/local/source/Sources.gz")
{
	push @SOURCES, "$mirror/dists/$codename/local/source/Sources.gz";
}

foreach (@SOURCES) {
	die "File `$_' cannot be found ..." if not -f;
}

my $oldrs = $/;
$/ = '';
my ($re, $p, $bin, $file, $size);
open (SOURCES, "zcat @SOURCES |") || die "Can't fork: $!\n";
while (defined($_ = <SOURCES>)) {
	# General information about the source package
	next if not m/^Package: (\S+)\s*$/m;
	$p = $1;
	$included{$p} = 0;
        $sources{$p}{"Package"} = $p;
	foreach $re (qw/Binary Version Section Directory/) {
		(m/^$re: (.*?)\s*$/m and $sources{$p}{$re} = $1)
		|| msg(1, "Header field '$re' missing for source '$p'\n");
	}
	foreach $bin (split (/,\s+/, $sources{$p}{"Binary"})) {
		$bin2src{$bin} = $p;
	}
	$sources{$p}{"Files"} = [];
	# Get the file list with the size
	if (not m/^Files:\s*\n/mgc) {
		msg(0,"ERROR: Cannot found Files field ...\n");
	}
	while (m/\G^\s+([\da-fA-F]+)\s+(\d+)\s+(\S+)\s*\n/mgc) {
		$file = $3; $size = $2;
		$file = "$sources{$p}{'Directory'}/$file";
		push @{$sources{$p}{"Files"}}, [ $file, $size ];
	}
	if (not @{$sources{$p}{"Files"}}) {
		msg(0, "ERROR: Source package $p has no files ...\n");
	}
}

$/ = $oldrs;

# Get the list of included packages
my @list = ();
my $i = 1;
while (-e "$bdir/$i.packages") {
	open (LIST, "< $bdir/$i.packages") || die "Can't open $file ...\n";
	while (defined($_ = <LIST>)) {
		chomp;
		push @list, $_;
	}
	close LIST;
	$i++;
}
msg(0, "ERROR: No source packages for the CD !\n") if not @list;

# Calculate what files go on which CD
my (%cds);
my ($cd, $cd_size, $total_size, $src) = (1, 0, 0);
foreach $p (@list) {
	if (not exists $bin2src{$p}) {
		msg(1, "WARNING: Package `$p' has no sources ... (ignored)\n");
		next;
	}
	$src = $bin2src{$p};
	if (not exists $included{$src}) {
		msg(0, "ERROR: Source `$src' does not exist ... (ignored)\n");
		next;
	}
	next if $included{$src};
	add_src ($src);
}

if ($complete) {
    msg(0, "Now we'll add the sources not yet included ...\n");
    foreach $p (sort { ($sources{$a}{"Section"} cmp $sources{$b}{"Section"})
                       || ($a cmp $b) }
                grep { not $included{$_} } keys %sources) 
    {
	add_src ($p);
    }

}

# Now write the lists down
foreach (keys %cds) {
        my $count = 0;
        open(CDLIST, "> $sdir/$_.sources") 
                        || die "Can't write in $sdir/$_.sources: $!\n";
        foreach (@{$cds{$_}}) {
                print CDLIST "$_\n";
                $count++;
        }
        close CDLIST;
        msg(0, "CD $_ will have $count files from source packages.\n");
}

close LOG;

## END OF MAIN

sub add_src {
	my $src = shift;
	my @files = ();
	$size = 0;
	msg(2, "+ Trying to add $src ...\n");
	foreach (@{$sources{$src}{"Files"}}) {
		$size += $_->[1];
		push @files, $_->[0];
	}
	if ($cd_size + $size > $limit) {
		msg(0, "Source CD $cd filled with $cd_size bytes ...",
		       " (limit was $limit)\n");
		$cd++;
		$cd_size = 0;
		# New limit
		$limit = $ENV{"SRCSIZELIMIT$cd"} || $deflimit;
		msg(1, "Limit for CD $cd is $limit\n");
	}
	$cd_size += $size;
	$total_size += $size;

	add_to_cd ($cd, \@files);
	$included{$src} = $cd;
}

sub add_to_cd {
	my $cd = shift;
	my $tab = shift;
	$cds{$cd} = [] if not ref $cds{$cd};
	msg(1, "Adding to CD $cd : @{$tab}\n");
	push (@{$cds{$cd}}, @{$tab});
}