#!/usr/bin/perl -w
# Copyright 2019 Gentoo Authors; Distributed under the GPL v2
# Trivial tool to modify the path strings of files in a tarball, WITHOUT
# unpacking the tarball.
use strict;
use warnings;
#use re 'strict'; # This fails if the modifiers are empty
use Getopt::Long;
use File::Temp qw/tempfile/;
use File::Basename;
use Archive::Tar::Stream;

my $input_filename;
my $output_filename;
my $regex;
my $verbose = 0;
#my ($t, $t2, $r);

GetOptions(
	"i|input-filename=s" => \$input_filename,
	"o|output-filename=s" => \$output_filename,
	"r|regex-replacement=s" => \$regex,
	"v|verbose" => \$verbose,
	#"t|test-string=s" => \$t,
) or die("Error in args");

die("--input-filename=... is required") unless -e $input_filename;
die("--output-filename=... is required") unless defined $output_filename;
die("--regex=... is required") unless defined $regex;
$regex =~ /^(?<op>s)(?<sep>.)(?<match>.*)\g{sep}(?<replacement>.*)\g{sep}(?<mod>[a-zA-Z0-9]*)$/;
my $regex_op = $+{op};
my $regex_match = $+{match};
my $regex_replacement = $+{replacement};
my $regex_mod = $+{mod};
die("--regex=$regex is not valid") unless defined $regex_op and defined $regex_match and defined $regex_replacement and defined $regex_mod;
die "Refusing unsafe/unknown regex modifiers" unless $regex_mod=~/^[msixpodualng]*$/;

die("Refusing to overwrite") if $input_filename eq $output_filename;

#printf "op %s\n", $regex_op;
#printf "match %s\n", $regex_match;
#printf "replacement %s\n", $regex_replacement;
#printf "mod %s\n", $regex_mod;

#my $infh = IO::File->new("zcat $infile |") || die "oops";
#my $outfh = IO::File->new("| gzip > $outfile") || die "double oops";
open(my $infh, '<', $input_filename);
my ($outfh, $temp_filename) = tempfile(
	sprintf('.%s.XXXXXXXX', basename($output_filename)),
	DIR => dirname($output_filename),
	UNLINK => 1,
);


my $ts = Archive::Tar::Stream->new(infh => $infh, outfh => $outfh);
my $success = 0;
$Archive::Tar::Stream::VERBOSE = $verbose;
$ts->StreamCopy(sub {
    my ($header, $outpos, $fh) = @_;

	$header->{name} =~ s/(?${regex_mod})${regex_match}/${regex_replacement}/;
	#printf "%s => %s\n", $header->{name}, $newheader->{name};

	return 'KEEP', $header;
});
$success = 1;

close($infh);

END {
	if($success == 1) {
		rename $temp_filename, $output_filename or do {
			unlink $temp_filename;
			die("Failed to rename temporary file to destination name");
		}
	}
	# Cleanup in other case
	unlink $temp_filename if -e $temp_filename;
	close $outfh;
}