#! /usr/bin/perl
use 5.010;
use strict;
use warnings;
use Pod::Usage;
use Getopt::Long;
use Readonly;
use DDP;

our $VERSION = '0.01';

use constant YES       => 'YES';
use constant NO        => 'NO';
use constant DUMPDATES => '/var/lib/dumpdates';
use constant FD3       => 3;
use constant FD4       => 4;

Readonly my %SUPPORT => (
    CONFIG          => YES,    # --config … (ignored?)
    HOST            => YES,    # --host …   (ignored?)
    DISK            => YES,    # --disk …   (ignored?)
    MAX_LEVEL       => 9,
    CLIENT_ESTIMATE => YES,    # estimate
    MULTI_ESTIMATE  => YES,    # estimate for multiple levels
    CALCSIZE        => YES,    # estimate --calcsize
    MESSAGE_LINE    => YES,    # --message line
    INDEX_LINE      => NO,     # --index line
    RECORD          => YES,    # --record
);

# the commands we need to support as required by the
# API:  http://wiki.zmanda.com/index.php/Application_API/Operations

sub exec_support;
sub exec_selfcheck;
sub exec_estimate;
sub exec_backup;

# some helper functions

sub device;
sub OK;
sub ERROR;

# bad but common style - the global options

my $opt_config;      # $config
my $opt_host;        # $host
my $opt_disk;        # $disk DLE[1]
my $opt_device;      # $device DLE[2]
my $opt_message;     # line / <>
my $opt_index;       # line / <>
my $opt_record;      # true / <>
my $opt_level;       # 0…99
my $opt_calcsize;    # true / <>

my $opt_dumpdates;

MAIN: {
    my @argv = @ARGV;
    my $command = shift // pod2usage;
    GetOptions(

        'config=s'  => \$opt_config,
        'host=s'    => \$opt_host,       # --host $host
        'disk=s'    => \$opt_disk,       # --disk $disk
        'device=s'  => \$opt_device,     # --device $device
        'message=s' => \$opt_message,    # --message line|xml
        'index=s'   => \$opt_index,      # --index line
        'record!'   => \$opt_record,     # --record
        'level=i@'  => \$opt_level,      # --level n
        'calcsize!' => \$opt_calcsize,

        'dumpdates=s' => \$opt_dumpdates,    # --dumpdates <file>
    ) or pod2usage;

    given ($command) {
        when ("support") { exec_support }
        when ("selfcheck") {
            pod2usage if not defined $opt_device;
            exec_selfcheck
        }
        when ("estimate") {
            pod2usage
              if not defined $opt_device
                  or not defined $opt_level;
            exec_estimate
        }
        when ("backup") { exec_backup }
        default         { pod2usage }
    }
}

# output a list of supported options
sub exec_support {
    print map { "$_ $SUPPORT{$_}\n" =~ s/_/-/gr } keys %SUPPORT;
    exit 0;
}

sub exec_selfcheck {
    # must: $opt_device
    # may: $opt_level
    if ($opt_level and ref $opt_level) { $opt_level = $opt_level->[0] }

    if ($_ = (grep { -x ($_ .= "/dump") } split /:/ => $ENV{PATH})[0]) {
        OK "dump is \"$_\"";
    }
    else { say "ERROR dump not found in $ENV{PATH}\n" }

    # check the device
    # the opt_disk is just a label, the device is in opt_device!
    my $device = device($opt_device);

    if    (-b $device) { OK "$opt_device ($device is block special)" }
    elsif (-d $device) { OK "$opt_device ($device is directory)" }
    else               { ERROR "$opt_device not recognized" }

    # check the dumpdates file
    if ($opt_record) {
        my $dumpdates = $opt_dumpdates ? expand($opt_dumpdates) : DUMPDATES;

        eval { open(my $x, "+>>", $dumpdates) or die "$!\n" };
        if   (chomp $@) { ERROR "dumpdates file \"$dumpdates\": $@" }
        else            { OK "dumpdates file: \"$dumpdates\"" }
    }

    exit 0;
}

sub exec_estimate {

    # must: $opt_level, $opt_device
    # may:  $opt_record, $opt_dumpdates
    my (@errors, @results);

    foreach my $level (@$opt_level) {
        my @cmd = (
            dump => "-$level",
            '-S',
            $opt_record && $opt_dumpdates ? (-D => expand($opt_dumpdates)) : (),
            device($opt_device),
        );

        chomp(my @output = `@cmd 2>&1`);

        if ($?) {
            say "unexpected output:\n",
		join "\n" => @output;
            exit 1;
        }

	# the last line should be the number of 1K blocks
	my $blocks = do {
	    my $_ = pop @output;
	    /^(\d+)/ or do {
		say "can't get estimate";
		exit 1;
	    };
	    $1 / 1024;
	};

        # level blocks blocksize
        # --> the blocksize unit is K
	push @errors, @output, "---" if @output;
	push @results, "$level $blocks 1";
    }

    say join "\n", @errors if @errors;
    say join "\n", @results;
    exit 0;
}

sub exec_backup {

    # fd1: data channel
    # fd3: message channel
    # fd4: index channel

    my @dump = (
        dump => "-$opt_level",
        -f   => "-",
        $opt_record ? "-u" : (),
        $opt_record && $opt_dumpdates ? (-D => expand($opt_dumpdates)) : (),
        device($opt_device)
    );

    # messages ----------,
    #   ,---------> fd2 ----> fd3
    # dump --o----> fd1                (data)
    #         `---> restore -t --> fd4 (index)

    open(my $msg, ">&=", FD3) or die "Can't open fd3: $!\n";
    open(my $idx, ">&=", FD4) or die "Can't open fd4: $!\n" if $opt_index;

    if ($opt_index) {
        my $pid = fork // die "Can't fork: $!\n";
        if (not $pid) {
            open(STDOUT, "|-") or do {
                open(my $restore, "|-") or do {
                    open(STDOUT, "|-") or do {
                        select($idx);
                        postprocess_toc();
                        exit 0;
                    };
                    exec "restore", "-tvf" => "-";
                    die "Can't exec `restore -tvf -`: $!";
                };
                local $/ = 2**16;
                while (<STDIN>) {
                    print $_;
                    print $restore $_;
                }
                exit 0;
            };

            open(STDERR, "|-") or do {
                select($msg);
                postprocess_dump_messages();
                exit 0;
            };

            exec @dump;
            die "Can't exec `@dump`: $!\n";
        }

        waitpid($pid, 0);
        exit $?;
    }

    # no need to send an index
    my $pid = fork // die "Can't fork: $!\n";
    if (not $pid) {
        open(STDERR, "|-") or do {
            select($msg);
            postprocess_dump_messages();
            exit 0;
        };
        exec @dump;
        die "Can't exec `@dump`: $!\n";
    }
    waitpid($pid, 0);
    exit $?;

}

sub postprocess_dump_messages() {
    while (<STDIN>) {
        print "| $_";

        if (/^\s+DUMP: (\d+) blocks?/) {

            # we assume a block size of 1K
            say "sendbackup: size $1";
        }
        elsif (/^\s+DUMP: DUMP IS DONE/) {
            say "sendbackup: end";
        }
    }
}

sub postprocess_toc {

    # dir  4711 ./aaa
    # leaf 4712 ./bbb/xxx
    # leaf 4713 ./bbb/a
    # b
    # leaf 8819 ./bbb/x

    my $name;

    while (<STDIN>) {
        chomp;
        if (/^(dir|leaf)\s+\d+\s+(\.\/.*)/) {
            say $name if defined $name;
            $name = $2 . ($1 eq "dir" ? "/" : "");
            next;
        }

        if ($name) {
            $name .= $_;
            next;
        }

    }

    say $name if defined $name;

}

sub device {
    my $_ = shift;
    return $_ if /^\//;
    return "/dev/$_";
}

sub expand {
    my $_ = shift;
    s/\${c}/$opt_config/g;
    return $_;
}

sub OK    { say "OK ",    @_ }
sub ERROR { say "ERROR ", @_ }

=head1 NAME

  amdumpext - the amanda dump application

=head1 SYNOPSIS

  amdumpext support
  amdumpext selfcheck [options] [--level <level>]    --device <device> 
  amdumpext estimate [options]  [--level <level>]... --device <device> 

=head1 COMMANDS

=over

=item B<support>

Send a list of supported features.

=back

=head1 OPTIONS

=head2 Common Options

The following options have to be supported by the application.

=over 4

=item B<--config> I<config>

The configuration to be used (the backup set).

=item B<--host> I<host>

The host from the DLE.

=item B<--disk> I<disk>

The disk to be saved. It's some "label" for the device to be backed up.

=item B<--device> I<device>

The device to be backed up (may be a device name, a mountpoint).

=back

=head2 Optional options

The following options need to be supported if indicated by the "support"
command.

=over

=item B<--message> "line"

Send messages line by line.

=item B<--index> "line"

Send the index line by line.

=back

=cut

=head2 Properties

=over 4

=item B<--dumpdates> I<dumpdates>

The location of the dumpdates file. Placeholder "${c}" is allowed and
replaced by the name of the current config.

=back

# vim:sts=4 sw=4 aw ai sm:
