英文:
How to print the in same line?
问题
#use Data::Dumper;
my $file3 = 'file1.csv';
my $file2 = 'file2.csv';
my $file1 = 'file3.csv';
open (my $fh_dest, ">", "outputfile.csv") or die "无法打开 outputfile.csv: $!";
my %HoA1;
my %HoA2;
my %HoA3;
open (MODIFIED_FILE2, $file1) or die ("无法打开 $file1!");
while(<MODIFIED_FILE2>){
chomp;
my ($k, $v1,$v2,$v3,$v4) = split /,/,$_,5;
push @{$HoA1{'MODIFIED_FILE2'}{$k}},$v1,$v2,$v3,$v4;
}
close(MODIFIED_FILE2);
open (MODIFIED_FILE1, $file2) or die ("无法打开 $file2!");
while(<MODIFIED_FILE1>){
chomp;
my ($k, $v1,$v2,$v3) = split /,/,$_,4;
push @{$HoA2{'MODIFIED_FILE1'}{$k}},$v1,$v2,$v3;
}
close(MODIFIED_FILE1);
open (BASE_FILE, $file3) or die ("无法打开 $file3!");
while(<BASE_FILE>){
chomp;
my ($k, $v1,$v2,$v3) = split /,/,$_,4;
push @{$HoA3{'BASE_FILE'}{$k}},$v1,$v2,$v3;
}
close(BASE_FILE);
#print $fh_dest Dumper \%HoA;
foreach my $MODIFIED_FILE2 (keys %{ $HoA1{'MODIFIED_FILE2'} }) {
if (exists $HoA3{'BASE_FILE'}{$MODIFIED_FILE2}) {
print $fh_dest "-" x 60, "\n";
print $fh_dest "$MODIFIED_FILE2\nMODIFIED_FILE2\t MODIFIED_FILE1 BASE_FILE\n";
print $fh_dest "-" x 60, "\n";
foreach my $class_BASE_FILE ( @{$HoA3{'BASE_FILE'}{$MODIFIED_FILE2}} ) {
printf $fh_dest "%-20s%-20s%s\n",$class_MODIFIED_FILE2,$class_MODIFIED_FILE1,$class_BASE_FILE;
}
foreach my $class_MODIFIED_FILE1 ( @{$HoA2{'MODIFIED_FILE1'}{$MODIFIED_FILE2}} ) {
printf $fh_dest "%-20s%s\n",$class_MODIFIED_FILE2,$class_MODIFIED_FILE1;
}
foreach my $class_MODIFIED_FILE2 ( @{$HoA1{'MODIFIED_FILE2'}{$MODIFIED_FILE2}} ) {
printf $fh_dest "%s\n",$class_MODIFIED_FILE2;
}
print $fh_dest "\n";
}
elsif (exists $HoA2{'MODIFIED_FILE1'}{$MODIFIED_FILE2}) {
print $fh_dest "-" x 60, "\n";
print $fh_dest "$MODIFIED_FILE2\nMODIFIED_FILE2\t MODIFIED_FILE1 BASE_FILE\n";
print $fh_dest "-" x 60, "\n";
foreach my $class_MODIFIED_FILE1 ( @{$HoA2{'MODIFIED_FILE1'}{$MODIFIED_FILE2}} ) {
printf $fh_dest "%-20s%s\n",$class_MODIFIED_FILE2,$class_MODIFIED_FILE1;
}
foreach my $class_MODIFIED_FILE2 ( @{$HoA1{'MODIFIED_FILE2'}{$MODIFIED_FILE2}} ) {
printf $fh_dest "%s\n",$class_MODIFIED_FILE2;
}
print $fh_dest "\n";
}
else {
print $fh_dest "-" x 60, "\n";
print $fh_dest "$MODIFIED_FILE2\nMODIFIED_FILE2\t MODIFIED_FILE1 BASE_FILE\n";
print $fh_dest "-" x 60, "\n";
foreach my $class_MODIFIED_FILE2 ( @{$HoA1{'MODIFIED_FILE2'}{$MODIFIED_FILE2}} ) {
printf $fh_dest "%s\n",$class_MODIFIED_FILE2;
}
print $fh_dest "\n";
}
}
close ($fh_dest);
英文:
I having problem in printing the hash element in same line.
t#!/usr/bin/perl
#use Data::Dumper;
my $file3 = 'file1.csv';
my $file2 = 'file2.csv';
my $file1 = 'file3.csv';
open (my $fh_dest, ">", "outputfile.csv") or die "Can't open > outputfile.csv: $!";
my %HoA1;
my %HoA2;
my %HoA3;
open (MODIFIED_FILE2, $file1) or die ("Could not open $file1!");
while(<MODIFIED_FILE2>){
chomp;
my ($k, $v1,$v2,$v3,$v4) = split /,/,$_,5;
push @{$HoA1{'MODIFIED_FILE2'}{$k}},$v1,$v2,$v3,$v4;
}
close(MODIFIED_FILE2);
open (MODIFIED_FILE1, $file2) or die ("Could not open $file2!");
while(<MODIFIED_FILE1>){
chomp;
my ($k, $v1,$v2,$v3) = split /,/,$_,4;
push @{$HoA2{'MODIFIED_FILE1'}{$k}},$v1,$v2,$v3;
}
close(MODIFIED_FILE1);
open (BASE_FILE, $file3) or die ("Could not open $file3!");
while(<BASE_FILE>){
chomp;
my ($k, $v1,$v2,$v3) = split /,/,$_,4;
push @{$HoA3{'BASE_FILE'}{$k}},$v1,$v2,$v3;
}
close(BASE_FILE);
#print $fh_dest Dumper \%HoA;
foreach my $MODIFIED_FILE2 (keys %{ $HoA1{'MODIFIED_FILE2'} }) {
if (exists $HoA3{'BASE_FILE'}{$MODIFIED_FILE2}) {
print $fh_dest "-" x 60, "\n";
print $fh_dest "$MODIFIED_FILE2\nMODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE\n";
print $fh_dest "-" x 60, "\n";
foreach my $class_BASE_FILE ( @{$HoA3{'BASE_FILE'}{$MODIFIED_FILE2}} ) {
printf $fh_dest "%-20s%-20s%s\n",$class_MODIFIED_FILE2,$class_MODIFIED_FILE1,$class_BASE_FILE;
}
foreach my $class_MODIFIED_FILE1 ( @{$HoA2{'MODIFIED_FILE1'}{$MODIFIED_FILE2}} ) {
printf $fh_dest "%-20s%s\n",$class_MODIFIED_FILE2,$class_MODIFIED_FILE1;
}
foreach my $class_MODIFIED_FILE2 ( @{$HoA1{'MODIFIED_FILE2'}{$MODIFIED_FILE2}} ) {
printf $fh_dest "%s\n",$class_MODIFIED_FILE2;
}
print $fh_dest "\n";
}
elsif (exists $HoA2{'MODIFIED_FILE1'}{$MODIFIED_FILE2}) {
print $fh_dest "-" x 60, "\n";
print $fh_dest "$MODIFIED_FILE2\nMODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE\n";
print $fh_dest "-" x 60, "\n";
foreach my $class_MODIFIED_FILE1 ( @{$HoA2{'MODIFIED_FILE1'}{$MODIFIED_FILE2}} ) {
printf $fh_dest "%-20s%s\n",$class_MODIFIED_FILE2,$class_MODIFIED_FILE1;
}
foreach my $class_MODIFIED_FILE2 ( @{$HoA1{'MODIFIED_FILE2'}{$MODIFIED_FILE2}} ) {
printf $fh_dest "%s\n",$class_MODIFIED_FILE2;
}
print $fh_dest "\n";
}
else {
print $fh_dest "-" x 60, "\n";
print $fh_dest "$MODIFIED_FILE2\nMODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE\n";
print $fh_dest "-" x 60, "\n";
foreach my $class_MODIFIED_FILE2 ( @{$HoA1{'MODIFIED_FILE2'}{$MODIFIED_FILE2}} ) {
printf $fh_dest "%s\n",$class_MODIFIED_FILE2;
}
print $fh_dest "\n";
}
}
close ($fh_dest);
The output I get :
------------------------------------------------------------
Dora
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
34
Malaysian
Malay
34
Malaysian
Arab
B-
------------------------------------------------------------
Boszor
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
91
Mexico
Chinese
91
Mexico
Chinese
91
Mexico
Chinese
AB+
------------------------------------------------------------
Szundi
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
23
German
Indian
23
German
Indian
23
German
Indian
AB-
the expected output:
-----------------------------------------------------------
Dora
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
34 34
Malaysian Malaysian
Malay Arab
B-
------------------------------------------------------------
Boszor
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
91 91 91
Mexico Mexico Mexico
Chinese Chinese Chinese
AB+
------------------------------------------------------------
Szundi
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
23 23 23
German German German
Indian Indian Indian
AB-
答案1
得分: 2
这是您提供的Perl代码的翻译部分：
有一个Perl的相对古老的特性完全符合您的要求 --- "format"。
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
my $name = '';
my $v = undef;
format STDOUT =
-----------------------------------------------------------
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$name
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
-----------------------------------------------------------
#==================#===================#===================#
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][0]//'', $v->[1][0]//'', $v->[2][0]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][1]//'', $v->[1][1]//'', $v->[2][1]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][2]//'', $v->[1][2]//'', $v->[2][3]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][3]//'', $v->[1][3]//'', $v->[2][3]//''
.
{
# 测试格式
# 在循环开始时清除列
$v = undef;
# 为各行设置值
$name = 'decline the in german';
# 在第三列中设置要使用的值
$v->[2] = [qw(das des dem das)];
# 在第二列中设置要使用的值
$v->[1] = [qw(die der der die)];
# 在第一列中设置要使用的值
$v->[0] = [qw(der des dem den)];
{
# 安全地输出格式化的STDOUT
my $old_handle = select STDOUT;
# 这将进入$new_handle：
write;
# 恢复以前的句柄
select $old_handle;
};
};
对于我们的测试，这会产生以下结果：
-----------------------------------------------------------
decline the in germ
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
-----------------------------------------------------------
der die das
des der des
dem der das
den die das
使用这个，我们可以简化您的代码为：
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
my $name = '';
my $v = undef;
format STDOUT =
-----------------------------------------------------------
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$name
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
-----------------------------------------------------------
#==================#===================#===================#
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][0]//'', $v->[1][0]//'', $v->[2][0]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][1]//'', $v->[1][1]//'', $v->[2][1]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][2]//'', $v->[1][2]//'', $v->[2][3]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][3]//'', $v->[1][3]//'', $v->[2][3]//''
.
if (0) { # 这只是用来检查我们的格式
# 测试格式
# 在循环开始时清除列
$v = undef;
# 为各行设置值
$name = 'decline the in german';
# 在第三列中设置要使用的值
$v->[2] = [qw(das des dem das)];
# 在第二列中设置要使用的值
$v->[1] = [qw(die der der die)];
# 在第一列中设置要使用的值
$v->[0] = [qw(der des dem den)];
{
# 安全地输出格式化的STDOUT
my $old_handle = select STDOUT;
# 这将进入$new_handle：
write;
# 恢复以前的句柄
select $old_handle;
};
};
my %HoHoA;
sub read_csv {
my ($filename, $tag, $values) = @_;
open(my $FILE, '<', $filename)
or die "Could not open '$filename'! $!";
my %HoA;
while (<$FILE>) {
chomp;
my ($k, @value) = split /,/, $_, $values;
$HoHoA{$k}{$tag} = \@value;
}
close($FILE);
} # 子程序read_csv
# 读取数据
read_csv('file3.csv', 'MODIFIED_FILE2', 5);
read_csv('file2.csv', 'MODIFIED_FILE1', 4);
read_csv('file1.csv', 'BASE_FILE', 4);
#;warn Data::Dumper->new([\%HoHoA],[qw(*HoHoA)])->Deepcopy(1)->Indent(1)->Maxdepth(3)->Sortkeys(1)->Dump(),q{ };
for my $key (sort keys %HoHoA) {
# 清除/设置在格式中使用的值
$name = $key;
$v = undef;
# 将数据放入列中 --- 仅供娱乐，它们的顺序是错乱的
$v->[2] = $HoHoA{$key}{'BASE_FILE'} # 第三列
if (exists $HoHoA{$key}{'BASE_FILE'});
$v->[1] = $HoHoA{$key}{'MODIFIED_FILE1'} # 第二列
if (exists $HoHoA{$key}{'MODIFIED_FILE1'});
$v->[0] = $HoHoA{$key}{'MODIFIED_FILE2'}; # 第一列
{
# 安全地输出格式化的STDOUT
my $old_handle = select STDOUT;
# 这将进入$new_handle：
write;
# 恢复以前的句柄
select $old_handle;
};
}
__DATA__
这是您提供的Perl代码的部分翻译。如果您需要更多的帮助或有其他问题，请随时提问。
英文:
There is a somewhat archiac feature of perl that does exactly what you were looking for --- the "format".
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
my $name='';
my $v=undef;
format STDOUT =
-----------------------------------------------------------
@<<<<<<<<<<<<<<<<<<
$name
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
#==================#===================#===================#
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][0]//'', $v->[1][0]//'', $v->[2][0]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][1]//'', $v->[1][1]//'', $v->[2][1]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][2]//'', $v->[1][2]//'', $v->[2][3]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][3]//'', $v->[1][3]//'', $v->[2][3]//''
.
{
# Test format
# clear the columns at the beginning of the loop
$v=undef;
# set values for the various lines
$name='decline the in german';
# set values to used in third column
$v->[2]=[qw(das des dem das)];
# set values to used in second column
$v->[1]=[qw(die der der die)];
# set values to used in first column
$v->[0]=[qw(der des dem den)];
{
# Safely output the format STDOUT
my $old_handle=select STDOUT;
# This goes to $new_handle:
write;
# restore the perevious handle
select $old_handle;
};
};
For our test this yields
-----------------------------------------------------------
decline the in germ
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
der die das
des der des
dem der das
den die das
Using this we can simplify your code to
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
my $name='';
my $v=undef;
format STDOUT =
-----------------------------------------------------------
@<<<<<<<<<<<<<<<<<<
$name
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
#==================#===================#===================#
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][0]//'', $v->[1][0]//'', $v->[2][0]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][1]//'', $v->[1][1]//'', $v->[2][1]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][2]//'', $v->[1][2]//'', $v->[2][3]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][3]//'', $v->[1][3]//'', $v->[2][3]//''
.
if (0) { # This is just for checking out our format
# Test format
# clear the columns at the beginning of the loop
$v=undef;
# set values for the various lines
$name='decline the in german';
# set values to used in third column
$v->[2]=[qw(das des dem das)];
# set values to used in second column
$v->[1]=[qw(die der der die)];
# set values to used in first column
$v->[0]=[qw(der des dem den)];
{
# Safely output the format STDOUT
my $old_handle=select STDOUT;
# This goes to $new_handle:
write;
# restore the perevious handle
select $old_handle;
};
};
my %HoHoA;
sub read_csv {
my ($filename,$tag,$values)=@_;
open(my $FILE,'<',$filename)
or die "Could not open '$filename'! $!";
my %HoA;
while (<$FILE>) {
chomp;
my ($k,@value)=split /,/,$_,$values;
$HoHoA{$k}{$tag}=\@value;
}
close($FILE);
} # sub read_csv
# Read in the data
read_csv('file3.csv','MODIFIED_FILE2',5);
read_csv('file2.csv','MODIFIED_FILE1',4);
read_csv('file1.csv','BASE_FILE',4);
#;warn Data::Dumper->new([\%HoHoA],[qw(*HoHoA)])->Deepcopy(1)->Indent(1)->Maxdepth(3)->Sortkeys(1)->Dump(),q{ };
for my $key (sort keys %HoHoA) {
# clear/set the values used in the format
$name=$key;
$v=undef;
# Put the stuff in columns --- just for fun they're out of order
$v->[2]=$HoHoA{$key}{'BASE_FILE'} # third column
if (exists $HoHoA{$key}{'BASE_FILE'});
$v->[1]=$HoHoA{$key}{'MODIFIED_FILE1'} # second column
if (exists $HoHoA{$key}{'MODIFIED_FILE1'});
$v->[0]=$HoHoA{$key}{'MODIFIED_FILE2'}; # first column
{
# Safely output the format STDOUT
my $old_handle=select STDOUT;
# This goes to $new_handle:
write;
# restore the perevious handle
select $old_handle;
};
};
__DATA__
which gives
-----------------------------------------------------------
Boszor
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
91 91 91
Mexico Mexico Mexico
Chinese Chinese
AB+
-----------------------------------------------------------
Dora
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
34 34
Malaysian Malaysian
Malay Arab
B-
In response to your post that was closed - modifying the subroutine "read_csv" will do what you desire. The updated version of read_csv look like:
sub read_csv {
my ($filename,$tag,$values)=@_;
my $FILE;
my $raw=do{
open $FILE,'<',$filename
or die "Could not open '$filename'! $!";
# discard the first three lines (header etc)
<$FILE>,<$FILE>,<$FILE>;
# slurp the rest
local $/=undef;
<$FILE>;
};
#;warn Data::Dumper->new([\$raw],[qw(*raw)])->Deepcopy(1)->Indent(1)->Maxdepth(3)->Sortkeys(1)->Dump(),q{ };
# remove all of those -----'s
$raw =~ s{^[-]+$(\r?\n)?}{}gms;
#warn Data::Dumper->new([\$raw],[qw(*raw)])->Deepcopy(1)->Indent(1)->Maxdepth(3)->Sortkeys(1)->Dump(),q{ };
# Use $raw as the buffer to read from
open $FILE,'<',\$raw;
while (<$FILE>) {
chomp;
my ($k,@value)=split /,/,$_,$values;
$HoHoA{$k}{$tag}=\@value;
}
close($FILE);
} # sub read_csv
This yields
-----------------------------------------------------------
Boszor
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
91 91 91
Mexico Mexico Mexico
Chinese Chinese
AB+
-----------------------------------------------------------
Dora
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
34 34
Malaysian Malaysian
Arab Malay
B-
-----------------------------------------------------------
Queeny
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
47
Rusia
Russian
O+`
-----------------------------------------------------------
Sarah
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
21 21
Malaysian Indonesia
Bugis Bugis`
AB+
-----------------------------------------------------------
Szundi
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
23 23 23
German German German
Indian Indian
AB-
-----------------------------------------------------------
Tharani
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
30
Australia
Malay
O-
-----------------------------------------------------------
Tudor
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
10 10 10
Spain Spain Vietnam
Chinese Chinese
A+
In response to the OP's comment
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
my $output='outputfile.csv';
# declaring variables used in MyFORMAT
my $name='';
my $v=undef;
# more on format https://perldoc.perl.org/perlform
format MyFORMAT =
-----------------------------------------------------------
@<<<<<<<<<<<<<<<<<<
$name
MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE
------------------------------------------------------------
#==================#===================#===================#
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][0]//'', $v->[1][0]//'', $v->[2][0]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][1]//'', $v->[1][1]//'', $v->[2][1]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][2]//'', $v->[1][2]//'', $v->[2][3]//'',
@|||||||||||||||||||@|||||||||||||||||||@||||||||||||||||||
$v->[0][3]//'', $v->[1][3]//'', $v->[2][3]//''
.
# note the "." which ends the format
# NB nothing else can be on that line not even a comment
my %HoHoA;
sub read_csv {
my ($filename,$tag,$values)=@_;
my $FILE;
my $raw=do{
open $FILE,'<',$filename
or die "Could not open '$filename'! $!";
# discard the first three lines (header etc)
<$FILE>,<$FILE>,<$FILE>;
# slurp the rest
local $/=undef;
<$FILE>;
};
#;warn Data::Dumper->new([\$raw],[qw(*raw)])->Deepcopy(1)->Indent(1)->Maxdepth(3)->Sortkeys(1)->Dump(),q{ };
# remove all of those -----'s
$raw =~ s{^[-]+$(\r?\n)?}{}gms;
#warn Data::Dumper->new([\$raw],[qw(*raw)])->Deepcopy(1)->Indent(1)->Maxdepth(3)->Sortkeys(1)->Dump(),q{ };
# Use $raw as the buffer to read from
open $FILE,'<',\$raw;
while (<$FILE>) {
chomp;
my ($k,@value)=split /,/,$_,$values;
$HoHoA{$k}{$tag}=\@value;
}
close($FILE);
} # sub read_csv
# Read in the data building a Hash of Hashes of Arrays
# with the key of the outer hash being the ID
# and the key of the inner hash being the tag (ie: 'BASE_FILE' etc)
read_csv('file3.csv','MODIFIED_FILE2',5);
read_csv('file2.csv','MODIFIED_FILE1',4);
read_csv('file1.csv','BASE_FILE',4);
#;warn Data::Dumper->new([\%HoHoA],[qw(*HoHoA)])->Deepcopy(1)->Indent(1)->Maxdepth(3)->Sortkeys(1)->Dump(),q{ };
# Open a handle to $output
open my $MyHANDLE,'>',$output
or die "Could not open '$output'! $!";
# Associate the handle with its format
# More on "->format name" https://perldoc.perl.org/perlvar#HANDLE-%3Eformat_name(EXPR)
# note - because the format is invariant within the loop we can set it here
$MyHANDLE->format_name('MyFORMAT');
for my $key (sort keys %HoHoA) {
# clear/set the values used in the format
$name=$key;
$v=undef;
# Put the stuff in columns --- just for fun they're out of order
$v->[2]=$HoHoA{$key}{'BASE_FILE'} # third column
if (exists $HoHoA{$key}{'BASE_FILE'});
$v->[1]=$HoHoA{$key}{'MODIFIED_FILE1'} # second column
if (exists $HoHoA{$key}{'MODIFIED_FILE1'});
$v->[0]=$HoHoA{$key}{'MODIFIED_FILE2'}; # first column
# Associate the handle with its format
# More on "->format name" https://perldoc.perl.org/perlvar#HANDLE-%3Eformat_name(EXPR)
# note - because the format is invariant within the loop it has been move outside the loop
#$MyHANDLE->format_name('MyFORMAT');
# More on write https://perldoc.perl.org/functions/write
write $MyHANDLE;
};
# Close the handle
close $MyHANDLE
or die "Could not open '$output'! $!";
__DATA__
答案2
得分: 1
以下是您提供的内容的翻译：
您正在查看您的数据记录，希望将其格式化为列，但您的输出媒体是基于行的。您需要将您的列式数据转换为适合您的媒体的输出。
使用 strict 和 warnings
所有 Perl 5 代码都应启用 strict 严格模式，并且最好使用 warnings 警告模式，特别是如果您需要帮助。strict 严格模式应该会为您提供一些关于出错原因的提示。在您的代码中启用 strict 将产生多个编译错误。
$ perl -c -Mstrict -Mwarnings -wl foo.pl
全局符号 "$class_MODIFIED_FILE2" 需要显式包名称（您是否忘记声明 "my $class_MODIFIED_FILE2"？）在 foo.pl 第 44 行。
全局符号 "$class_MODIFIED_FILE1" 需要显式包名称（您是否忘记声明 "my $class_MODIFIED_FILE1"？）在 foo.pl 第 44 行。
全局符号 "$class_MODIFIED_FILE2" 需要显式包名称（您是否忘记声明 "my $class_MODIFIED_FILE2"？）在 foo.pl 第 47 行。
全局符号 "$class_MODIFIED_FILE2" 需要显式包名称（您是否忘记声明 "my $class_MODIFIED_FILE2"？）在 foo.pl 第 63 行。
foo.pl 存在编译错误。
您看到这个错误的原因是因为您尝试在声明变量之前使用它们。由于 Perl 是过程性的，它按行执行；它无法打印尚未声明的内容。
使用 CPAN 模块
最简单的解决方法是使用现有的 CPAN 模块之一。Data::Format::Pretty::Console 可以以列格式输出您的记录。其他流行的 CPAN 选项包括 Text::Table、Text::ASCIITable。
考虑您的输出
这个问题本质上不是一个 Perl 问题，而是一个数据/格式化问题。由于您的目标输出媒体（ASCII 终端）基于行，您必须逐行打印。
如果您想在没有模块的情况下执行此操作，您必须考虑逐行打印。
以下是我认为可以实现您想要的效果的工作程序：
#!/usr/bin/perl
use strict;
use warnings;
my %HoA = (
MODIFIED_FILE2 => {
Dora => [qw(34 Malaysian Malay B-)],
Boszor => [qw(91 Mexico Chinese AB+)],
},
MODIFIED_FILE1 => {
Dora => [qw(34 Malaysian Arab)],
Boszor => [qw(91 Mexico Chinese)],
},
BASE_FILE => {
Boszor => [qw(91 Mexico Chinese)],
},
);
my @columns = qw(MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE);
# 注意使用 sort 以确保一致的输出
for my $name (sort keys %{ $HoA{MODIFIED_FILE2} }) {
print "-" x 60, "\n";
print "$name\n";
printf "%-20s" x @columns, @columns;
print "\n";
print "-" x 60, "\n";
for my $idx (0..3) { # 年龄、国家、种族、血型
for my $column (@columns) {
printf "%-20s", $HoA{$column}{$name}[$idx] // q{};
}
print "\n";
}
print "\n";
}
请注意 for（或 foreach）循环 - 您必须从内到外考虑它们。您想要在同一行上打印每一列，这就是为什么列是最内层的循环，而在该循环中不打印换行符的原因。
接下来的循环是索引，因为您想要按索引打印列的组（最内层循环），并在每个组的末尾打印换行符。
最后，$name 是最外层的循环，因为您想要按名称打印每组数据。
此代码仅检查 $HoA{MODIFIED_FILE2} 中的名称，这就是您的代码正在做的事情。如果您实际上想要检查所有名称，您可能希望使用 map 和 List::Util::uniq。
英文:
You are looking at your data in terms of records, which you want formatted as columns, but your output medium is row (line) based. You have to transform your columnar data into an output suitable for your medium.
Use strict and warnings
All Perl 5 code should enable the strict pragma, and ideally use warnings pragma especially if you are asking for help. The strict pragma would have given you some hints about what went wrong. Enabling strict on your code yields several compilation errors.
$ perl -c -Mstrict -Mwarnings -wl foo.pl
Global symbol "$class_MODIFIED_FILE2" requires explicit package name (did you forget to declare "my $class_MODIFIED_FILE2"?) at foo.pl line 44.
Global symbol "$class_MODIFIED_FILE1" requires explicit package name (did you forget to declare "my $class_MODIFIED_FILE1"?) at foo.pl line 44.
Global symbol "$class_MODIFIED_FILE2" requires explicit package name (did you forget to declare "my $class_MODIFIED_FILE2"?) at foo.pl line 47.
Global symbol "$class_MODIFIED_FILE2" requires explicit package name (did you forget to declare "my $class_MODIFIED_FILE2"?) at foo.pl line 63.
foo.pl had compilation errors.
The reason you see this is because you are trying to use variables before you declare them. Since Perl is procedural, it goes line-by-line; it can't print what hasn't been declared yet.
Use a CPAN module
The simplest answer for this is to use one of several existing CPAN modules. Data::Format::Pretty::Console can output your records in columnar format. Other popular CPAN options include Text::Table, Text::ASCIITable.
Think about your output
This question is not fundamentally a Perl question, but a data/formatting question. Since your target output medium (an ASCII terminal) is based on rows, you have to print one row at a time.
If you want to do this without a module, you have to think in terms of printing one line at a time.
Here is a working program that I think accomplishes what you want:
#!/usr/bin/perl
use strict;
use warnings;
my %HoA = (
MODIFIED_FILE2 => {
Dora => [qw(34 Malaysian Malay B-)],
Boszor => [qw(91 Mexico Chinese AB+)],
},
MODIFIED_FILE1 => {
Dora => [qw(34 Malaysian Arab)],
Boszor => [qw(91 Mexico Chinese)],
},
BASE_FILE => {
Boszor => [qw(91 Mexico Chinese)],
},
);
my @columns = qw(MODIFIED_FILE2 MODIFIED_FILE1 BASE_FILE);
# NOTE use sort to guarantee consistent output
for my $name (sort keys %{ $HoA{MODIFIED_FILE2} }) {
print "-" x 60, "\n";
print "$name\n";
printf "%-20s" x @columns, @columns;
print "\n";
print "-" x 60, "\n";
for my $idx (0..3) { # age, country, ethincity, blood type
for my $column (@columns) {
printf "%-20s", $HoA{$column}{$name}[$idx] // q{};
}
print "\n";
}
print "\n";
}
Notice the for (or foreach) loops - you have to think about them from the inside out. You want to print each column on the same line, which is why column is the inner-most loop and there is no newline printed in that loop.
The next loop out is the index, because you want to print groups of columns (the inner-most loop) per index, along with a newline at the end of each.
Finally, the $name is the outermost loop, because you want to print each group of data per name.
This code only checks the names in $HoA{MODIFIED_FILE2}, which is what your code was doing. If you actually meant to check all of them, you would probably want to use a map with a List::Util::uniq.
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论