parser
author "Tomas Zeman <tzeman@volny.cz>"
Fri, 27 Nov 2009 23:12:41 +0100
changeset 17 d39ff14a8964
parent 9 837e0e828d06
child 18 8d541766cd1f
permissions -rw-r--r--
parser: store result via Storable if requested
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
9
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
     1
#!/usr/bin/perl -w
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
     2
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
     3
use strict;
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
     4
use Parse::RecDescent;
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
     5
use Data::Dumper;
17
d39ff14a8964 parser: store result via Storable if requested
"Tomas Zeman <tzeman@volny.cz>"
parents: 9
diff changeset
     6
use Storable;
9
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
     7
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
     8
my $grammar_file = shift;
17
d39ff14a8964 parser: store result via Storable if requested
"Tomas Zeman <tzeman@volny.cz>"
parents: 9
diff changeset
     9
my $storable = shift; # optional
9
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    10
unless (defined $grammar_file) {
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    11
	print "Usage: $0 grammar_file\n";
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    12
	exit 1;
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    13
}
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    14
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    15
unless (-f $grammar_file) {
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    16
	die "Grammar file $grammar_file does not exit";
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    17
}
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    18
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    19
my $grammar = '';
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    20
{
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    21
	open G, $grammar_file;
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    22
	local $/;
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    23
	$grammar = <G>;
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    24
	close G;
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    25
}
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    26
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    27
# Enable warnings within the Parse::RecDescent module.
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    28
$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    29
$::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    30
$::RD_HINT   = 1; # Give out hints to help fix problems.
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    31
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    32
my $parser = Parse::RecDescent->new($grammar);
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    33
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    34
my $content = '';
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    35
{
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    36
	local $/;
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    37
	$content = <>;
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    38
}
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    39
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    40
$::res = {};
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    41
my $p_res = $parser->file($content);
17
d39ff14a8964 parser: store result via Storable if requested
"Tomas Zeman <tzeman@volny.cz>"
parents: 9
diff changeset
    42
store($::res, $storable) if (defined $storable && length($storable) > 0);
9
837e0e828d06 added generic parser
"Tomas Zeman <tzeman@volny.cz>"
parents:
diff changeset
    43
print Dumper $::res;