annotate mayachemtools/lib/Parsers/Lexer.pm @ 2:dfff2614510e draft

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