annotate Lib/BNFCompiler.pm @ 35:f25d021780b3

DOM::Navigator::Builder working version
author Sergey
date Tue, 17 Nov 2009 17:46:24 +0300
parents 03e58a454b20
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package BNFCompiler;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 package BNFCompiler::DOM;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3 package BNFCompiler::DOM::Builder;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4 package BNFCompiler::DOM::Node;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7 package BNFCompiler::EventParser;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9 use lib '.';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10 use Common;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 our @ISA = qw(Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13 our $EventMapSchema = {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 Description => 'Parser events',
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15 Type => 'HASH',
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 Values => 'SCALAR'
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 DeclareProperty(EventMap => ACCESS_READ);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21 DeclareProperty(CompiledEvents => ACCESS_NONE);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22 DeclareProperty(Handler => ACCESS_ALL);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 my ($this,%args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27 $this->SUPER::CTOR(%args);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30 sub Compile {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 my ($this) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33 delete $this->{$CompiledEvents};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34 while (my ($key,$val) = each %{$this->{$EventMap}}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 $this->{$CompiledEvents}{$key} = qr/\G$val/;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 sub Parse {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41 my ($this,$data) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43 my $StateData;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44 OUTER: while(pos($data) < length($data)) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45 keys %{$this->{$CompiledEvents}};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46 while (my ($event,$match) = each %{$this->{$CompiledEvents}}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47 if ($data =~ m/($match)/gc) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48 $StateData .= $1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
49 eval {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
50 undef $StateData if $this->{$Handler}->($event,$StateData);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
51 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
52 if ($@) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
53 die ["Invalid syntax","unexpected $event: $1",pos($data)];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
54 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
55 next OUTER;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
56 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
57 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
58 die ["Invalid syntax",substr($data,pos($data),10),pos($data)];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
59 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
60
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
61 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
62 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
63
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
64 # íåáîëüøàÿ óëîâêà, ïîñêîëüêó ref îò ðåãóëÿðíîãî âûðàæåíèÿ åñòü Regexp, ìîæíî ïîñòàâèòü õóêè
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
65 package Regexp;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
66 use Data::Dumper;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
67
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
68 sub STORABLE_freeze {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
69 my ($obj,$cloning) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
70
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
71 return $obj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
72 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
73
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
74 sub STORABLE_attach {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
75 my($class, $cloning, $serialized) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
76 return qr/$serialized/;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
77 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
78
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
79 package BNFCompiler;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
80 use Common;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
81 use Storable;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
82 use Data::Dumper;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
83 our @ISA = qw(Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
84
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
85 our $BNFSchema;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
86 my $ParseAgainstSchema;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
87 my $TransformDOMToBNF;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
88
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
89 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
90 DeclareProperty(Schema => ACCESS_NONE);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
91 DeclareProperty(SchemaCache => ACCESS_NONE);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
92 DeclareProperty(Transform => ACCESS_NONE);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
93 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
94
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
95 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
96 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
97 $this->SUPER::CTOR(@_);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
98
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
99 $this->{$SchemaCache} .= '/' if ($this->{$SchemaCache} and not $this->{$SchemaCache} =~ /\/$/);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
100 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
101 {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
102 my $compiledBNFSchema;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
103 sub LoadBNFSchema {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
104 my ($this,%args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
105
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
106 my $CompileBNFText = sub {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
107 my ($this,$text) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
108
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
109 my %SchemaDOM;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
110 foreach my $item (split /\n{2,}/, $text) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
111 next if not $item;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
112 $compiledBNFSchema = CompileBNFSchema($BNFSchema) if not $compiledBNFSchema;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
113 my $context = new BNFCompiler::DOM::Builder();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
114 eval {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
115 my $expr = &$ParseAgainstSchema($compiledBNFSchema,$item,$context);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
116 die ["Unexpected expression", $expr] if $expr;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
117 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
118 if ($@) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
119 if (ref $@ eq 'ARRAY') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
120 die new Exception(@{$@});
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
121 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
122 die $@;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
123 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
124 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
125
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
126 $SchemaDOM{$context->Document->selectNodes('name')->text()} = &$TransformDOMToBNF($context->Document->selectNodes('def'));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
127
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
128 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
129
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
130 $SchemaDOM{'separator'} = ['re:\\s+'];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
131 $this->{$Schema} = CompileBNFSchema(\%SchemaDOM);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
132 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
133
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
134 my $text;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
135 if ($args{'file'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
136
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
137 my $fnameCached;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
138 if ($this->{$SchemaCache}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
139 my $fname = $args{'file'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
140 $fname =~ tr/\//_/;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
141 $fnameCached = $this->{$SchemaCache}.$fname.'.cbs';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
142 if ( -e $fnameCached && -f $fnameCached && ( -M $args{'file'} >= -M $fnameCached )) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
143 my $compiledSchema = retrieve($fnameCached);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
144 if ($compiledSchema) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
145 $this->{$Schema} = $compiledSchema;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
146 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
147 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
148 unlink $fnameCached;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
149 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
150 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
151 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
152 open my $hFile, '<', $args{'file'} or die new Exception("Failed to open file",$args{'file'},$!);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
153 local $/ = undef;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
154 my $text = <$hFile>;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
155
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
156 $this->$CompileBNFText($text);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
157
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
158 if ($fnameCached) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
159 store($this->{$Schema},$fnameCached);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
160 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
161 } elsif ($args{'Schema'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
162 $this->{$Schema} = CompileBNFSchema($args{'Schema'});
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
163 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
164 } elsif ($args{'text'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
165 $this->$CompileBNFText( $args{'text'} );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
166 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
167 die new Exception("'file', 'text' or 'Schema' parameter required");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
168 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
169
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
170 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
171 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
172
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
173 sub Parse {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
174 my ($this, $string, %flags) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
175
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
176 my $context = new BNFCompiler::DOM::Builder;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
177
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
178 eval {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
179 my $err;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
180 $err = &$ParseAgainstSchema($this->{$Schema},$string,$context,\%flags) and die new Exception('Failed to parse',substr($err,0,80).' ...');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
181 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
182 if ($@) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
183 if (ref $@ eq 'ARRAY') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
184 die new Exception(@{$@});
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
185 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
186 die $@;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
187 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
188 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
189 if (not $this->{$Transform}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
190 return $context->Document;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
191 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
192 return $this->{$Transform}->($context->Document);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
193 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
194 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
195
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
196 sub Dispose {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
197 my ($this) = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
198 CleanSchema($this->{$Schema});
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
199 delete @$this{$Schema, $Transform};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
200 $this->SUPER::Dispose;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
201 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
202
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
203 sub CleanSchema {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
204 my ($schema,$table) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
205
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
206 UNIVERSAL::isa($schema,'ARRAY') or return;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
207 $table or $table = { $schema, 1};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
208
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
209 for(my $i=0; $i<@$schema;$i++) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
210 my $item = $schema->[$i];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
211 if (ref $item) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
212 next if $table->{$item};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
213 $table->{$item} = 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
214 if (UNIVERSAL::isa($item,'ARRAY')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
215 CleanSchema($item,$table);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
216 } elsif( UNIVERSAL::isa($item,'HASH')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
217 CleanSchema($item->{'syntax'},$table);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
218 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
219 undef $schema->[$i];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
220 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
221 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
222 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
223
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
224
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
225 sub OPT {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
226 return bless [@_], 'OPT';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
227 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
228
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
229 sub SWITCH {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
230 return bless [@_], 'SWITCH';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
231 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
232
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
233 sub REPEAT {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
234 return bless [@_], 'REPEAT';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
235 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
236
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
237 $TransformDOMToBNF = sub {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
238 my ($nodeRoot) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
239
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
240 return [grep $_, map {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
241 my $nodeName = $_->nodeName;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
242 if (not $nodeName ){
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
243 my $obj = $_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
244 $obj->text() if (not( grep { $obj->text() eq $_} ('{', '}', '[', ']') ) );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
245 }elsif($nodeName eq 'name') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
246 $_->text();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
247 } elsif ($nodeName eq 'separator') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
248 OPT('separator');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
249 } elsif ($nodeName eq 'or_sep') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
250 # nothing
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
251 } elsif ($nodeName eq 'switch_part') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
252 &$TransformDOMToBNF($_);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
253 } elsif ($nodeName eq 'class') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
254 my $class = $_->childNodes->[0]->text();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
255
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
256 $class =~ s{(^<|>$|\\.|[\]\[])}{
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
257 my $char = { '>' => '', '<' => '', '[' => '\\[', ']' => '\\]', '\\\\' => '\\\\'}->{$1};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
258 defined $char ? $char : ($1 =~ tr/\\// && $1);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
259 }ge;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
260 $class = '['.$class.']';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
261 $class .= $_->childNodes->[1]->text() if $_->childNodes->[1];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
262 're:'.$class;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
263 } elsif ($nodeName eq 'symbol') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
264 $_->text();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
265 } elsif ($nodeName eq 'simple') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
266 @{&$TransformDOMToBNF($_)};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
267 } elsif ($nodeName eq 'multi_def') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
268 @{&$TransformDOMToBNF($_)};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
269 } elsif ($nodeName eq 'optional') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
270 my $multi_def = &$TransformDOMToBNF($_);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
271 if ($multi_def->[scalar(@{$multi_def})-1] eq '...') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
272 pop @{$multi_def};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
273 OPT(REPEAT(@{$multi_def}));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
274 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
275 OPT(@{$multi_def});
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
276 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
277 } elsif ($nodeName eq 'switch') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
278 SWITCH(@{&$TransformDOMToBNF($_)});
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
279 } elsif ($nodeName eq 'def') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
280 @{&$TransformDOMToBNF($_)};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
281 } else{
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
282 die "unknown nodeName: $nodeName";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
283 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
284 } @{$nodeRoot->childNodes}];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
285 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
286
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
287 $BNFSchema = {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
288 syntax => ['name',OPT('separator'),'::=',OPT('separator'),'def'],
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
289 name => ['re:\\w+'],
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
290 class => ['re:<([^<>\\\\]|\\\\.)+>',OPT('re:\\*|\\+|\\?|\\{\\d+\\}')],
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
291 symbol => ['re:[^\\w\\d\\s\\[\\]{}<>\\\\|]+'],
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
292 separator => ['re:\\s+'],
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
293 simple => [
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
294 SWITCH(
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
295 'name',
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
296 'class',
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
297 'symbol'
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
298 )
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
299 ],
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
300 multi_def => [
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
301 OPT('separator'), SWITCH('...',[SWITCH('simple','optional','switch'),OPT('multi_def')])
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
302 ],
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
303 optional => [
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
304 '[','multi_def', OPT('separator') ,']'
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
305
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
306 ],
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
307 keyword => [],
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
308 or_sep => ['|'],
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
309 switch_part => [OPT('separator'),SWITCH('simple','optional','switch'),OPT(REPEAT(OPT('separator'),SWITCH('simple','optional','switch'))),OPT('separator')],
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
310 switch => [
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
311 '{','switch_part',OPT(REPEAT('or_sep','switch_part')),'}'
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
312 ],
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
313 def => [REPEAT(OPT('separator'),SWITCH('simple','optional','switch'))]
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
314 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
315
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
316 my $CompileTerm;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
317 $CompileTerm = sub {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
318 my ($term,$Schema,$cache,$ref) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
319
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
320 my $compiled = ref $term eq 'ARRAY' ? ($ref or []) : bless (($ref or []), ref $term);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
321
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
322 die new Exception("Invalid term type $term", $term, ref $term) if not grep ref $term eq $_, qw(ARRAY REPEAT SWITCH OPT);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
323
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
324 foreach my $element (@{$term}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
325 if (ref $element) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
326 push @{$compiled}, &$CompileTerm($element,$Schema,$cache);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
327 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
328 if($element =~/^\w+$/) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
329 if (exists $Schema->{$element}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
330 # reference
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
331 my $compiledUnit;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
332 if (exists $cache->{$element}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
333 $compiledUnit = $cache->{$element};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
334 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
335 $compiledUnit = [];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
336 $cache->{$element} = $compiledUnit;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
337 &$CompileTerm($Schema->{$element},$Schema,$cache,$compiledUnit);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
338 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
339
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
340 push @{$compiled},{ name => $element, syntax => $compiledUnit};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
341 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
342 # simple word
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
343 push @{$compiled}, $element;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
344 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
345 } elsif ($element =~ /^re:(.*)/){
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
346 # regexp
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
347 push @{$compiled},qr/\G(?:$1)/;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
348 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
349 # char sequence
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
350 push @{$compiled},$element;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
351 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
352 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
353 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
354
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
355 return $compiled;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
356 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
357
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
358 sub CompileBNFSchema {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
359 my($Schema) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
360
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
361 my %Cache;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
362 return &$CompileTerm($Schema->{'syntax'},$Schema,\%Cache);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
363 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
364
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
365 my $CompiledSchema = CompileBNFSchema($BNFSchema);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
366
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
367 $ParseAgainstSchema = sub {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
368 my ($Schema,$expression,$context,$flags,$level) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
369
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
370 $level = 0 if not defined $level;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
371 my $dbgPrint = $flags->{debug} ? sub {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
372 print "\t" x $level, @_,"\n";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
373 } : sub {};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
374
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
375 foreach my $elem (@{$Schema}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
376 my $type = ref $elem;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
377 $expression = substr $expression,pos($expression) if $type ne 'Regexp' and pos($expression);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
378
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
379 if ($type eq 'HASH') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
380 $context->NewContext($elem->{'name'});
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
381 &$dbgPrint("$elem->{name} ", join(',',map { ref $_ eq 'HASH' ? $_->{name} : $_ }@{$elem->{'syntax'}}));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
382 eval {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
383 $expression = &$ParseAgainstSchema($elem->{'syntax'},$expression,$context,$flags,$level+1);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
384 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
385 if ($@) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
386 $context->EndContext(0);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
387 &$dbgPrint("/$elem->{name} ", "0");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
388 die $@;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
389 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
390 &$dbgPrint("/$elem->{name} ", "1");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
391 $context->EndContext(1);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
392 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
393 } elsif ($type eq 'ARRAY') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
394 &$dbgPrint("entering ", join(',',map { ref $_ eq 'HASH' ? $_->{name} : $_ }@{$elem}));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
395 $expression = &$ParseAgainstSchema($elem,$expression,$context,$flags,$level+1);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
396 &$dbgPrint("success");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
397 } elsif ($type eq 'OPT') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
398 if (defined $expression) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
399 &$dbgPrint("optional ",join(',',map { ref $_ eq 'HASH' ? $_->{name} : $_ }@{$elem}));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
400 eval {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
401 $expression = &$ParseAgainstSchema($elem,$expression,$context,$flags,$level+1);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
402 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
403 if ($@) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
404 &$dbgPrint("failed");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
405 undef $@;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
406 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
407 &$dbgPrint("success");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
408 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
409 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
410 } elsif ($type eq 'SWITCH') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
411 my $success = 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
412 &$dbgPrint("switch");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
413 LOOP_SWITCH: foreach my $subelem (@{$elem}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
414 eval {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
415 &$dbgPrint("\ttry ",join(',',map { ref $_ eq 'HASH' ? $_->{name} : $_ } @{(grep ref $subelem eq $_, qw(ARRAY SWITCH OPT REPEAT)) ? $subelem : [$subelem]}));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
416 $expression = &$ParseAgainstSchema((grep ref $subelem eq $_, qw(ARRAY SWITCH OPT REPEAT)) ? $subelem : [$subelem],$expression,$context,$flags,$level+1);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
417 $success = 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
418 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
419 if ($@) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
420 undef $@;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
421 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
422 last LOOP_SWITCH;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
423 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
424 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
425 if ($success) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
426 &$dbgPrint("success");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
427 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
428 &$dbgPrint("failed");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
429 die ["syntax error",$expression,$elem];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
430 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
431 } elsif ($type eq 'REPEAT') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
432 my $copy = [@{$elem}];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
433 my $i = 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
434 &$dbgPrint("repeat ",join(',',map { ref $_ eq 'HASH' ? $_->{name} : $_ }@{$elem}));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
435 while (1) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
436 eval {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
437 $expression = &$ParseAgainstSchema($copy,$expression,$context,$flags,$level+1);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
438 $i++;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
439 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
440 if ($@) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
441 if (not $i) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
442 &$dbgPrint("failed");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
443 die $@;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
444 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
445 &$dbgPrint("found $i matches");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
446 undef $@;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
447 last;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
448 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
449 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
450 } elsif ($type eq 'Regexp') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
451 my $posPrev = pos($expression) || 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
452 if ( $expression =~ m/($elem)/ ) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
453 $context->Data($1);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
454 pos($expression) = $posPrev+length($1);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
455 &$dbgPrint("Regexp: $1 $elem ", pos($expression));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
456 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
457 &$dbgPrint("Regexp: $elem failed");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
458 die ["syntax error",$expression,$elem,$posPrev];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
459 pos($expression) = $posPrev;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
460 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
461 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
462 if ((my $val = substr($expression, 0, length($elem),'')) eq $elem) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
463 &$dbgPrint("Scalar: $val");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
464 $context->Data($elem);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
465 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
466 &$dbgPrint("Scalar: failed $val expected $elem");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
467 die ["syntax error",$val.$expression,$elem];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
468 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
469 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
470
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
471 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
472
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
473 if (pos $expression) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
474 return substr $expression,(pos($expression) || 0);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
475 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
476 return $expression;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
477 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
478
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
479 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
480
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
481 package BNFCompiler::DOM::Node;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
482 use Common;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
483 our @ISA = qw(Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
484
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
485 sub NODE_TEXT { 1 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
486 sub NODE_ELEM { 2 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
487
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
488 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
489 DeclareProperty(nodeName => ACCESS_READ);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
490 DeclareProperty(nodeType => ACCESS_READ);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
491 DeclareProperty(nodeValue => ACCESS_READ);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
492 DeclareProperty(childNodes => ACCESS_READ);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
493 DeclareProperty(isComplex => ACCESS_READ);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
494 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
495
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
496 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
497 my ($this,%args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
498 $args{'nodeType'} = NODE_ELEM if not $args{'nodeType'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
499 die new Exception("Invalid args. nodeName reqired.") if $args{'nodeType'} == NODE_ELEM and not $args{nodeName};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
500
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
501 #for speed reason
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
502 #$this->SUPER::CTOR(%args);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
503
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
504 $this->{$nodeName} = $args{'nodeName'} if $args{'nodeName'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
505 $this->{$nodeType} = $args{'nodeType'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
506 $this->{$nodeValue} = $args{'nodeValue'} if exists $args{'nodeValue'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
507
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
508 $this->{$isComplex} = 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
509 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
510
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
511 sub insertNode {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
512 my ($this,$node,$pos) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
513
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
514 die new Exception("Invalid operation on text node.") if $this->{$nodeType} != NODE_ELEM;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
515 die new Exception("Invalid node type",ref $node) if ref $node ne __PACKAGE__;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
516
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
517 $this->{$childNodes} = [] if not $this->{$childNodes};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
518
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
519 $pos = scalar(@{$this->{$childNodes}}) if not defined $pos;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
520 die new Exception("Index out of range",$pos) if $pos > scalar(@{$this->{$childNodes}}) or $pos < 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
521
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
522 splice @{$this->{$childNodes}},$pos,0,$node;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
523 $this->{$isComplex} = 1 if not $this->{$isComplex} and $node->{$nodeType} == NODE_ELEM;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
524
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
525 return $node;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
526 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
527
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
528 sub removeNode {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
529 my ($this,$node) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
530
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
531 die new Exception("Invalid operation on text node.") if $this->{$nodeType} != NODE_ELEM;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
532 @{$this->{$childNodes}} = grep { $_ != $node } @{$this->{$childNodes}};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
533
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
534 return $node;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
535 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
536
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
537 sub removeAt {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
538 my ($this,$pos) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
539
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
540 die new Exception("Invalid operation on text node.") if $this->{$nodeType} != NODE_ELEM;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
541 die new Exception("Index out of range",$pos) if $pos >= scalar(@{$this->{$childNodes}}) or $pos < 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
542
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
543 return splice @{$this->{$childNodes}},$pos,1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
544 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
545
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
546 sub selectNodes {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
547 my ($this,$name) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
548
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
549 die new Exception("Invalid operation on text node.") if $this->{$nodeType} != NODE_ELEM;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
550
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
551 my @nodes = grep { $_->{$nodeType} == NODE_ELEM and $_->{$nodeName} eq $name } @{$this->{$childNodes}};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
552
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
553 if (wantarray) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
554 return @nodes;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
555 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
556 return shift @nodes;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
557 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
558 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
559
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
560 sub text {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
561 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
562
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
563 if ($this->{$nodeType} == NODE_TEXT) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
564 return $this->{$nodeValue};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
565 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
566 my @texts;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
567
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
568 foreach my $node (@{$this->{$childNodes}}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
569 push @texts, $node->{$nodeValue} if ($node->{$nodeType}==NODE_TEXT);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
570 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
571
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
572 if (wantarray) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
573 return @texts;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
574 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
575 return join '',@texts;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
576 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
577 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
578 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
579
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
580 package BNFCompiler::DOM::Builder;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
581 use Common;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
582 our @ISA=qw(Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
583
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
584 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
585 DeclareProperty(Document => ACCESS_READ);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
586 DeclareProperty(currentNode => ACCESS_NONE);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
587 DeclareProperty(stackNodes => ACCESS_NONE);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
588 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
589
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
590 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
591 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
592
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
593 $this->{$Document} = new BNFCompiler::DOM::Node(nodeName => 'Document', nodeType => BNFCompiler::DOM::Node::NODE_ELEM);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
594 $this->{$currentNode} = $this->{$Document};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
595 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
596
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
597 sub NewContext {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
598 my ($this,$contextName) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
599
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
600 push @{$this->{$stackNodes}},$this->{$currentNode};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
601 $this->{$currentNode} = new BNFCompiler::DOM::Node(nodeName => $contextName, nodeType=> BNFCompiler::DOM::Node::NODE_ELEM);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
602
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
603 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
604 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
605 sub EndContext{
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
606 my ($this,$isNotEmpty) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
607
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
608 if ($isNotEmpty) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
609 my $child = $this->{$currentNode};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
610 $this->{$currentNode} = pop @{$this->{$stackNodes}};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
611 $this->{$currentNode}->insertNode($child);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
612 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
613 $this->{$currentNode} = pop @{$this->{$stackNodes}};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
614 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
615 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
616 sub Data {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
617 my ($this,$data) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
618 $this->{$currentNode}->insertNode(new BNFCompiler::DOM::Node(nodeType=> BNFCompiler::DOM::Node::NODE_TEXT, nodeValue => $data));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
619 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
620
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
621 package BNFCompiler::DOM;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
622
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
623 sub TransformDOMToHash {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
624 my ($root,$options) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
625
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
626 my %content;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
627
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
628 if (not $root->childNodes) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
629 die;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
630 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
631
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
632 foreach my $child (@{$root->childNodes}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
633 if ($child->nodeType == BNFCompiler::DOM::Node::NODE_ELEM) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
634 my @newValue;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
635 my $nodeName = $child->nodeName;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
636 next if $nodeName eq 'separator' and $options->{'skip_spaces'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
637 if ($child->isComplex) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
638 $newValue[0] = TransformDOMToHash($child,$options);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
639 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
640 @newValue = $child->text()
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
641 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
642
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
643 if ($options->{'use_arrays'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
644 push @{$content{$nodeName}},@newValue;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
645 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
646
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
647 if (exists $content{$nodeName}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
648 if (ref $content{$nodeName} eq 'ARRAY') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
649 push @{$content{$nodeName}}, @newValue;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
650 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
651 $content{$nodeName} = [$content{$nodeName},@newValue];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
652 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
653 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
654 $content{$nodeName} = $newValue[0] if scalar(@newValue) == 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
655 $content{$nodeName} = \@newValue if scalar(@newValue) > 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
656 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
657 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
658 next if $options->{'skip_text'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
659 push @{$content{'_text'}},$child->nodeValue();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
660 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
661 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
662
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
663 return \%content;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
664 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
665
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
666 1;