+++ /dev/null
-####################################################################
-#
-# This file was generated using Parse::Yapp version 1.05.
-#
-# Don't edit this file, use source file instead.
-#
-# ANY CHANGE MADE HERE WILL BE LOST !
-#
-####################################################################
-package videosite::JSONNospace;
-use vars qw ( @ISA );
-use strict;
-
-@ISA= qw ( Parse::Yapp::Driver );
-#Included Parse/Yapp/Driver.pm file----------------------------------------
-{
-#
-# Module Parse::Yapp::Driver
-#
-# This module is part of the Parse::Yapp package available on your
-# nearest CPAN
-#
-# Any use of this module in a standalone parser make the included
-# text under the same copyright as the Parse::Yapp module itself.
-#
-# This notice should remain unchanged.
-#
-# (c) Copyright 1998-2001 Francois Desarmenien, all rights reserved.
-# (see the pod text in Parse::Yapp module for use and distribution rights)
-#
-
-package Parse::Yapp::Driver;
-
-require 5.004;
-
-use strict;
-
-use vars qw ( $VERSION $COMPATIBLE $FILENAME );
-
-$VERSION = '1.05';
-$COMPATIBLE = '0.07';
-$FILENAME=__FILE__;
-
-use Carp;
-
-#Known parameters, all starting with YY (leading YY will be discarded)
-my(%params)=(YYLEX => 'CODE', 'YYERROR' => 'CODE', YYVERSION => '',
- YYRULES => 'ARRAY', YYSTATES => 'ARRAY', YYDEBUG => '');
-#Mandatory parameters
-my(@params)=('LEX','RULES','STATES');
-
-sub new {
- my($class)=shift;
- my($errst,$nberr,$token,$value,$check,$dotpos);
- my($self)={ ERROR => \&_Error,
- ERRST => \$errst,
- NBERR => \$nberr,
- TOKEN => \$token,
- VALUE => \$value,
- DOTPOS => \$dotpos,
- STACK => [],
- DEBUG => 0,
- CHECK => \$check };
-
- _CheckParams( [], \%params, \@_, $self );
-
- exists($$self{VERSION})
- and $$self{VERSION} < $COMPATIBLE
- and croak "Yapp driver version $VERSION ".
- "incompatible with version $$self{VERSION}:\n".
- "Please recompile parser module.";
-
- ref($class)
- and $class=ref($class);
-
- bless($self,$class);
-}
-
-sub YYParse {
- my($self)=shift;
- my($retval);
-
- _CheckParams( \@params, \%params, \@_, $self );
-
- if($$self{DEBUG}) {
- _DBLoad();
- $retval = eval '$self->_DBParse()';#Do not create stab entry on compile
- $@ and die $@;
- }
- else {
- $retval = $self->_Parse();
- }
- $retval
-}
-
-sub YYData {
- my($self)=shift;
-
- exists($$self{USER})
- or $$self{USER}={};
-
- $$self{USER};
-
-}
-
-sub YYErrok {
- my($self)=shift;
-
- ${$$self{ERRST}}=0;
- undef;
-}
-
-sub YYNberr {
- my($self)=shift;
-
- ${$$self{NBERR}};
-}
-
-sub YYRecovering {
- my($self)=shift;
-
- ${$$self{ERRST}} != 0;
-}
-
-sub YYAbort {
- my($self)=shift;
-
- ${$$self{CHECK}}='ABORT';
- undef;
-}
-
-sub YYAccept {
- my($self)=shift;
-
- ${$$self{CHECK}}='ACCEPT';
- undef;
-}
-
-sub YYError {
- my($self)=shift;
-
- ${$$self{CHECK}}='ERROR';
- undef;
-}
-
-sub YYSemval {
- my($self)=shift;
- my($index)= $_[0] - ${$$self{DOTPOS}} - 1;
-
- $index < 0
- and -$index <= @{$$self{STACK}}
- and return $$self{STACK}[$index][1];
-
- undef; #Invalid index
-}
-
-sub YYCurtok {
- my($self)=shift;
-
- @_
- and ${$$self{TOKEN}}=$_[0];
- ${$$self{TOKEN}};
-}
-
-sub YYCurval {
- my($self)=shift;
-
- @_
- and ${$$self{VALUE}}=$_[0];
- ${$$self{VALUE}};
-}
-
-sub YYExpect {
- my($self)=shift;
-
- keys %{$self->{STATES}[$self->{STACK}[-1][0]]{ACTIONS}}
-}
-
-sub YYLexer {
- my($self)=shift;
-
- $$self{LEX};
-}
-
-
-#################
-# Private stuff #
-#################
-
-
-sub _CheckParams {
- my($mandatory,$checklist,$inarray,$outhash)=@_;
- my($prm,$value);
- my($prmlst)={};
-
- while(($prm,$value)=splice(@$inarray,0,2)) {
- $prm=uc($prm);
- exists($$checklist{$prm})
- or croak("Unknow parameter '$prm'");
- ref($value) eq $$checklist{$prm}
- or croak("Invalid value for parameter '$prm'");
- $prm=unpack('@2A*',$prm);
- $$outhash{$prm}=$value;
- }
- for (@$mandatory) {
- exists($$outhash{$_})
- or croak("Missing mandatory parameter '".lc($_)."'");
- }
-}
-
-sub _Error {
- print "Parse error.\n";
-}
-
-sub _DBLoad {
- {
- no strict 'refs';
-
- exists(${__PACKAGE__.'::'}{_DBParse})#Already loaded ?
- and return;
- }
- my($fname)=__FILE__;
- my(@drv);
- open(DRV,"<$fname") or die "Report this as a BUG: Cannot open $fname";
- while(<DRV>) {
- /^\s*sub\s+_Parse\s*{\s*$/ .. /^\s*}\s*#\s*_Parse\s*$/
- and do {
- s/^#DBG>//;
- push(@drv,$_);
- }
- }
- close(DRV);
-
- $drv[0]=~s/_P/_DBP/;
- eval join('',@drv);
-}
-
-#Note that for loading debugging version of the driver,
-#this file will be parsed from 'sub _Parse' up to '}#_Parse' inclusive.
-#So, DO NOT remove comment at end of sub !!!
-sub _Parse {
- my($self)=shift;
-
- my($rules,$states,$lex,$error)
- = @$self{ 'RULES', 'STATES', 'LEX', 'ERROR' };
- my($errstatus,$nberror,$token,$value,$stack,$check,$dotpos)
- = @$self{ 'ERRST', 'NBERR', 'TOKEN', 'VALUE', 'STACK', 'CHECK', 'DOTPOS' };
-
-#DBG> my($debug)=$$self{DEBUG};
-#DBG> my($dbgerror)=0;
-
-#DBG> my($ShowCurToken) = sub {
-#DBG> my($tok)='>';
-#DBG> for (split('',$$token)) {
-#DBG> $tok.= (ord($_) < 32 or ord($_) > 126)
-#DBG> ? sprintf('<%02X>',ord($_))
-#DBG> : $_;
-#DBG> }
-#DBG> $tok.='<';
-#DBG> };
-
- $$errstatus=0;
- $$nberror=0;
- ($$token,$$value)=(undef,undef);
- @$stack=( [ 0, undef ] );
- $$check='';
-
- while(1) {
- my($actions,$act,$stateno);
-
- $stateno=$$stack[-1][0];
- $actions=$$states[$stateno];
-
-#DBG> print STDERR ('-' x 40),"\n";
-#DBG> $debug & 0x2
-#DBG> and print STDERR "In state $stateno:\n";
-#DBG> $debug & 0x08
-#DBG> and print STDERR "Stack:[".
-#DBG> join(',',map { $$_[0] } @$stack).
-#DBG> "]\n";
-
-
- if (exists($$actions{ACTIONS})) {
-
- defined($$token)
- or do {
- ($$token,$$value)=&$lex($self);
-#DBG> $debug & 0x01
-#DBG> and print STDERR "Need token. Got ".&$ShowCurToken."\n";
- };
-
- $act= exists($$actions{ACTIONS}{$$token})
- ? $$actions{ACTIONS}{$$token}
- : exists($$actions{DEFAULT})
- ? $$actions{DEFAULT}
- : undef;
- }
- else {
- $act=$$actions{DEFAULT};
-#DBG> $debug & 0x01
-#DBG> and print STDERR "Don't need token.\n";
- }
-
- defined($act)
- and do {
-
- $act > 0
- and do { #shift
-
-#DBG> $debug & 0x04
-#DBG> and print STDERR "Shift and go to state $act.\n";
-
- $$errstatus
- and do {
- --$$errstatus;
-
-#DBG> $debug & 0x10
-#DBG> and $dbgerror
-#DBG> and $$errstatus == 0
-#DBG> and do {
-#DBG> print STDERR "**End of Error recovery.\n";
-#DBG> $dbgerror=0;
-#DBG> };
- };
-
-
- push(@$stack,[ $act, $$value ]);
-
- $$token ne '' #Don't eat the eof
- and $$token=$$value=undef;
- next;
- };
-
- #reduce
- my($lhs,$len,$code,@sempar,$semval);
- ($lhs,$len,$code)=@{$$rules[-$act]};
-
-#DBG> $debug & 0x04
-#DBG> and $act
-#DBG> and print STDERR "Reduce using rule ".-$act." ($lhs,$len): ";
-
- $act
- or $self->YYAccept();
-
- $$dotpos=$len;
-
- unpack('A1',$lhs) eq '@' #In line rule
- and do {
- $lhs =~ /^\@[0-9]+\-([0-9]+)$/
- or die "In line rule name '$lhs' ill formed: ".
- "report it as a BUG.\n";
- $$dotpos = $1;
- };
-
- @sempar = $$dotpos
- ? map { $$_[1] } @$stack[ -$$dotpos .. -1 ]
- : ();
-
- $semval = $code ? &$code( $self, @sempar )
- : @sempar ? $sempar[0] : undef;
-
- splice(@$stack,-$len,$len);
-
- $$check eq 'ACCEPT'
- and do {
-
-#DBG> $debug & 0x04
-#DBG> and print STDERR "Accept.\n";
-
- return($semval);
- };
-
- $$check eq 'ABORT'
- and do {
-
-#DBG> $debug & 0x04
-#DBG> and print STDERR "Abort.\n";
-
- return(undef);
-
- };
-
-#DBG> $debug & 0x04
-#DBG> and print STDERR "Back to state $$stack[-1][0], then ";
-
- $$check eq 'ERROR'
- or do {
-#DBG> $debug & 0x04
-#DBG> and print STDERR
-#DBG> "go to state $$states[$$stack[-1][0]]{GOTOS}{$lhs}.\n";
-
-#DBG> $debug & 0x10
-#DBG> and $dbgerror
-#DBG> and $$errstatus == 0
-#DBG> and do {
-#DBG> print STDERR "**End of Error recovery.\n";
-#DBG> $dbgerror=0;
-#DBG> };
-
- push(@$stack,
- [ $$states[$$stack[-1][0]]{GOTOS}{$lhs}, $semval ]);
- $$check='';
- next;
- };
-
-#DBG> $debug & 0x04
-#DBG> and print STDERR "Forced Error recovery.\n";
-
- $$check='';
-
- };
-
- #Error
- $$errstatus
- or do {
-
- $$errstatus = 1;
- &$error($self);
- $$errstatus # if 0, then YYErrok has been called
- or next; # so continue parsing
-
-#DBG> $debug & 0x10
-#DBG> and do {
-#DBG> print STDERR "**Entering Error recovery.\n";
-#DBG> ++$dbgerror;
-#DBG> };
-
- ++$$nberror;
-
- };
-
- $$errstatus == 3 #The next token is not valid: discard it
- and do {
- $$token eq '' # End of input: no hope
- and do {
-#DBG> $debug & 0x10
-#DBG> and print STDERR "**At eof: aborting.\n";
- return(undef);
- };
-
-#DBG> $debug & 0x10
-#DBG> and print STDERR "**Dicard invalid token ".&$ShowCurToken.".\n";
-
- $$token=$$value=undef;
- };
-
- $$errstatus=3;
-
- while( @$stack
- and ( not exists($$states[$$stack[-1][0]]{ACTIONS})
- or not exists($$states[$$stack[-1][0]]{ACTIONS}{error})
- or $$states[$$stack[-1][0]]{ACTIONS}{error} <= 0)) {
-
-#DBG> $debug & 0x10
-#DBG> and print STDERR "**Pop state $$stack[-1][0].\n";
-
- pop(@$stack);
- }
-
- @$stack
- or do {
-
-#DBG> $debug & 0x10
-#DBG> and print STDERR "**No state left on stack: aborting.\n";
-
- return(undef);
- };
-
- #shift the error token
-
-#DBG> $debug & 0x10
-#DBG> and print STDERR "**Shift \$error token and go to state ".
-#DBG> $$states[$$stack[-1][0]]{ACTIONS}{error}.
-#DBG> ".\n";
-
- push(@$stack, [ $$states[$$stack[-1][0]]{ACTIONS}{error}, undef ]);
-
- }
-
- #never reached
- croak("Error in driver logic. Please, report it as a BUG");
-
-}#_Parse
-#DO NOT remove comment
-
-1;
-
-}
-#End of include--------------------------------------------------
-
-
-#line 31 "JSONNospace.yp"
-
-use Encode;
-
-
-sub new {
- my($class)=shift;
- ref($class)
- and $class=ref($class);
-
- my($self)=$class->SUPER::new( yyversion => '1.05',
- yystates =>
-[
- {#State 0
- ACTIONS => {
- 'TRUE' => 1,
- 'FALSE' => 10,
- 'CURLYOPEN' => 2,
- 'SQUAREOPEN' => 11,
- 'QUOTE' => 3
- },
- GOTOS => {
- 'boolean' => 8,
- 'array' => 7,
- 'hash' => 6,
- 'basicstream' => 5,
- 'quotestring' => 9,
- 'basictype' => 4
- }
- },
- {#State 1
- DEFAULT => -7
- },
- {#State 2
- ACTIONS => {
- 'CURLYCLOSE' => 14,
- 'QUOTE' => 3
- },
- GOTOS => {
- 'quotestring' => 15,
- 'kvstream' => 12,
- 'kvpair' => 13
- }
- },
- {#State 3
- ACTIONS => {
- 'INTEGER' => 24,
- 'SIMPLECHAR' => 23,
- 'TRUE' => 16,
- 'NULL' => 17,
- 'COLON' => 18,
- 'COMMA' => 26,
- 'BACKSLASH' => 25,
- 'QUOTE' => 27,
- 'SINGLEQUOTE' => 28,
- 'FALSE' => 20,
- 'SQUARECLOSE' => 30,
- 'SQUAREOPEN' => 33,
- 'U' => 32,
- 'QUOTEDNORMAL' => 31,
- 'QUADHEX' => 21
- },
- GOTOS => {
- 'charstream' => 22,
- 'char' => 29,
- 'escapedchar' => 19
- }
- },
- {#State 4
- DEFAULT => -1
- },
- {#State 5
- ACTIONS => {
- '' => 34,
- 'COMMA' => 35
- }
- },
- {#State 6
- DEFAULT => -3
- },
- {#State 7
- DEFAULT => -4
- },
- {#State 8
- DEFAULT => -6
- },
- {#State 9
- DEFAULT => -5
- },
- {#State 10
- DEFAULT => -8
- },
- {#State 11
- ACTIONS => {
- 'TRUE' => 1,
- 'FALSE' => 10,
- 'SQUARECLOSE' => 37,
- 'CURLYOPEN' => 2,
- 'SQUAREOPEN' => 11,
- 'QUOTE' => 3
- },
- GOTOS => {
- 'basicstream' => 36,
- 'hash' => 6,
- 'array' => 7,
- 'boolean' => 8,
- 'quotestring' => 9,
- 'basictype' => 4
- }
- },
- {#State 12
- ACTIONS => {
- 'CURLYCLOSE' => 38,
- 'COMMA' => 39
- }
- },
- {#State 13
- DEFAULT => -13
- },
- {#State 14
- DEFAULT => -11
- },
- {#State 15
- ACTIONS => {
- 'COLON' => 40
- }
- },
- {#State 16
- DEFAULT => -43
- },
- {#State 17
- DEFAULT => -45
- },
- {#State 18
- DEFAULT => -40
- },
- {#State 19
- DEFAULT => -48
- },
- {#State 20
- DEFAULT => -44
- },
- {#State 21
- DEFAULT => -37
- },
- {#State 22
- ACTIONS => {
- 'SIMPLECHAR' => 23,
- 'INTEGER' => 24,
- 'TRUE' => 16,
- 'NULL' => 17,
- 'COLON' => 18,
- 'BACKSLASH' => 25,
- 'COMMA' => 26,
- 'QUOTE' => 41,
- 'SINGLEQUOTE' => 28,
- 'FALSE' => 20,
- 'SQUARECLOSE' => 30,
- 'QUOTEDNORMAL' => 31,
- 'U' => 32,
- 'SQUAREOPEN' => 33,
- 'QUADHEX' => 21
- },
- GOTOS => {
- 'char' => 42,
- 'escapedchar' => 19
- }
- },
- {#State 23
- DEFAULT => -38
- },
- {#State 24
- DEFAULT => -39
- },
- {#State 25
- ACTIONS => {
- 'BACKSLASH' => 47,
- 'CURLYOPEN' => 44,
- 'SLASH' => 43,
- 'QUOTE' => 48,
- 'CURLYCLOSE' => 45,
- 'SINGLEQUOTE' => 49,
- 'SQUARECLOSE' => 50,
- 'SQUAREOPEN' => 52,
- 'QUADHEX' => 46,
- 'QUOTEDNORMAL' => 51
- }
- },
- {#State 26
- DEFAULT => -41
- },
- {#State 27
- DEFAULT => -21
- },
- {#State 28
- DEFAULT => -42
- },
- {#State 29
- DEFAULT => -23
- },
- {#State 30
- DEFAULT => -47
- },
- {#State 31
- DEFAULT => -35
- },
- {#State 32
- DEFAULT => -36
- },
- {#State 33
- DEFAULT => -46
- },
- {#State 34
- DEFAULT => 0
- },
- {#State 35
- ACTIONS => {
- 'TRUE' => 1,
- 'FALSE' => 10,
- 'CURLYOPEN' => 2,
- 'SQUAREOPEN' => 11,
- 'QUOTE' => 3
- },
- GOTOS => {
- 'hash' => 6,
- 'array' => 7,
- 'boolean' => 8,
- 'quotestring' => 9,
- 'basictype' => 53
- }
- },
- {#State 36
- ACTIONS => {
- 'SQUARECLOSE' => 54,
- 'COMMA' => 35
- }
- },
- {#State 37
- DEFAULT => -9
- },
- {#State 38
- DEFAULT => -12
- },
- {#State 39
- ACTIONS => {
- 'QUOTE' => 3
- },
- GOTOS => {
- 'quotestring' => 15,
- 'kvpair' => 55
- }
- },
- {#State 40
- ACTIONS => {
- 'INTEGER' => 59,
- 'TRUE' => 1,
- 'NULL' => 56,
- 'FALSE' => 10,
- 'CURLYOPEN' => 2,
- 'SQUAREOPEN' => 11,
- 'QUOTE' => 3
- },
- GOTOS => {
- 'hash' => 60,
- 'array' => 58,
- 'boolean' => 57,
- 'quotestring' => 61
- }
- },
- {#State 41
- DEFAULT => -22
- },
- {#State 42
- DEFAULT => -24
- },
- {#State 43
- DEFAULT => -31
- },
- {#State 44
- DEFAULT => -25
- },
- {#State 45
- DEFAULT => -26
- },
- {#State 46
- DEFAULT => -33
- },
- {#State 47
- DEFAULT => -32
- },
- {#State 48
- DEFAULT => -29
- },
- {#State 49
- DEFAULT => -30
- },
- {#State 50
- DEFAULT => -28
- },
- {#State 51
- DEFAULT => -34
- },
- {#State 52
- DEFAULT => -27
- },
- {#State 53
- DEFAULT => -2
- },
- {#State 54
- DEFAULT => -10
- },
- {#State 55
- DEFAULT => -14
- },
- {#State 56
- DEFAULT => -19
- },
- {#State 57
- DEFAULT => -18
- },
- {#State 58
- DEFAULT => -17
- },
- {#State 59
- DEFAULT => -20
- },
- {#State 60
- DEFAULT => -16
- },
- {#State 61
- DEFAULT => -15
- }
-],
- yyrules =>
-[
- [#Rule 0
- '$start', 2, undef
- ],
- [#Rule 1
- 'basicstream', 1,
-sub
-#line 37 "JSONNospace.yp"
-{ return [ $_[1] ] }
- ],
- [#Rule 2
- 'basicstream', 3,
-sub
-#line 38 "JSONNospace.yp"
-{ return [ @{$_[1]}, $_[3] ] }
- ],
- [#Rule 3
- 'basictype', 1, undef
- ],
- [#Rule 4
- 'basictype', 1, undef
- ],
- [#Rule 5
- 'basictype', 1, undef
- ],
- [#Rule 6
- 'basictype', 1, undef
- ],
- [#Rule 7
- 'boolean', 1,
-sub
-#line 47 "JSONNospace.yp"
-{ return 1 }
- ],
- [#Rule 8
- 'boolean', 1,
-sub
-#line 48 "JSONNospace.yp"
-{ return 0 }
- ],
- [#Rule 9
- 'array', 2,
-sub
-#line 51 "JSONNospace.yp"
-{ return [] }
- ],
- [#Rule 10
- 'array', 3,
-sub
-#line 52 "JSONNospace.yp"
-{ return [ @{$_[2]} ] }
- ],
- [#Rule 11
- 'hash', 2,
-sub
-#line 55 "JSONNospace.yp"
-{ return { } }
- ],
- [#Rule 12
- 'hash', 3,
-sub
-#line 56 "JSONNospace.yp"
-{ return { @{$_[2]} } }
- ],
- [#Rule 13
- 'kvstream', 1, undef
- ],
- [#Rule 14
- 'kvstream', 3,
-sub
-#line 60 "JSONNospace.yp"
-{ return [ @{$_[1]}, @{$_[3]} ] }
- ],
- [#Rule 15
- 'kvpair', 3,
-sub
-#line 63 "JSONNospace.yp"
-{ return [ $_[1], $_[3] ] }
- ],
- [#Rule 16
- 'kvpair', 3,
-sub
-#line 64 "JSONNospace.yp"
-{ return [ $_[1], $_[3] ] }
- ],
- [#Rule 17
- 'kvpair', 3,
-sub
-#line 65 "JSONNospace.yp"
-{ return [ $_[1], $_[3] ] }
- ],
- [#Rule 18
- 'kvpair', 3,
-sub
-#line 66 "JSONNospace.yp"
-{ return [ $_[1], $_[3] ] }
- ],
- [#Rule 19
- 'kvpair', 3,
-sub
-#line 67 "JSONNospace.yp"
-{ return [ $_[1], undef ] }
- ],
- [#Rule 20
- 'kvpair', 3,
-sub
-#line 68 "JSONNospace.yp"
-{ return [ $_[1], $_[3] ] }
- ],
- [#Rule 21
- 'quotestring', 2,
-sub
-#line 71 "JSONNospace.yp"
-{ return "" }
- ],
- [#Rule 22
- 'quotestring', 3,
-sub
-#line 72 "JSONNospace.yp"
-{ return $_[2] }
- ],
- [#Rule 23
- 'charstream', 1, undef
- ],
- [#Rule 24
- 'charstream', 2,
-sub
-#line 76 "JSONNospace.yp"
-{ return $_[1] . $_[2] }
- ],
- [#Rule 25
- 'escapedchar', 2,
-sub
-#line 79 "JSONNospace.yp"
-{ return $_[2] }
- ],
- [#Rule 26
- 'escapedchar', 2,
-sub
-#line 80 "JSONNospace.yp"
-{ return $_[2] }
- ],
- [#Rule 27
- 'escapedchar', 2,
-sub
-#line 81 "JSONNospace.yp"
-{ return $_[2] }
- ],
- [#Rule 28
- 'escapedchar', 2,
-sub
-#line 82 "JSONNospace.yp"
-{ return $_[2] }
- ],
- [#Rule 29
- 'escapedchar', 2,
-sub
-#line 83 "JSONNospace.yp"
-{ return $_[2] }
- ],
- [#Rule 30
- 'escapedchar', 2,
-sub
-#line 84 "JSONNospace.yp"
-{ return $_[2] }
- ],
- [#Rule 31
- 'escapedchar', 2,
-sub
-#line 85 "JSONNospace.yp"
-{ return $_[2] }
- ],
- [#Rule 32
- 'escapedchar', 2,
-sub
-#line 86 "JSONNospace.yp"
-{ return $_[2] }
- ],
- [#Rule 33
- 'escapedchar', 2,
-sub
-#line 87 "JSONNospace.yp"
-{ return encode("utf8", pack("U", hex(substr($_[2],1)))) }
- ],
- [#Rule 34
- 'escapedchar', 2,
-sub
-#line 88 "JSONNospace.yp"
-{
- if ($_[2] eq 'n') {
- return "\n";
- } elsif ($_[2] eq 'r') {
- return "\r";
- } else {
- return $_[2];
- }}
- ],
- [#Rule 35
- 'char', 1, undef
- ],
- [#Rule 36
- 'char', 1, undef
- ],
- [#Rule 37
- 'char', 1, undef
- ],
- [#Rule 38
- 'char', 1, undef
- ],
- [#Rule 39
- 'char', 1, undef
- ],
- [#Rule 40
- 'char', 1, undef
- ],
- [#Rule 41
- 'char', 1, undef
- ],
- [#Rule 42
- 'char', 1, undef
- ],
- [#Rule 43
- 'char', 1, undef
- ],
- [#Rule 44
- 'char', 1, undef
- ],
- [#Rule 45
- 'char', 1, undef
- ],
- [#Rule 46
- 'char', 1, undef
- ],
- [#Rule 47
- 'char', 1, undef
- ],
- [#Rule 48
- 'char', 1, undef
- ]
-],
- @_);
- bless($self,$class);
-}
-
-#line 113 "JSONNospace.yp"
-
-
-1;
+++ /dev/null
-/*
- * 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 |
- SQUAREOPEN |
- SQUARECLOSE |
- escapedchar;
-
-%%