perl Пропуск значений в массиве

Question

У меня есть текстовый файл

II : RE: released for CR CHG1001739981 : Urgent for NYK SOD - INC1012082403
CN: RE: futures  - INC1012083269
AP: RE: REQ25116618-1: setups - INC1012084465
DS: RE: access - INC1012084976
LC: RE: options Grid - INC1012085569
II: RE: issues - INC1012085587
VK: RE: FW data - INC1012085827
NW: RE: spread  - INC1012086027
AP: RE: Exception Notification - INC1012087025
VK: RE: Yellow - INC1012087066
DS: RE: Exception Notification - INC1012087664</none>
LC: RE:  - INC1012087915
CN: RE: [Restricted - Internal] - INC1012088249
WJ: FW: issue - INC1012088961
can i get an inc for this pls
you sure can
CN: User Feedback - INC1012089212
thank you
np
CN: benchmark - INC1012089691
DS: NAN Value - INC1012089989
TM:downstream - INC1012090321
re-assigning to myself
II: setup - INC1012090460
LC: size - INC1012090813
BJ - help with filter
**handover mail**
:)

Так распределяются билеты в этой группе. Большая часть команды приезжает сюда в 7 утра, БиДжей приходит сюда в 10:30 и Передача в США в 11:00. Поскольку Би Джей просто входит, его часто переводят на вершину очереди - он получает первый билет. Что мне нужно сделать, так это выяснить, каков порядок для остальной части смены. Обычно вручную я убираю людей из Англии, которые выходят с работы в 11 часов по пасхальному времени.
Затем я снимаю тест с напоминающих людей из США и помещаю их в горизонтальный порядок.

II AP DS LC II AP DS LC WJ DS AP II LC BJ

затем поменять их

 BJ LC II AP DS WJ LC DS AP II LC DS AP II

затем пропустив BJ, перейдите к [1] ​​в списке в данном случае LC, и вернитесь туда, где мы снова получим «LC».

 BJ LC II AP DS WJ 

почитайте его снова - и вуаля вы даете распоряжение о назначении на день.

WJ DS AP II LC BJ

Прямо сейчас у меня проблемы с остановкой печати в первом экземпляре "LC"

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper ;
my @team = ("AP","II","DS","WJ", "JK","LC","BJ") ;
my @orderdTeam ;
my $begin ;
my $rev ;
my @rev_orderdTeam  ;
my $filename = shift @ARGV ;
open(my $fh, '<', $filename) or die "Could not open file $filename $!";
while (my $line = <$fh> ) {
    foreach my $op (@team) {
        if ($line =~ /$op/) {
        push (@orderdTeam, $op) ;
        }
    }

    }


print "order ---------> " . "@orderdTeam" . "\n"       ;
@rev_orderdTeam = reverse(@orderdTeam)              ;
print "reverse order -> " . "@rev_orderdTeam" . "\n"   ;

print "The last person to get assigned is $begin\n" ;

foreach $rev (@rev_orderdTeam[1 .. $#rev_orderdTeam]) {
    if ("$rev_orderdTeam[0]" eq "BJ") {
           $begin = $rev_orderdTeam[1]
    }
    else {
          $begin = "$rev_orderdTeam[0]" ;
    }

    if ($rev ne "$begin") {
            print "$rev " ;

    }
}

Answer 1

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

II AP DS LC II AP DS LC WJ DS II LC BJ

, а не

II AP DS LC II AP DS LC WJ DS AP II LC BJ

, как вы заявили.

---

Для достижения вашей цели я рекомендую использовать другой подход, чем тот, который вы описываете.Мне кажется, что ваше настоящее намерение - удалить дубликаты, и вот что делает следующее решение:

#!/usr/bin/perl
use strict;
use warnings;
use feature qw( say );

use List::Util qw( uniq );

my @team = qw( AP II DS WJ JK LC BJ );
my %team = map { $_ => 1 } @team;

my @order;
while (<>) {
   my ($op) = /^(\w+)/
      or next;

   $team{$op}
      or next;

   push @order, $op;
}

my @filtered = reverse uniq reverse @order;
say "@filtered";

Вывод:

AP WJ DS II LC BJ

---

Чтобы сделать то, что вы на самом деле просилипросто прогуляйтесь по массиву, пока не найдете копию второго последнего элемента, затем извлеките все последующие элементы.

Для этого замените

my @filtered = reverse uniq reverse @order;

на

my $i = @order - 3;
--$i while $i >= 0 && $order[$i] ne $order[-2];
my @filtered = @order[$i+1 .. $#order];

Вывод:

WJ DS II LC BJ

Как видите, вывод отличается.AP нет в списке, потому что они не отображаются между двумя экземплярами LC.Так что это не просто гораздо более сложный подход;это также намного более хрупкое.

Answer 2

Вот один из подходов, использующий флаг для определения того, когда извлекать элементы из массива команды заказа:

use strict;
use warnings;

my @team = ("AP","II","DS","WJ", "JK","LC","BJ") ;
my ( $team_regex ) = map {qr /$_/} join "|", map {quotemeta} @team;

my @orderdTeam ;
my $filename = shift @ARGV ;
open(my $fh, '<', $filename) or die "Could not open file $filename $!";
while (my $line = <$fh> ) {
    if ( $line =~ /^($team_regex)/ ) {
        push @orderdTeam, $1;
    }
}
close $fh;

print "Ordered: @orderdTeam\n";
my $extract_flag = 0;
my @result;
my $end_name;
for my $name (reverse @orderdTeam) {
    if ($name eq "BJ") {
        $extract_flag = 1;
    }
    next if $extract_flag == 0; # skip items until we get "BJ"
    if ( $extract_flag == 2 ) {
        $end_name = $name; # save stop name
    }
    last if $extract_flag == 3 && ($name eq $end_name); # second occurrence of $end_name
    push @result, $name;
    $extract_flag = 3 if $extract_flag == 2;
    $extract_flag = 2 if $extract_flag == 1;
}

print "Result: ", (join " ", reverse @result), "\n";

Вывод :

Ordered: II AP DS LC II AP DS LC WJ DS II LC BJ
Result: WJ DS II LC BJ