Question

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

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

我需要的输出是Tab Separated格式。

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库可以帮助我解决此类问题。

Answer 1

我的尝试：

#!/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);

在perl中解析树数据文件

1 个答案: