#!/usr/bin/perl

use strict;
use warnings;
use IPC::Run qw(run);

# Configuration variables

my $min_speed = 60;      # Minimum allowed read speed
my $trim_edges = 3;      # Trim this many extents from each side of good areas
my $min_good_size = 125; # Good areas below this number of extents are marked as bad

die("Usage: $0 test_file lv_name\n") if scalar @ARGV != 2;
my ($test_file, $lv_name) = @ARGV;

sub read_lv_map {
  my $lv_name = shift;
  run ['lvs', '--noheadings', '-oseg_pe_ranges', $lv_name], '>', \my $map or die("lvs: $?\n");
  return map { s/^ +//; s/ +$//; [ split /[:-]/ ] } split /\n/, $map;
}

my @lv_map = read_lv_map($lv_name);

open my $test_file_h, '<', $test_file or die("open: $?\n");
my @lv_speed = map { (split / /)[1] } <$test_file_h>;
my %pv_speed;
my $lv_idx = 0;
for my $map_item (@lv_map) {
  my ($dev, $pv_start, $pv_end) = @$map_item;
  for(my $pv_idx = $pv_start; $pv_idx <= $pv_end; $pv_idx++) {
    $pv_speed{$dev} = [] if !defined $pv_speed{$dev};
    $pv_speed{$dev}->[$pv_idx] = $lv_speed[$lv_idx++];
  }
}
my $lv_data_len = scalar @lv_speed;
die("Wrong test file length: got $lv_data_len, expected $lv_idx\n") if $lv_idx != $lv_data_len;

# Converts array of values to RLE representation

sub rle {
  return () if scalar @_ == 0;
  my $v;
  my $l = 0;
  my $t;
  my @rle = map {
    if($l == 0) {
      $l++;
      $v = $_;
      ();
    } elsif (!(defined($v) || defined($_)) || (defined($v) && defined($_) && $v == $_)) {
      $l++;
      ();
    } else {
      $t = [$v, $l];

      $l = 1;
      $v = $_;

      $t;
    }
  } @_;
  push @rle, [$v, $l];
  return @rle;
}

sub trim_func {
 my ($a, $b, $c) = @_;
 return $b if !defined $b;
 return (defined $a ? $a : 1) & $b & (defined $c ? $c : 1);
}

# Process array of speed values
sub process_data {
  my @data = @_;
# Values less than $min_speed are changed to 0, greater or equal to 1
  @data = map { defined($_) ? ($_ >= $min_speed ? 1 : 0) : undef } @data;
# Trim good areas by calculating logical AND of each data point with its neighbours
  for(1..$trim_edges) {
    @data = (trim_func(undef, $data[0], $data[1]), (map { trim_func($data[$_-1], $data[$_], $data[$_+1]) } 1..$#data));
  }
  return @data;
}

my %pv_status;
my %sum;

for my $dev (keys %pv_speed) {
  $pv_status{$dev} = [];
  my @data = @{$pv_speed{$dev}};
  # Apply $min_speed threshold (0 = below = bad, 1 = above or equal = good), and trim
  @data = process_data(@data);
  # Change to LRE...
  my @rle = rle(@data);
  # ...and change areas smaller than $min_good_size to 0 (bad)
  @rle = rle(map { my ($v, $l) = @$_; defined($v) && $v == 1 && $l < $min_good_size ? map {0} 1..$l : map{$v} 1..$l } @rle);

  my $start = 0;
  for(@rle) {
    my ($v, $l) = @$_;
    $sum{('bad','good')[$v]} += $l if defined($v);
    my $end = $start + $l - 1;
    if(defined($v)) {
      for(my $pv_idx = $start ; $pv_idx <= $end; $pv_idx++) {
        $pv_status{$dev}->[$pv_idx] = $v;
      }
    }
    $start += $l;
  }
}

print "# $sum{good} $sum{bad}\n";
print "lvresize -f -l$sum{good} $lv_name\n";

my @shrink_areas;
my $to_shrink = $sum{'bad'};
while($to_shrink > 0) {
  my ($dev, $pv_start, $pv_end) = @{pop @lv_map};
  my $len = $pv_end - $pv_start + 1;
  if ($len <= $to_shrink) {
    push @shrink_areas, [$dev, $pv_start, $pv_end];
  } else {
    push @shrink_areas, [$dev, $pv_end - $to_shrink + 1, $pv_end];
    push @lv_map, [$dev, $pv_start, $pv_end - $to_shrink];
  }
  $to_shrink -= $len;
}

my @pv_bad;
for my $map_item (@lv_map) {
  my ($dev, $pv_start, $pv_end) = @$map_item;
  for(rle(@{$pv_status{$dev}}[$pv_start..$pv_end])) {
    my($v, $l) = @$_;
    die("status cannot be undef at $dev:$pv_start length $l\n") if !defined($v);
    push @pv_bad, [$dev, $pv_start, $pv_start + $l - 1] if $v == 0;
    $pv_start += $l;
  }
}

for my $map_item (@shrink_areas) {
  my ($dev, $pv_start, $pv_end) = @$map_item;
  my $idx = 0;
  for(rle(@{$pv_status{$dev}}[$pv_start..$pv_end])) {
    my($v, $l) = @$_;
    die("status cannot be undef at $dev:$pv_start length $l\n") if !defined($v);
    next if $v == 0; # bad blocks are just dropped
    # good blocks are used for bad blocks from other areas
    while($l > 0) {
      my ($src_end, $dst_end);
      my ($bad_dev, $bad_pv_start, $bad_pv_end) = @{shift @pv_bad};
      my $bad_len = $bad_pv_end - $bad_pv_start + 1;
      if ($bad_len > $l) {
        $src_end = $bad_pv_start + $l - 1;
        $dst_end = $pv_start + $l - 1;
        $l = 0;
        unshift @pv_bad, [$bad_dev, $src_end + 1, $bad_pv_end];
      } else {
        $src_end = $bad_pv_end;
        $dst_end = $pv_start + $bad_len - 1;
        $l -= $bad_len;
      }
      print "pvmove --alloc anywhere -n $lv_name $bad_dev:$bad_pv_start-$src_end $dev:$pv_start-$dst_end\n";
      $bad_pv_start = $src_end + 1;
      $pv_start = $dst_end + 1;
    }
  }
}
die("Still some bad blocks left!\n") if scalar @pv_bad != 0;