annotate Lib/IMPL/Text/Parser/Player.pm @ 40:ac21a032e7a9

bnf parser in progress
author Sergey
date Thu, 10 Dec 2009 17:43:39 +0300
parents 4f5a6a1bfb0e
children c442eb67fa22
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
39
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
1 package IMPL::Text::Parser::Player;
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
2 use strict;
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
3 use warnings;
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
4
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
5 use base qw(IMPL::Object);
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
6 use IMPL::Class::Property;
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
7 use IMPL::Class::Property::Direct;
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
8
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
9 use IMPL::Text::Parser::Chunk;
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
10
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
11 my %opCodesMap = (
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
12 IMPL::Text::Parser::Chunk::OP_REGEXP , &MatchRegexp ,
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
13 IMPL::Text::Parser::Chunk::OP_STRING , &MatchString ,
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
14 IMPL::Text::Parser::Chunk::OP_REFERENCE , &MatchReference ,
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
15 IMPL::Text::Parser::Chunk::OP_CHUNK , &PlayChunk ,
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
16 IMPL::Text::Parser::Chunk::OP_SWITCH , &MatchSwitch ,
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
17 IMPL::Text::Parser::Chunk::OP_REPEAT , &MatchRepeat
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
18 );
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
19
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
20 BEGIN {
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
21 private _direct property _data => prop_all;
40
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
22 private _direct property _current => prop_all;
39
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
23 public _direct property Punctuation => prop_all;
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
24 public _direct property Delimier => prop_all;
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
25 }
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
26
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
27 sub LoadString {
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
28 my ($this,$string) = @_;
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
29
40
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
30 my $rxDelim = /(\s+|[.,;!-+*~$^&|%()`@\\\/])/;
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
31
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
32 my $line = 0;
39
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
33
40
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
34 $this->{$_data} = [
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
35 map {
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
36 $line++;
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
37 map {
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
38 [$line,$_]
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
39 } split $rxDelim, $_
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
40 } split /\n/, $string
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
41 ]
39
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
42 }
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
43
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
44 sub PlayChunk {
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
45 my ($this,$chunk) = @_;
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
46
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
47 $opCodesMap{shift @$_}->(@$_) foreach @{$chunk->opStream};
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
48 }
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
49
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
50 sub MatchRegexp {
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
51 my ($this,$rx) = @_;
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
52
40
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
53 if ($this->{$_current}{token} =~ $rx) {
39
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
54
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
55 }
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
56 }
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
57
40
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
58 sub moveNext {
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
59 my ($this) = @_;
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
60
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
61 my $pos = $this->{$_current}{pos};
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
62
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
63 $pos ++;
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
64
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
65 if ($pos < @{$this->{$_data}}) {
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
66
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
67 $this->{$_current} = {
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
68 pos => $pos
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
69 };
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
70
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
71 } else {
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
72 return undef;
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
73 }
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
74 }
ac21a032e7a9 bnf parser in progress
Sergey
parents: 39
diff changeset
75
39
4f5a6a1bfb0e Text parser
Sergey
parents:
diff changeset
76 1;