projekt kivitendo

use Exporter qw(import);

our @EXPORT_OK = qw(flatten unflatten read_cgi_input);

sub _store_value {

  my @tokens = split /((?:\[\+?\])?(?:\.)|(?:\[\+?\]))/, $key;

    $curr = \ $$curr->[$#$$curr], next   if $sep eq '[]' && @tokens;

    $curr = \ $$curr->[++$#$$curr], next if $sep eq '[]' && !@tokens;

    $curr = \ $$curr->[++$#$$curr], next if $sep eq '[+]';

sub flatten {

  my ($source, $target, $prefix, $in_array) = @_;

  $target ||= [];

  # there are two edge cases that need attention. first: more than one hash

  # inside an array.  only the first of each nested can have a [+].  second: if

  # an array contains mixed values _store_value will rely on autovivification.

  # so any type change must have a [+]

  # this closure decides one recursion step AFTER an array has been found if a

  # [+] needs to be generated

  my $arr_prefix = sub {

    return $_[0] ? '[+]' : '[]' if $in_array;

    return '';

  };

  for (ref $source) {

    /^HASH$/ && do {

      my $first = 1;

      for my $key (keys %$source) {

        flatten($source->{$key} => $target, (defined $prefix ? $prefix . $arr_prefix->($first) . '.' : '') . $key);

        $first = 0;

      };

      next;

    };

    /^ARRAY$/ && do {

      for my $i (0 .. $#$source) {

        flatten($source->[$i] => $target, $prefix . $arr_prefix->($i == 0), '1');

      }

      next;

    };

    !$_ && do {

      die "can't flatten a pure scalar" unless defined $prefix;

      push @$target, [ $prefix . $arr_prefix->(0) => $source ];

      next;

    };

    die "unrecognized reference of a data structure $_. cannot serialize refs, globs and code yet. to serialize Form please use the method there";

  }

  return $target;

}

sub unflatten {

  my ($data, $target) = @_;

  $target ||= {};

  for my $pair (@$data) {

    _store_value($target, @$pair) if defined $pair->[0];

  }

  return $target;

}

SL::Request.pm - request parsing and data serialization

This module handles unpacking of cgi parameters. usually you don't want to call

anything in here directly.

  use SL::Request qw(read_cgi_input);

  # read cgi input depending on request type, unflatten and recode

  read_cgi_input($target_hash_ref);

  # $hashref and $new_hashref should be identical

  my $new_arrayref = flatten($hashref);

  my $new_hashref  = unflatten($new_arrayref);

=head1 DESCRIPTION

This module handles flattening and unflattening of data for request

roundtrip purposes. Lx-Office uses the format as described below:

=over 4

=item Hashes

Hash entries will be connected with a dot (C<.>). A simple hash like this

  order => {

    item     => 2,

    customer => 5

  }

will be serialized to

  [ order.item     => 2 ],

  [ order.customer => 5 ],

=item Arrays

Arrays will by trailing empty brackets (C<[]>). An hash like this

  selected_id => [ 2, 6, 8, 9 ]

will be flattened to

  [ selected_id[] => 2 ],

  [ selected_id[] => 6 ],

  [ selected_id[] => 8 ],

  [ selected_id[] => 9 ],

Since this will produce identical keys, the resulting flattened list can not be

used as a hash. It is however very easy to use this in a template to generate

input:

  [% FOREACH id = selected_ids %]

    <input type="hidden" name="selected_id[]" value="[% id | html %]">

  [% END %]

=item Nested structures

A special version of this are nested hashs in an array, which is very common.

The combined operator (C<[].>) will be used. As a special case, every time a new

array slice is started, the special convention (C<[+].>) will be used. Again this

is because it's easy to write a template with it.

So this

  order => {

    orderitems => [

      {

        id   => 1,

        part => 15

      },

      {

        id   => 2,

        part => 7

      },

    ]

  }

will be

  [ order.orderitems[+].id  => 1  ],

  [ order.orderitems[].part => 15 ],

  [ order.orderitems[+].id  => 2  ],

  [ order.orderitems[].part => 7  ],

=item Limitations

  The format currently does have certain limitations when compared to other

  serialization formats.

=over 4

=item Order

The order of serialized values matters to reconstruct arrays properly. This

should rarely be a problem if you just flatten and dump into a url or a field

of hiddens.

=item Empty Keys

The current implementation of flatten does produce correct serialization of

empty keys, but unflatten is unable to resolve these. Do no use C<''> or

C<undef> as keys. C<0> is fine.

=item Key Escaping

You cannot use the tokens C<[]>, C<[+]> and C<.> in keys. No way around it.

=item Sparse Arrays

It is not possible to serialize somehing like

  sparse_array => do { my $sa = []; $sa[100] = 1; $sa },

This is a feature, as perl doesn't do well with very large arrays.

=item Recursion

There is currently no support nor prevention for flattening a circular structure.

=item Custom Delimiter

No support for other delimiters, sorry.

=item Other References

No support for globs, scalar refs, code refs, filehandles and the like. These will die.

=back

=back

=head1 FUNCTIONS

=over 4

=item C<flatten HASHREF [ ARRAYREF ]>

This function will flatten the provided hash ref into the provided array ref.

The array ref may be non empty, but will be changed in this case.

Return value is the flattened array ref.

=item C<unflatten ARRAYREF [ HASHREF ]>

This function will parse the array ref, and will store the contents into the hash ref. The hash ref may be non empty, in this case any new keys will override the old ones only on leafs with same type. Type changes on a node will die.

=back

  _store_value($target, $key, $value);

use Test::More;

use Test::Deep;

use Data::Dumper;

use_ok 'SL::Request', qw(flatten unflatten);

use constant DEBUG => 0;

sub f ($$$) {

  my $flat = flatten($_[0]);

  print Dumper($flat) if DEBUG;

  my $unflat = unflatten($flat);

  print Dumper($unflat) if DEBUG;

  cmp_deeply($flat, $_[1], $_[2]);

  cmp_deeply($unflat, $_[0], $_[2]);

}

f {

  test => 1,

  whut => 2

},

[

  [ test => 1 ],

  [ whut => 2 ],

], 'simple case';

f { a => { b => 2 } },

[

 [ 'a.b' => 2 ]

], 'simple hash nesting';

f { a => [ 2,  4 ] },

[

 [  'a[]' => 2 ],

 [  'a[]' => 4 ],

], 'simple array';

f { a => [ { c => 1, d => 2 }, { c => 3, d => 4 }, ] },

[

  [ 'a[+].c', 1 ],

  [ 'a[].d', 2 ],

  [ 'a[+].c', 3 ],

  [ 'a[].d', 4  ],

], 'array of hashes';

# tests from Hash::Flatten below

f {

  'x' => 1,

  'y' => {

    'a' => 2,

    'b' => {

      'p' => 3,

      'q' => 4

    },

  }

}, bag(

 [ 'x'     => 1, ],

 [ 'y.a'   => 2, ],

 [ 'y.b.p' => 3, ],

 [ 'y.b.q' => 4  ],

), 'Hash::Flatten 1';

f {

  'x' => 1,

  '0' => {

    '1' => 2,

  },

  'a' => [1,2,3],

},

bag (

 ['x'    => 1, ],

 ['0.1'  => 2, ],

 ['a[]'  => 1, ],

 ['a[]'  => 2, ],

 ['a[]'  => 3, ],

), 'Hash::Flatten 2 - weird keys and values';

f {

  'x' => 1,

  'ay' => {

    'a' => 2,

    'b' => {

      'p' => 3,

      'q' => 4

    },

  },

  'y' => [

    'a', 2,

    {

      'baz' => 'bum',

    },

  ]

},

bag(

  [ 'ay.b.p'  => 3,       ],

  [ 'ay.b.q'  => 4,       ],

  [ 'ay.a'    => 2,       ],

  [ 'x'       => 1,       ],

  [ 'y[]'     => 'a',    ],

  [ 'y[]'     => 2        ],

  [ 'y[+].baz' => 'bum',  ],

), 'Hash::Flatten 3 - mixed';

f {

  'x' => 1,

  'y' => [

    [

      'a', 'fool', 'is',

    ],

    [

      'easily', [ 'parted', 'from' ], 'his'

    ],

    'money',

  ]

},

bag(

 [ 'x'        => 1,        ],

 [ 'y[][]'    => 'his',    ],

 [ 'y[][+][]' => 'parted', ],

 [ 'y[][][]'  => 'from',   ],

 [ 'y[+][]'   => 'a',      ],

 [ 'y[+][]'   => 'easily', ],

 [ 'y[][]'    => 'fool',   ],

 [ 'y[][]'    => 'is'      ],

 [ 'y[]'      => 'money',  ],

), 'Hash::Flatten 4 - array nesting';

f {

  'x' => 1,

  'ay' => {

    'a' => 2,

    'b' => {

      'p' => 3,

      'q' => 4

    },

  },

  's' => 'hey',

  'y' => [

    'a', 2, {

      'baz' => 'bum',

    },

  ]

},

bag(

  [ 'x'        => 1,     ],

  [ 's'        => 'hey', ],

  [ 'ay.a'     => 2,     ],

  [ 'y[+].baz' => 'bum', ],

  [ 'ay.b.p'   => 3,     ],

  [ 'y[]'      => 'a',   ],

  [ 'ay.b.q'   => 4,     ],

  [ 'y[]'      => 2      ],

), 'Hash::Flatten 5 - deep mix';

done_testing();