annotate mayachemtool/mayachemtools/lib/Parsers/Lexer.pm @ 0:68300206e90d draft default tip

Uploaded
author deepakjadmin
date Thu, 05 Nov 2015 02:41:30 -0500
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
1 package Parsers::Lexer;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
2 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
3 # $RCSfile: Lexer.pm,v $
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
4 # $Date: 2015/02/28 20:50:55 $
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
5 # $Revision: 1.10 $
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
6 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
7 # Author: Manish Sud <msud@san.rr.com>
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
8 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
9 # Copyright (C) 2015 Manish Sud. All rights reserved.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
10 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
11 # This file is part of MayaChemTools.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
12 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
13 # MayaChemTools is free software; you can redistribute it and/or modify it under
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
14 # the terms of the GNU Lesser General Public License as published by the Free
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
15 # Software Foundation; either version 3 of the License, or (at your option) any
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
16 # later version.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
17 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
18 # MayaChemTools is distributed in the hope that it will be useful, but without
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
19 # any warranty; without even the implied warranty of merchantability of fitness
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
20 # for a particular purpose. See the GNU Lesser General Public License for more
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
21 # details.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
22 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
23 # You should have received a copy of the GNU Lesser General Public License
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
24 # along with MayaChemTools; if not, see <http://www.gnu.org/licenses/> or
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
25 # write to the Free Software Foundation Inc., 59 Temple Place, Suite 330,
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
26 # Boston, MA, 02111-1307, USA.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
27 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
28
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
29 use strict;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
30 use Carp;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
31 use Exporter;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
32 use Scalar::Util ();
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
33
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
34 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
35
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
36 @ISA = qw(Exporter);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
37 @EXPORT = qw();
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
38 @EXPORT_OK = qw();
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
39
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
40 %EXPORT_TAGS = (all => [@EXPORT, @EXPORT_OK]);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
41
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
42 # Setup class variables...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
43 my($ClassName);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
44 _InitializeClass();
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
45
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
46 # Overload Perl functions...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
47 use overload '""' => 'StringifyLexer';
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
48
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
49 # Class constructor...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
50 sub new {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
51 my($Class, $Input, @TokensSpec) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
52
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
53 # Initialize object...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
54 my $This = {};
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
55 bless $This, ref($Class) || $Class;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
56 $This->_InitializeLexer();
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
57
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
58 $This->_ValidateParametersAndGenerateLexer($Input, @TokensSpec);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
59
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
60 return $This;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
61 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
62
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
63
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
64 # Initialize class ...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
65 sub _InitializeClass {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
66 #Class name...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
67 $ClassName = __PACKAGE__;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
68 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
69
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
70 # Initialize object data...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
71 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
72 sub _InitializeLexer {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
73 my($This) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
74
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
75 # Input parameter used by lexer to retrieve text to be lexed. Supported parameter types:
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
76 # . Reference to input iterator function
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
77 # . Reference to an open file handle
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
78 # . Text string
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
79 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
80 $This->{Input} = undef;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
81
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
82 # Type of input paramater determined using Perl ref function:
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
83 # . InputIterator - ref returns CODE
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
84 # . FileStream - ref return GLOB and fileno is valid
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
85 # . String - ref return an empty string
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
86 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
87 $This->{InputType} = '';
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
88
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
89 # Tokens specifications supplied by the caller. It's an array containing references
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
90 # to arrays with each containing TokenLabel and TokenMatchRegex pair along with
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
91 # an option reference to code to be executed after a matched.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
92 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
93 # For example:
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
94 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
95 # @LexerTokensSpec = (
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
96 # [ 'LETTER', qr/[a-zA-Z]/ ],
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
97 # [ 'NUMBER', qr/\d+/ ],
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
98 # [ 'SPACE', qr/[ ]*/, sub { my($This, $TokenLabel, $MatchedText) = @_; return ''; } ],
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
99 # [ 'NEWLINE', qr/(?:\r\n|\r|\n)/, sub { my($This, $TokenLabel, $MatchedText) = @_; return "\n"; } ],
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
100 # [ 'CHAR', qr/[\.]/ ],
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
101 # );
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
102 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
103 @{$This->{TokensSpec}} = ();
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
104
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
105 # Refernce to chained lexer...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
106 $This->{ChainedLexer} = undef;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
107
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
108 return $This;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
109 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
110
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
111 # Validate input parameters and generate a chained lexer...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
112 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
113 sub _ValidateParametersAndGenerateLexer {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
114 my($This, $Input, @TokensSpec) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
115
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
116 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
117 # Validate input to be lexed...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
118 if (!defined $Input) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
119 croak "Error: ${ClassName}->new: Object can't be instantiated: Input is not defined. Supported values: a reference to input iterator function, a reference to an open file handle or a text string...";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
120 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
121 $This->{Input} = $Input;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
122
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
123 # Check input parameter type...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
124 my($InputType);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
125
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
126 $InputType = ref $Input;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
127 if ($InputType =~ /CODE/i) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
128 # Input iterator...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
129 $This->{InputType} = "InputIterator";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
130 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
131 elsif ($InputType =~ /GLOB/i && defined fileno $Input) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
132 # Input stream...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
133 $This->{InputType} = "FileStream";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
134 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
135 elsif ($InputType) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
136 # Perl ref function returns nonempty string for all other references...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
137 croak "Error: ${ClassName}->new: Object can't be instantiated: Invalid input parameter type specified. Supported parameter types: a reference to input iterator function, a reference to an open file handle or a text string...";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
138 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
139 else {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
140 # Input string...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
141 $This->{InputType} = "String";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
142 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
143
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
144 # Check tokens specifications...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
145 if (!@TokensSpec) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
146 croak "Error: ${ClassName}->new: TokensSpec is not defined or the array doesn't contain any values. Supported values: a reference to an array containg token label, regular expression to match and an option reference to function to modify matched values...";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
147 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
148 @{$This->{TokensSpec}} = @TokensSpec;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
149
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
150 $This->_GenerateLexer($Input, @TokensSpec);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
151
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
152 return $This;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
153 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
154
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
155 # Generate a lexer using reference to an input iterator function, an open file
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
156 # handle or an input string passed as first parameter by the caller along
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
157 # with token specifications as second paramater...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
158 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
159 sub _GenerateLexer {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
160 my($This, $Input, @TokensSpec) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
161
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
162 if ($This->{InputType} =~ /^InputIterator$/i) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
163 $This->_GenerateInputIteratorLexer($Input, @TokensSpec);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
164 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
165 elsif ($This->{InputType} =~ /^FileStream$/i) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
166 $This->_GenerateInputFileStreamLexer($Input, @TokensSpec);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
167 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
168 elsif ($This->{InputType} =~ /^String$/i) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
169 $This->_GenerateInputStringLexer($Input, @TokensSpec);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
170 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
171 else {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
172 croak "Error: ${ClassName}->new: Object can't be instantiated: Invalid input parameter type specified. Supported parameter types: a reference to input iterator function, a reference to an open file handle or a text string...";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
173 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
174
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
175 return $This;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
176 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
177
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
178 # Generate a lexer using specifed input iterator...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
179 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
180 sub _GenerateInputIteratorLexer {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
181 my($This, $InputIteratorRef, @TokensSpec) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
182
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
183 $This->_GenerateChainedLexer($InputIteratorRef, @TokensSpec);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
184
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
185 return $This;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
186 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
187
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
188 # Generate a lexer using specifed input file stream reference...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
189 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
190 sub _GenerateInputFileStreamLexer {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
191 my($This, $FileHandleRef, @TokensSpec) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
192
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
193 # Iterator is a annoymous function reference and Perl keeps $FileHandleRef
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
194 # in scope during its execution.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
195
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
196 $This->_GenerateChainedLexer( sub { return <$FileHandleRef>; }, @TokensSpec);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
197
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
198 return $This;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
199 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
200
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
201 # Generate a lexer using specifed input string...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
202 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
203 sub _GenerateInputStringLexer {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
204 my($This, $Text, @TokensSpec) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
205 my(@InputText) = ($Text);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
206
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
207 # Iterator is a annoymous function reference and Perl keeps @InputText
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
208 # in scope during its execution.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
209
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
210 $This->_GenerateChainedLexer( sub { return shift @InputText; }, @TokensSpec);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
211
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
212 return $This;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
213 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
214
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
215 # Get next available token label and value pair as an array reference or unrecognized
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
216 # text from input stream by either removing it from the input or simply peeking ahead...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
217 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
218 # Supported mode values: Peek, Next. Default: Next
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
219 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
220 sub Lex {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
221 my($This, $Mode) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
222
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
223 return $This->{ChainedLexer}->($Mode)
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
224 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
225
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
226 # Get next available token label and value pair as an array reference or unrecognized
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
227 # text from input stream by either removing it from the input stream...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
228 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
229 sub Next {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
230 my($This) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
231
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
232 return $This->Lex();
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
233 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
234
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
235 # Get next available token label and value pair as an array reference or unrecognized
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
236 # text from input stream by simply peeking ahead and without removing it from the input
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
237 # stream..
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
238 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
239 sub Peek {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
240 my($This) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
241
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
242 return $This->Lex('Peek')
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
243 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
244
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
245 # Get a reference to lexer method to be used by the caller...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
246 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
247 sub GetLex {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
248 my($This) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
249
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
250 return sub { $This->Lex(); };
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
251 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
252
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
253 # The chained lexer generation is implemented based on examples in Higher-order Perl
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
254 # [ Ref 126 ] book.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
255 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
256 # Generate a lexer using specified input iterator and chaining it with other lexers generated
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
257 # for all token specifications. The lexer generated for first token specification uses input
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
258 # iterator to retrieve any available input text; the subsequent chained lexeres for rest
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
259 # of the tokens use lexers generated for previous token specifications to get next input
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
260 # which might be unmatched input text or a reference to an array containing token and
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
261 # matched text pair.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
262 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
263 sub _GenerateChainedLexer {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
264 my($This, $InputIteratorRef, @TokensSpec) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
265 my($TokenSpecRef, $ChainedLexer);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
266
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
267 $ChainedLexer = undef;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
268 for $TokenSpecRef (@TokensSpec) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
269 $ChainedLexer = defined $ChainedLexer ? $This->_GenerateLexerForToken($ChainedLexer, @{$TokenSpecRef}) : $This->_GenerateLexerForToken($InputIteratorRef, @{$TokenSpecRef});
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
270 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
271
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
272 $This->{ChainedLexer} = $ChainedLexer;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
273
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
274 return $This;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
275 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
276
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
277
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
278 # Generate a lexer using specifed token specification using specified input or
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
279 # input retrieved using another token lexer. The lexer retrieving input from the
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
280 # specified input stream is at the bottom of the chain.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
281 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
282 sub _GenerateLexerForToken {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
283 my($This, $InputIteratorOrLexer, $TokenLabel, $RegexPattern, $TokenMatchActionRef) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
284 my($TokenMatchAndSplitRef, $InputBuffer, @ProcessedTokens);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
285
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
286 # Input buffer for a specific lexer in chained lexers containing unprocessed
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
287 # text for token specifications retrieved from a downstrean lexer or intial
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
288 # input...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
289 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
290 $InputBuffer = "";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
291
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
292 # @ProcessedTokens contains either references to an array containing token label
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
293 # and matched text or any unmatched input text string...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
294 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
295 @ProcessedTokens = ();
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
296
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
297 # Setup a default annoymous function reference to generate an array reference
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
298 # containing $Token and text matched to $RegexPattern.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
299 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
300 $TokenMatchActionRef = defined $TokenMatchActionRef ? $TokenMatchActionRef : sub { my($This, $Label, $MatchedText) = @_; return [$Label, $MatchedText] };
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
301
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
302 # Setup an annoymous function to match and split input text using $RegexPattern for
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
303 # a specific token during its lexer invocation in chained lexers.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
304 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
305 # The usage of parenthesis around $RegexPattern during split allows capturing of matched
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
306 # text, which is subsequently processed to retrieve matched $Token values. The split function
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
307 # inserts a "" separator in the returned array as first entry whenever $InputText starts with
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
308 # $RegexPattern. $InputText is returned as the only element for no match.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
309 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
310 $TokenMatchAndSplitRef = sub { my($InputText) = @_; return split /($RegexPattern)/, $InputText; };
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
311
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
312 # Setup a lexer for $TokenLabel as an annoymous function and return its reference to caller
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
313 # which in turns chains the lexers for all $Tokens before returning a reference to a lexer
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
314 # at top of the lexer chain.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
315 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
316 # Perl maintains scope of all variables defined with in the scope of the current function
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
317 # during invocation of annoymous function even after the return call.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
318 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
319 return sub {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
320 my($Mode) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
321
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
322 # Currenly supported value for mode: Peek, Next
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
323 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
324 $Mode = defined $Mode ? $Mode : 'Next';
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
325
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
326 while (@ProcessedTokens == 0 && defined $InputBuffer ) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
327 # Get any new input....
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
328 my $NewInput = $InputIteratorOrLexer->();
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
329
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
330 if (ref $NewInput) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
331 # Input is an array reference containing matched token and text returned by
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
332 # a chained lexer downstream lexer...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
333 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
334 # Match $RegexPattern in available buffer text to retieve any matched text
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
335 # for current $Token. $Separator might be "": $RegexPattern is at start of
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
336 # of $InputBuffer
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
337 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
338 # Process input buffer containing text to be matched for the current lexer
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
339 # which didn't get processed earlier during @NewTokens > 2 while loop:
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
340 # no match for current lexer or more input available. It maintains order
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
341 # of token matching in input stream.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
342 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
343 my($Separator, $MatchedTokenRefOrText);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
344
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
345 ($Separator, $MatchedTokenRefOrText) = $TokenMatchAndSplitRef->($InputBuffer);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
346 if (defined $MatchedTokenRefOrText) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
347 $MatchedTokenRefOrText = $TokenMatchActionRef->($This, $TokenLabel, $MatchedTokenRefOrText);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
348 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
349
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
350 # Collect valid token references or text...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
351 push @ProcessedTokens, grep { defined $_ && $_ ne "" } ($Separator, $MatchedTokenRefOrText, $NewInput);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
352
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
353 # Empty put buffer...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
354 $InputBuffer = "";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
355
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
356 # Get out of the loop as processed token refererences and/or text are available...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
357 last;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
358 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
359
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
360 # Process input retrieved from downstream lexer or input iterator which hasn't
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
361 # been processed into tokens..
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
362 if (defined $NewInput) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
363 $InputBuffer .= $NewInput;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
364 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
365
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
366 # Retrieve any matched tokens from available input for the current lexer...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
367 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
368 my(@NewTokens) = $TokenMatchAndSplitRef->($InputBuffer);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
369
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
370 while ( @NewTokens > 2 || @NewTokens && !defined $NewInput) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
371 # Scenario 1: Complete match
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
372 # @NewTokens > 2 : Availability of separator, matched token text, separator.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
373 # The separator might correspond to token for a token for upstream lexer followed
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
374 # by matched token from current lexer. It ends up getting passed to upsrteam
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
375 # lexer for processing.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
376 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
377 # Scenario 2: No more input available from iterator or downstream lexer
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
378 # @NewTokens <= 2 and no more input implies any left over text in buffer. And
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
379 # it ends up getting passed to upsrteam for processing.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
380 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
381
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
382 # Take off any unprocessed input text that doesn't match off the buffer: It'll be
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
383 # passed to upstream chained lexer for processing...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
384 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
385 push @ProcessedTokens, shift @NewTokens;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
386
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
387 if (@NewTokens) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
388 my $MatchedTokenText = shift @NewTokens;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
389 push @ProcessedTokens, $TokenMatchActionRef->($This, $TokenLabel, $MatchedTokenText);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
390 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
391 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
392
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
393 # Retrieve any leftover text from NewTokens and put it back into InputBuffer for
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
394 # processing by current lexer. All token references have been taken out....
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
395 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
396 $InputBuffer = "";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
397 if (@NewTokens) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
398 $InputBuffer = join "", @NewTokens;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
399 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
400
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
401 if (!defined $NewInput) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
402 # No more input from the downstream lexer...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
403 $InputBuffer = undef;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
404 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
405
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
406 # Clean up any empty strings from ProcessedTokens containing token
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
407 # references or text...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
408 @ProcessedTokens = grep { $_ ne "" } @ProcessedTokens;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
409
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
410 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
411
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
412 # Return reference to an array containing token and matched text or just unmatched input text...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
413 my $TokenRefOrText = undef;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
414
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
415 if (@ProcessedTokens) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
416 # Get first available reference either by just peeking or removing it from the list
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
417 # of available tokens...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
418 $TokenRefOrText = ($Mode =~ /^Peek$/i) ? $ProcessedTokens[0] : shift @ProcessedTokens;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
419 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
420
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
421 return $TokenRefOrText;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
422 };
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
423 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
424
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
425 # Is it a lexer object?
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
426 sub _IsLexer {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
427 my($Object) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
428
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
429 return (Scalar::Util::blessed($Object) && $Object->isa($ClassName)) ? 1 : 0;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
430 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
431
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
432 # Return a string containing information about lexer...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
433 sub StringifyLexer {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
434 my($This) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
435 my($LexerString);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
436
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
437 $LexerString = "Lexer: PackageName: $ClassName; " . $This->_GetLexerInfoString();
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
438
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
439 return $LexerString;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
440 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
441
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
442 # Return a string containing information about lexer...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
443 sub _GetLexerInfoString {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
444 my($This) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
445 my($LexerInfoString, $TokensSpec, $TokenSpec, $TokenLabel, $TokenMatchRegex, $TokenMatchAction);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
446
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
447 $LexerInfoString = "InputType: $This->{InputType}";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
448
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
449 if ($This->{InputType} =~ /^String$/i) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
450 $LexerInfoString .= "; InputString: $This->{Input}";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
451 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
452
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
453 $TokensSpec = "TokensSpecifications: <None>";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
454 if (@{$This->{TokensSpec}}) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
455 $TokensSpec = "TokensSpecifications: < [Label, MatchRegex, MatchAction]:";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
456 for $TokenSpec (@{$This->{TokensSpec}}) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
457 ($TokenLabel, $TokenMatchRegex) = @{$TokenSpec};
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
458 $TokenMatchAction = (@{$TokenSpec} == 3) ? "$TokenSpec->[2]" : "undefined";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
459 $TokensSpec .= " [$TokenLabel, $TokenMatchRegex, $TokenMatchAction]";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
460 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
461 $TokensSpec .= " >";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
462 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
463
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
464 $LexerInfoString .= "; $TokensSpec";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
465
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
466 return $LexerInfoString;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
467 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
468
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
469 1;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
470
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
471 __END__
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
472
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
473 =head1 NAME
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
474
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
475 Parsers::Lexer
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
476
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
477 =head1 SYNOPSIS
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
478
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
479 use Parsers::Lexer;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
480
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
481 use Parsers::Lexer qw(:all);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
482
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
483 =head1 DESCRIPTION
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
484
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
485 B<Lexer> class provides the following methods:
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
486
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
487 new, GetLex, Lex, Next, Peek, StringifyLexer
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
488
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
489 The object oriented chained B<Lexer> is implemented based on examples available in
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
490 Higher-order Perl [ Ref 126 ] book by Mark J. Dominus. It is designed to be used
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
491 both in standalone mode or as a base class for B<YYLexer>.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
492
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
493 A chained lexer is created by generating a lexer for for the first specified token
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
494 specification using specified input and chaining it with other lexers generated for all
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
495 subsequent token specifications. The lexer generated for the first token specification
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
496 uses input iterator to retrieve any available input text; the subsequent chained lexeres
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
497 for rest of the token specifications use lexers generated for previous token
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
498 specifications to get next input, which might be unmatched input text or a reference
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
499 to an array containing token and matched text pair.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
500
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
501 =head2 METHODS
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
502
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
503 =over 4
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
504
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
505 =item B<new>
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
506
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
507 $Lexer = new Parsers::Lexer($Input, @TokensSpec);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
508
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
509 Using specified I<Input> and I<TokensSpec>, B<new> method generates a new lexer
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
510 and returns a reference to newly created B<Lexer> object.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
511
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
512 Example:
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
513
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
514 # Tokens specifications supplied by the caller. It's an array containing references
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
515 # to arrays with each containing TokenLabel and TokenMatchRegex pair along with
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
516 # an option reference to code to be executed after a matched.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
517 #
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
518 @LexerTokensSpec = (
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
519 [ 'LETTER', qr/[a-zA-Z]/ ],
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
520 [ 'NUMBER', qr/\d+/ ],
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
521 [ 'SPACE', qr/[ ]*/,
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
522 sub { my($This, $TokenLabel, $MatchedText) = @_; return ''; }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
523 ],
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
524 [ 'NEWLINE', qr/(?:\r\n|\r|\n)/,
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
525 sub { my($This, $TokenLabel, $MatchedText) = @_; return "\n"; }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
526 ],
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
527 [ 'CHAR', qr/./ ]
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
528 );
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
529
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
530 # Input string...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
531 $InputText = 'y = 3 + 4';
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
532 $Lexer = new Parsers::Lexer($InputText, @LexerTokensSpec);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
533
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
534 # Process input stream...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
535 while (defined($Token = $Lexer->Lex())) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
536 print "Token: " . ((ref $Token) ? "@{$Token}" : "$Token") . "\n";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
537 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
538
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
539 # Input file...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
540 $InputFile = "Input.txt";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
541 open INPUTFILE, "$InputFile" or die "Couldn't open $InputFile: $!\n";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
542 $Lexer = new Parsers::Lexer(\*INPUTFILE, @LexerTokensSpec);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
543
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
544 # Input file iterator...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
545 $InputFile = "TestSimpleCalcParser.txt";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
546 open INPUTFILE, "$InputFile" or die "Couldn't open $InputFile: $!\n";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
547 $InputIterator = sub { return <INPUTFILE>; };
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
548 $Lexer = new Parsers::Lexer($InputIterator, @LexerTokensSpec);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
549
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
550 @LexerTokensSpec = (
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
551 [ 'VAR', qr/[[:alpha:]]+/ ],
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
552 [ 'NUM', qr/\d+/ ],
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
553 [ 'OP', qr/[-+=\/]/,
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
554 sub { my($This, $Label, $Value) = @_;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
555 $Value .= "; ord: " . ord $Value;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
556 return [$Label, $Value];
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
557 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
558 ],
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
559 [ 'NEWLINE', qr/(?:\r\n|\r|\n)/, sub { return [$_[1], 'NewLine']; } ],
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
560 [ 'SPACE', qr/\s*/, sub { return [$_[1], 'Space']; } ],
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
561 );
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
562
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
563 # Look ahead without removing...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
564 $Token = $Lexer->Lex('Peek');
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
565 if (defined $Token && ref $Token) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
566 print "PEEK: Token: @{$Token}\n\n";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
567 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
568
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
569 # Process input stream...
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
570 while (defined($Token = $Lexer->Lex())) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
571 print "Token: " . ((ref $Token) ? "@{$Token}" : "$Token") . "\n";
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
572 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
573
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
574 =item B<GetLex>
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
575
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
576 $LexerRef = $Lexer->GetLex();
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
577
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
578 Returns a refernece to I<Lexer> method to the caller for use in a specific B<YYLexer>.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
579
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
580 =item B<Lex>
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
581
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
582 $TokenRefOrText = $Lexer->Lex($Mode);
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
583 if (ref $TokenRefOrText) {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
584 ($TokenLabel, $TokenValue) = @{$TokenRefOrText};
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
585 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
586 else {
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
587 $TokenText = $TokenRefOrText;
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
588 }
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
589
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
590 Get next available token label and value pair as an array reference or unrecognized
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
591 text from input stream by either removing it from the input or simply peeking ahead
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
592 and without removing it from the input stream.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
593
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
594 Possible I<Mode> values: I<Peek, Next>. Default: I<Next>.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
595
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
596 =item B<Next>
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
597
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
598 $TokenRefOrText = $Lexer->Next();
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
599
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
600 Get next available token label and value pair as an array reference or unrecognized
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
601 text from input stream by removing it from the input stream.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
602
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
603 =item B<Peek>
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
604
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
605 $TokenRefOrText = $Lexer->Peek();
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
606
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
607 Get next available token label and value pair as an array reference or unrecognized
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
608 text from input stream by by simply peeking ahead and without removing it from the
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
609 input stream.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
610
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
611 =item B<StringifyLexer>
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
612
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
613 $LexerString = $Lexer->StringifyLexer();
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
614
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
615 Returns a string containing information about I<Lexer> object.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
616
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
617 =back
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
618
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
619 =head1 AUTHOR
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
620
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
621 Manish Sud <msud@san.rr.com>
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
622
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
623 =head1 SEE ALSO
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
624
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
625 YYLexer.pm, SimpleCalcYYLexer.pm, SimpleCalcParser.yy
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
626
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
627 =head1 COPYRIGHT
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
628
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
629 Copyright (C) 2015 Manish Sud. All rights reserved.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
630
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
631 This file is part of MayaChemTools.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
632
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
633 MayaChemTools is free software; you can redistribute it and/or modify it under
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
634 the terms of the GNU Lesser General Public License as published by the Free
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
635 Software Foundation; either version 3 of the License, or (at your option)
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
636 any later version.
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
637
68300206e90d Uploaded
deepakjadmin
parents:
diff changeset
638 =cut