#!/usr/bin/perl

use Getopt::Long;

$profiles_dir = "../new_root_home/profiles";
$tasks_dir = "../new_root_home/tasks";
$master = "./master";

# Defaults
$check_dependencies = 1;
$dependencies_errors_are_fatal = 1;
$dummy = 0;

$result = GetOptions ("check_dependencies!" => \$check_dependencies, 
		      "dependencies_errors_are_fatal!" => \$dependencies_errors_are_fatal,
		      "packages_not_requested_is_fatal" => \$packages_not_requested_is_fatal,
		      "debug=i" => \$debug,
		      "dummy!" => \$dummy,
		      "help!" => \$help);
if (! $result) {
    die "Usage: $0 [options] architecture [packages-file-name] (-h to see the options)";
}

if ($help) {
    print << 'EOF';
    --[no]check_dependencies: check the dependencies between packages of a same                           profile. 
    --[no]dependencies_errors_are_fatal: die is there is a dependency error.
    --[no]packages_not_requested_is_fatal: die if an important or standard 
                           package is not requested.
    --debug=level: indicates a debug level.
    --dummy: don't write profiles or tasks, just check dependencies.
EOF
    exit (0);
}

if ($dependencies_errors_are_fatal) {
    $check_dependencies = 1;
}

$architecture = shift (@ARGV);
if (! $architecture) {
   die "Usage: $0 [options] architecture [packages-file-name] (-h to see the options)";
}
$master .= ".$architecture";

$current_packages = shift (@ARGV);
if (! $current_packages) {
    @current_packages = ("slink_main_binary-i386_Packages");
}
else {
    @current_packages = split (',', $current_packages);
}

&Scan_Master;

%existing_packages = &Scan_Packages;

&Check_Dependencies;

&Compute_Sizes;

if (! $dummy) {

  if (! -d $profiles_dir) {
      mkdir $profiles_dir, 0777;
  }
  if (! -d $tasks_dir) {
      mkdir $tasks_dir, 0777;
  }
  
  &Create_Tasks;

  &Create_Profiles;
}

sub Scan_Master {
    open (MASTER, "< $master") or die "Cannot open $master: $!";
    while (<MASTER>) {
	$line++;
	if (/^ *$/) {
	    next;
	}
	elsif (/^ *#/) {
	       next;
	   }
	elsif (/^ *--- *(.*):/) {
	    $section = $1;
	    $section =~ tr/A-Z/a-z/;
	}
	elsif (/^ *([A-Za-z0-9_\-\+.]+): (.+)/) {
	    if ($section eq "tasks") {
		$task = $1;
		if ($tasks{$task}) {
		    die "Task $task is multiply defined (line $line)";
		}
		else {
		    if ($debug >= 1) {
			print STDERR "Adding task \"$task\"\n";
		    }
		    $text = $2;
		    $text =~ /([^\(]+) *(\(incl\. *([A-Za-z0-9\-\_, ]+)\)|) *$/;
		    if ($3) {
			$tasks{$task} = $1;
			$inclusions{$task} = $3;
			if ($debug >= 2) {
			    print STDERR "  it includes \"$3\"\n";
			}
		    }
		    else {
			$tasks{$task} = $text;
		    }
		}
	    }
	    elsif ($section eq "profiles") {
		$profile = $1;
		if ($profiles{$profile}) {
		    die "Profile $profile is multiply defined (line $line)";
		}
		else {
		    if ($debug >= 1) {
			print STDERR "Adding profile \"$profile\"\n";
		    }
		    $profiles{$profile} = $2;
		}
	    }
	    elsif ($section eq "packages") {
		$package = $1;
		if ($packages{$package}) {
		    die "Package $package is multiply defined (line $line)";
		}
		else {
		    $list = $2;
		    $packages{$package} = $list;
		    $list =~ /^ *Tasks:(.+) Profiles:(.+)/;
		    $my_tasks = $1;
		    $my_profiles = $2;
		    $my_tasks =~ s/ //g;
		    $my_profiles =~ s/ //g;
		    @my_tasks = split (',', $my_tasks);
		    @my_profiles = split (',', $my_profiles);
		    foreach $task (@my_tasks) {
			if (! $tasks{$task}) {
			    die "Package $package is in task \"$task\" which does not exist (line $line)";
			}
			else {
			    $list_packages_of_tasks{$task} .= ($package . ",");
			}
		    }
		    foreach $profile (@my_profiles) {
			if (! $profiles{$profile}) {
			    die "Package $package is in profile $profile which does not exist (line $line)";
			}
			else {
			    $list_packages_of_profiles{$profile} .= ($package . ",");
			}
		    }
		}
	    }
	}
	else {
	    die "Abnormal line $line";
	}
    }
    close (MASTER);

    # Canonicalize packages lists
    foreach $task (keys (%tasks)) {
	foreach $package (split (',', $list_packages_of_tasks{$task})) {
	    $packages_of_tasks{$task}{$package} = 1;
	}
    }
    foreach $profile (keys (%profiles)) {
	foreach $package (split (',', $list_packages_of_profiles{$profile})) {
	    $packages_of_profiles{$profile}{$package} = 1;
	}
    }
    
    foreach $task (keys (%tasks)) {
	foreach $other_task (split (',', $inclusions{$task})) {
	    $other_task =~ s/^ *//;
	    $other_task =~ s/ *$//;
	    if (! $tasks{$other_task}) {
		    die "Task \"$other_task\" is included by \"$task\" but does not exist";
	    }
	    if ($debug >= 4) {
		print STDERR "Including $other_task into $task\n";
	    }
	    foreach $package (keys %{$packages_of_tasks{$other_task}}) {
		$packages_of_tasks{$task}{$package} = 1;
	    }
	}
    }
}

sub Check_Dependencies {
    foreach $task (keys (%tasks)) {
	foreach $package (keys %{$packages_of_tasks{$task}}) {
	    if (! $existing_packages{$package}) {
		die "Package $package, requested by task $task does not exist";
	    }
	    if ($check_dependencies) {
		Check_Dependencies_Of ($package, "task", $task);
	    }
	}
    }
    foreach $profile (keys (%profiles)) {
	foreach $package (keys (%{$packages_of_profiles{$profile}})) {
	    if (! $existing_packages{$package}) {
		die "Package $package, requested by profile $profile does not exist";
	    }
	    if ($check_dependencies) {
		Check_Dependencies_Of ($package, "profile", $profile);
	    }
	}
    }
    foreach $package (keys (%existing_packages)) {
	($priority, $section, $size) = 
	    split (':', $existing_packages{$package});
	if ((($priority eq "important") or ($priority eq "standard")) and
	    (! $packages{$package})) {
	    if ($packages_not_requested_is_fatal) {
		die "Package $package is standard or important but is not requested " .
		    "by any task (or profile)";
	    }
	    else {
		warn "Package $package is standard or important but is not requested " .
		    "by any task (or profile)";
	    }
	}
    }
}

sub Scan_Packages {

    my ($package, $packages, $priority, $size, $depends);

	foreach $packages (@current_packages)  {
	    if ( -f $packages) {
		open (PACKAGES, "< $packages");
	    } 
	    elsif ( -f "$packages.gz" ) {
		open (PACKAGES, "zcat $packages.gz |");
	    } 
	    else {
		die "Cannot open $packages: $!";
	    }
	    undef $package;
	    undef $priority;
	    undef $section;
	    undef $size;
	    undef $depends;
	    while (<PACKAGES>) {
		chomp;
		if (/^Package: (.*)/) {
		    $package = $1;
		    $package =~ s/ //g;
		}
		elsif (/^\s*$/) {
		    # Test if everything is defined?
		    $existing_packages{$package} = "$priority:$section:$size:$depends";
		    if ($debug >= 7) {
			print "Adding package \"$package\" of size $size in section $section\n";
		    }
		    undef $package;
		    undef $priority;
		    undef $section;
		    undef $size;
		    undef $depends;
		}        
		elsif ((/^Priority: (.*)/) and defined ($package)) {
		    $priority = $1;
		    if ($priority eq "required") {
			if ($debug >= 8) {
			    print STDERR "Required package: $package\n";
			}
			$required_packages{$package} = 1;
		    }
		}
		elsif ((/^Section: (.*)/) and defined ($package)) {
		    $section = $1;
		}
		elsif ((/^Depends: (.*)/) and defined ($package)) {
		    $depends = $1;
		}
		elsif ((/^Provides: (.*)/) and defined ($package)) {
		    foreach $virtual_package (split (',', $1)) {
			$virtual_package =~ s/ //g;
			$provided_packages{$virtual_package} .= "$package,";
			if ($debug >= 8) {
			    print STDERR "Package $package provides \"$virtual_package\"\n";
			}
		    }
		}
		elsif ((/^installed-size: (.*)/) and defined ($package)) {
		    $size = $1;
		}
	    }
	    close (PACKAGES);
	}
    return %existing_packages;
}

sub Compute_Sizes {
    foreach $task (keys (%tasks)) {
	$size_of_tasks{$task} = int (Sum_Of_Task($task)/1024);
	if ($debug >= 3) {
	    print "Size of $task is $size_of_tasks{$task} Mbytes\n";
	}
    }
    foreach $profile (keys (%profiles)) {
	$size_of_profiles{$profile} = int (Sum_Of_Profile($profile)/1024);
    }
}

sub Sum_Of_Task {
    my ($task) = @_;
    my ($size, $package);
    foreach $package (keys (%{$packages_of_tasks{$task}})) {
	# Find its size, increment
	if (! $existing_packages{$package}) {
	    warn "Inexisting package \"$package\"";
	}
	else {
	    ($garbage, $garbage, $increment) = 
		split (':', $existing_packages{$package});
	    $size += $increment;
	}
    }
    return $size;
}

sub Sum_Of_Profile {
    my ($profile) = @_;
    my ($size, $package);
    foreach $package (keys (%{$packages_of_profiles{$profile}})) {
	# Find its size, increment
	if (! $existing_packages{$package}) {
	    # Ignore
	}
	else {
	    ($garbage, $garbage, $increment) = 
		split (':', $existing_packages{$package});
	    $size += $increment;
	}
    }
    return $size;
}

sub Create_Tasks {
    foreach $task (keys (%tasks)) {
	open (TASK, "> $tasks_dir/$task") or die "Cannot create $task: $!";
	print TASK $tasks{$task}, "[~ ", $size_of_tasks{$task}, "M]\n";
	foreach $package (keys (%{$packages_of_tasks{$task}})) {
	    print TASK "$package	install\n";
	}
	close (TASK);
    }
}

sub Create_Profiles {
    foreach $profile (keys (%profiles)) {
	open (PROFILE, "> $profiles_dir/$profile") or die "Cannot create $profile: $!";
	print PROFILE $profiles{$profile}, "[~ ", $size_of_profiles{$profile}, "M]\n";
	foreach $package (keys (%{$packages_of_profiles{$profile}})) {
	    print PROFILE "$package	install\n";
	}
	close (PROFILE);
    }
}

sub Check_Dependencies_Of {
    my ($package, $type, $file) = @_;
    my ($garbage, $garbage, $garbage, $dependencies) = 
	split (':', $existing_packages{$package}, 4);
    my (@dependencies) = split (',', $dependencies);

    my (%partners);

    if ($type eq "task") {
        %partners = %{$packages_of_tasks{$file}};
    }
    else {
        %partners = %{$packages_of_profiles{$file}};
    }
    for $i (0..$#dependencies) {
	#$dependencies[$i] =~ s/^ *([a-z0-9\-.]+)( ?.*|)$/$1/; 
        # We should keep the version numbers, to test them!
	# Drop version numbers
	$dependencies[$i] =~ s/\([^\)]*\)//g;
	# Trim
	$dependencies[$i] =~ s/^ *//;
	$dependencies[$i] =~ s/ *$//;
    }
  Dependency:
    foreach $dependency (@dependencies) {
	# It's more complicated, thre are the version numbers, for instance...
	if ($dependency =~ /\|/) {
	    @alternates = split ('\|', $dependency);
	    foreach $alternate (@alternates) {
		# Trim
		$alternate =~ s/^ *//;
		$alternate =~ s/ *$//;
		if (&Dependency_OK ($alternate, $type, $file, \%partners)) {
		    next Dependency;
		}
	    }
	    if ($dependencies_errors_are_fatal) {
		die "Package $package in $type $file depends on \"$dependency\" whose none ".
		    "is not in the same $type";
	    }
	    else {
		warn "Package $package in $type $file depends on \"$dependency\" whose none ".
		    "is not in the same $type";
	    }	    
	}
	elsif (! &Dependency_OK ($dependency, $type, $file, \%partners)) {
	    if ($dependencies_errors_are_fatal) {
		die "Package $package in $type $file depends on \"$dependency\" which ".
		    "is not in the same $type";
	    }
	    else {
		warn "Package $package in $type $file depends on \"$dependency\" which ".
		    "is not in the same $type";
	    }
	}
    }
    foreach $partner (@partners) {
	$partners{$partner} = 0;
    }
}

sub Dependency_OK {
    my ($package, $type, $file, $partners) = @_;
    return ((${$partners}{$package}) or
	($required_packages{$package}) or
	    (&One_Package_Provides ($package, $type, $file)));
}

sub One_Package_Provides {
    my ($virtual_package, $type, $file) = @_;
    if (! $provided_packages{$virtual_package}) {
	if ($debug >= 5) {
	    print STDERR "No package provides \"$virtual_package\"\n";
	}
	return 0;
    }
    else {
	my (@provider_packages) = 
	    split (',',  $provided_packages{$virtual_package});
	my (@packages_of_file);
	if ($type eq "task") {
	    @packages_of_file = keys (%{$packages_of_tasks{$file}});
	}
	else {
	    @packages_of_file = keys (%{$packages_of_profiles{$file}});
	}
	my (%packages_of_file);
	foreach $package (@packages_of_file) {
	    $package =~ s/ //g;
	    $packages_of_file{$package} = 1;
	}
	if ($debug >= 5) {
	    print STDERR "Providers of \"$virtual_package\" are " .
		join (',', @provider_packages) . "\n";
	}
	if ($debug >= 6) {
	    print STDERR "Packages of \"$file\" are " .
		join (',', @packages_of_file) . "\n";
	}
	foreach $package (@provider_packages) {
	    $package =~ s/ //g;
	    if ($packages_of_file{$package}) {
		return 1;
	    } 
	    elsif ($required_packages{$package}) {
	    	if ($debug >= 5) {
		    print STDERR "Package $package provides $virtual_package and is a required package."
		}
		return 1;
	    }
	    elsif ($debug >= 5) {
		print STDERR "Package $package provides $virtual_package but is not in $type $file\n";
	    }
	}
	return 0;
    }
}



