comparison Lib/IMPL/Text/Parser/Player.pm @ 41:c442eb67fa22

parser in progress
author Sergey
date Mon, 21 Dec 2009 17:40:09 +0300
parents ac21a032e7a9
children 16ada169ca75
comparison
equal deleted inserted replaced
40:ac21a032e7a9 41:c442eb67fa22
18 ); 18 );
19 19
20 BEGIN { 20 BEGIN {
21 private _direct property _data => prop_all; 21 private _direct property _data => prop_all;
22 private _direct property _current => prop_all; 22 private _direct property _current => prop_all;
23 private _direct property _states => prop_all;
24 private _direct property _document => prop_all;
25
26 public _direct property errorLast => prop_all;
23 public _direct property Punctuation => prop_all; 27 public _direct property Punctuation => prop_all;
24 public _direct property Delimier => prop_all; 28 public _direct property Delimier => prop_all;
29 }
30
31 sub CTOR {
32 my ($this,$document) = @_;
33
34 $this->{$_document} = $document or die new IMPL::InvalidArgumentException("The first parameter must be a document");
25 } 35 }
26 36
27 sub LoadString { 37 sub LoadString {
28 my ($this,$string) = @_; 38 my ($this,$string) = @_;
29 39
39 } split $rxDelim, $_ 49 } split $rxDelim, $_
40 } split /\n/, $string 50 } split /\n/, $string
41 ] 51 ]
42 } 52 }
43 53
54 sub Play {
55 my ($this) = @_;
56 }
57
44 sub PlayChunk { 58 sub PlayChunk {
45 my ($this,$chunk) = @_; 59 my ($this,$chunk) = @_;
46 60
47 $opCodesMap{shift @$_}->(@$_) foreach @{$chunk->opStream}; 61 my $end = 0;
62
63 my $name = $chunk->chunkName;
64
65 $this->enter($name) if $name;
66
67 foreach my $op ( @{$chunk->opStream} ) {
68 $this->leave(0) and return $this->error("no more data") if $end;
69
70 $opCodesMap{shift @$op}->(@$op) || return $this->leave(0) ;
71 $this->moveNext or $end = 1;
72 }
73
74 return $this->leave(1);
48 } 75 }
49 76
50 sub MatchRegexp { 77 sub MatchRegexp {
51 my ($this,$rx) = @_; 78 my ($this,$rx) = @_;
52 79
53 if ($this->{$_current}{token} =~ $rx) { 80 $this->{$_current}{token} =~ $rx ? ($this->data() and return 1) : return $this->error("Expected: $rx");
54 81 }
55 } 82
83 sub MatchString {
84 my ($this,$string) = @_;
85
86 $this->{$_current}{token} eq $string ? ($this->data() and return 1) : return $this->error("Expected: $string");
87 }
88
89 sub MatchReference {
90 my ($this,$name) = @_;
91
92 my $chunk = $this->ResolveChunk($name) || return $this->error("Invalid reference: $name");
93 return $this->PlayChunk($chunk);
94 }
95
96 sub MatchSwitch {
97 my ($this,@chunks) = @_;
98
99 foreach my $chunk (@chunks) {
100 $this->save;
101 if ( $this->PlayChunk($chunk) ) {
102 $this->apply;
103 return 1;
104 } else {
105 $this->restore;
106 }
107 }
108
109 return 0; # passthrough last error
110 }
111
112 sub MatchRepeat {
113 my ($this,$chunk, $min, $max) = @_;
114
115 my $count = 0;
116
117 $this->save;
118 while (1) {
119 $this->save;
120 if ($this->PlayChunk($chunk)) {
121 $count ++;
122 $this->apply;
123 $this->apply and return 1 if ($count >= $max)
124 } else {
125 $this->restore;
126 $count >= $min ?
127 ($this->apply() and return 1) :
128 ($this->restore() and return $this->error("Expected at least $min occurances, got only $count"));
129 }
130 }
131
132 # we should never get here
133 die new IMPL::InvalidOperationException("unexpected error");
56 } 134 }
57 135
58 sub moveNext { 136 sub moveNext {
59 my ($this) = @_; 137 my ($this) = @_;
60 138
63 $pos ++; 141 $pos ++;
64 142
65 if ($pos < @{$this->{$_data}}) { 143 if ($pos < @{$this->{$_data}}) {
66 144
67 $this->{$_current} = { 145 $this->{$_current} = {
68 pos => $pos 146 pos => $pos,
147 token => $this->{$_data}[$pos][1],
148 line => $this->{$_data}
69 }; 149 };
70 150
71 } else { 151 } else {
152 $this->{$_current} = {};
72 return undef; 153 return undef;
73 } 154 }
74 } 155 }
75 156
157 sub ResolveChunk {
158 my ($this,$name) = @_;
159 }
160
161 sub save {
162 my ($this) = @_;
163
164 push @{$this->{$_states}}, $this->{$_current};
165 }
166
167 sub restore {
168 my ($this) = @_;
169
170 $this->{$_current} = pop @{$this->{$_states}};
171 }
172
173 sub apply {
174 my ($this) = @_;
175
176 pop @{$this->{$_states}};
177 }
178
179 sub error {
180 my ($this,$message) = @_;
181
182 $this->{$errorLast} = {
183 message => $message,
184 line => $this->{$_current}{line},
185 token => $this->{$_current}{token}
186 };
187
188 return 0;
189 }
190
191 sub __debug {
192
193 }
194 sub enter {
195 my ($this,$name) = @_;
196
197 #always return true;
198 return 1;
199 }
200
201 sub leave {
202 my ($this,$isEmpty) = @_;
203
204 #always return true;
205 return 1;
206 }
207
208 sub data {
209 my ($this) = @_;
210
211 my $data = $this->{$_current}{token};
212
213 # always return true;
214 return 1;
215 }
216
76 1; 217 1;