Base: Add support for connectors
[videosite.git] / videosite / JSLexArrayParser.pm
index f250d61..9320d03 100644 (file)
@@ -1,9 +1,9 @@
 #
-# A helper class for parsing textual JS hashes into perl 
-# hashes
+# A helper class for parsing textual JSON structures into perl 
+# structures
 #
-# The parser is in jsarray.yp, to regenerate you'll need the Parse::YAPP
-# package. Use 'yapp -m videosite::jsarray -s jsarray.yp' to regenerate
+# The parser is in JSONNospace.yp, to regenerate you'll need the Parse::YAPP
+# package. Use 'yapp -m videosite::JSONNospace -s JSONNospace.yp' to regenerate
 #
 
 package videosite::JSLexArrayParser;
@@ -12,24 +12,38 @@ use videosite::JSArrayParser;
 @ISA = qw(videosite::JSArrayParser);
 
 use Parse::Lex;
-use videosite::jsarray;
+use videosite::JSONNospace;
+use Data::Dumper;
 use strict;
 
 my @tokens = (
-    COLON  => '[:]',
-    RIGHTC => '[\}]',
-    LEFTC => '[\{]',
-    QUOTE => '[\"]',
-    COMMA => '[,]',
-    ID =>    '[\w_%\.\+-]+'
+    COLON => ':',
+    QUOTE => '\"',
+    SINGLEQUOTE => '\\\'',
+    TRUE => 'true',
+    FALSE => 'false',
+    NULL => 'null',
+    QUADHEX => 'u[0-9a-fA-F]{4}',
+    INTEGER => '[0-9]+',
+    QUOTEDNORMAL => '[nr]',
+    SIMPLECHAR => '[-\w\._\?\+=\&\!%<>;\#]+',
+    BACKSLASH => '\\\\',
+    SLASH => '/',
+    COMMA => ',',
+    CURLYOPEN => '{',
+    CURLYCLOSE => '}',
+    SQUAREOPEN => '\[',
+    SQUARECLOSE => '\]',
 );
 
 sub new {
     my $class = shift;
+    my %params = @_;
     my $self = $class->SUPER::new();
 
-    $self->{'_PARSER'} = videosite::jsarray->new();
+    $self->{'_PARSER'} = videosite::JSONNospace->new();
     $self->{'_LEXER'} = Parse::Lex->new(@tokens);
+    $self->{'_PARAMS'} = \%params;
 
     return bless($self, $class);
 }
@@ -37,22 +51,23 @@ sub new {
 sub parse {
     my $self = shift;
     my $s = shift;
-    my @result;
+    my $result;
     my $l = $self->{'_LEXER'};
 
     $l->from($s);
-    @result = $self->{'_PARSER'}->YYParse(
+    $result = $self->{'_PARSER'}->YYParse(
         yylex => sub {
             my $tok = $l->next();
             return ('', undef) unless $tok;
             return ('', undef) if $l->eoi();
+            print STDERR $tok->text(), "\n" if (exists($self->{'_PARAMS'}->{'debug'}) and ($self->{'_PARAMS'}->{'debug'} > 0));
             return ($tok->name(), $tok->text());
         },
         yyerror => sub {
             $_[0]->YYAbort();
         },
-        yydebug => 0x0);
-    return $result[0]?{@{$result[0]}}:undef;
+        yydebug => (exists($self->{'_PARAMS'}->{'debug'})?$self->{'_PARAMS'}->{'debug'}:0x0));
+    return ref($result)?$result->[0]:$result;
 }
 
 1;