Parse JSON-like markup in perl - json

Question

I am not sure what markup this is to be honest, I though at first JSON but using parse_json from JSON::Parse fails with: JSON error at line 2, byte 15/1380740: Unexpected character '{' parsing initial state: expecting whitespace: '\n', '\r', '\t', ' ' at ....
This is what I parse into an hash: https://steamcdn-a.akamaihd.net/apps/730/scripts/items/items_game.d8a302f03758b99ab65b60b3a4a11d73ca4738bd.txt.
What I tried:
use strict;
use warnings;
use LWP::UserAgent;
use JSON::Parse 'parse_json';
my $ua = LWP::UserAgent->new;
my $response = $ua->get( "https://steamcdn-a.akamaihd.net/apps/730/scripts/items/items_game.d8a302f03758b99ab65b60b3a4a11d73ca4738bd.txt" );
if ( $response->is_success ) {
my $game_items = parse_json( $response->content );
# ... do stuff
}
Am I doing something wrong? Is this JSON or must I create some hack-ish solution to parse this?
I could not find any suggestions through the "Questions that may already have your answer" section though I think it would be easier if I knew the name of this markup.

Answer 1

This will process your data, It's a bit hacky but it does the job!
use strict;
use warnings;
use autodie;
use Data::Dump;
use LWP::Simple qw/ mirror /;
use constant URL => 'https://steamcdn-a.akamaihd.net/apps/730/scripts/items/items_game.d8a302f03758b99ab65b60b3a4a11d73ca4738bd.txt';
use constant MIRROR => 'steamcdn.txt';
my $data = do {
mirror URL, MIRROR;
open my $fh, '<', MIRROR;
local $/;
<$fh>;
};
my ($hash, $key);
my #stack;
while ( ) {
if ( $data =~ / \G \s* " ([^"]*) " /gcx ) {
if ( defined $key ) {
$hash->{$key} = $1;
$key = undef;
}
else {
$key = $1;
}
}
elsif ( $data =~ / \G \s* \{ /gcx ) {
push #stack, [ $hash, $key ];
$key = $hash = undef;
}
elsif ( $data =~ / \G \s* \} /gcx ) {
die "Structure unbalanced" if defined $key or #stack == 0;
my ($parent, $key) = #{ pop #stack };
$parent->{$key} = $hash;
$hash = $parent;
}
else {
last;
}
}
die "Structure unbalanced" if #stack;
dd $hash;
output
{
items_game => {
alternate_icons2 => {
weapon_icons => {
65604 => {
icon_path => "econ/default_generated/weapon_deagle_hy_ddpat_urb_light",
},
65605 => {
icon_path => "econ/default_generated/weapon_deagle_hy_ddpat_urb_medium",
},
65606 => {
icon_path => "econ/default_generated/weapon_deagle_hy_ddpat_urb_heavy",
},
65684 => {
icon_path => "econ/default_generated/weapon_deagle_aa_flames_light",
},
65685 => {
icon_path => "econ/default_generated/weapon_deagle_aa_flames_medium",
},
65686 => {
icon_path => "econ/default_generated/weapon_deagle_aa_flames_heavy",
},
65696 => {
icon_path => "econ/default_generated/weapon_deagle_so_night_light",
},
65697 => {
icon_path => "econ/default_generated/weapon_deagle_so_night_medium",
},
65698 => {
icon_path => "econ/default_generated/weapon_deagle_so_night_heavy",
},
65780 => {
icon_path => "econ/default_generated/weapon_deagle_aa_vertigo_light",
},
65781 => {
icon_path => "econ/default_generated/weapon_deagle_aa_vertigo_medium",
},
65782 => {
icon_path => "econ/default_generated/weapon_deagle_aa_vertigo_heavy",
},
65896 => {
icon_path => "econ/default_generated/weapon_deagle_hy_mottled_sand_light",
},
65897 => {
icon_path => "econ/default_generated/weapon_deagle_hy_mottled_sand_medium",
},
65898 => {
icon_path => "econ/default_generated/weapon_deagle_hy_mottled_sand_heavy",
},
66276 => {
icon_path => "econ/default_generated/weapon_deagle_am_scales_bravo_light",
},
66277 => {
icon_path => "econ/default_generated/weapon_deagle_am_scales_bravo_medium",
},
66278 => {

Answer 2

my $file = do { local $/; <> };
my #stack = [];
my %handlers = (
'"' => sub {
/\G ([^"]*) " /xgc
or die("Unterminated \"\n");
push(#{ $stack[-1] }, $1);
},
'{' => sub {
die("Expected string\n") if #{ $stack[-1] } % 2 == 0;
push(#stack, []);
},
'}' => sub {
die("Unmatched \"}\"\n") if #stack == 1;
my $hash = pop(#stack);
die("Missing value\n") if #$hash % 2 == 1;
push(#{ $stack[-1] }, { #$hash });
},
);
my $data;
for ($file) {
while (1) {
my $next_char = /\G \s* (\S) /gcx ? $1 : last;
my $handler = $handlers{$next_char}
or die("Unrecognized character \"$next_char\"\n");
$handler->();
}
die("Unmatched \"{\"\n") if #stack > 1;
my $hash = pop(#stack);
die("Missing value\n") if #$hash % 2 == 1;
$data = { #$hash };
}
Aside from a simpler stack than Borodin's and the use of a dispatch table instead of a long sequence of "if", this version provides proper error detection. This will detect truncated documents as well as unsupported features.