2

我是 Perl 的新手。我有一个文件,其中包含树格式的数据,如下所示。我需要解析大数据并从中生成 .TSV 文件。文件格式如下

A 
|
|--B 
|  |
|  |--C
|     | 
|     |---PQR
|     |---XYZ
|--D
|  |
|  |---LMN
|---XYZ

我需要的输出是制表符分隔格式。

Coloum1     Coloum2     Coloum3     Coloum4 
A           B           C           PQR
A           B           C           XYZ
A           D                       LMN
A                                   XYZ

我编写了一个不适用于中间节点的代码。这里是 B 节点,它没有叶节点,连接到根节点的叶节点没有正确进入输出。我正在从命令行读取输入文件。

#!/usr/bin/perl
use Data::Dumper;
open (MYFILE, "<", $ARGV[0]);

my $content = "";
while(<MYFILE>)
{
    my $line = $_;
    $content = $content.$line;
}

my ($root, @block) = split(/\|--(\w)/, $content);

$root =~ s/.*?(\w+).*/$1/is;
my %block = @block;

print "\nColoum1\tColumn2\tColumn3\tColumn4";
foreach my $key( keys %block)
{
    my $content =  $block{$key};
    my (undef, @lines) = split(/\n/, $content);
    foreach my $line (@lines)
    {
        if($line =~ /---(\w+)/is)
        {
            my $val = $1;

            if(defined $val)
            {
                print "\n$root\t$key\t$val";
            }
        }
    }
}

我从中得到的输出是

Coloum1     Column2     Column3     Column4
A           D       LMN
A           D       XYZ
A           C       PQR
A           C       XYZ

是我在这段代码中缺少的东西。你能指导我解决我的问题。

是否有任何 CPAN 库可以帮助我处理此类问题。

4

1 回答 1

4

我的尝试:

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

use Test::More tests => 1;

my $input = 'A 
|
|--B 
|  |
|  |--C
|     | 
|     |---PQR
|     |---XYZ
|--D
|  |
|  |---LMN
|---XYZ
';

open my $IN, '<', \$input or die $!;

my @path;
my @output;
my $size = 0;

while (<$IN>) {
    if (!/\|/) {                        # Root.
        @path = [0, /(\S+)/];

    } elsif (/\|(?=-)/g) {              # Capture the position of the last |.

        if ($path[-1][0] == pos) {      # Sibling.
            ($path[-1][1]) = /-+(\S+)/;

        } elsif ( $path[-1][0] < pos) { # Child.
            push @path, [pos, /-+(\S+)/];

        } else {                        # New branch.
            pop @path until $path[-1][0] == pos;
            $path[-1] = [pos, /-+(\S+)/];
        }

        if (/---/) {
            push @output, [ map $_->[1], @path ];
            $size = @path if @path > $size;
        }
    }
}

my $expected = 'Column1 Column2 Column3 Column4
A   B   C   PQR
A   B   C   XYZ
A   D       LMN
A           XYZ
';

my $output = join "\t", map "Column$_", 1 .. $size;

for my $row (@output) {
    $output .= "\n";
    $output .= join "\t", @{$row}[0 .. $#{$row} - 1],
                          (q()) x ($size - @$row),
                          $row->[-1];
}
$output .= "\n";

is($output, $expected);
于 2013-12-10T01:27:40.353 回答