perl匹配两个文件中字符串的一部分
我正在使用perl脚本查找两个以制表符分隔的文件中的列之间的匹配。但是对于一列，我只想查找两列中两个字符串之间的部分匹配 它涉及$表2的$行[4]和$表1的$行{d}。 $table2的$row[4]中的值如下所示： “xxxx”。 $table1的$row{d}中的值如下所示： “xxxx.aaa” 如果“.”前面的部分相同，则存在匹配项。如果没有，就没有对手。我不知道如何在我的脚本中实现这一点。这就是我目前所拥有的。我只查找不同列之间的完全匹配。“…”表示对此问题不重要的代码perl匹配两个文件中字符串的一部分,perl,Perl,我正在使用perl脚本查找两个以制表符分隔的文件中的列之间的匹配。但是对于一列，我只想查找两列中两个字符串之间的部分匹配 它涉及$表2的$行[4]和$表1的$行{d}。 $table2的$row[4]中的值如下所示： “xxxx”。 $table1的$row{d}中的值如下所示： “xxxx.aaa” 如果“.”前面的部分相同，则存在匹配项。如果没有，就没有对手。我不知道如何在我的脚本中实现这一点。这就是我目前所拥有的。我只查找不同列之间的完全匹配。“…”表示对此问题不重要的代码 #! /usr
#! /usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
local $Data::Dumper::Useqq = 1;
use Getopt::Long qw(GetOptions);
...
...
chomp( my @header_table2 = split /\t/, <$table2> );
my %lookup;
while(<$table2>){
chomp;
my @row = split(/\t/);
$lookup{ $row[0] }{ $row[1] }{ $row[4] }{ $row[5] }{ $row[6] }{ $row[7] }{ $row[8] } = [ $row[9], $row[10] ];
}
my @header = do {
my $header = <$table1>;
$header =~ s/\t?\n\z//;
split /\t/, $header;
};
print $table3 join ("\t", @header, qw/ name1 name2 /), "\n";
{
no warnings 'uninitialized';
while(<$table1>){
s/\t?\n\z//;
my %row;
@row{@header} = split /\t/;
print $table3 join ( "\t", @row{@header},
@{ $lookup{ $row{a} }{ $row{b} }{ $row{c} }{ $row{d} }{ $row{e} }{ $row{f} }{ $row{g} }
// [ "", "" ] }), "\n";
}
}
#/usr/bin/perl
严格使用；
使用警告；
使用数据：：转储程序；
本地$Data:：Dumper:：Useqq=1；
使用Getopt:：longqw（GetOptions）；
...
...
chomp（my@header_table2=split/\t/，）；
我的%lookup；
while（）{
咀嚼；
我的@row=split（/\t/）；
$lookup{$row[0]}{$row[1]}{$row[4]}{$row[5]}{$row[6]}{$row[7]}{$row[8]}=[$row[9]，$row[10]；
}
我的@header=do{
我的$header=；
$header=~s/\t？\n\z/；
拆分/\t/，$header；
};
打印$table3 join（“\t”，@header，qw/name1 name2/），“\n”；
{
没有“未初始化”的警告；
while（）{
s/\t？\n\z/；
我的%行；
@行{@header}=split/\t/；
打印$table3 join（“\t”，@row{@header}，
@{$lookup{$row{a}}{$row{b}{$row{c}{$row{d}{$row{e}}{$row{f}{$row{g}}
//[“”，“”]}），“\n”；
}
}
@row%row$foo$bar$foo$barif ($foo =~ /^$bar\./) {
# match
} else {
# no match
}
这看起来像是数据库的工作 下面的解决方案行不通，因为您正在使用九个级别的键（
$row[0]$row[8]%lookup$row{a}$row{g}jointable2table1表1@row@key$keydieuse strict;
use warnings 'all';
use Data::Dumper;
local $Data::Dumper::Useqq = 1;
use Getopt::Long qw(GetOptions);
use constant TABLE1_COLUMNS => 9;
use constant TABLE2_COLUMNS => 11;
open my $table2, '<', 'table2.txt' or die $!;
my @header_table2 = do {
my $header = <$table2>;
$header =~ s/\t?\n\z//;
split /\t/, $header;
};
die "Incorrect table 2 header count " . scalar @header_table2
unless @header_table2 == TABLE2_COLUMNS;
my %lookup;
while ( <$table2> ) {
chomp;
my @row = split /\t/;
die "Incorrect table 2 column count " . scalar @row
unless @row == TABLE2_COLUMNS;
my $key = do {
local $" = "\n";
"@row[0..8]";
};
$lookup{ $key } = [ @row[9,10] ];
}
open my $table1, '<', 'table1.txt' or die $!;
my @header = do {
my $header = <$table1>;
$header =~ s/\t?\n\z//;
split /\t/, $header;
};
die "Incorrect table 1 header count " . scalar @header
unless @header == TABLE1_COLUMNS;
open my $table3, '>', 'table3.txt' or die $!;
print $table3 join ("\t", @header, qw/ name1 name2 /), "\n";
while ( <$table1> ) {
s/\t?\n\z//;
my @row = split /\t/;
die "Incorrect table 1 column count " . scalar @row
unless @row == TABLE1_COLUMNS;
my $key = do {
my @key = @row;
$key[3] =~ s/\.[^.]*\z//;
local $" = "\n";
"@key";
};
my $lookup = $lookup{ $key } // [ "", "" ];
print $table3 join("\t", @row, @$lookup), "\n";
}
使用严格；
使用“全部”警告；
使用数据：：转储程序；
本地$Data:：Dumper:：Useqq=1；
使用Getopt:：longqw（GetOptions）；
使用常量表1_列=>9；
使用常数表2_列=>11；
打开我的$table2、'table3.txt'或die$！；
打印$table3 join（“\t”，@header，qw/name1 name2/），“\n”；
而（）{
s/\t？\n\z/；
my@row=split/\t/；
die“表1列计数不正确”。标量@行
除非@row==TABLE1\u列；
我的$key=do{
我的@key=@行；
$key[3]=~s/\.[^.]*\z/；
本地$“=”\n”；
“@key”；
};
我的$lookup=$lookup{$key}/[“”，“”]；
打印$table3 join（“\t”，@row，@$lookup），“\n”；
}