#!/usr/bin/env perl

use warnings;
use strict;

use File::Spec::Functions ( "catfile", "catdir", "file_name_is_absolute", "splitdir" );
use File::Basename;
use Scalar::Util ( "tainted" );
use v5.16;

$ENV{PATH} = "/usr/local/bin:/usr/bin:/bin";

sub usage {
    my ( $stream ) = @_;
    $stream = *STDERR unless defined $stream;
    say $stream "backup-restore MACHINE YYYY-MM-DD PATH[S]"
}

if ( @ARGV < 3 ) {
    usage(*STDOUT);
    exit 1;
}

my $machine;
if ( (shift @ARGV) =~ m|^([^/ ]*)$| ) {
    $machine = $1;
} else {
    print STDERR "Machine must be a machine name only, not a path\n";
    usage;
    exit 2;
}
my $date;
if ( (shift @ARGV) =~ /([0-9]+-[0-9]+-[0-9]+)/ ) {
    $date = $1;
} else {
    print STDERR "Date must be in YEAR-MONTH-DAY format\n";
    usage;
    exit 2;
}
my @paths = ();
for my $p ( @ARGV ) {
	if ( $p =~ m,/[.]{2}(/|$), ) {
		print STDERR "Paths must not contain backward (/../) elements";
		usage;
		exit 2;
	}
	# strip the leading / to match paths in the tar
    if ( $p =~ m,^/(.*)$, ) {
        push( @paths, $1 );
    } else {
        print STDERR "Expected absolute path but got $p\n";
        usage;
        exit 2;
    }
}

print "$machine $date @paths\n";

my $namematch = qr/^([0-9]+-[0-9]+-[0-9]+)[.](daily|weekly|full)[.](.*)$/;

sub getDirContents {
	my ( $dirname ) = @_;
	opendir( my $dir, $dirname ) or die $!;
	my @contents = readdir( $dir );
	my @backups = sort( grep { /$namematch/ } @contents );
	my @subdirs = sort( grep { !/^(stamps|[.]{1,2})$/ && !/$namematch/ } @contents );
	return ( [ @backups ], [ @subdirs ] );
}

sub restore {
	my ( $restore_path, @backups ) = @_;
	say "restore( $restore_path, " . join( ", ", @backups ) . " );";

	my $full;
	my @weekly = ();
	my @daily = ();

	for my $backup_path ( @backups ) {
		my $backup = basename( $backup_path );
		$backup =~ /$namematch/;
		my $from = $1;
		my $type = $2;
		last if $from gt $date;

		if ( $type eq "full" ) {
			$full = $backup_path;
			@weekly = ();
		} elsif ( $type eq "weekly" ) {
			push( @weekly, $backup_path );
			@daily = ();
		} else {
			push( @daily, $backup_path );
		}
	}

	my @to_restore = ( $full, @weekly, @daily );

	for my $backup ( @to_restore ) {
		print "$backup…\n";
		my @args = ( "tar", "--extract", "--auto-compress", "--incremental", "--xattrs",
					 "--acls", "-vv", "-f$backup", "--", $restore_path );
		system( @args ) == 0 or die "extract of $backup failed with $?, @args\n";
	}
}

sub find_and_restore {
	my ( $anchor, $path, $fullpath ) = @_;
	$fullpath = $path unless defined $fullpath;

	say "find_and_restore( $anchor, $path, $fullpath );";

	my ( $backups, $subdirs ) = getDirContents( $anchor );
	if ( @{$backups} ) {
		return restore( $fullpath, map { catdir( $anchor, $_ ) } @{$backups} );
	}
	$path =~ m,([^/]*)(?:/|$)(.*), or die "Could not parse path $path";
	my $first_segment = $1;
	my $path_rest = $2;
	my @next = grep { $_ eq $first_segment } @{$subdirs};
	if ( @next ) {
		return find_and_restore( catdir( $anchor, $first_segment ), $path_rest, $fullpath );
	}
	say STDERR "No match for $first_segment in $anchor";
	exit 3;
}

for my $p ( @paths ) {
	find_and_restore( catdir( "/backup-tar", $machine ), $p );
}
