#!/usr/bin/perl -CA
# dput-remove v1.0.1  (c) 27.3.2020 by Andreas Ley  (u) 7.4.2020
# Remove a package from the repository

use strict;
#no strict 'vars';
use warnings;
no warnings 'uninitialized';
use sigtrap;
use diagnostics;

# The script itself may use utf-8 encoded identifiers and literals
use utf8;
# Latin-1 codepoints are considered characters
use feature 'unicode_strings';
#use locale;
# Enable UTF-8 encoding for all files (but not already open handles)
use open ':encoding(utf8)';

use Getopt::Long;
use File::Basename;
use File::Spec::Functions;

use Term::Cap;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Terse = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Deepcopy = 1;
#warn Data::Dumper->Dump([\%hash],['*']) if ($debug{'file'}>0);
#warn Data::Dumper->new([\%hash],['*'])->Indent(0)->Dump if ($debug{'file'}>0);

my $global_conf = '/etc/dput.cf';
my $user_conf = catfile($ENV{'HOME'},'.dput.cf');

my $dpcl = '/usr/bin/dpkg-parsechangelog';
my $ssh = '/usr/bin/ssh';
#undef $ENV{'SSH_AUTH_SOCK'};

sub usage
{
	my $image = $0;
	$image =~ s!.*/!!;
	print  STDERR  "Usage: $image [package [release [...]]]\n";
	#print  STDERR  "-v, --verbose	Verbose mode\n";
	exit(1);
}

my %opt;
@_ = @ARGV unless (defined($Devel::Trace::TRACE));
$Getopt::Long::ignorecase = 0;
GetOptions (\%opt,'debug|D:s','help|h','trace|x','verbose|v+','dry-run|n');
exec($^X,'-d:Trace',$0,@_) if (defined($opt{'trace'}) && !defined($Devel::Trace::TRACE));

#&usage() if (defined($opt{'help'}) || !@ARGV);
&usage() if (defined($opt{'help'}));

if (defined($opt{'verbose'}) || defined($opt{'debug'})) {
	$|=1;
	select((select(STDERR),$|=1)[0]);
}

my (%debug,$on,$off);

sub debug
{
	my $file = shift;
	my $line = shift;
	my $prefix = defined($debug{'path'})?$file:defined($debug{'file'})?basename($file):'';
	if (defined($debug{'line'})) {
		$prefix .= ':' if (length($prefix));
		$prefix .= $line;
	}
	$prefix .= '  ' if (length($prefix));
	warn $prefix.(scalar(@_)>1 ? join(', ',map("\"$_\"",@_))."\n" : "@_\n");
}
$debug{undef} = \&debug;

if (defined($opt{'debug'})) {
	for (split(',',$opt{'debug'})) {
		if (/=/) {
			$debug{$`} = $';
		}
		else {
			$debug{$_} = 1;
		}
	}
	&debug(__FILE__,__LINE__,'%debug = '.Data::Dumper->Dump([\%debug],['*debug'])) if ($debug{'debug'}>0);
	&debug(__FILE__,__LINE__,'%opt = '.Data::Dumper->Dump([\%opt],['*opt'])) if ($debug{'opt'}>0);
	my $term = Tgetent Term::Cap { 'OSPEED'=>9600 };
	$on = $term->Tputs('md');
	$off = $term->Tputs('me');
}

# Enable UTF-8 encoding for already open handles
# ":utf8" would enable perl native coding which happens to be UTF-8 only on ASCII platforms
binmode(STDIN,':encoding(utf8)');
binmode(STDOUT,':encoding(utf8)');
# Triggers "syswrite() is deprecated on :utf8 handles. This will be a fatal error in Perl 5.30 at /usr/share/perl/5.28/sigtrap.pm line 86." when a signal is received
#binmode(STDERR,':encoding(utf8)') unless (defined($Devel::Trace::TRACE));

################################################################################

# Unfortunatly, dput.cf(5) is only almost like Config::IniFiles
# Sections don't add up but overwrite earlier instances
# Continuation lines aren't backslash linefeed but linefeed whitespace

my ($section,$key,$value,%config);
for my $file ($global_conf, $user_conf) {
	if (open(FILE,'<',$file)) {
		while (<FILE>) {
			chomp;
			&debug(__FILE__,__LINE__,$_) if ($debug{'read'}>0);
			if (/^\[([^[]+)]/) {
				&handle($section,$key,$value);
				$section = $1;
			}
			elsif (/^\s+/ && defined($value)) {
				$value .= ' '.$';
			}
			elsif (/^(\S+)\s*=\s*/) {
				&handle($section,$key,$value);
				$key = $1;
				$value = $';
			}
		}
		close(FILE);
		&handle($section,$key,$value);
	}
}

sub handle
{
	my ($section,$key,$value) = @_;

	&debug(__FILE__,__LINE__,$section,$key,$value) if ($debug{'config'}>1 && defined($section) && defined($key));
	$config{$section}{$key} = $value if (defined($section) && defined($key));
	undef $value;
}

my $host = $config{'DEFAULT'}{'default_host_main'};
&debug(__FILE__,__LINE__,'host='.$host) if ($debug{'config'}>0 && defined($host));
my $fqdn = $config{$host}{'fqdn'};
&debug(__FILE__,__LINE__,'fqdn='.$fqdn) if ($debug{'config'}>0 && defined($fqdn));
my $login = $config{$host}{'login'};
&debug(__FILE__,__LINE__,'login='.$login) if ($debug{'config'}>0 && defined($login));
my $method = $config{$host}{'method'};
&debug(__FILE__,__LINE__,'method='.$method) if ($debug{'config'}>0 && defined($method));
my $ssh_config_options = $config{$host}{'ssh_config_options'};
&debug(__FILE__,__LINE__,'ssh_config_options='.$ssh_config_options) if ($debug{'config'}>0 && defined($ssh_config_options));

die unless ($method eq 'scp');

unless (@ARGV) {
	open(DPCL,'-|',$dpcl,'-S','Source') or die;
	my $source = <DPCL>;
	chomp $source;
	close(DPCL);
	push(@ARGV,$source);
	# FIXME: Use Dpkg::Control::Info to get the names of the binary packages
}

&debug(__FILE__,__LINE__,$ssh,map(('-o',$_),split(' ',$ssh_config_options)),'-l',$login,$fqdn,'remove',@ARGV) if ($debug{'exec'}>0);
exec($ssh,map(('-o',$_),split(' ',$ssh_config_options)),'-l',$login,$fqdn,'remove',@ARGV);
