my $testData = <<'_EOGTESTA_';
RECORD
#input_id 1210758171x001_0013
#output_id
#input_type PTC
#output_type PTC
#addkey
#source_id 01
#filename TTFILE01-0001-20080101000000
F ptc_record_length 00B6
F ptc_record_type
B firstBlock
F ptc_charging_end_time 20080604093721
F ptc_called_msrn_ton FF
.
F ptc_term_mcz_duration 060000
F ptc_term_mcz_change_direction
.
_EOGTESTA_
####
#!/usr/bin/perl -w
use strict;
use Parse::RecDescent;
use Data::Dumper;
# Enable warnings within the Parse::RecDescent module.
$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
$::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c.
$::RD_HINT = 1; # Give out hints to help fix problems.
my $grammar = <<'_EOGRAMMAR_';
RECORDSTART : /RECORD/
{ print "\n[*] RECORDSTART"; }
RECORDEND : /^\.$/
{ print '\n[*] RECORDEND'; }
fieldName : /[^ \t]+/
{ print "\n[*] fieldName\n" }
metaName : /[^ \t]+/
{ print "\n[*] metaName\n" }
# metaFieldValue: /^\.$/
# fieldValue: /^\.$/
# blockName : /^\.$/
# metaFieldValue: /.*$/
# fieldValue: /.*$/
# blockName : /.*$/
metaFieldValue: /.*/
{ print "\n[*] metaFieldValue\n" }
fieldValue: /.*/
{ print "\n[*] fieldValue\n" }
blockName : /.*/
{ print "\n[*] blockName\n" }
metaField : #/#/ metaName /[ \t]+/ metaFieldValue
/#/ metaName metaFieldValue
{ print "\n[*] Got metafield named $metaName" . $item{ metaName } . ' with value ' . $item{ metaFieldValue } . "\n" }
field : /^F[ \t]+/ fieldName /[ \t]+/ fieldValue
{ print '\n[*] Got field named ' . $item{ fieldName } . ' with value ' . $item{ fieldValue } . '\n' }
block : /^B/ blockName
{ print '\n[*] Got block named ' . $item{ blockName } . ' with value ' . ':-P' . '\n' }
recordBody : field(s)
{ print '\n[*] field(s)\n' }
|
block(s)
{ print '\n[*] block(s)\n' }
|
metaField(s)
{ print '\n[*] metaField(s)\n' }
#startOfRecord: RECORDSTART recordBody(s /$/) RECORDEND
startOfRecord: RECORDSTART recordBody RECORDEND
|
_EOGRAMMAR_
#$skeletonPattern = "#input_type[ \t]*";
#my $metaFieldPattern = qr/[ \t]*#([^ \t]+)[ \t]+(.*)/o; # "#input_type SCDR+", "#filename processed_01_20080616001403.cdr", etc
#my $normalFieldPattern = qr/([ \t]*)([0-9]*)F[ \t]+([^ \t]+)[ \t]+([^ \t\r\n]+)(.*)/; # "1F S_Diagnostic1 62" OR " F S_Diagnostic1 62" OR " F S_Diagnostic1 62" are synonymous, etc
print $testData, "\n\n";
my $parser = Parse::RecDescent->new($grammar);
$parser->startOfRecord($testData) or die "Bad input!\n";
##
##
Variable "$errorprefix" is not available at C:/cpanfly/var/megalib/Parse/RecDescent.pm line 2906.
Use of uninitialized value $errorprefix in formline at C:/cpanfly/var/megalib/Parse/RecDescent.pm line 2850.