annotate Lib/IMPL/Text/Parser/Chunk.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents c529d386d80e
children 4f5a6a1bfb0e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
26
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
1 package IMPL::Text::Parser::Chunk;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
2 use strict;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
3 use warnings;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
4
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
5 use base qw(IMPL::Object);
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
6
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
7 use IMPL::Class::Property;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
8 use IMPL::Class::Property::Direct;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
9
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
10 use constant {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
11 OP_REGEXP => 1,
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
12 OP_STRING => 2,
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
13 OP_REFERENCE => 3,
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
14 OP_CHUNK => 4,
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
15 OP_THROW => 5,
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
16 OP_TRYCATCH => 6
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
17 };
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
18
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
19 BEGIN {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
20 public _direct property chunkName => prop_get;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
21 public _direct property opStream => prop_get;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
22 }
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
23
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
24 sub Regexp {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
25 my ($this,$rx) = @_;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
26
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
27 if (ref $rx eq 'Regexp') {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
28
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
29 } elsif (not ref $rx) {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
30 $rx = q/$rx/;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
31 } else {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
32 die new IMPL::InvalidArgumentException('A regular expression required');
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
33 }
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
34
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
35 push @{$this->{$opStream}}, [OP_REGEXP, $rx];
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
36 }
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
37
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
38 sub String {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
39 my ($this,$str) = @_;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
40
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
41 die new IMPL::InvalidArgumentException("A simple value is required") if ref $str;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
42
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
43 push @{$this->{$opStream}}, [OP_STRING, $str];
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
44 }
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
45
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
46 sub Reference {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
47 my ($this,$ref) = @_;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
48
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
49 die new IMPL::InvalidArgumentException("A simple value is reqiured") if ref $ref;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
50
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
51 push @{$this->{$opStream}}, [OP_REFERENCE, $ref];
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
52 }
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
53
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
54 sub Chunk {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
55 my ($this,$chunk) = @_;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
56
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
57 die new IMPL::InvalidArgumentException unless UNIVERSAL::isa($chunk,'IMPL::Text::Parser::Chunk');
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
58
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
59 push @{$this->{$opStream}}, [OP_CHUNK, $chunk];
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
60 }
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
61
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
62 sub Throw {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
63 my ($this, $msg) = @_;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
64
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
65 push @{$this->{$opStream}}, [OP_THROW, $msg];
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
66 }
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
67
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
68 sub TryCatch {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
69 my ($this,$chunkTry,$chunkCatch) = @_;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
70
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
71 push @{$this->{$opStream}}, [OP_TRYCATCH, $chunkTry, $chunkCatch];
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
72 }
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
73
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
74 sub compile {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
75 my ($this) = @_;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
76
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
77 my $text = '';
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
78
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
79 if ($this->{$opStream}) {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
80 foreach my $op (@{$this->{$opStream}}) {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
81 my $code = shift @$op;
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
82
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
83 if ($code == OP_REGEXP) {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
84
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
85 } elsif ($code == OP_STRING) {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
86
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
87 } elsif ($code == OP_REFERENCE) {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
88
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
89 } elsif ($code == OP_CHUNK) {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
90
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
91 } elsif ($code == OP_THROW) {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
92
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
93 } elsif ($code == OP_TRYCATCH) {
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
94
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
95 }
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
96 }
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
97 }
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
98 }
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
99
c529d386d80e Text services in progress
Sergey
parents:
diff changeset
100 1;