Как я могу извлечь/разобрать табличные данные из текстового файла в Perl?

Я ищу что-то вроде HTML::TableExtract, только не для ввода HTML, а для ввода простого текста, который содержит «таблицы», отформатированные с отступом и интервалом.

Данные могут выглядеть так:

Here is some header text.

Column One       Column Two      Column Three
a                                           b
a                    b                      c


Some more text

Another Table     Another Column
abdbdbdb          aaaa

person Thilo    schedule 14.10.2010    source источник
comment
Я предоставил решение, но оно создаст ШЕСТЬ столбцов. Вы делаете предположение, что разделитель столбцов ДОЛЖЕН быть 1 пробелом?   -  person DVK    schedule 14.10.2010
comment
Нет, но мы можем предположить, что я знаю строки заголовков столбцов и что данные столбцов правильно выровнены по заголовкам.   -  person Thilo    schedule 14.10.2010


Ответы (2)


Не знаю ни о каком пакетном решении, но что-то не очень гибкое довольно просто сделать, предполагая, что вы можете сделать два прохода по файлу: (ниже приведен частично пример псевдокода Perlish)

  • Предположение: данные могут содержать пробелы и НЕ заключаются в кавычки аля CSV, если есть пробел - если это не так, просто используйте Text::CSV(_XS).
  • Предположение: для форматирования не используются вкладки.
  • Логика определяет «разделитель столбцов» как любой последовательный набор вертикальных строк, заполненных пробелами на 100 %.
  • Если случайно в каждой строке есть пробел, который является частью данных со смещением M символов, логика будет считать смещение M разделителем столбцов, поскольку она не может знать ничего лучшего. ЕДИНСТВЕННЫЙ способ узнать лучше, если вы требуете, чтобы разделение столбцов было не менее X пробелов, где X>1 — см. второй фрагмент кода для этого.

Образец кода:

my $INFER_FROM_N_LINES = 10; # Infer columns from this # of lines
                             # 0 means from entire file
my $lines_scanned = 0;
my @non_spaces=[];
# First pass - find which character columns in the file have all spaces and which don't
my $fh = open(...) or die;
while (<$fh>) {
    last if $INFER_FROM_N_LINES && $lines_scanned++ == $INFER_FROM_N_LINES;
    chomp;
    my $line = $_;
    my @chars = split(//, $line); 
    for (my $i = 0; $i < @chars; $i++) { # Probably can be done prettier via map?
        $non_spaces[$i] = 1 if $chars[$i] ne " ";
    }
}
close $fh or die;

# Find columns, defined as consecutive "non-spaces" slices.
my @starts, @ends; # Index at which columns start and end
my $state = " "; # Not inside a column
for (my $i = 0; $i < @non_spaces; $i++) {
    next if $state eq " " && !$non_spaces[$i];
    next if $state eq "c" && $non_spaces[$i];
    if ($state eq " ") { # && $non_spaces[$i] of course => start column
        $state = "c";
        push @starts, $i;
    } else { # meaning $state eq "c" && !$non_spaces[$i] => end column
        $state = " ";
        push @ends, $i-1;
    }
}
if ($state eq "c") { # Last char is NOT a space - produce the last column end
    push @ends, $#non_spaces;
}

# Now split lines
my $fh = open(...) or die;
my @rows = ();
while (<$fh>) {
    my @columns = ();
    push @rows, \@columns;
    chomp;
    my $line = $_;
    for (my $col_num = 0; $col_num < @starts; $col_num++) {
        $columns[$col_num] = substr($_, $starts[$col_num], $ends[$col_num]-$starts[$col_num]+1);
    }
}
close $fh or die;

Теперь, если вы требуете, чтобы расстояние между столбцами было не менее X пробелов, где X>1, это также выполнимо, но синтаксический анализатор расположения столбцов должен быть немного сложнее:

# Find columns, defined as consecutive "non-spaces" slices separated by at least 3 spaces.
my $min_col_separator_is_X_spaces = 3;
my @starts, @ends; # Index at which columns start and end
my $state = "S"; # inside a separator
NEXT_CHAR: for (my $i = 0; $i < @non_spaces; $i++) {
    if ($state eq "S") { # done with last column, inside a separator
        if ($non_spaces[$i]) { # start a new column
            $state = "c";
            push @starts, $i;
        }
        next;
    }
    if ($state eq "c") { # Processing a column
        if (!$non_spaces[$i]) { # First space after non-space
                                # Could be beginning of separator? check next X chars!
            for (my $j = $i+1; $j < @non_spaces
                            || $j < $i+$min_col_separator_is_X_spaces; $j++) {
                 if ($non_spaces[$j]) {
                     $i = $j++; # No need to re-scan again
                     next NEXT_CHAR; # OUTER loop
                 }
                 # If we reach here, next X chars are spaces! Column ended!
                 push @ends, $i-1;
                 $state = "S";
                 $i = $i + $min_col_separator_is_X_spaces;
            }
         }
        next;
    }
}
person DVK    schedule 14.10.2010

Вот очень быстрое решение, прокомментированное обзором. (Прошу прощения за длину.) По сути, если «слово» появляется после начала заголовка столбца n, оно заканчивается в столбце n, если только большая часть его body переходит в столбец n + 1, и в этом случае вместо этого оно оказывается там. Приведение в порядок этого, расширение его для поддержки нескольких разных таблиц и т. д. остается в качестве упражнения. Вы также можете использовать что-то другое, кроме левого смещения заголовка столбца, в качестве граничной отметки, например центр, или какое-либо значение, определяемое номером столбца.

#!/usr/bin/perl


use warnings;
use strict;


# Just plug your headers in here...
my @headers = ('Column One', 'Column Two', 'Column Three');

# ...and get your results as an array of arrays of strings.
my @result = ();


my $all_headers = '(' . (join ').*(', @headers) . ')';
my $found = 0;
my @header_positions;
my $line = '';
my $row = 0;
push @result, [] for (1 .. @headers);


# Get lines from file until a line matching the headers is found.

while (defined($line = <DATA>)) {

    # Get the positions of each header within that line.

    if ($line =~ /$all_headers/) {
        @header_positions = @-[1 .. @headers];
        $found = 1;
        last;
    }

}


$found or die "Table not found! :<\n";


# For each subsequent nonblank line:

while (defined($line = <DATA>)) {
    last if $line =~ /^$/;

    push @{$_}, "" for (@result);
    ++$row;

    # For each word in line:

    while ($line =~ /(\S+)/g) {

        my $word = $1;
        my $position = $-[1];
        my $length = $+[1] - $position;
        my $column = -1;

        # Get column in which word starts.

        while ($column < $#headers &&
            $position >= $header_positions[$column + 1]) {
            ++$column;
        }

        # If word is not fully within that column,
        # and more of it is in the next one, put it in the next one.

        if (!($column == $#headers ||
            $position + $length < $header_positions[$column + 1]) &&
            $header_positions[$column + 1] - $position <
            $position + $length - $header_positions[$column + 1]) {

            my $element = \$result[$column + 1]->[$row];
            $$element .= " $word";

        # Otherwise, put it in the one it started in.

        } else {

            my $element = \$result[$column]->[$row];
            $$element .= " $word";

        }

    }

}


# Output! Eight-column tabs work best for this demonstration. :P

foreach my $i (0 .. $#headers) {
    print $headers[$i] . ": ";
    foreach my $c (@{$result[$i]}) {
        print "$c\t";
    }
    print "\n";
}


__DATA__

This line ought to be ignored.

Column One       Column Two      Column Three
These lines are part of the tabular data to be processed.
The data are split based on how much words overlap columns.

This line ought to be ignored also.

Пример вывода:

Column One:      These lines are         The data are split
Column Two:      part of the tabular     based on how
Column Three:    data to be processed.   much words overlap columns.
person Jon Purdy    schedule 14.10.2010