| author | Tomas Zeman <tzeman@volny.cz> |
| Tue, 21 Aug 2012 13:34:19 +0200 | |
| changeset 43 | 597596f302ef |
| parent 35 | 5a18e00f9ba1 |
| permissions | -rw-r--r-- |
| 9 | 1 |
#!/usr/bin/perl -w |
2 |
||
| 18 | 3 |
# Copyright (c) 2009, Tomas Zeman <tzeman@volny.cz> |
4 |
# All rights reserved. |
|
5 |
# |
|
6 |
# Redistribution and use in source and binary forms, with or without |
|
7 |
# modification, are permitted providing that the following conditions |
|
8 |
# are met: |
|
9 |
# 1. Redistributions of source code must retain the above copyright |
|
10 |
# notice, this list of conditions and the following disclaimer. |
|
11 |
# 2. Redistributions in binary form must reproduce the above copyright |
|
12 |
# notice, this list of conditions and the following disclaimer in the |
|
13 |
# documentation and/or other materials provided with the distribution. |
|
14 |
# |
|
15 |
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR |
|
16 |
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED |
|
17 |
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
|
18 |
# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY |
|
19 |
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
|
20 |
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
|
21 |
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
|
22 |
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, |
|
23 |
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING |
|
24 |
# IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE |
|
25 |
# POSSIBILITY OF SUCH DAMAGE. |
|
26 |
# |
|
| 35 | 27 |
$main::VERSION = "1.3-dev"; |
| 18 | 28 |
|
| 9 | 29 |
use strict; |
30 |
use Parse::RecDescent; |
|
31 |
use Data::Dumper; |
|
|
17
d39ff14a8964
parser: store result via Storable if requested
"Tomas Zeman <tzeman@volny.cz>"
parents:
9
diff
changeset
|
32 |
use Storable; |
| 18 | 33 |
use Getopt::Std; |
| 9 | 34 |
|
| 18 | 35 |
my $opts = {};
|
36 |
getopts("do:g:", $opts);
|
|
37 |
||
38 |
my $grammar_file = $opts->{g};
|
|
| 9 | 39 |
unless (defined $grammar_file) {
|
| 18 | 40 |
HELP_MESSAGE(); |
| 9 | 41 |
exit 1; |
42 |
} |
|
43 |
||
44 |
unless (-f $grammar_file) {
|
|
45 |
die "Grammar file $grammar_file does not exit"; |
|
46 |
} |
|
47 |
||
48 |
my $grammar = ''; |
|
49 |
{
|
|
50 |
open G, $grammar_file; |
|
51 |
local $/; |
|
52 |
$grammar = <G>; |
|
53 |
close G; |
|
54 |
} |
|
55 |
||
56 |
# Enable warnings within the Parse::RecDescent module. |
|
57 |
$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error |
|
58 |
$::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c. |
|
59 |
$::RD_HINT = 1; # Give out hints to help fix problems. |
|
60 |
||
61 |
my $parser = Parse::RecDescent->new($grammar); |
|
62 |
||
63 |
my $content = ''; |
|
64 |
{
|
|
65 |
local $/; |
|
66 |
$content = <>; |
|
67 |
} |
|
68 |
||
| 18 | 69 |
$::res = {}; # parse tree result
|
| 9 | 70 |
my $p_res = $parser->file($content); |
|
22
78285474e8d3
parser: die if parsing failed
"Tomas Zeman <tzeman@volny.cz>"
parents:
18
diff
changeset
|
71 |
defined $p_res || die "Parser failed"; |
| 18 | 72 |
my $storable = $opts->{o};
|
|
17
d39ff14a8964
parser: store result via Storable if requested
"Tomas Zeman <tzeman@volny.cz>"
parents:
9
diff
changeset
|
73 |
store($::res, $storable) if (defined $storable && length($storable) > 0); |
| 18 | 74 |
print Dumper $::res if ($opts->{d});
|
75 |
||
76 |
||
77 |
sub main::VERSION_MESSAGE {
|
|
78 |
my $fh = shift; |
|
| 35 | 79 |
print $fh "parser version $main::VERSION - Copyright 2009-2012 Tomas Zeman\n"; |
| 18 | 80 |
} |
81 |
||
82 |
sub main::HELP_MESSAGE {
|
|
83 |
print <<EOF; |
|
84 |
Usage: parser [ -d ] [ -o data ] -g grammar_file |
|
85 |
||
86 |
-o data store parse tree into file (using Storable module) |
|
87 |
-d dump parse tree to stdout |
|
88 |
-g grammar_file |
|
89 |
file containing parse grammar |
|
90 |
||
91 |
EOF |
|
92 |
} |
|
93 |
||
94 |