Perl 列中的模式匹配

文件1

文件2

输出

我试过了

但是没有起作用

基本上，我想从文件1中获取详细信息，并与文件2主列表进行比较

例如：

文件2中的A1在文件1中不可用，因此在输出文件中，前三个字段为“-”，其余字段为文件2。现在，我们有了A11，并且在文件1中获得了详细信息。因此，我们从文件1和文件2编写A11的详细信息，通常的Perl方法是：使用哈希来记住主列表：

#!/usr/bin/perl
use warnings;
use strict;

my %hash;

open my $MASTER, '<', 'File1' or die $!;
while (<$MASTER>) {
    chomp;
    my @columns = split /;/;
    $hash{$columns[0]} = [@columns[1 .. $#columns]];
}
close $MASTER;

open my $DETAIL, '<', 'File2' or die $!;
while (<$DETAIL>) {
    my @columns = split /;/;
    if (exists $hash{$columns[1]}) {
        print join ';', $columns[1], @{ $hash{$columns[1]} }, q();
    } else {
        print '-;-;-;';
    }
    print;
}
close $DETAIL;

通常的Perl方法：使用散列来记住主列表：

#!/usr/bin/perl
use warnings;
use strict;

my %hash;

open my $MASTER, '<', 'File1' or die $!;
while (<$MASTER>) {
    chomp;
    my @columns = split /;/;
    $hash{$columns[0]} = [@columns[1 .. $#columns]];
}
close $MASTER;

open my $DETAIL, '<', 'File2' or die $!;
while (<$DETAIL>) {
    my @columns = split /;/;
    if (exists $hash{$columns[1]}) {
        print join ';', $columns[1], @{ $hash{$columns[1]} }, q();
    } else {
        print '-;-;-;';
    }
    print;
}
close $DETAIL;

使用Perl：

use warnings;
use strict;
my %file1;
open (my $f1, "<", "file1") or die();
while (<$f1>) {
  chomp;
  my @v = (split(/;/))[0];
  $file1{$v[0]} = $_; 
}
close ($f1);
open (my $f2, "<", "file2") or die();
while (<$f2>) {
  chomp;
  my $v = (split(/;/))[1];
  if (defined $file1{$v}) {
    print "$file1{$v};$_\n";
  } else {
    print "-;-;-;$_\n";
  }
}
close ($f2);

使用Perl：

use warnings;
use strict;
my %file1;
open (my $f1, "<", "file1") or die();
while (<$f1>) {
  chomp;
  my @v = (split(/;/))[0];
  $file1{$v[0]} = $_; 
}
close ($f1);
open (my $f2, "<", "file2") or die();
while (<$f2>) {
  chomp;
  my $v = (split(/;/))[1];
  if (defined $file1{$v}) {
    print "$file1{$v};$_\n";
  } else {
    print "-;-;-;$_\n";
  }
}
close ($f2);

---

我个人会用Perl来做这件事，但由于每个人和他们的母亲都在给你一个Perl解决方案，这里有一个替代方案：

如果每个文件中的记录具有一致数量的字段，并且每个文件中的记录按联接字段按字典顺序排序，则可以使用联接：

选项说明：

-1和-2表示联接字段A11、A23等是文件1中的第一个字段，也是文件2中的第二个字段。 -t'；'表示字段之间用； -e-表示空字段应替换为- -o“1.1 1.2 1.3 2.1 2.2.3 2.4 2.5 2.6 2.7”意味着您希望每个输出行由File1中的前三个字段组成，然后是File2中的前七个字段。这就是为什么这种方法要求每个文件中的记录具有一致的字段数。 -2意味着您希望在输出中包含File2中的每一行，即使File1中没有对应的行。否则，它将只输出两个文件中都匹配的行。

---

我个人会用Perl来做这件事，但由于每个人和他们的母亲都在给你一个Perl解决方案，这里有一个替代方案：

如果每个文件中的记录具有一致数量的字段，并且每个文件中的记录按联接字段按字典顺序排序，则可以使用联接：

选项说明：

-1和-2表示联接字段A11、A23等是文件1中的第一个字段，也是文件2中的第二个字段。 -t'；'表示字段之间用； -e-表示空字段应替换为- -o“1.1 1.2 1.3 2.1 2.2.3 2.4 2.5 2.6 2.7”意味着您希望每个输出行由File1中的前三个字段组成，然后是File2中的前七个字段。这就是为什么这种方法要求每个文件中的记录具有一致的字段数。 -2意味着您希望在输出中包含File2中的每一行，即使File1中没有对应的行。否则，它将只输出两个文件中都匹配的行。

---

这在一行程序中无法方便地完成，因为它需要读取两个输入文件，但是问题并不难

该程序读取file1中的所有行，并使用第一个字段作为键将该行存储在散列中

然后读取file2中的所有行，并将第二个字段用作访问散列的键。使用//defined or运算符打印元素的值（如果存在），或者打印默认字符串（如果不存在）

最后打印文件2中的当前行

use strict;
use warnings;

my %data;

open my $fh, '<', 'file1' or die $!;
while (<$fh>) {
  chomp;
  my $key = (split /;/)[0];
  $data{$key} = $_;
}

open $fh, '<', 'file2' or die $!;
while (<$fh>) {
  my $key = (split /;/)[1];
  print $data{$key} // '-;-;-;', $_;
}

---

这在一行程序中无法方便地完成，因为它需要读取两个输入文件，但是问题并不难

该程序读取file1中的所有行，并使用第一个字段作为键将该行存储在散列中

然后读取file2中的所有行，并将第二个字段用作访问散列的键。使用//defined or运算符打印元素的值（如果存在），或者打印默认字符串（如果不存在）

最后打印文件2中的当前行

use strict;
use warnings;

my %data;

open my $fh, '<', 'file1' or die $!;
while (<$fh>) {
  chomp;
  my $key = (split /;/)[0];
  $data{$key} = $_;
}

open $fh, '<', 'file2' or die $!;
while (<$fh>) {
  my $key = (split /;/)[1];
  print $data{$key} // '-;-;-;', $_;
}

---

perl解决方案可能包含非常好的模块。如果是这样，您可以将值提取到散列中，然后使用该散列进行查找。查找值时，您可以在查找散列中为任何未定义的值插入空值-；-；-

use strict;
use warnings;
use Text::CSV;

my $lookup = "file1.csv";   # whatever file is used to look up fields 0-2
my $master = "file2.csv";   # the file controlling the printing

my $csv = Text::CSV->new({
        sep_char    => ";", 
        eol         => $/,  # to add newline to $csv->print()
        quote_space => 0,   # to avoid adding quotes 
    });

my %lookup;

open my $fh, "<", $lookup or die $!;

while (my $row = $csv->getline($fh)) {
    $lookup{$row->[0]} = $row;    # add entire row to specific key
}
open $fh, "<", $master or die $!; # new $fh needs no close

while (my $row = $csv->getline($fh)) {
    my $extra = $lookup{$row->[1]} // [ qw(- - -) ]; # blank row if undef
    unshift @$row, @$extra;       # add the new values
    $csv->print(*STDOUT, $row);   # then print them
}

---

perl解决方案可能包含非常好的模块。如果是这样，您可以将值提取到散列中，然后使用该散列进行查找。查找值时，您可以在查找散列中为任何未定义的值插入空值-；-；-

use strict;
use warnings;
use Text::CSV;

my $lookup = "file1.csv";   # whatever file is used to look up fields 0-2
my $master = "file2.csv";   # the file controlling the printing

my $csv = Text::CSV->new({
        sep_char    => ";", 
        eol         => $/,  # to add newline to $csv->print()
        quote_space => 0,   # to avoid adding quotes 
    });

my %lookup;

open my $fh, "<", $lookup or die $!;

while (my $row = $csv->getline($fh)) {
    $lookup{$row->[0]} = $row;    # add entire row to specific key
}
open $fh, "<", $master or die $!; # new $fh needs no close

while (my $row = $csv->getline($fh)) {
    my $extra = $lookup{$row->[1]} // [ qw(- - -) ]; # blank row if undef
    unshift @$row, @$extra;       # add the new values
    $csv->print(*STDOUT, $row);   # then print them
}

@TLP：我同意。我从来没有这么做过！Fixed@TLP：我同意。我从来没做过那该死的事！修好了

-;-;-;P01;A1;0;0--00  ;123;456;150
A11;F1;BMWP01;A11;0;0--00  ;123;444;208
B12;F3;BMWP01;B12;0;0--00  ;123;111;36
-;-;-;P01;V11;0;0--00  ;123;787;33.9

use strict;
use warnings;
use Text::CSV;

my $lookup = "file1.csv";   # whatever file is used to look up fields 0-2
my $master = "file2.csv";   # the file controlling the printing

my $csv = Text::CSV->new({
        sep_char    => ";", 
        eol         => $/,  # to add newline to $csv->print()
        quote_space => 0,   # to avoid adding quotes 
    });

my %lookup;

open my $fh, "<", $lookup or die $!;

while (my $row = $csv->getline($fh)) {
    $lookup{$row->[0]} = $row;    # add entire row to specific key
}
open $fh, "<", $master or die $!; # new $fh needs no close

while (my $row = $csv->getline($fh)) {
    my $extra = $lookup{$row->[1]} // [ qw(- - -) ]; # blank row if undef
    unshift @$row, @$extra;       # add the new values
    $csv->print(*STDOUT, $row);   # then print them
}

-;-;-;P01;A1;0;0--00  ;123;456;150
A11;F1;BMW;P01;A11;0;0--00  ;123;444;208
B12;F3;BMW;P01;B12;0;0--00  ;123;111;36
-;-;-;P01;V11;0;0--00  ;123;787;33.9