Perl - удаление ненужных элементов из массива

Question

Я пишу скрипт, который анализирует команду "pure-ftpwho -s", чтобы получить список текущих передач.Но когда пользователь отключается от FTP и снова подключается и возобновляет передачу, файл появляется дважды.Я хочу удалить призрака с помощью Perl.После синтаксического анализа вот как выглядит arrayref (сбрасывается с помощью Data :: Dumper)

$VAR1 = [
      {
        'status' => 'DL',
        'percent' => '20',
        'speed' => '10',
        'file' => 'somefile.txt',
        'user' => 'user1',
        'size' => '14648'
      },
      {
        'status' => 'DL',
        'percent' => '63',
        'speed' => '11',
        'file' => 'somefile.txt',
        'user' => 'user1',
        'size' => '14648'
      },
      {
        'status' => 'DL',
        'percent' => '16',
        'speed' => '60',
        'file' => 'somefile.txt',
        'user' => 'user2',
        'size' => '14648'
      }
    ];

Здесь user1 и user2 загружают один и тот же файл, но user1 появляется дважды, потому что первый - «призрак»,Какой лучший способ проверить и удалить ненужные мне элементы (в данном случае первый элемент arrayref).Необходимо проверить следующее: если ключ «файл» и ключ «пользователь» совпадают, удалите хеш-код, содержащий меньшее значение ключа «процент» (если они одинаковы, то удалите все, кроме одного).

Answer 1

В этом случае правильным решением было бы использование хеша при разборе файла журнала. Поместите всю информацию в хеш, скажем %log, с ключами user и file:

$log{$user}->{$file} = {
    'status' => 'DL',
    'percent' => '20',
    'speed' => '10',
    'size' => '14648'
};

и т.д.. Последние записи в файле журнала будут перезаписывать более ранние. В качестве альтернативы, вы можете перезаписать записи с меньшим процентом заполненных записей с более высокими показателями завершения.

Использование хеша избавило бы от большого количества лишнего кода, работающего вокруг выбора неправильной структуры данных.

Answer 2

Если порядок в исходном массиве не имеет значения, это должно сработать:

my %users;
my @result;

for my $data (@$arrayref) {
    push @{ $users{$data->{user}.$data->{file}} }, $data;
}

for my $value (values %users) {
    my @data = sort { $a->{percent} <=> $b->{percent} } @$value;
    push @result, $data[-1];
}

Это определенно можно улучшить для повышения эффективности.

Answer 3

Для чего это стоит, вот мой (немного) альтернативный подход.Опять же, он не сохраняет первоначальный порядок:

my %most_progress;

for my $data ( sort { $b->{percent} <=> $a->{percent} } @$data ) {
    next if exists $most_progress{$data->{user}.$data->{file}};
    $most_progress{$data->{user}.$data->{file}} = $data;
}

my @clean_data = values %most_progress;

Answer 4

Это сохранит порядок:

use strict;
use warnings;

my $data = [ ... ]; # As posted.

my %pct;
for my $i ( 0 .. $#{$data} ){
    my $r = $data->[$i];
    my $k = join '|', $r->{file}, $r->{user};
    next if exists $pct{$k} and $pct{$k}[1] >= $r->{percent};
    $pct{$k} = [$i, $r->{percent}];
}

@$data = @$data[sort map $_->[0], values %pct];

Answer 5

Вариация на тему с Perl6::Gather

use Perl6::Gather;

my @cleaned = gather {
    my %seen;
    for (sort { $b->{percent} <=> $a->{percent} } @$data) {
        take unless $seen{ $_->{user} . $_->{file} }++;
    }
};

Answer 6

my %check; 

for (my $i = 0; $i <= $#{$arrayref}; $i++) { 
  my $transfer = $arrayref->[$i]; 

  # check the transfer for user and file 
  my $key = $transfer->{user} . $transfer->{file};  
  $check{$key} = { } if ( !exists $check{$key} ); 

  if ( $transfer->{percent} <= $check{$key}->{percent} ) { 
    # undefine this less advanced transfer 
    $arrayref->[$i] = undef; 

  } else { 
    # remove the other transfer 
    $arrayref->[$check{$key}->{index}] = undef if exists $check{$key}->{index}; 

    # set the new standard 
    $check{$key} = { index => $i, percent => $transfer->{percent} } 
  } 
}  

# remove all undefined transfers     
$arrayref = [ grep { defined $_ } @$arrayref ];