+/*
+ * This file contains a simple and quite possible wrong parser for
+ * JSON encoded structures.
+ *
+ * It does not support white space in quoted strings, those are silently
+ * dropped.
+ *
+ * It has primarily been written to parse video parameters from the
+ * DailyMotion site
+ *
+ * Token definitions:
+ * COLON => ':',
+ * QUOTE => '\"',
+ * SINGLEQUOTE => '\\\'',
+ * TRUE => 'true',
+ * FALSE => 'false',
+ * NULL => 'null',
+ * QUADHEX => 'u[0-9a-fA-F]{4}',
+ * INTEGER => '[0-9]+',
+ * QUOTEDNORMAL => '[nr]',
+ * SIMPLECHAR => '[-a-zA-Z\._\?\+=\&\!%<>]+',
+ * BACKSLASH => '\\\\',
+ * SLASH => '/',
+ * COMMA => ',',
+ * CURLYOPEN => '{',
+ * CURLYCLOSE => '}',
+ * SQUAREOPEN => '\[',
+ * SQUARECLOSE => '\]',
+ */
+
+%{
+use Encode;
+%}
+%%
+
+basicstream:
+ basictype { return [ $_[1] ] } |
+ basicstream COMMA basictype { return [ @{$_[1]}, $_[3] ] };
+
+basictype:
+ hash |
+ array |
+ quotestring |
+ boolean;
+
+boolean:
+ TRUE { return 1 } |
+ FALSE { return 0 };
+
+array:
+ SQUAREOPEN SQUARECLOSE { return [] } |
+ SQUAREOPEN basicstream SQUARECLOSE { return [ @{$_[2]} ] };
+
+hash:
+ CURLYOPEN CURLYCLOSE { return { } } |
+ CURLYOPEN kvstream CURLYCLOSE { return { @{$_[2]} } };
+
+kvstream:
+ kvpair |
+ kvstream COMMA kvpair { return [ @{$_[1]}, @{$_[3]} ] };
+
+kvpair:
+ quotestring COLON quotestring { return [ $_[1], $_[3] ] } |
+ quotestring COLON hash { return [ $_[1], $_[3] ] } |
+ quotestring COLON array { return [ $_[1], $_[3] ] } |
+ quotestring COLON boolean { return [ $_[1], $_[3] ] } |
+ quotestring COLON NULL { return [ $_[1], undef ] } |
+ quotestring COLON INTEGER { return [ $_[1], $_[3] ] };
+
+quotestring:
+ QUOTE QUOTE { return "" } |
+ QUOTE charstream QUOTE { return $_[2] };
+
+charstream:
+ char |
+ charstream char { return $_[1] . $_[2] };
+
+escapedchar:
+ BACKSLASH CURLYOPEN { return $_[2] } |
+ BACKSLASH CURLYCLOSE { return $_[2] } |
+ BACKSLASH SQUAREOPEN { return $_[2] } |
+ BACKSLASH SQUARECLOSE { return $_[2] } |
+ BACKSLASH QUOTE { return $_[2] } |
+ BACKSLASH SINGLEQUOTE { return $_[2] } |
+ BACKSLASH SLASH { return $_[2] } |
+ BACKSLASH BACKSLASH { return $_[2] } |
+ BACKSLASH QUADHEX { return encode("utf8", pack("U", hex(substr($_[2],1)))) } |
+ BACKSLASH QUOTEDNORMAL {
+ if ($_[2] eq 'n') {
+ return "\n";
+ } elsif ($_[2] eq 'r') {
+ return "\r";
+ } else {
+ return $_[2];
+ }};
+
+char:
+ QUOTEDNORMAL |
+ U |
+ QUADHEX |
+ SIMPLECHAR |
+ INTEGER |
+ COLON |
+ COMMA |
+ SINGLEQUOTE |
+ TRUE |
+ FALSE |
+ NULL |
+ escapedchar;
+
+%%