Существует ли модуль Perl для разбора столбчатого текста?

Question

Допустим, у меня есть текстовый файл с разделителями табуляции, который содержит данные, расположенные в столбцах (с заголовками).

Возможно, что разные столбцы могут быть "сложены" в "листе", например, есть некоторый разделитель (который может быть или не быть известен заранее), который позволяет различным столбцам располагаться вертикально.

Существует ли модуль Perl, который облегчает синтаксический анализ столбчатых данных в этом текстовом файле в структуру данных (например, хеш-таблицу, ключом которой является заголовок столбца, а значением является массив скаляров данных столбца)?

РЕДАКТИРОВАТЬ Под «сложенным» я подразумеваю, что столбец текста может содержать несколько отдельных «векторов» данных, каждый с разными заголовками и различной длиной. Правда, это усложняет разбор.

РЕДАКТИРОВАТЬ Я, честно говоря, не уверен, где путаница. Тем не менее, вот пример:

header_one\theader_three
data_1\tdata_7
data_2\tdata_8
data_3\tdata_9
\tdata_10
header_two\tdata_11
data_4\theader_four
data_5\tdata_12
data_6\tdata_13
\tdata_14

Сценарий превратит это в хеш-таблицу с четырьмя ключами: header_one, header_two, header_three и header_four, причем каждый ключ ссылается на ссылку массива, указывающую на элементы data_n под заголовком.

Answer 1

Я думаю, это близко к тому, о чем вы говорите. Если количество столбцов изменяется, то входные данные обрабатываются так, как если бы это была другая таблица. Этот код можно легко изменить, чтобы он распознавал какой-то другой маркер (например, строку знаков равенства) вместо использования количества столбцов.

#!/usr/bin/perl

use strict;
use warnings;

use Text::CSV_XS;

#setup the parser, here we want tab separated and we allow
#loose quoting, so qq/foo\t"bar\tbaz"\tquux/ is 
#("foo", "bar\tbaz", "quux")
my $p = Text::CSV_XS->new(
    {
        sep_char           => "\t",
        allow_loose_quotes => 1,
    }
);

my @stacked;
my $cur = 0;
while (<>) {
    $p->parse($_) or die $p->error_input;
    my @rec = $p->fields;
    #normal case, just add the record to the last
    #section in @stacked
    if (@rec == $cur) {
        push @{$stacked[-1]}, \@rec;
        next;
    }
    #if the number of columns don't match then
    #we have a new section
    push @stacked, [\@rec];
    $cur = @rec; #set the new number of columns
}

for my $table (@stacked) {
    print "header: ", join("::", @{$table->[0]}), "\n";
    for my $i (1 .. $#$table) {
        print "data: ", join("::", @{$table->[$i]}), "\n";
    }
    print "\n";
}

Answer 2

Я бы начал с DBD :: CSV , если это возможно, хотя ваше "сложенное" требование (которое я не полностью понимаю), вероятно, потребовало бы некоторого ручного разбора, используя Text :: CSV_XS .

Не обманывайтесь их именами - они могут анализировать любые разделители, не только запятые.

Answer 3

Не очень гладко, но я делал это так:

        my $recordType = unpack("A3", $_);

        if ($recordType eq "APT")
        {
            $currentKey = parseFAAAirportAirportRecord($_);
        }
        elsif ($recordType eq "ATT")
        {
            parseFAAAirportAttendenceRecord($currentKey, $_);
        }
        elsif ($recordType eq "RWY")
        {
            parseFAAAirportRunwayRecord($currentKey, $_);
        }
        elsif ($recordType eq "RMK")
        {
            parseFAAAirportRemarkRecord($currentKey, $_);
        }
...
sub parseFAAAirportAirportRecord($)
{
    my ($line) = @_;

    my ($recordType, $datasource_key, $type, $id, $effDate, $faaRegion,
        $faaFieldOffice, $state, $stateName, $county, $countyState,
        $city, $name, $ownershipType, $facilityUse, $ownersName,
        $ownersAddress, $ownersCityStateZip, $ownersPhone, $facilitiesManager,
        $managersAddress, $managersCityStateZip, $managersPhone,
        $formattedLat, $secondsLat, $formattedLong, $secondsLong,
        $refDetermined, $elev, $elevDetermined, $magVar, $magVarEpoch, $tph,
        $sectional, $distFromTown, $dirFromTown, $acres,
        $bndryARTCC, $bndryARTCCid,
        $bndryARTCCname, $respARTCC, $respARTCCid, $respARTCCname,
        $fssOnAirport, $fssId, $fssName, $fssPhone, $fssTollFreePhone,
        $altFss, $altFssName,
        $altFssPhone, $notamFacility, $notamD, $arptActDate,
        $arptStatusCode, $arptCert,
        $naspAgreementCode, $arptAirspcAnalysed, $aoe, $custLandRights,
        $militaryJoint, $militaryRights, $nationalEmergency, $milUse,
        $inspMeth, $inspAgency, $lastInsp, $lastInfo, $fuel, $airframeRepairs
,
        $engineRepairs, $bottledOyxgen, $bulkOxygen,
        $lightingSchedule, $tower, $unicomFreqs, $ctafFreq, $segmentedCircle,
        $lens, $landingFee, $isMedical,
        $numBasedSEL, $numBasedMEL, $numBasedJet,
        $numBasedHelo, $numBasedGliders, $numBasedMilitary,
        $numBasedUltraLight,
        $numScheduledOperation, $numCommuter, $numAirTaxi,
        $numGAlocal, $numGAItinerant,
        $numMil, $countEndingDate,
        $aptPosSrc, $aptPosSrcDate, $aptElevSrc, $aptElevSrcDate,
        $contractFuel, $transientStorage, $otherServices, $windIndicator,
        $icaoId) =
        unpack("A3 A11 A13 A4 A10 A3 A4 A2 A20 A21 A2 A40 " .
        "A42 A2 A2 A35 A72 A45 A16 A35 A72 A45 A16 A15 A12 A15 A12 A1 A5 A1 " .
        "A3 A4 A4 A30 A2 A3 A5 A4 A3 A30 A4 A3 A30 A1 A4 A30 A16 A16 " .
        "A4 A30 A16 A4 " .
        "A1 A7 A2 A15 A7 A13 A1 A1 A1 A1 A18 A6 A2 A1 A8 A8 A40 A5 A5 A8 " .
        "A8 A9 A1 A42 A7 A4 A3 A1 A1 A3 A3 A3 A3 A3 A3 A3 " .
        "A6 A6 A6 A6 A6 A6 A10" .
        "A16 A10 A16 A10 A1 A12 A71 A3 A7", $line);