src/reinstall.pl

#!/usr/bin/env perl
use v5.16;
use strict;
use warnings FATAL => 'all';
use FindBin;
use lib "$FindBin::Bin";
use mplib::config qw($CFG);
use mplib::util qw(fail confirm spin_start spin_stop);
use mplib::db qw(read_db);
use mplib::resolve qw(init reinstall_pkg expand_meta plan_resolution);
 
# --inplace (mplib::config::parse_flags): reinstall_pkg builds the new
# copy into a private, throwaway prefix and folds it onto the live root
# only once it's known good, instead of this file's own normal remove-
# then-install order below -- see reinstall_pkg's own comment.
my $flags = mplib::config::parse_flags(\@ARGV);
mplib::config::load($flags);
fail("reinstall needs at least one package name") unless @ARGV;
init();
 
my $db = read_db();
my @names = map { expand_meta($_, $db) } @ARGV;
 
# see install.pl's identical block for why -- plan_resolution validates
# the whole batch up front instead of discovering a conflict mid-way
# with some of it already really reinstalled.
unless($CFG->{NODEPS})
{
	spin_start("resolving dependencies...");
	my ($status, $result) = plan_resolution(\@names, $db);
	spin_stop();
	if($status eq 'fail')
	{
		fail("cannot satisfy this request: $result");
	}
	elsif($status eq 'ok')
	{
		for my $tag (keys %$result)
		{
			next if defined $CFG->{conf}{"TARGET_$tag"} && $CFG->{conf}{"TARGET_$tag"} ne '';
			$CFG->{conf}{"TARGET_$tag"} = $result->{$tag};
		}
	}
}
 
confirm("reinstall: " . join(' ', @names) . " -- continue?");
reinstall_pkg($_, $db) for @names;