#!/usr/bin/perl

use warnings;
use strict;

use constant CONFIG_DIR     => '/var/lib/tarantool/started';
use constant PID_DIR        => '/var/run/tarantool';
use constant SNAPSHOT_DIR   => '/var/lib/tarantool/snapshot';
use File::Spec::Functions 'catfile';
use File::Basename 'basename', 'dirname';
use IO::Socket::INET;
use Getopt::Long;
use Pod::Usage;
use Data::Dumper;


pod2usage(-exitstatus => 0, -verbose => 2) unless
    GetOptions
        'help|h'                => \my $help,
        'verbose|v'             => \my $verbose,
        'snapshots|s=i'         => \my $snapshots,
        'snapshot_period|p=i'   => \my $period,
;


sub DEBUGF($;@) {
    return unless $verbose;
    my ($fmt, @arg) = @_;
    $fmt =~ s/\s*$/\n/;
    printf STDERR $fmt, @arg;
}


sub list_files($) {
    my $sndir = shift;
    unless (-d $sndir) {
        DEBUGF 'Snapshot directory "%s" was not found', $sndir;
        return;
    }

    unless (-w $sndir) {
        DEBUGF 'Can not write into directory %s', $sndir;
        return;
    }

    my $dh;
    opendir $dh, $sndir;
    my @files = sort
        grep /\.(snap|xlog)$/,
        grep { -r $_ and -f $_ }
            map { catfile $sndir, $_ }
            readdir $dh;
    return @files;
}

sub rotate_snapshot($$$) {
    my ($pidfile, $snap_count, $snap_period) = @_;

    $snap_count = $snapshots || 10 unless defined $snap_count;
    $snap_period = $period || 24 unless defined $snap_period;
    $snap_count = $snapshots if defined $snapshots;
    $snap_period = $period if defined $period;
    $snap_period ||= 0;

    my $pid;

    DEBUGF "\tBegin rotating process period=%s, count=%s",
        $snap_period, $snap_count;


    if (open my $ph, '<', $pidfile) {
        $pid = <$ph>;
        $pid =~ s/\D+//g;
    } else {
        warn "Can't open file $pidfile: $!\n";
        return;
    }

    unless($pid) {
        warn "PID was not received\n";
        return;
    }


    my $sndir = catfile SNAPSHOT_DIR, basename $pidfile, '.pid';
    my @files = list_files $sndir;
    goto FINISH unless @files;

    my ($last_snap) = grep /\.snap$/, reverse @files;
    if ($last_snap) {{
        my @stat = stat $last_snap;
        last unless @stat;
        my $ctime = $stat[10];
        if (time - $ctime < $snap_period * 3600 - 3600 / 2) {
            DEBUGF "\tLast snapshot was created %3.2f hours ago, ".
                "do not create new",
                (time - $ctime) / 3600;
            return;
        }
        DEBUGF "\tLast snapshot was created %3.2f hours ago, creating new",
            (time - $ctime) / 3600;
    }} else {
        DEBUGF "\tLast snapshot was not found, creating new";
    }

    while(@files and $files[0] =~ /\.xlog$/) {
        DEBUGF "\tRemove orphaned %s", $files[0];
        unless (unlink $files[0]) {
            DEBUGF "\tCan't unlink file %s: %s", $files[0], $!;
            return;
        }
        shift @files;
    }

    unless (kill 0 => $pid) {
        DEBUGF "\tProcess %s is not started", $pidfile;
        return;
    }

    if (kill USR1 => $pid) {
        goto FINISH unless @files;
        for (my $i = 0; $i < 5; $i++) {
            sleep 1;
            my @inpr = sort glob catfile SNAPSHOT_DIR, '*.snap.inprogress';
            last unless @inpr;
            if ($inpr[-1] and $inpr[-1] gt $files[-1]) {
                DEBUGF "\tsnapshot %s is still in progress...", $inpr[-1];
                next;
            }
        }
    } else {
        warn "Error while sending snapshot signal: $!";
        return;
    }

    if ($snap_count) {
        @files = list_files $sndir;
        my $snaps = grep /\.snap$/, @files;
        if ($snaps > $snap_count) {
            my $to_remove = $snaps - $snap_count;

            while (@files) {
                my $file = shift @files;
                $to_remove-- if $file =~ /\.snap$/;
                DEBUGF "\tUnlink file: %s...", $file;
                unless (unlink $file) {
                    DEBUGF "\tCan't unlink file %s: %s", $file, $!;
                    return;
                }
                last unless $to_remove > 0;
            }
            while(@files and $files[0] =~ /\.xlog$/) {
                DEBUGF "\tRemove orphaned %s", $files[0];
                unless (unlink $files[0]) {
                    DEBUGF "\tCan't unlink file %s: %s", $files[0], $!;
                    return;
                }
                shift @files;
            }
        }
    } else {
        DEBUGF "\tDon't remove any old snapshots";
    }

    FINISH:
}


DEBUGF "Looking through %s...", PID_DIR;
for (glob catfile PID_DIR, '*.pid') {
    my $cfg = catfile CONFIG_DIR, basename $_, '.pid';

    unless(-r $cfg) {
        warn "Config file '$cfg' is not found\n";
        next;
    }
    DEBUGF 'Found instance "%s" (%s)', basename($cfg), basename $_;

    if (open my $fh, '<:encoding(UTF-8)', $cfg) {
        my @lines = <$fh>;

        my ($user_snapshots) =
            grep /^\s*(?:opt\s+)?save_snapshots\s*=\s*\d+\s*(?:#.*)?$/,
                reverse @lines;

        my ($snapshot_period) =
            grep /^\s*(?:opt\s+)?snapshot_period\s*=\s*\d+\s*(?:#.*)?$/,
                reverse @lines;

        if ($user_snapshots) {
            for ($user_snapshots) {
                s/#.*//;
                s/\D//g;
            }
            unless($user_snapshots =~ /^[1-9]\d*$/) {
                warn "wrong format of save_snapshots\n";
                $user_snapshots = undef;
            }
        }

        if ($snapshot_period) {
            for ($snapshot_period) {
                s/#.*//;
                s/\D//g;
            }
            unless($snapshot_period =~ /^[1-9]\d*$/) {
                warn "wrong format of snapshot_period\n";
                $snapshot_period = undef;
            }

        }

        rotate_snapshot $_, $user_snapshots, $snapshot_period;


    } else {
        warn "Can't open file $cfg: $!\n";
        next;
    }
}

exit 0 unless -x PID_DIR;
exit 0 unless -x CONFIG_DIR;

=head1 NAME

tarantool_snapshot_rotate - script to creates/rotates snapshots

=head1 SYNOPSIS

    tarantool_snapshot_rotate
    tarantool_snapshot_rotate --verbose

=head1 DESCRIPTION

The script passes through all started tarantool instances and creates
snapshots for each instance.

The script understands some additional options in tarantool.cfg:

=over

=item save_snapshots = COUNT

Count of snapshots to save (default = 10). COUNT=0 disables removing
old snapshots.

=item

=back

=head1 OPTIONS

=over

=item -h | --help

show the helpscreen

=item -v | --verbose

log process to B<STDOUT>

=item -s | --snapshots COUNT

redefines B<save_snapshots> option of config file

=back

=cut
