Как преобразовать параметры глубокого запроса в структуру данных Perl?

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

columns[0][data]=status&
columns[0][name]=&
columns[0][searchable]=true&
columns[0][orderable]=true&
columns[0][search][value]=&
columns[0][search][regex]=false&
columns[1][data]=some&
columns[1][name]=&
columns[1][searchable]=true&
columns[1][orderable]=true&
columns[1][search][value]=&
columns[1][search][regex]=false&
columns[2][data]=title&
columns[2][name]=&
columns[2][searchable]=true&
columns[2][orderable]=true&
columns[2][search][value]=&
columns[2][search][regex]=false

станет таким:

@columns = ( {
    data => 'status',
    name => '',
    searchable => 1,
    orderable => 1,
    search => {
      value => '',
      regex => 0,
    }
  },
  {
    data => 'true',
    name => '',
    searchable => 1,
    orderable => 1,
    search => {
      value => '',
      regex => 0,
    }
  },
  {
    data => 'title',
    name => '',
    searchable => 1,
    orderable => 1,
    search => {
      value => '',
      regex => 0,
    }
  },
);

Каков наилучший способ добиться этого?

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


person w.k    schedule 01.06.2014    source источник
comment
Уже существует интеграция Perl для таблиц данных, которая может дать вам то, что вам нужно datatables.net/development/server- сторона/perl_mvc   -  person KeepCalmAndCarryOn    schedule 02.06.2014
comment
@KeepCalmAndCarryOn: AFAIU, это и таблицы данных модуля Perl несовместимы с новым API Datatables.   -  person w.k    schedule 02.06.2014


Ответы (3)


Предполагая, что вы вытащили параметры из объекта CGI, может работать следующее:

use strict;
use warnings;

my %params = (
    'columns[0][data]'          => 'status',
    'columns[0][name]'          => '',
    'columns[0][searchable]'    => 'true',
    'columns[0][orderable]'     => 'true',
    'columns[0][search][value]' => '',
    'columns[0][search][regex]' => 'false',
    'columns[1][data]'          => 'some',
    'columns[1][name]'          => '',
    'columns[1][searchable]'    => 'true',
    'columns[1][orderable]'     => 'true',
    'columns[1][search][value]' => '',
    'columns[1][search][regex]' => 'false',
    'columns[2][data]'          => 'title',
    'columns[2][name]'          => '',
    'columns[2][searchable]'    => 'true',
    'columns[2][orderable]'     => 'true',
    'columns[2][search][value]' => '',
    'columns[2][search][regex]' => 'false',
);

my @columns;
while (my ($key, $val) = each %params) {
    next if $key !~ /^columns/;
    my @keys = $key =~ /\[(.*?)\]/g;
    my $ref = $columns[shift @keys] ||= {};
    $ref = $ref->{shift @keys} ||= {} while @keys > 1;
    $ref->{$keys[0]} = $val;
}

use Data::Dump;
dd @columns;

Выходы:

(
  {
    data => "status",
    name => "",
    orderable => "true",
    search => { regex => "false", value => "" },
    searchable => "true",
  },
  {
    data => "some",
    name => "",
    orderable => "true",
    search => { regex => "false", value => "" },
    searchable => "true",
  },
  {
    data => "title",
    name => "",
    orderable => "true",
    search => { regex => "false", value => "" },
    searchable => "true",
  },
)
person Miller    schedule 01.06.2014

Вы можете попробовать что-то вроде:

#! /usr/bin/perl

use warnings;
use strict;

my $qs="columns[0][data]=status&columns[0][name]=&columns[0][searchable]=true&columns[0][orderable]=true&columns[0][search][value]=&columns[0][search][regex]=false&columns[1][data]=some&columns[1][name]=&columns[1][searchable]=true&columns[1][orderable]=true&columns[1][search][value]=&columns[1][search][regex]=false&columns[2][data]=title&columns[2][name]=&columns[2][searchable]=true&columns[2][orderable]=true&columns[2][search][value]=&columns[2][search][regex]=false";

my @data=split ("&",$qs);

my @col;

for (@data) {
   my ($val)=/=(.*)$/;
   $_=~s/=.*//;
   my @b=split(/\[(.*?)\]/);
   my @c=@b[grep {$_% 2} 0..$#b];
   if (@c==2) {
      $col[$c[0]]->{$c[1]}=$val;
   } else {
      $col[$c[0]]->{$c[1]}{$c[2]}=$val;
   }
}

или используя eval для более общего решения:

for (@data) {
   my ($val)=/=(.*)$/;
   $_=~s/=.*//;
   my @b=split(/\[(.*?)\]/);
   my @c=@b[grep {$_% 2} 0..$#b];
   my $cmd='$col[$c[0]]->';
   for my $i (1..$#c) {
      $cmd.='{$c['.$i.']}';
   }
   $cmd.='=$val';
   eval ($cmd);
}
person Håkon Hægland    schedule 01.06.2014

person    schedule
comment
Что это за конструкция, где вы назначаете вызов функции (DiveVal() = ...)? - person w.k; 02.06.2014
comment
@w.k: это малоиспользуемая функция, называемая lvalue subs; подпрограмма должна объявить, что ее можно так называть. это особенно полезно в таких случаях, когда подпрограмма создает новый контейнер, который предположительно будет назначен. Есть альтернативный DiveRef, который не является чем-то особенным, и его можно назвать ${ DiveRef( ... ) } = $value. - person ysth; 02.06.2014