# # parseRecordLabel.yp # # # # Parse::Yapp grammar file. Used to create parser for the record node # labels # %token <i> T_string %left '{' %% rlabel : field optMoreFields { shift; my ($arg1, $arg2) = @_; my (@arg1, @arg2); # flatten any args if( ref($arg1) eq 'ARRAY' ){ @arg1 = @$arg1; } else{ @arg1 = ($arg1); } if( ref($arg2) eq 'ARRAY' ){ @arg2 = @$arg2; } elsif(defined($arg2)){ @arg2 = ($arg2); } return [ @arg1, @arg2 ]; } | /* empty */ ; optMoreFields : '|' rlabel { #print "rlabel = ".Data::Dumper::Dumper($_[2])." in optMoreFields\n"; return $_[2]; } | /* empty */ ; field : boxlabel { return $_[1]; } | '{' rlabel '}' { return $_[2]; } ; boxlabel : optName T_string { return { $_[1] || '', $_[2] } ; } ; optName : '<' T_string '>' { return $_[2] } | /* empty */ ; %% sub Error { my $parse = shift; my($token)=$parse->YYCurtok; my($value)=$parse->YYCurval; my($expected)=$parse->YYExpect; my $input = $parse->YYData->{INPUT}; # Get rid of all but the first line ($input) = split("\n",$input); print "Parse Error, Got token/value '$token', '$value'; Expected token '$expected'\n"; print "Near line :\n".$input."\n"; exit(1); } sub Lexer { my($parser)=shift; my @expect = $parser->YYExpect; # If at the end of the string, and expecting a T_string token # Return a null t_string # This enables strings like '<f0> 0x10ba8| <f1>' to be parsed # correctly if( $parser->YYData->{INPUT} eq '' && @expect == 1 && $expect[0] eq 'T_string'){ return('T_string',''); } defined($parser->YYData->{INPUT}) or return('',undef); for( $parser->YYData->{INPUT}){ # Differnt Token Types # check for tokens '<>{} tokens (Whitespace OK) if( s/^\s*([\<\>\{])//){ # <, > and { with whitespace before return($1, $1); } if( s/^(\})\s*//){ # } with whitespace after return($1, $1); } if( s/^(\|)//){ # | with no whitespace return($1, $1); } # T_string s/^(.*?)((?<!\\)[\>\{\|\}])/$2/s # strings with embedded special characters (not backslashed) and return('T_string',$1); # End of string, return everything s/(.+)//s and return ('T_string', $1); # Other stuff s/^(.)//s and return($1,$1); return('',''); } }