in reply to Find a Position and Insert Text

Because I'm sick of trying to solve my own problems. :P

#!/usr/bin/env perl use strictures; use JSON; use Data::Dump "dump"; use Test::More; my $in = decode_json '{"OWNER":"KeyProjects","Region":"Southern","Dist +rict":"Arid","PLANTNO":"Sunset View","COMPT":"A08","age1":null,"ht1": +null,"age2":null,"ht2":null,"age3":null,"ht3":null,"age4":null,"ht4": +null,"age5":null,"ht5":null,"age6":null,"ht6":null,"age1":null,"ht1": +null,"age2":null,"ht2":null,"age3":null,"ht3":null,"age4":null,"ht4": +null,"age5":null,"ht5":null,"age6":null,"ht6":null,"wc":"EF1"}'; my $out = decode_json '{"OWNER":"KeyProjects","Region":"Southern","Dis +trict":"Arid","PLANTNO":"Sunset View","COMPT":"A08","scheduled":{"age +1":null,"ht1":null,"age2":null,"ht2":null,"age3":null,"ht3":null,"age +4":null,"ht4":null,"age5":null,"ht5":null,"age6":null,"ht6":null},"co +mpleted":{"age1":null,"ht1":null,"age2":null,"ht2":null,"age3":null," +ht3":null,"age4":null,"ht4":null,"age5":null,"ht5":null,"age6":null," +ht6":null},"wc":"EF1"}'; my $planned = qr/\A (?: age\d+ | ht\d+ ) \z/x; my $corrected = $in; for my $key ( keys %{$corrected} ) { if ( $key =~ $planned ) { $corrected->{completed}{$key} = $corrected->{scheduled}{$key} += delete $corrected->{$key}; } } # print dump $in; is_deeply $out, $corrected, "Corrected data matches expectations"; diag encode_json $corrected; done_testing();

Replies are listed 'Best First'.
Re^2: Find a Position and Insert Text
by jlb333333 (Novice) on Mar 16, 2016 at 18:32 UTC

    Thank you for your reply and code.

    This is just way too advanced for me at present.

    I am still learning Perl etc.

    John

      I totally understand. I remember the same boat quite well. That said, the solution, or at least its style, I gave is the only sane way to approach your problem and by far the easiest. Regular expressions can indeed move mountains but it's much harder than you're thinking and for your problem I doubt you (or anyone for that matter) would ever arrive at anything that worked except in the most trivial and inflexible case.

      My code was idiomatic but it is easy and straightforward once you can follow it. It's also robust whereas a regex solution will never be. I'll adapt the code a bit to make it more clear and walk you through it. <readmore/> away…

      Have fun, HTH, TTFN, etc. :P

      Further Reading

      Update: </c></c> fixed.

        In the original data, age1 occurs two times (with potentially two different values), while in your approach, both entries will share the same value. I don't know if that is important for the OP though.

        Thank you for your time and effort with your reply

        I really appreciate it.

        Below is just your code with some comments/questions etc.

        Would appreciate your comments at some stage.

        I am really still learning Perl.

        use warnings; use strict; use JSON; use Data::Dumper; my $original = '{"OWNER":"KeyProjects","age1":null,"ht1":null}';

        #Literal entry.

        my $desired  = '{"OWNER":"KeyProjects","scheduled":{"age1":null,"ht1":null}}';

        #Literal entry.

        my $data = decode_json($original); print Dumper $original; print Dumper $desired; print Dumper $data; for my $key ( keys % {$data} )

        #Converts $data into a hash and cycles through it.

        { print "Found a key: $key", $/; if ( $key =~ /\A (?: age\d+ | ht\d+ ) \z/x ) { print " -> It matches our regular expression\n"; print " -> Deleting it from data structure\n"; my $value = delete $data->{$key};

        #Does this delete the pair, the value, or what? See below.

        print Dumper $key;

        #Looks like nothing is deleted.

        print Dumper $value;

        #Looks like nothing is deleted.

        print " -> Putting it back under sub-structure with key 'sche +duled'\n"; $data->{scheduled}{$key} = $value;

        #I should understand this step but I don't really know what each aspect of this line is doing.

        print Dumper $key; print Dumper $value; print Dumper $data; } else { print " -> It's fine where it is, no action taken\n"; print Dumper $key; print Dumper $data; } } print encode_json( $data ), $/; use Test::More; my $desired_data = decode_json( $desired ); is_deeply( $desired_data, $data, "Data structures match" ); done_testing(1);