view release on metacpan or  search on metacpan

t/samples/perlmonks.html  view on Meta::CPAN

    {
        foo => '1foo'
    }
]
</tt></div><div class='embed-code-dl'><a href="?abspart=1;displaytype=displaycode;node_id=1105074;part=1">&#91;download&#93;</a></div></pre>


<p>The data is parsed by splitting the key into its individual components then running them through Data::Diver. The problem is I sometimes need to add data into the middle of the dataset and as a result have to increment index components within keys...

<pre class="code"><div class='codeblock'><tt class='codetext'>&gt;.foo.bar = 0foobar
&lt;.foo.baz = 0foobaz
&gt;.foo     = 1foo
</tt></div><div class='embed-code-dl'><a href="?abspart=1;displaytype=displaycode;node_id=1105074;part=2">&#91;download&#93;</a></div></pre>


<p>Where '>' means "next index // 0" and '&lt;' means "last index // 0", within scope of the dimension. I wrote the following demo:</p> 

<pre class="code"><div class='codeblock'><tt class='codetext'>use strict;
use warnings;
use Data::Diver  qw#DiveVal DiveError#;
use Data::Dumper qw#Dumper#;

$/ = qq#\r\n#;

my $state = { };
my $ref   = undef;

while ( my $line = &lt;DATA&gt; )
{
    next if ( $line =~ qr#^(\#|\s*$)# ); # ignore line if comment or b<span class="line-breaker">
<font color="red">+</font></span>lank.
    
    chomp $line; # remove newline.
    
    my ( $selector, $value ) = split qr#\s*=\s*#, $line; # (selector)=<span class="line-breaker">
<font color="red">+</font></span>(value). todo: unless escaped.
    
    next if ( not defined $selector ); # ignore line if no selector.
    
    my @selector = split qr#\.#, $selector; # (one).(two).(three)... t<span class="line-breaker">
<font color="red">+</font></span>odo: unless escaped.
    
    $ref //= ( $selector&#91;0&#93; =~ qr#^(&#91;&gt;&lt;&#93;|\d+)$# ) ? &#91; &#93; : { } ;

    _dive( $ref, \@selector, $value );
}

print Dumper $state, $ref;

sub _dive
{
    my ( $ref, $selector, $value ) = @_;
    
    return if ( not defined $ref or not defined $selector or not scala<span class="line-breaker">
<font color="red">+</font></span>r @$selector ); # return if no ref or no selectees.
    
    my @selector_b = qw##;
   
    for my $selectee ( @$selector )
    {
        if ( $selectee =~ qr#^(&#91;&gt;&lt;&#93;)$# ) # if incognito selectee. todo<span class="line-breaker">
<font color="red">+</font></span>: unless escaped.
        {
            my $selector_b = join q#.#, @selector_b;
            
            if ( $1 eq q#&gt;# ) # incognito selectee is of increment typ<span class="line-breaker">
<font color="red">+</font></span>e.
            {
                if ( defined $state-&gt;{$selector_b} ) # we have seen th<span class="line-breaker">
<font color="red">+</font></span>is state before.
                {
                    push @selector_b, $state-&gt;{$selector_b} += 1; # pu<span class="line-breaker">
<font color="red">+</font></span>sh current index + 1.
                }
                else
                {
                    push @selector_b, $state-&gt;{$selector_b} = 0; # pus<span class="line-breaker">
<font color="red">+</font></span>h 0 (first) index.
                }
            }
            elsif ( $1 eq q#&lt;# ) # incognito selectee is of maintain t<span class="line-breaker">
<font color="red">+</font></span>ype.
            {
                push @selector_b, $state-&gt;{$selector_b} //= 0; # push <span class="line-breaker">
<font color="red">+</font></span>current index or 0 (first) index.
            }
        }
        else # else non inconito selectee.
        {
            push @selector_b, $selectee; # push selectee.
        }
    }
    
    DiveVal( $ref, @selector_b ) = $value;
    my ( $error ) = DiveError( );
    $error and warn $error;
    
    return 1;
}

__DATA__

&gt;.name          = john
&lt;.location      = uk
&lt;.interests.&gt;   = programming
&lt;.interests.&gt;   = cycling

&gt;.name          = laura
&lt;.location      = 
&lt;.interests.&gt;   = knitting
&lt;.interests.&gt;   = tennis
&lt;.interests.&gt;   = dancing

&gt;.name
&lt;.location      = canada
&lt;.interests.&gt;.&gt; = dogs
&lt;.interests.&lt;.&gt; = horses
&lt;.interests.&gt;   = cars

# test.error = blah
</tt></div><div class='embed-code-dl'><a href="?abspart=1;displaytype=displaycode;node_id=1105074;part=3">&#91;download&#93;</a></div></pre>


<p>Output:</p>

<pre class="code"><div class='codeblock'><tt class='codetext'>$VAR1 = {
          &#39;2.interests&#39; =&gt; 1,
          &#39;&#39; =&gt; 2,
          &#39;2.interests.0&#39; =&gt; 1,
          &#39;0.interests&#39; =&gt; 1,
          &#39;1.interests&#39; =&gt; 2
        };
$VAR2 = &#91;
          {
            &#39;interests&#39; =&gt; &#91;
                           &#39;programming&#39;,
                           &#39;cycling&#39;
                         &#93;,
            &#39;location&#39; =&gt; &#39;uk&#39;,
            &#39;name&#39; =&gt; &#39;john&#39;
          },