Как проверить наличие файлов с двумя разными расширениями в Perl

Question

У меня есть файл reflog с содержанием, как показано ниже. Будут элементы с одинаковым именем, но с разными расширениями. Я хочу проверить, что для каждого из элементов (file1, file2 & file3 здесь в качестве примера) он должен существовать в обоих расширениях (.abc и .def). Если оба расширения существуют, он выполнит некоторое регулярное выражение и распечатает. В противном случае он просто сообщит с именем файла вместе с расширением (то есть, если существует только файл file1.abc или file1.def, он будет распечатан).

reflog:

file1.abc


file2.abc

file2.def 

file3.abc
file3.def

file4.abc 

file5.abc 
file5.def
file6.def
file8abc.def
file7.abc

file1.def
file9abc.def
file10def.abc

Мой скрипт такой же, как и ниже (отредактированный из скрипта yb007), но у меня есть некоторые проблемы с выводом, которые я не знаю, как решить. Я заметил, что вывод будет неправильным, когда файл reflog имеет файл с именем * abc.def (например, file8abc.def & file9abc.def). Он урезает последние 4 суффикса и возвращает неправильный .ext (здесь это .abc, но я полагаю, это должен быть .def).

    #! /usr/bin/perl 
    use strict; 
    use warnings; 
    my @files_abc ;
    my @files_def ;
    my $line;
    open(FILE1, 'reflog') || die ("Could not open reflog") ;
    open (FILE2, '>log') || die ("Could not open log") ;
    while ($line = <FILE1>) {   
        if($line=~ /(.*).abc/) {       
            push(@files_abc,$1);   
        } elsif ($line=~ /(.*).def/) { 
            push(@files_def,$1);     } 
    } 
    close(FILE1);

    my %first = map { $_ => 1 } @files_def ;
    my @same = grep { $first{$_} } @files_abc ;
    my @abc_only = grep { !$first{$_} } @files_abc ;
    foreach my $abc (sort @abc_only) {
        $abc .= ".abc";
    }   

    my %second = map {$_=>1} @files_abc; 
    my @same2 = grep { $second{$_} } @files_def; #@same and same2 are equal.
    my @def_only = grep { !$second{$_} } @files_def;
    foreach my $def (sort @def_only) {
        $def .= ".def";
    }

    my @combine_all = sort (@same, @abc_only, @def_only);
    print "\nCombine all:-\n @combine_all\n" ;
    print "\nList of files with same extension\n @same";  
    print "\nList of files with abc only\n @abc_only"; 
    print "\nList of files with def only\n @def_only"; 
    foreach my $item (sort @combine_all) {
        print FILE2 "$item\n" ;
    }
    close (FILE2) ;

Мой вывод похож на это, что неправильно: - 1-й: - вывод на печать экрана, как показано ниже: Объедините все: - file.abc file.abc file1 file10def.abc file2 file3 file4.abc file5 file6.def file7.abc

List of files with same extension
 file1 file2 file3 file5
List of files with abc only
 file4.abc file.abc file7.abc file.abc file10def.abc
List of files with def only
 file6.def

Log output as below:
    **file.abc
    file.abc**
    file1
    file10def.abc
    file2
    file3
    file4.abc
    file5
    file6.def
    file7.abc

Можете ли вы помочь мне взглянуть, где Gies не так? Спасибо, куча.

Answer 1

ВСЕГДА добавляйте

use strict;
use warnings;

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

• Вы должны всегда проверять, удалось ли открыть файл с помощью open FILE, "reflog" or die $!;
• Вы используете переменную $ine, которая не существует. Вы имеете в виду $line
• Строки, которые вы читаете в массив, содержат завершающий символ новой строки. Напишите chomp @lines; чтобы удалить их
• Ваши регулярные выражения неверны, и вам нужно || вместо &&. Вместо этого напишите if ($line =~ /\.(iif|isp)$/)

Если у вас все еще есть проблемы, когда они устранены, пожалуйста, спросите еще раз.

Answer 2

Помимо уже указанных ошибок, вы, похоже, загружаете @lines из FUNC вместо FILE. Это тоже опечатка?

Кроме того, если reflog действительно содержит серию строк с одним именем файла в каждой строке, зачем вам ожидать условного "if ($ line = ~ /.abc/ && $ line = ~ / .def /) "чтобы оценить истину?

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

Answer 3

open( FILE, "reflog" );
open( FUNC, '>log' );
my %seen;
while ( chomp( my $line = <FILE> ) ) {
    $line =~ s/^\s*//;
    if ( $ine =~ /(\.+)\.(abc|def)$/ ) {
        $seen{$1}++;
    }
}

foreach my $file ( keys %seen ) {
    if ( $seen{$file} > 1 ) {
        ## do whatever you want to
    }
}
unlink "reflog";
chmod( 0750, "log" );
close(FUNC);
close(FILE);

Answer 4

use strict;
use warnings;

my @files_abc;
my @files_def;
my $line;

open(FILE,'reflog') || die ("could not open reflog");

while ($line = <FILE>) {
    if($line=~ /(.*)\.abc/) {
        push(@files_abc,$1);
    }
    elsif($line=~ /(.*)\.def/) {
        push(@files_def,$1);
    }
}

close(FILE);

my %second = map {$_=>1} @files_def;
my @same = grep { $second{$_} } @files_abc;

print "\nList of files with same extension\n @same";


foreach my $abc (@files_abc) {
           $abc .= ".abc";
         }
foreach my $def (@files_def) {
           $def .= ".def";
         }

print "\nList of files with abc extension\n @files_abc";
print "\nList of files with def extension\n @files_def";

Выход

List of files with same extension
file1 file2 file3 file5

List of files with abc extension
file1.abc file2.abc file3.abc file4.abc file5.abc file7.abc file10def.abc

List of files with def extension
file2.def file3.def file5.def file6.def file8abc.def file1.def file9abc.def

Надеюсь, это поможет ...

Answer 5

Вам не нужно хлебать весь файл;Вы можете читать по одной строке за раз.Я думаю, что этот код работает с этой расширенной версией вашего reflog файла:

xx.pl

#!/usr/bin/env perl

use strict;
use warnings;

open my $file, '<', "reflog" or die "Failed to open file reflog for reading ($!)";
open my $func, '>', 'log'    or die "Failed to create file log for writing ($!)";

my ($oldline, $oldname, $oldextn) = ("", "", "");
while (my $newline = <$file>)
{
    chomp $newline;
    $newline =~ s/^\s*//;
    my ($newname, $newextn) = ($newline =~ m/(.*)([.][^.]*)$/);
    if ($oldname eq $newname)
    {
        # Found the same file - presumably $oldextn eq ".abc" and $newextn eq ".def"
        print $func "$newname\n";
        print "$newname\n";
        $oldline = "";
        $oldname = "";
        $oldextn = "";
    }
    else
    {
        print $func "$oldline\n" if ($oldline);
        print "$oldline\n" if ($oldline);
        $oldline = $newline;
        $oldname = $newname;
        $oldextn = $newextn;
    }
}
print $func "$oldline\n" if ($oldline);
print "$oldline\n" if ($oldline);

#unlink "reflog" ;
chmod 0644, "log";
close $func;
close $file;

Поскольку код на самом деле не проверяет расширения, было бы целесообразно опустить$oldextn и $newextn;с другой стороны, вы, возможно, захотите проверить расширения, если вы достаточно обеспокоены форматом ввода, чтобы иметь дело с лидирующим пробелом.

Я очень редко нахожу это хорошим для сценария обработки, подобного этомуудалить свой собственный ввод, поэтому я оставил unlink "reflog"; закомментированным;Ваш пробег может варьироваться.Я также часто просто читал из стандартного ввода и записывал в стандартный вывод;это немного упростит код.Этот код записывает как в файл журнала, так и в стандартный вывод;очевидно, вы можете пропустить любой выходной поток.Мне было лень писать функцию для обработки записи, поэтому операторы print идут парами.

Это вариант отчетов об отключении управления.

reflog

file1.abc
file1.def
file2.abc
file2.def
file3.abc
file3.def
file4.abc
file5.abc
file5.def
file6.def
file7.abc

Вывод

$ perl xx.pl
file1
file2
file3
file4.abc
file5
file6.def
file7.abc
$ cat log
file1
file2
file3
file4.abc
file5
file6.def
file7.abc
$ 

---

Обработка несортированных имен файлов с пустыми строками

#!/usr/bin/env perl

use strict;
use warnings;

open my $file, '<', "reflog" or die "Failed to open file reflog for reading ($!)";
open my $func, '>', 'log'    or die "Failed to create file log for writing ($!)";

my @lines;

while (<$file>)
{
    chomp;
    next if m/^\s*$/;
    push @lines, $_;
}

@lines = sort @lines;

my ($oldline, $oldname, $oldextn) = ("", "", "");
foreach my $newline (@lines)
{
    chomp $newline;
    $newline =~ s/^\s*//;
    my ($newname, $newextn) = ($newline =~ m/(.*)([.][^.]*)$/);
    if ($oldname eq $newname)
    {
        # Found the same file - presumably $oldextn eq ".abc" and $newextn eq ".def"
        print $func "$newname\n";
        print "$newname\n";
        $oldline = "";
        $oldname = "";
        $oldextn = "";
    }
    else
    {
        print $func "$oldline\n" if ($oldline);
        print "$oldline\n" if ($oldline);
        $oldline = $newline;
        $oldname = $newname;
        $oldextn = $newextn;
    }
}
print $func "$oldline\n" if ($oldline);
print "$oldline\n" if ($oldline);

#unlink "reflog" ;
chmod 0644, "log";
close $func;
close $file;

Это очень похоже на исходный код, который я разместил.Новые строки:

my @lines;

while (<$file>)
{
    chomp;
    next if m/^\s*$/;
    push @lines, $_;
}

@lines = sort @lines;

my ($oldline, $oldname, $oldextn) = ("", "", "");    # Old
foreach my $newline (@lines)

Это читает файл 'reflog', пропуская пустые строки, сохраняя остальное в массиве @lines.Когда все строки прочитаны, они отсортированы.Затем вместо чтения цикла из файла новый код считывает записи из отсортированного массива строк.Остальная часть обработки такая же, как и раньше.Для описанного вами входного файла вывод будет:

file1
file2
file3

Ург: chomp $newline; не требуется, хотя в противном случае он не является вредным.Старомодный chop (предшественник chomp) был бы опасен.Оценка один для современного Perl.