Разбор YAML-подобного текстового файла в хеш-структуру

Question

У меня есть текстовый файл:

country = { 
    tag = ENG 
    ai = { 
        flags = { } 
        combat = { ROY WLS PUR SCO EIR FRA DEL USA QUE BGL MAH MOG VIJ MYS DLH GUJ ORI JAI ASS MLC MYA ARK PEG TAU HYD } 
        continent = { "Oceania" } 
        area = { "America" "Maine" "Georgia" "Newfoundland" "Cuba" "Bengal" "Carnatic" "Ceylon" "Tanganyika" "The Mascarenes" "The Cape" "Gold" "St Helena" "Guiana" "Falklands" "Bermuda" "Oregon" } 
        region = { "North America" "Carribean" "India" } 
        war = 50 
        ferocity = no 
    }
    date = { year = 0 month = january day = 0 } 
}

Я пытаюсь разобрать этот текст в структуру perl-хеша, чтобы вывод после дампа данных выглядел так:

$VAR1 = {
          'country' => {
                         'ai' => {
                                   'area' => [
                                               'America',
                                               'Maine',
                                               'Georgia',
                                               'Newfoundland',
                                               'Cuba',
                                               'Bengal',
                                               'Carnatic',
                                               'Ceylon',
                                               'Tanganyika',
                                               'The Mascarenes',
                                               'The Cape',
                                               'Gold',
                                               'St Helena',
                                               'Guiana',
                                               'Falklands',
                                               'Bermuda',
                                               'Oregon'
                                             ],
                                   'combat' => [
                                                 'ROY',
                                                 'WLS',
                                                 'PUR',
                                                 'SCO',
                                                 'EIR',
                                                 'FRA',
                                                 'DEL',
                                                 'USA',
                                                 'QUE',
                                                 'BGL',
                                                 'MAH',
                                                 'MOG',
                                                 'VIJ',
                                                 'MYS',
                                                 'DLH',
                                                 'GUJ',
                                                 'ORI',
                                                 'JAI',
                                                 'ASS',
                                                 'MLC',
                                                 'MYA',
                                                 'ARK',
                                                 'PEG',
                                                 'TAU',
                                                 'HYD'
                                               ],
                                   'continent' => [
                                                    'Oceania'
                                                  ],
                                   'ferocity' => 'no',
                                   'flags' => [],
                                   'region' => [
                                                 'North America',
                                                 'Carribean',
                                                 'India'
                                               ],
                                   'war' => 50
                                 },
                         'date' => {
                                     'day' => 0,
                                     'month' => 'january',
                                     'year' => 0
                                   },
                         'tag' => 'ENG'
                       }
        };

Версия в жестком коде может выглядеть так:

#!/usr/bin/perl
use Data::Dumper;
use warnings;
use strict;

my $ret;

$ret->{'country'}->{tag} = 'ENG';
$ret->{'country'}->{ai}->{flags} = [];
my @qw = qw( ROY WLS PUR SCO EIR FRA DEL USA QUE BGL MAH MOG VIJ MYS DLH GUJ ORI JAI ASS MLC MYA ARK PEG TAU HYD );
$ret->{'country'}->{ai}->{combat} = \@qw; 
$ret->{'country'}->{ai}->{continent} =  ["Oceania"];
$ret->{'country'}->{ai}->{area} =  ["America", "Maine", "Georgia", "Newfoundland", "Cuba", "Bengal", "Carnatic", "Ceylon", "Tanganyika", "The Mascarenes", "The Cape", "Gold", "St Helena", "Guiana", "Falklands", "Bermuda", "Oregon"];
$ret->{'country'}->{ai}->{region} = ["North America", "Carribean", "India"];
$ret->{'country'}->{ai}->{war} = 50;
$ret->{'country'}->{ai}->{ferocity} = 'no';
$ret->{'country'}->{date}->{year} = 0;
$ret->{'country'}->{date}->{month} = 'january';
$ret->{'country'}->{date}->{day} = 0;

sub hash_sort {
  my ($hash) = @_;
  return [ (sort keys %$hash) ];
}

$Data::Dumper::Sortkeys = \hash_sort;

print Dumper($ret);

Я должен признать, что у меня огромная проблема с вложенными фигурными скобками.Я пытался решить эту проблему, используя жадные и неадекватные сопоставления, но, похоже, это не сработало.Я также читал о расширенных шаблонах (например, (? PARNO)), но у меня нет абсолютно никакой подсказки, как использовать их в моей конкретной проблеме.Порядок данных не имеет значения, так как у меня есть подпрограмма hash_sort.Я буду признателен за любую помощь.

Answer 1

Я разбил его на несколько простых предположений:

1. Запись будет состоять из идентификатора, за которым следует знак равенства
2. Запись будет одного из трех основных типов:уровень или набор или одно значение
3. Набор имеет 3 формы: 1) кавычки, разделенный пробелами список;2) пары ключ-значение, 3) qw-подобный список без кавычек
4. Набор пар ключ-значение должен содержать идентификатор для ключа и либо пробелы, либо значение в кавычках для значения

См. Вкрапленные комментарии.

use strict;
use warnings;

my $simple_value_RE
    = qr/^ \s* (\p{Alpha}\w*) \s* = \s* ( [^\s{}]+ | "[^"]*" ) \s* $/x
    ;
my $set_or_level_RE
    = qr/^ \s* (\w+) \s* = \s* [{] (?: ([^}]+) [}] )? \s* $/x
    ;
my $quoted_set_RE
    = qr/^ \s* (?: "[^"]+" \s+ )* "[^"]+" \s* $/x
    ;
my $associative_RE
    = qr/^ \s* 
        (?: \p{Alpha}\w* \s* = \s* (?: "[^"]+" | \S+ ) \s+ )*
        \p{Alpha}\w* \s* = \s* (?: "[^"]+" | \S+ ) 
        \s* $
    /x
    ;
my $pair_RE = qr/ \b ( \p{Alpha}\w* ) \s* = \s* ( "[^"]+" | \S+ )/x;

sub get_level { 
    my $handle = shift;
    my %level;
    while ( <$handle> ) {
        # if the first character on the line is a close, then we're done
        # at this level
        last if  m/^\s*[}]/; 
        my ( $key, $value );

        # get simple values
        if (( $key, $value ) =  m/$simple_value_RE/ ) { 
            # done.
        }
        elsif (( $key, my $complete_set ) = m/$set_or_level_RE/ ) {
            if ( $complete_set ) {
                if ( $complete_set =~ m/$quoted_set_RE/ ) { 
                    # Pull all quoted values with global flag
                    $value = [ $complete_set =~ m/"([^"]+)"/g ];
                }
                elsif ( $complete_set =~ m/$associative_RE/ ) { 
                    # going to create a hashref. First, with a global flag
                    # repeatedly pull all qualified pairs
                    # then split them to key and value by spliting them at
                    # the first '='
                    $value 
                        = { map { split /\s*=\s*/, $_, 2 } 
                                ( $complete_set =~ m/$pair_RE/g )
                        };
                }
                else {
                    # qw-like
                    $value = [ split( ' ', $complete_set ) ];
                }
            }
            else { 
                $value = get_level( $handle );
            }
        }
        $level{ $key } = $value;
    }
    return wantarray ? %level : \%level;
}

my %base = get_level( \*DATA );

Answer 2

Содержимое выглядит довольно регулярно.Почему бы не выполнить некоторые замены содержимого и не преобразовать его в синтаксис хэша, а затем проверить его.Это был бы быстрый и грязный способ конвертировать его.

Вы также можете написать парсер, предполагая, что знаете грамматику.

Answer 3

Что ж, как предположил Дэвид, проще всего было бы заставить любой созданный файл использовать стандартный формат. Разобрать JSON, YAML или XML будет намного проще.

Но если вам действительно нужно проанализировать этот формат, я бы написал для него грамматику, используя Regexp :: Grammars (если вам может потребоваться Perl 5.10) или Parse :: RecDescent (если не можете) Это будет немного сложно, особенно потому, что вы, похоже, используете скобки для обоих хешей и массивов, но это должно быть выполнимо.